X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=7gui%2Ftest.icl;h=e2b46cbde3bb66f419110530bd7beabcf69fcf88;hb=e5305ee9d4290e1aa803a2e62a14f32e5cd29782;hp=6265465eba713dfcab74319e987e5d4d98bf5667;hpb=0a29dac39a56a8a23dee0b3fcf74ad6cd96f38dd;p=clean-tests.git diff --git a/7gui/test.icl b/7gui/test.icl index 6265465..e2b46cb 100644 --- a/7gui/test.icl +++ b/7gui/test.icl @@ -1,58 +1,112 @@ module test +import Graphics.Scalable.Internal.Types +import StdMisc import Data.Func import Data.Tuple import System.Time import iTasks -import iTasks.Extensions.DateTime import iTasks.UI.Editor.Common +import iTasks.Extensions.DateTime +import iTasks.Extensions.SVG.SVGEditor => qualified grid + +import qualified Data.Map as DM +import Data.Map.GenJSON -Start w = doTasks gui5 w +//Start w = doTasks (gui1 0) w +//Start w = doTasks gui2 w +//Start w = doTasks gui3 w +//Start w = doTasks (get currentTimestamp >>- \t->gui4 30 t) w +//Start w = doTasks gui5 w +Start w = doTasks gui6 w gui1 :: Int -> Task Int -gui1 c = viewInformation "Counter" [] c +gui1 c = viewInformation [] c <<@ Label "Counter" >>* [OnAction (Action "Count") (withValue (Just o gui1 o inc))] gui2 :: Task Real gui2 = withShared 42.0 \sh-> - updateSharedInformation "Celcius" [] sh - -|| updateSharedInformation "Fahrenheit" - [UpdateAs (\c->1.8*c+32.0) \_ f->(f-32.0)/1.8] sh + (updateSharedInformation [] sh <<@ Label "Celcius") + -|| updateSharedInformation + [UpdateSharedAs (\c->1.8*c+32.0) (\_ f->(f-32.0)/1.8) const] sh <<@ Label "Fahrenheit" +//This should be possible with just a custom editor... :: Flight = OneWay Date | Return (Date, Date) derive class iTask Flight - gui3 :: Task Flight gui3 = get currentDate - >>- \now->editChoice () [] ["one-way flight", "return flight"] (Just "one-way flight") + >>- \now->editChoice [] ["one-way flight", "return flight"] (Just "one-way flight") >&> \sh-> whileUnchanged sh \v->case fromJust v of "one-way flight" = withShared now \sh-> - updateSharedInformation () [] sh - -|| updateSharedInformation () [UpdateUsing toString const (gEditor{|*|} <<@ enabledAttr False)] sh + updateSharedInformation [] sh + -|| updateSharedInformation [UpdateSharedUsing toString const const (gEditor{|*|} <<@ enabledAttr False)] sh >>* [OnAction (Action "Book") $ ifValue (\_->True) $ return o OneWay] "return flight" - = updateInformation () [] now - -&&- updateInformation () [] now + = updateInformation [] now + -&&- updateInformation [] now >>* [OnAction (Action "Book") $ ifValue (uncurry (<)) $ return o Return] gui4 :: Timestamp Int -> Task Timestamp gui4 startTime duration = withShared duration \duration-> - viewSharedInformation "Elapsed time: " [ViewUsing toProgress progressBar] (currentTimestamp >*< duration) - -&&- viewSharedInformation () [ViewAs \now->on (-) toInt now startTime] currentTimestamp - -&&- updateSharedInformation "Duration: " [UpdateUsing id (const id) $ slider <<@ minAttr 0 <<@ maxAttr 3600] duration + (viewSharedInformation [ViewUsing toProgress progressBar] (currentTimestamp >*< duration) <<@ Label "Elapsed time: ") + -&&- viewSharedInformation [ViewAs \now->on (-) toInt now startTime] currentTimestamp + -&&- updateSharedInformation [UpdateSharedUsing id (const id) const $ slider <<@ minAttr 0 <<@ maxAttr 3600] duration <<@ Label "Duration: " >>* [OnAction (Action "Reset") $ always $ get (currentTimestamp >*< duration) >>- uncurry gui4] where toProgress (now, duration) = (Just $ toInt $ on (-) (toReal o toInt) now startTime / toReal duration * 100.0, Nothing) -gui5 = withShared [(0, "Emil", "Hans"), (1, "Mustermann", "Max"), (2, "Tisch", "Roman")] \data-> - enterInformation "Filter prefix" [] +:: Name = {name :: String, surname :: String} +name :: String String -> Name +name name surname = {name=name, surname=surname} +derive class iTask Name +instance toString Name where toString n = n.Name.name +++ ", " +++ n.surname + +gui5 :: Task (Int, Name) +gui5 = withShared ('DM'.fromList [(0, name "Emil" "Hans"), (1, name "Mustermann" "Max"), (2, name "Tisch" "Roman")]) \data-> + enterInformation [] <<@ Title "Filter prefix" >&> \v->whileUnchanged (mapRead (fromMaybe " ") v) \filter-> - tune ArrangeHorizontal - $ enterChoiceWithShared () [ChooseFromList (\(_, f, l)->f +++ ", " +++ l)] data - >&> \v->whileUnchanged v \selection->case selection of - Nothing = viewInformation "Nothing selected" [] () @? const NoValue - Just x = updateInformation () [] x + tune ArrangeHorizontal + $ enterChoiceWithShared [ChooseFromList (toString o snd)] (mapRead 'DM'.toList data) + >&> \sh->whileUnchanged sh \v->case v of + Nothing = return () @? const NoValue + Just x = updateInformation [UpdateAs snd (tuple o fst)] x + >^* [ OnAction (Action "new") $ always $ upd (\l->'DM'.put (inc $ maxList $ 'DM'.keys l) (name "-" "-") l) data + , OnAction (Action "update") $ withValue \(i, n)->Just $ upd ('DM'.put i n) data + , OnAction (Action "delete") $ withValue \(i, n)->Just $ upd ('DM'.del i) data + ] + +gui6 :: Task [(Span, Span, Span)] +gui6 = updateInformation + [UpdateUsing id (const id) (fromSVGEditor svged)] + [(px 5.0, px 5.0, px 5.0)] + +svged :: SVGEditor [(Span, Span, Span)] [(Span, Span, Span)] +svged = {initView=id, renderImage=renderImage, updModel= \m v->v} +where + renderImage _ images ts + # (_, images) = trace_stdout ("img: ", images) + = overlay + [(AtMiddleX, AtMiddleY)] + [(px 0.0, px 0.0)] + [img] + $ Host $ rect (px 1000.0) (px 1000.0) + <@< {fill=toSVGColor "white"} + where + img = collage [(x, y)\\(_, x, y)<-images] [circle r\\(r, _, _)<-images] + $ Host $ rect (px 100.0) (px 100.0) + <@< {fill=toSVGColor "white"} + <@< {onclick=clicker,local=False} + + clicker (x, y) m = [(px 5.0, x, y):m] + +import Debug.Trace, StdDebug +import iTasks.UI.JavaScript +derive gEq Span, LookupSpan, ImageTag +derive gText Span, LookupSpan, ImageTag, FontDef` +derive JSONEncode Span, LookupSpan, ImageTag +derive JSONDecode Span, LookupSpan, ImageTag +derive gEditor Span, LookupSpan, ImageTag, FontDef`