7gui/test.icl

   1 module test
   2
   3 import Graphics.Scalable.Internal.Types
   4 import StdMisc
   5 import Data.Func
   6 import Data.Tuple
   7 import System.Time
   8
   9 import iTasks
  10 import iTasks.UI.Editor.Common
  11 import iTasks.Extensions.DateTime
  12 import iTasks.Extensions.SVG.SVGEditor => qualified grid
  13
  14 import qualified Data.Map as DM
  15 import Data.Map.GenJSON
  16
  17 //Start w = doTasks (gui1 0) w
  18 //Start w = doTasks gui2 w
  19 //Start w = doTasks gui3 w
  20 //Start w = doTasks (get currentTimestamp >>- \t->gui4 30 t) w
  21 //Start w = doTasks gui5 w
  22 Start w = doTasks gui6 w
  23
  24 gui1 :: Int -> Task Int
  25 gui1 c = viewInformation [] c <<@ Label "Counter"
  26         >>* [OnAction (Action "Count") (withValue (Just o gui1 o inc))]
  27
  28 gui2 :: Task Real
  29 gui2 = withShared 42.0 \sh->
  30             (updateSharedInformation [] sh <<@ Label "Celcius")
  31         -|| updateSharedInformation
  32                 [UpdateSharedAs (\c->1.8*c+32.0) (\_ f->(f-32.0)/1.8) const] sh <<@ Label "Fahrenheit"
  33
  34 //This should be possible with just a custom editor...
  35 :: Flight
  36         = OneWay Date
  37         | Return (Date, Date)
  38 derive class iTask Flight
  39 gui3 :: Task Flight
  40 gui3 =         get currentDate
  41         >>- \now->editChoice [] ["one-way flight", "return flight"] (Just "one-way flight")
  42         >&> \sh-> whileUnchanged sh \v->case fromJust v of
  43                 "one-way flight" = withShared now \sh->
  44                             updateSharedInformation [] sh
  45                         -|| updateSharedInformation [UpdateSharedUsing toString const const (gEditor{|*|} <<@ enabledAttr False)] sh
  46                         >>* [OnAction (Action "Book") $ ifValue (\_->True) $ return o OneWay]
  47                 "return flight"
  48                         =    updateInformation [] now
  49                         -&&- updateInformation [] now
  50                         >>* [OnAction (Action "Book") $ ifValue (uncurry (<)) $ return o Return]
  51
  52 gui4 :: Timestamp Int -> Task Timestamp
  53 gui4 startTime duration = withShared duration \duration->
  54              (viewSharedInformation  [ViewUsing toProgress progressBar] (currentTimestamp >*< duration) <<@ Label "Elapsed time: ")
  55         -&&- viewSharedInformation   [ViewAs \now->on (-) toInt now startTime] currentTimestamp
  56         -&&- updateSharedInformation [UpdateSharedUsing id (const id) const $ slider <<@ minAttr 0 <<@ maxAttr 3600] duration <<@ Label "Duration: "
  57         >>* [OnAction (Action "Reset") $ always $ get (currentTimestamp >*< duration) >>- uncurry gui4]
  58 where
  59         toProgress (now, duration) =
  60                 (Just $ toInt $ on (-) (toReal o toInt) now startTime / toReal duration * 100.0, Nothing)
  61
  62 :: Name = {name :: String, surname :: String}
  63 name :: String String -> Name
  64 name name surname = {name=name, surname=surname}
  65 derive class iTask Name
  66 instance toString Name where toString n = n.Name.name +++ ", " +++ n.surname
  67
  68 gui5 :: Task (Int, Name)
  69 gui5 = withShared ('DM'.fromList [(0, name "Emil" "Hans"), (1, name "Mustermann" "Max"), (2, name "Tisch" "Roman")]) \data->
  70                 enterInformation [] <<@ Title "Filter prefix"
  71         >&> \v->whileUnchanged (mapRead (fromMaybe " ") v) \filter->
  72                          tune ArrangeHorizontal
  73                 $        enterChoiceWithShared [ChooseFromList (toString o snd)] (mapRead 'DM'.toList data)
  74                 >&> \sh->whileUnchanged sh \v->case v of
  75                                 Nothing = return () @? const NoValue
  76                                 Just x = updateInformation [UpdateAs snd (tuple o fst)] x
  77                 >^* [ OnAction (Action "new") $ always $ upd (\l->'DM'.put (inc $ maxList $ 'DM'.keys l) (name "-" "-") l) data
  78                     , OnAction (Action "update") $ withValue \(i, n)->Just $ upd ('DM'.put i n) data
  79                     , OnAction (Action "delete") $ withValue \(i, n)->Just $ upd ('DM'.del i) data
  80                     ]
  81
  82 gui6 :: Task [(Span, Span, Span)]
  83 gui6 = updateInformation
  84         [UpdateUsing id (const id) (fromSVGEditor svged)]
  85         [(px 5.0, px 5.0, px 5.0)]
  86
  87 svged :: SVGEditor [(Span, Span, Span)] [(Span, Span, Span)]
  88 svged = {initView=id, renderImage=renderImage, updModel= \m v->v}
  89 where
  90         renderImage _ images ts
  91                 # (_, images) = trace_stdout ("img: ", images)
  92                 = overlay
  93                         [(AtMiddleX, AtMiddleY)]
  94                         [(px 0.0, px 0.0)]
  95                         [img]
  96                         $ Host $ rect (px 1000.0) (px 1000.0)
  97                                 <@< {fill=toSVGColor "white"}
  98         where
  99                 img = collage [(x, y)\\(_, x, y)<-images] [circle r\\(r, _, _)<-images]
 100                         $ Host $ rect (px 100.0) (px 100.0)
 101                                 <@< {fill=toSVGColor "white"}
 102                                 <@< {onclick=clicker,local=False}
 103
 104         clicker (x, y) m = [(px 5.0, x, y):m]
 105
 106 import Debug.Trace, StdDebug
 107 import iTasks.UI.JavaScript
 108 derive gEq Span, LookupSpan, ImageTag
 109 derive gText Span, LookupSpan, ImageTag, FontDef`
 110 derive JSONEncode Span, LookupSpan, ImageTag
 111 derive JSONDecode Span, LookupSpan, ImageTag
 112 derive gEditor Span, LookupSpan, ImageTag, FontDef`