From 9b250e33701c0905600c8bd403c0d72fa76d64b8 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 28 Nov 2018 10:14:11 +0100 Subject: [PATCH] 10 --- TimeGraph.zip | Bin 0 -> 2349 bytes afp/a10/a10.icl | 33 +++++++++---- rank2/test.icl | 49 +++++++++++++++++++ timegraph/TimeGraph/TimeGraph.dcl | 31 ++++++++++++ timegraph/TimeGraph/TimeGraph.icl | 77 ++++++++++++++++++++++++++++++ 5 files changed, 182 insertions(+), 8 deletions(-) create mode 100644 TimeGraph.zip create mode 100644 rank2/test.icl create mode 100644 timegraph/TimeGraph/TimeGraph.dcl create mode 100644 timegraph/TimeGraph/TimeGraph.icl diff --git a/TimeGraph.zip b/TimeGraph.zip new file mode 100644 index 0000000000000000000000000000000000000000..63b86583b126ad1a03716bbcdffb339acf487fd4 GIT binary patch literal 2349 zcmZ`*2{aU38y?1_WM9K%!jye!kVFkKWEqCf60(ln$k?+aTUjzfmKgJ)k)>owWMs`) zLqf=)rV!$jMr50QzQ651|M%T{?tR~T&wHQeyyv{;(or6cR^!t7D$sxMb5J|X7qM! z?5k7ZdS2J13mD6mot`W+6!z+$5Ppzyw1ZuWksj{81f6~a5i1#wq)kUmfU?XCC2%(; zcnR7Up9{4-zFU@V4Z9tLwqf>{TY})}4f>TQb|~$TCks>3O`{~KqG_X&KMm$i+0AMv z8aaj8-eiMqb|84Srxi;;X?=jV;u`Hl)X@r|!e}hxxd_IV@y#qltla~kNKx&@sL*6biF<}6MfdF3)TwP%bX z_cC+BCM>_YRb|acr*B=_;ujed2G?E zKZq8TAfTtjs+8uUwz>FruV2=!D(2H2wf(}Rs=(VN`8d<~vzf=sDeTOI;9L+tmX3q|m60YpY8JBB=t|vV-s#H@~+oTBH z>!vPA!IGB+Ni6;rw&%e2d5dzEIeV0Y-C0*$snTyqVwI(v69JqJpN#H$X7qt4 zN~;rSmeAzvOr`gZss>!{F@utI+%WO}6(uP7R7XVXB*#`H#k&`kx*l3e7PpA?H_f`R z%&(J(WuSv7?`EcU^LjANMsC$Lp_h$c1m_n7oNf}}*m+k@>e&1S`pc5;+5RDW^ZCb^ zEUP2gRJIx6CCIOGZ`&((kGqHD2}}UMU+n*0?w)8&lclZiup)2dbP+xNe15uIoamjn z6F2I86v@cI=soVG`h-s)=j85NoJnV#2_d7L2OPfeOSkn zap2+^1dQjTOJ14h0N+XQ91IvW!%HgtMDhEY%fXX&1cZX*cqf<@XCMOWmaP-v+(eyE ziz9y35D9Hs9)ets+YIB5)P2cg$CZrJFM4KAHVe-A{0WK{Zx-_}B%!*wqTPMxS0s%e z_sLu`>C$t~1+A@$;1qm{c2~`HP@iuCQyFx+^#v*{(9q-_gx@R(bUuf8O^u}5i5r|} z)sjdONIPb=2tB_c5|bL*IfRZYlqd}MN`Ze?i%1jXnd(1|fMpIxJd_m$#c!Pc&xIP1nUEPPV9 z^)LA~Nc?u2_~bh(y>-J-o_6wu8ce35(9Fuh@9HD>3qkfxb%ejuJ;o||?Z|W;vswWNi>rvagybFyvM-P~AO(16*x7B4KUe4jUCY#GB z0}QY>bO$>5l&_`ny3kJTms{-;CTE0g;KsV|k^OMDvaM_D95y*zXdY*=caF3VqQxfa zA>;2@m2jM@sqkK+xr~@j#}| z4vBSFwK!;<{MF=ipq=dgzDe2{LcWiMTnyaHxsci6#=WDW}(a!cz7MkY}e&wG4&5i(4;kuZv6I}H z>@)55wU~gc5>= eval b +eval (Wait _) s = Ok s +eval (a :. b) s = eval a s >>= eval b eval (WhileContainerBelow _ action) s | s.craneOnQuay && not (isEmpty s.onQuay) || not s.craneOnQuay && not (isEmpty s.onShip) = eval (action :. whileContainerBelow action) s = pure s -Start = moveToShip :. moveDown +Start = loadShip +p1 = moveToShip :. moveDown + +//p2 = moveToShip :. wait :. lock // the required type error + +loadShip = + whileContainerBelow ( + moveDown:. + lock:. + moveUp:. + moveToShip:. + wait:. + moveDown:. + wait:. + unlock:. + moveUp:. + moveToQuay + ) diff --git a/rank2/test.icl b/rank2/test.icl new file mode 100644 index 0000000..da53852 --- /dev/null +++ b/rank2/test.icl @@ -0,0 +1,49 @@ +module test + +import StdEnv + +class arith v +where + lit :: a -> v a | toString a + plus :: (v a) (v a) -> v a | + a + +class rtrn v :: (v a) -> v (TaskValue a) + +:: Print a = P String +unPrint :: (Print a) -> String +unPrint (P a) = a + +:: Eval a = E a +unEval :: (Eval a) -> a +unEval (E a) = a + +:: TaskValue a = NoValue | Value a Bool + +instance arith Print +where + lit a = P (toString a) + plus (P a) (P b) = P (a +++ "+" +++ b) + +instance arith Eval +where + lit a = E a + plus (E a) (E b) = E (a + b) + +instance rtrn Print where rtrn (P a) = P ("Task (" +++ a +++ ")") +instance rtrn Eval where rtrn (E a) = E (Value a True) + +class default a :: a +instance default Int where default = 42 +instance default (TaskValue a) where default = NoValue + +listItem :: + (A.v: a -> v (TaskValue b) | rtrn, arith v) + -> (String, b) + | +, toString, default b & default a +listItem mtask = + ( unPrint (mtask default) + , default //unEval (mtask default) + ) + +Start :: (String, Int) +Start = listItem \i->rtrn (lit i) diff --git a/timegraph/TimeGraph/TimeGraph.dcl b/timegraph/TimeGraph/TimeGraph.dcl new file mode 100644 index 0000000..4313cb8 --- /dev/null +++ b/timegraph/TimeGraph/TimeGraph.dcl @@ -0,0 +1,31 @@ +definition module TimeGraph + +import iTasks.WF.Definition +import iTasks.UI.JS.Encoding +import Graphics.Scalable.Image + +:: TimeGraphOptions a + = { valueSpan :: a -> Span // turn value into rendering distance + , measures :: [TimeGraphMeasure a] // the measures that are drawn across the graph + , distance :: Span // the distance between two neighbouring values + , maxValue :: a // the maximum value that can be rendered visibly + , maxNoElts :: Int // the maximum number of elements that are rendered + } +:: TimeGraphMeasure a + = { base :: a // the value at which the measure is rendered + , label :: String // the label of the measure + , left :: Bool // if True, label is rendered at left of graph, otherwise at right of graph + , font :: FontDef // the font used to render this label + } + +/** time_graph options values: + is a task that renders @values in a graph using @options. + The number of values that are shown is controlled by @options.maxNoElts. + The dimensions of the graph are controlled by @options.distance (the width of each bar) and the application of + the function @options.valueSpan to the displayed value (the height of each bar). + The maximum value that can be displayed is controlled by @options.maxValue. + The @options.measures show labelled lines across the bars. The position of the label is controlled by the .left + field of the measure. The height is controlled by the .base field of the measure. Each label can have a different + font, defined by the .font field of the measure. +*/ +time_graph :: !(TimeGraphOptions a) ![a] -> Task [a] | JSEncode{|*|}, JSDecode{|*|}, iTask a diff --git a/timegraph/TimeGraph/TimeGraph.icl b/timegraph/TimeGraph/TimeGraph.icl new file mode 100644 index 0000000..95a1992 --- /dev/null +++ b/timegraph/TimeGraph/TimeGraph.icl @@ -0,0 +1,77 @@ +implementation module TimeGraph + +// An example of a task that uses SVG to render a list of values and measures + +from iTasks.WF.Definition import class iTask +import iTasks.Engine +import iTasks.WF.Tasks.Interaction +import iTasks.UI.Prompt +import Graphics.Scalable.Image +import iTasks.Extensions.SVG.SVGEditor +import StdEnum, StdList +from StdFunc import id, o, const + +// shorthand definitions for the used fonts in these examples +times = normalFontDef "Times New Roman" + +// shorthand definitions for the used colours in these examples +none = toSVGColor "none" +linecolour = toSVGColor "red" +backgroundcolour = toSVGColor "aliceblue" +barcolour = toSVGColor "steelblue" +barstrokecolour = backgroundcolour + +Start :: !*World -> *World +Start world + = doTasks (time_graph options ([1.0..5.0] ++ [4.5,3.5..0.5])) world +where + options = {TimeGraphOptions + | valueSpan = \v = px (50.0*v) + , measures = [ {TimeGraphMeasure + | base = 3.14 + , label = "low" + , left = True + , font = times 8.0 + } + , {TimeGraphMeasure + | base = 4.88 + , label = "high" + , left = False + , font = times 8.0 + } + ] + , distance = px 10.0 + , maxValue = 10.0 + , maxNoElts = 10 + } + +time_graph :: !(TimeGraphOptions a) ![a] -> Task [a] | JSEncode{|*|}, JSDecode{|*|}, iTask a +time_graph options values + = viewInformation "TimeGraph" [ViewUsing id (fromSVGEditor { initView = id + , renderImage = const (graph options) + , updView = \m _ = m + , updModel = \_ v = v + })] values + +graph :: !(TimeGraphOptions a) ![a] !*TagSource -> Image [a] +graph options=:{TimeGraphOptions | valueSpan,distance,measures,maxValue,maxNoElts} values tags + = beside (repeat AtBottom) [] Nothing [] + [ left_labels + , collage [(zero,height-diagram_height):[(zero,height-(valueSpan m.base)) \\ m <- measures]] + [diagram : [xline diagram_width <@< {stroke = linecolour} \\ m <- measures]] + (Host (rect diagram_width height <@< {fill = backgroundcolour} <@< {stroke = none})) + , right_labels + ] (Host (empty width height)) +where + left_measures = filter (\m = m.left) measures + right_measures = filter (\m = not m.left) measures + 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)) + 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)) + left_labels_width = maxSpan [textxspan m.font m.label \\ m <- left_measures] + right_labels_width = maxSpan [textxspan m.font m.label \\ m <- right_measures] + diagram = beside (repeat AtBottom) [] Nothing [] bars (Host (empty diagram_width height)) + bars = [rect distance (valueSpan v) <@< {fill = barcolour} <@< {stroke = barstrokecolour} \\ v <- take maxNoElts values] + width = left_labels_width + diagram_width + right_labels_width + diagram_width = distance *. maxNoElts + diagram_height = maxSpan (map valueSpan values) + height = valueSpan maxValue -- 2.20.1