old/timegraph/TimeGraph/TimeGraph.icl

   1 implementation module TimeGraph
   2
   3 //      An example of a task that uses SVG to render a list of values and measures
   4
   5 from   iTasks.WF.Definition import class iTask
   6 import iTasks.Engine
   7 import iTasks.WF.Tasks.Interaction
   8 import iTasks.UI.Prompt
   9 import Graphics.Scalable.Image
  10 import iTasks.Extensions.SVG.SVGEditor
  11 import StdEnum, StdList
  12 from   StdFunc import id, o, const
  13
  14 //      shorthand definitions for the used fonts in these examples
  15 times = normalFontDef "Times New Roman"
  16
  17 //      shorthand definitions for the used colours in these examples
  18 none             = toSVGColor "none"
  19 linecolour       = toSVGColor "red"
  20 backgroundcolour = toSVGColor "aliceblue"
  21 barcolour        = toSVGColor "steelblue"
  22 barstrokecolour  = backgroundcolour
  23
  24 Start :: !*World -> *World
  25 Start world
  26         = doTasks (time_graph options ([1.0..5.0] ++ [4.5,3.5..0.5])) world
  27 where
  28         options = {TimeGraphOptions
  29                   | valueSpan = \v = px (50.0*v)
  30                   , measures  = [ {TimeGraphMeasure
  31                                   | base  = 3.14
  32                                   , label = "low"
  33                                   , left  = True
  34                                   , font  = times 8.0
  35                                   }
  36                                 , {TimeGraphMeasure
  37                                   | base  = 4.88
  38                                   , label = "high"
  39                                   , left  = False
  40                                   , font  = times 8.0
  41                                   }
  42                                 ]
  43                   , distance  = px 10.0
  44                   , maxValue  = 10.0
  45                   , maxNoElts = 10
  46                   }
  47
  48 time_graph :: !(TimeGraphOptions a) ![a] -> Task [a] | JSEncode{|*|}, JSDecode{|*|}, iTask a
  49 time_graph options values
  50         = viewInformation "TimeGraph" [ViewUsing id (fromSVGEditor { initView    = id
  51                                                                    , renderImage = const (graph options)
  52                                                                    , updView     = \m _ = m
  53                                                                    , updModel    = \_ v = v
  54                                                                    })] values
  55
  56 graph :: !(TimeGraphOptions a) ![a] !*TagSource -> Image [a]
  57 graph options=:{TimeGraphOptions | valueSpan,distance,measures,maxValue,maxNoElts} values tags
  58         = beside (repeat AtBottom) [] Nothing []
  59                  [ left_labels
  60                  , collage [(zero,height-diagram_height):[(zero,height-(valueSpan m.base)) \\ m <- measures]]
  61                        [diagram : [xline diagram_width <@< {stroke = linecolour} \\ m <- measures]]
  62                        (Host (rect diagram_width height <@< {fill = backgroundcolour} <@< {stroke = none}))
  63                  , right_labels
  64                  ] (Host (empty width height))
  65 where
  66         left_measures      = filter (\m =     m.left) measures
  67         right_measures     = filter (\m = not m.left) measures
  68         left_labels        = collage [(zero,height-(valueSpan m.base)) \\ m <- left_measures]  [text m.font m.label \\ m <- left_measures]  (Host (empty left_labels_width  height))
  69         right_labels       = collage [(zero,height-(valueSpan m.base)) \\ m <- right_measures] [text m.font m.label \\ m <- right_measures] (Host (empty right_labels_width height))
  70         left_labels_width  = maxSpan [textxspan m.font m.label \\ m <- left_measures]
  71         right_labels_width = maxSpan [textxspan m.font m.label \\ m <- right_measures]
  72         diagram            = beside (repeat AtBottom) [] Nothing [] bars (Host (empty diagram_width height))
  73         bars               = [rect distance (valueSpan v) <@< {fill = barcolour} <@< {stroke = barstrokecolour} \\ v <- take maxNoElts values]
  74         width              = left_labels_width + diagram_width + right_labels_width
  75         diagram_width      = distance *. maxNoElts
  76         diagram_height     = maxSpan (map valueSpan values)
  77         height             = valueSpan maxValue