Commit 79a5ef07 authored by Reg Huijben's avatar Reg Huijben

Add start of controller task

parent c4db2efe
definition module controllerImage
import trackState
from Graphics.Scalable.Image import :: Image, :: Image`
myControllerImage :: State -> Image State
//myImage :: State -> Image [Tile]
implementation module controllerImage
import iTasks.Extensions.SVG.SVGEditor
import trackState
import Data.List
import StdEnv
import StdDebug
myControllerImage :: State -> Image State
myControllerImage state = margin (px 20.0, px 20.0)
(grid (Columns 9) (RowMajor, LeftToRight, TopToBottom) [] [] [] [] (createTiles state) NoHost)
strw = 6.0
full = 100.0
half = full/2.0
zero = px 0.0
activecol = "goldenrod"
inactivecol = "darkolivegreen"//"whitesmoke" // "lightgray"
myCoolTiles :: State -> [(Tile,Int)]
myCoolTiles s = (zipWith (\t i.(t,i)) s.tiles [0..])
createTiles :: State -> [Image State]
createTiles s = map createTile (myCoolTiles s)
createTile :: (Tile,Int) -> Image State
createTile (t,i) = overlay [(AtMiddleX,AtMiddleY),(AtMiddleX,AtMiddleY)] offs imgs NoHost where
offs = [(px 0.0, px 0.0): fst3 (unzip3 (filteredSwitchList (t, i)))]
imgs = [createTracksOfTile (t,i): snd3 (unzip3 (filteredSwitchList (t, i)))]
filteredSwitchList (t,i) = filter (\(_,_,active). active) (switchList (t,i))
switchList :: (Tile,Int) -> [(ImageOffset,Image State, Bool)]
switchList (t,i) = [
((px 0.0, px (half - strw)), (south t i), drawSouth t )
]
createTracksOfTile :: (Tile,Int) -> Image State
createTracksOfTile (t,i) = overlay [] offs imgs NoHost where
offs = [(px 0.0, px 0.0): fst3 (unzip3 (filteredTrackList (t, i)))]
imgs = [backgroundSquare: snd3 (unzip3 (filteredTrackList (t, i)))]
filteredTrackList (t,i) = filter (\(_,_,active). active) (trackList (t,i))
trackList :: (Tile,Int) -> [(ImageOffset,Image State, Bool)]
trackList (t,i) = [
( (px half, px 0.0) , (ns t i), t.ns ),
( (zero, px half), (ew t i), t.ew),
( (px 0.0, px 0.0), (ne t i), t.ne),
( (px half, px 0.0), (nw t i), t.nw),
((px 0.0, px half),(sw t i), t.sw ),
((px half, px half), (se t i),t.se)
]
ne tile i = line (px (half)) (px (0.0-half))
<@< { stroke = toSVGColor (if tile.ne activecol inactivecol)}
<@< { strokewidth = (px (strw))}
<@< { mask = (rect (px half) (px half) <@< {fill = toSVGColor "white"})}
nw tile i = line (px (full)) (px full)
<@< { stroke = toSVGColor (if tile.nw activecol inactivecol)}
<@< { strokewidth = (px (strw))}
<@< { mask = (rect (px (half + (strw))) (px (half + (strw))) <@< {fill = toSVGColor "white"})}
sw tile i = line (px (half)) (px (half))
<@< { strokewidth = (px (strw))}
<@< { stroke = toSVGColor (if tile.sw activecol inactivecol)}
se tile i = line (px half) (px (0.0 - half))
<@< { stroke = toSVGColor (if tile.se activecol inactivecol)}
<@< { strokewidth = (px (toReal (strw)))}
<@< { mask = (rect (px half) (px half) <@< {fill = toSVGColor "white"})}
ns tile i = line (px 0.0) (px full)
<@< { stroke = toSVGColor (if tile.ns activecol inactivecol)}
<@< { strokewidth = (px (strw))}
ew tile i = line (px full) (px 0.0)
<@< { stroke = toSVGColor (if tile.ew activecol inactivecol)}
<@< { strokewidth = (px (strw))}
south tile i = circle (px (strw * 2.0))
// <@< { onclick = \span s.{s & tiles = (trace "f" updateAt i {tile & south = Middle} s.tiles ) } , local = False}
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & south = Middle} s.tiles ) } , local = False}
<@< { opacity = if (drawSouth tile) (1.0) (0.0) }
<@< { strokewidth = if (drawSouth tile) (px 1.0) (px 0.0) }
<@< { fill = case tile.south of
Blocked -> toSVGColor "red"
_ -> toSVGColor "yellow" }
drawSouth :: Tile -> Bool
drawSouth t = (length (filter id [t.ns,t.se,t.sw])) >= 2
//case tile.south of
// Blocked -> toSVGColor "red"
// _ -> toSVGColor "yellow" }
backgroundSquare = square (px full)
<@< { strokewidth = (px (strw /4.0))}
<@< { stroke = toSVGColor "dimgray"}
<@< { fill = toSVGColor "forestgreen"}
font = normalFontDef "Ariel" height
height = 40.0
......@@ -3,5 +3,5 @@ definition module designImage
import trackState
from Graphics.Scalable.Image import :: Image, :: Image`
myImage :: State -> Image State
myDesignImage :: State -> Image State
//myImage :: State -> Image [Tile]
......@@ -5,8 +5,8 @@ import trackState
import Data.List
import StdEnv
myImage :: State -> Image State
myImage state = margin (px 20.0, px 20.0)
myDesignImage :: State -> Image State
myDesignImage state = margin (px 20.0, px 20.0)
(grid (Columns 9) (RowMajor, LeftToRight, TopToBottom) [] [] [] [] (createTiles state) NoHost)
strw = 6.0
......@@ -71,14 +71,6 @@ sw tile i = line (px (half)) (px (half))
<@< { stroke = toSVGColor (if tile.sw activecol inactivecol)}
swOLD tile i = line (px (full)) (px (full))
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & sw = not tile.sw} s.tiles ) } , local = False}
<@< { stroke = toSVGColor (if tile.sw activecol inactivecol)}
<@< { strokewidth = (px (strw))}
<@< { mask = (rect (px half) (px half) <@< {fill = toSVGColor "white"})}
se tile i = line (px half) (px (0.0 - half))
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & se = not tile.se} s.tiles ) } , local = False}
<@< { stroke = toSVGColor (if tile.se activecol inactivecol)}
......
......@@ -4,11 +4,13 @@ import iTasks
//import StdDebug
import designImage
import controllerImage
from iTasks.Extensions.SVG.SVGEditor import fromSVGEditor, :: SVGEditor {..}
from Graphics.Scalable.Types import :: TagSource, :: TagRef, :: ImageTag
derive class iTask State
derive class iTask Tile
derive class iTask RailroadSwitch
:: LCSMWorkflowCollection =
{
......@@ -27,7 +29,7 @@ instance Startable LCSMWorkflowCollection
state :: SimpleSDSLens State
state = sharedStore "sharedState" {tiles = (take (5*9) (repeat tl)) }
tl = {ne = False, nw = False, se = False, sw = False, ew = False, ns = False}
tl = {ne = False, nw = False, se = False, sw = False, ew = False, ns = False, north = Blocked, south = Blocked, west = Blocked, east = Blocked}
:: LCSMUser = {name :: String, roles :: [String] }
......@@ -58,9 +60,23 @@ setup :: [Workflow] -> LCSMWorkflowCollection
setup w = { LCSMWorkflowCollection|workflows = w }
//designTask = viewInformation [] "Designer Task"
controlTask = viewInformation [] "Controller Task"
//controlTask = viewInformation [] "Controller Task"
driverTask = viewInformation [] "Driver Task"
controlTask =
updateSharedInformation
[UpdateSharedUsing
id//(\s -> s.tiles)//id
//(\m v. {m & tiles = v})//(\m v-> v.tiles)//id
(\m v.v)
(\s v.Just s)
(fromSVGEditor
{ initView = id//(\s -> s.tiles)//id
, renderImage = \m v ts.myControllerImage m
, updModel = \m v.v//{m&tiles = v}//\m v.v
})
] state
designTask =
updateSharedInformation
[UpdateSharedUsing
......@@ -70,7 +86,7 @@ designTask =
(\s v.Just s)
(fromSVGEditor
{ initView = id//(\s -> s.tiles)//id
, renderImage = \m v ts.myImage m
, renderImage = \m v ts.myDesignImage m
, updModel = \m v.v//{m&tiles = v}//\m v.v
})
] state
......
definition module trackState
:: RailroadSwitch = Left | Middle | Right | Blocked
:: Tile =
{ ne :: Bool
......@@ -7,7 +8,11 @@ definition module trackState
, se :: Bool
, sw :: Bool
, ns :: Bool
, ew :: Bool
, ew :: Bool
, north :: RailroadSwitch
, east :: RailroadSwitch
, south :: RailroadSwitch
, west :: RailroadSwitch
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment