diff options
| -rw-r--r-- | assignment-13/uFPL.dcl | 8 | ||||
| -rw-r--r-- | assignment-13/uFPL.icl | 32 | ||||
| -rw-r--r-- | assignment-13/uFPL.prj.default | 2 | ||||
| -rw-r--r-- | assignment-13/uFPL/Sim.icl | 27 |
4 files changed, 46 insertions, 23 deletions
diff --git a/assignment-13/uFPL.dcl b/assignment-13/uFPL.dcl index 55c9c66..f9b3ed6 100644 --- a/assignment-13/uFPL.dcl +++ b/assignment-13/uFPL.dcl @@ -58,7 +58,7 @@ instance Expr Char | E.rwa rwb rwc: EIf (Expr Bool rwa) (Expr t rwb) (Expr t rwc) lit :: (t -> Expr t RO) -(?) infix 4 :: (Expr Bool rwa) (Expr t rwb, Expr t rwc) -> Expr t RO +(?) infix 5 :: (Expr Bool rwa) (Expr t rwb, Expr t rwc) -> Expr t RO (==.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, == t (<.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, < t @@ -73,8 +73,10 @@ lit :: (t -> Expr t RO) | (?&) infixr 3 Trigger Trigger | (?|) infixr 4 Trigger Trigger +pressed :: (Expr Bool RO) -> Trigger + :: Rule - = E.t rw: (<#) infix 3 (Expr t RW) (Expr t rw) & Expr t + = E.t rw: (<#) infix 4 (Expr t RW) (Expr t rw) & Expr t | E.rw: When (Expr Bool rw) [Rule] | (>>>) infixr 2 Trigger [Rule] | E.rwa rwb: SetCursor (Expr Int rwa, Expr Int rwb) @@ -84,7 +86,7 @@ lit :: (t -> Expr t RO) class gen f t :: f -> t -class (:.) infixr 2 r :: Rule r -> [Rule] +class (:.) infixr 3 r :: Rule r -> [Rule] instance :. Rule instance :. [Rule] diff --git a/assignment-13/uFPL.icl b/assignment-13/uFPL.icl index 129df92..234d2cd 100644 --- a/assignment-13/uFPL.icl +++ b/assignment-13/uFPL.icl @@ -98,7 +98,7 @@ instance Expr Char where litExpr c = CEChar c lit :: (t -> Expr t RO) lit = ELit -(?) infix 4 :: (Expr Bool rwa) (Expr t rwb, Expr t rwc) -> Expr t RO +(?) infix 5 :: (Expr Bool rwa) (Expr t rwb, Expr t rwc) -> Expr t RO (?) b (t,e) = EIf b t e (==.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, == t @@ -116,6 +116,9 @@ lit = ELit (||.) infixr 4 :: (Expr Bool rwa) (Expr Bool rwb) -> Expr Bool RO (||.) a b = EOr bm a b +pressed :: (Expr Bool RO) -> Trigger +pressed shr = shr ?= true + instance :. Rule where (:.) a b = [a,b] instance :. [Rule] where (:.) r rs = [r:rs] @@ -275,10 +278,10 @@ where example_score :: [NamedRule] example_score = - "a" :=: b0 ?= true >>> [scorea <# scorea +. lit 1] - ||| "b" :=: b1 ?= true >>> [scoreb <# scoreb +. lit 1] - ||| "r" :=: b2 ?= true >>> [scorea <# lit 0, scoreb <# lit 0] - ||| "print" :=: Change scorea ?| Change scoreb >>> + "a" :=: pressed b0 >>> [scorea <# scorea +. lit 1] + ||| "b" :=: pressed b1 >>> [scoreb <# scoreb +. lit 1] + ||| "r" :=: pressed b2 >>> [scorea <# lit 0, scoreb <# lit 0] + ||| "print" :=: (Change scorea ?| Change scoreb) >>> SetCursor (lit 0, lit 0) :. Print scorea :. Print (lit '-') :. @@ -290,20 +293,25 @@ where example_countdown :: [NamedRule] example_countdown = "time" :=: - When (millis -. DELAY >. counter) ( + (Change millis >>> [When (millis -. DELAY >. counter) ( counter <# counter +. DELAY :. - seconds <# seconds -. lit 1 :. + seconds <# running ? (seconds -. lit 1, seconds) :. SetCursor (lit 0, lit 0) :. Print minutes :. Print (lit ':') :. Print seconds - ) :. - When (seconds ==. lit 0) (seconds <# lit 60 :. minutes <# minutes -. lit 1) - ||| "status" :=: - When (seconds ==. lit 60 &&. minutes ==. lit 0) [running <# false] + )]) :. + When (seconds ==. lit 0 &&. minutes >. lit 0) (seconds <# lit 60 :. minutes <# minutes -. lit 1) :. + When (seconds <. lit 0) [seconds <# lit 0] :. + When (minutes <. lit 0) [minutes <# lit 0] :. + When (seconds ==. lit 0 &&. minutes ==. lit 0) [running <# false] + ||| "setsec" :=: pressed b0 >>> [seconds <# seconds +. lit 1] + ||| "setmin" :=: pressed b1 >>> [minutes <# minutes +. lit 1] + ||| "on_off" :=: pressed b2 >>> [running <# running ? (false, true)] + ||| "reset" :=: pressed b3 >>> [seconds <# lit 0, minutes <# lit 0] where running = rwBool "running" False minutes = rwUInt "minutes" 0 seconds = rwUInt "seconds" 0 - counter = rwULong "counter" 1000 // If set to 0, this will overflow on first iteration + counter = rwULong "counter" 0 // If set to 0, this will overflow on first iteration DELAY = lit 1000 diff --git a/assignment-13/uFPL.prj.default b/assignment-13/uFPL.prj.default index 4bd7872..27290da 100644 --- a/assignment-13/uFPL.prj.default +++ b/assignment-13/uFPL.prj.default @@ -7,7 +7,7 @@ Global CheckStacks: False CheckIndexes: True Application - HeapSize: 167772160 + HeapSize: 1677721600 StackSize: 1048576 ExtraMemory: 81920 IntialHeapSize: 204800 diff --git a/assignment-13/uFPL/Sim.icl b/assignment-13/uFPL/Sim.icl index 0f232fc..7556867 100644 --- a/assignment-13/uFPL/Sim.icl +++ b/assignment-13/uFPL/Sim.icl @@ -288,10 +288,13 @@ where set (unlift (allShares rs)) ishares sim = - (updateSharedInformation (Title "Rules") [] irules - -&&- updateSharedInformation (Title "Shares") [] ishares + (updateSharedInformation (Title "Rules") + [UpdateUsing id (const id) (listEditor (Just $ const Nothing) True False Nothing gEditor{|*|})] irules + -&&- + updateSharedInformation (Title "Shares") + [UpdateUsing id (const id) (listEditor (Just $ const Nothing) True False Nothing gEditor{|*|})] ishares ) -&&- - (show -&&- check) + (check -&&- show) <<@ ArrangeHorizontal newShares :: [INamedRule] IShares -> Task IState @@ -356,14 +359,24 @@ where ifOk _ _ = Nothing buttonActions :: IShares -> [TaskCont String (Task String)] - buttonActions shrs = - [action ("Toggle B" <+ i) $ press i \\ i <- [0..5] | any ((==) ("b" <+ i) o isharedName) shrs] + buttonActions shrs = flatten + [ [ action ("Toggle B" <+ i) $ toggle i + , action ("Press B" <+ i) $ press i + ] \\ i <- [0..5] | any ((==) ("b" <+ i) o isharedName) shrs] where - press :: Int -> Task IState - press i = get istate >>= lift >>= \st -> case st of + toggle :: Int -> Task IState + toggle i = get istate >>= lift >>= \st -> case st of (st :: State) -> set (unlift {st & vars='M'.alter upd ("b" <+ i) st.vars}) istate with upd (Just s=:{val=v :: Bool}) = Just {s & val=dynamic not v, dirty=s.subscriptions} + press :: Int -> Task IState + press i = change True >>| step >>| change False + with + change v = get istate >>= lift >>= \st -> case st of + (st :: State) -> set (unlift {st & vars='M'.alter (upd v) ("b" <+ i) st.vars}) istate + + upd v (Just s) = Just {s & val=dynamic v, dirty=s.subscriptions} + millisActions :: IShares -> [TaskCont String (Task String)] millisActions shrs | any ((==) "millis" o isharedName) shrs = |