diff options
author | Camil Staps | 2018-01-07 10:51:38 +0100 |
---|---|---|
committer | Camil Staps | 2018-01-07 10:51:38 +0100 |
commit | 2043a55c410a0332bd9453e01c28f0a6a8327ddd (patch) | |
tree | 77f6a5bec730ee7582da0ac5a00dba4a2a30040f /assignment-13/uFPL | |
parent | Layouting (diff) |
Generate code from iTasks
Diffstat (limited to 'assignment-13/uFPL')
-rw-r--r-- | assignment-13/uFPL/Sim.icl | 13 |
1 files changed, 11 insertions, 2 deletions
diff --git a/assignment-13/uFPL/Sim.icl b/assignment-13/uFPL/Sim.icl index 35f0465..5fccd8e 100644 --- a/assignment-13/uFPL/Sim.icl +++ b/assignment-13/uFPL/Sim.icl @@ -19,6 +19,7 @@ import iTasks.UI.Layout.Default import uFPL import uFPL.Bootstrap import uFPL.C +import uFPL.Util derive class iTask UFPLException instance toString UFPLException @@ -334,6 +335,7 @@ where show :: Task IState show = viewSharedInformation (Title "State") [viewAsLists] istate + <<@ ApplyLayout (setUIAttributes $ minWidthAttr $ ExactBound 400) where viewAsLists = ViewUsing tolists $ container4 listView listView listView (textView <<@ styleAttr "font-family:monospace;") with @@ -365,11 +367,15 @@ where >>* buttonActions shrs ++ millisActions shrs ++ - [action "Step" $ step]) + [ action "Step" $ step + , OnAction (Action "Generate code") $ ifOk $ get irules >>= lift >>= \rs -> case rs of + (rs :: [NamedRule]) -> viewInformation (Title "Generated code") + [ViewUsing id (textArea <<@ sizeAttr (ExactSize 500) (ExactSize 600) <<@ styleAttr "font-size:11px;")] + (printToString (genp rs)) >>| check + ]) <<@ ApplyLayout (sequenceLayouts finalizeStep (layoutSubUIs (SelectByType UIButtonBar) arrangeVertical)) - <<@ ApplyLayout (setUIAttributes (widthAttr (ExactSize 400))) <<@ ApplyLayout (layoutSubUIs (SelectOR (SelectByPath []) (SelectByPath [0])) $ setUIAttributes (heightAttr WrapSize)) ) where @@ -380,6 +386,9 @@ where ifOk t (Value "OK" _) = Just t ifOk _ _ = Nothing + genp :: (a -> CProg) | gen a CProg + genp = gen + buttonActions :: IShares -> [TaskCont String (Task String)] buttonActions shrs = flatten [ [ action ("Toggle B" <+ i) $ toggle i |