X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=7gui%2Ftest.icl;h=e2b46cbde3bb66f419110530bd7beabcf69fcf88;hb=HEAD;hp=b76ee5754c896ef2982c2cdc81ed78787e480715;hpb=4334ca7b15eb33a8106a0085297c579130a0a64b;p=clean-tests.git diff --git a/7gui/test.icl b/7gui/test.icl deleted file mode 100644 index b76ee57..0000000 --- a/7gui/test.icl +++ /dev/null @@ -1,99 +0,0 @@ -module test - -import StdMisc -import Data.Func -import Data.Tuple -import System.Time - -import iTasks -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 (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 - >>* [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 - -//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") - >&> \sh-> whileUnchanged sh \v->case fromJust v of - "one-way flight" = withShared now \sh-> - updateSharedInformation () [] sh - -|| updateSharedInformation () [UpdateUsing toString const (gEditor{|*|} <<@ enabledAttr False)] sh - >>* [OnAction (Action "Book") $ ifValue (\_->True) $ return o OneWay] - "return flight" - = 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 - >>* [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) - -:: 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 "Filter prefix" [] - >&> \v->whileUnchanged (mapRead (fromMaybe " ") v) \filter-> - 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 [(Real, Real, Real)] -gui6 = updateInformation () - [UpdateUsing id (const id) (fromSVGEditor svged)] - [(5.0, 5.0, 5.0)] - -svged :: SVGEditor [(Real, Real, Real)] [(Real, Real, Real)] -svged = {initView=id, renderImage=renderImage, updModel=const id} -where - renderImage _ images ts - # (_, images) = trace_stdout ("img: ", images) - = collage [(px x, px y)\\(_, x, y)<-images] [circle (px r)\\(r, _, _)<-images] - $ Host $ rect (px 100.0) (px 100.0) - <@< {fill=toSVGColor "white"} - <@< {onclick=clicker,local=False} - - clicker m = jsTrace "click" [(5.0, 10.0, 10.0):m] - -import Debug.Trace, StdDebug -import iTasks.UI.JavaScript