1 implementation module TimeGraph
3 // An example of a task that uses SVG to render a list of values and measures
5 from iTasks.WF.Definition import class iTask
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
14 // shorthand definitions for the used fonts in these examples
15 times = normalFontDef "Times New Roman"
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
24 Start :: !*World -> *World
26 = doTasks (time_graph options ([1.0..5.0] ++ [4.5,3.5..0.5])) world
28 options = {TimeGraphOptions
29 | valueSpan = \v = px (50.0*v)
30 , measures = [ {TimeGraphMeasure
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)
56 graph :: !(TimeGraphOptions a) ![a] !*TagSource -> Image [a]
57 graph options=:{TimeGraphOptions | valueSpan,distance,measures,maxValue,maxNoElts} values tags
58 = beside (repeat AtBottom) [] Nothing []
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}))
64 ] (Host (empty width height))
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