Commit e4ad99c2 authored by Reg Huijben's avatar Reg Huijben

Added driver view, somehow

parent 9ec9f897
......@@ -212,7 +212,7 @@ nextDirE tile = case tile.east of
// Right = Blocked
drawSouth :: Tile -> Bool
drawSouth t = (length (filter id [t.ns,t.se,t.sw])) >= 2
drawSouth t = (length (filter id [t.ns,t.se,t.sw])) >= 2
drawNorth :: Tile -> Bool
drawNorth t = (length (filter id [t.ns,t.ne,t.nw])) >= 2
......
definition module driverImage
import trackState
from Graphics.Scalable.Image import :: Image, :: Image`
myDriverImage :: State -> Image State
//myImage :: State -> Image [Tile]
implementation module driverImage
import iTasks.Extensions.SVG.SVGEditor
import trackState
import Data.List
import StdEnv
import StdDebug
import iTasks.UI.JavaScript
instance mod Int where
(mod) a b = a - b * (a/b)
myDriverImage :: State -> Image State
myDriverImage 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
quarter = half/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 createTileWithTrains (myCoolTiles s)
createTileWithTrains :: (Tile,Int) -> Image State
createTileWithTrains (t,i) = overlay all offs imgs NoHost where
all = [(AtLeft,AtTop): fst4 (unzip4 (filteredTrainList (t, i)))]
offs = [(zero, zero): snd4 (unzip4 (filteredTrainList (t, i)))]
imgs = [createTile (t,i): thd4 (unzip4 (filteredTrainList (t, i)))]
// ^^^^ first draw background ^^^ then draw the switches
createTile :: (Tile,Int) -> Image State
//createTile (t,i) = overlay [(AtMiddleX,AtMiddleY),(AtMiddleX,AtMiddleY)] offs imgs NoHost where
createTile (t,i) = overlay all offs imgs NoHost where
all = [(AtLeft,AtTop): fst4 (unzip4 (filteredSwitchList (t, i)))]
offs = [(zero, zero): snd4 (unzip4 (filteredSwitchList (t, i)))]
imgs = [createTracksOfTile (t,i): thd4 (unzip4 (filteredSwitchList (t, i)))]
// ^^^^ first draw background ^^^ then draw the switches
// welp
fst4 :: (a, b, c,d) -> a
fst4 (a,_,_,_) = a
snd4 :: (a, b, c,d) -> b
snd4 (_,b,_,_) = b
thd4 :: (a, b, c,d) -> c
thd4 (_,_,c,_) = c
:: Direction = North | East | South | West
instance toString Direction where
toString d = case d of
North -> "Nort"
East -> "East"
South -> "South"
West -> "West"
instance toString (Maybe Direction) where
toString d = case d of
Nothing -> "No direction"
Just d -> toString d
trainSize = px 16.0
filteredTrainList (t,i) = filter (\(_,_,_,active). active) (trainList (t,i))
trainList :: (Tile, Int) -> [(XYAlign,ImageOffset,Image State, Bool)]
trainList (t,i) = [
((AtMiddleX,AtTop), (zero, zero), (trainImage (t,i) North), t.tnorth),
((AtRight,AtMiddleY), (zero, zero), (trainImage (t,i) East), t.teast),
((AtMiddleX,AtBottom), (zero, zero), (trainImage (t,i) South), t.tsouth),
((AtLeft,AtMiddleY), (zero, zero), (trainImage (t,i) West), t.twest)
]
opDir d = case d of
North -> South
East -> West
South -> North
West -> East
// Hopefully not wrong on borders anymore
neighbourTileInd :: Int Direction -> Maybe Int
neighbourTileInd i d = case d of
North -> if ((i-9) >= 0) (Just (i-9)) Nothing
East -> if ((i mod 9) < 8) (Just (i+1)) Nothing
South -> if (i+9 < 5*9) (Just (i+9)) Nothing
West -> if (i mod 9 > 0) (Just (i-1)) Nothing
f :: Int -> Int
f a= a
trainImage :: (Tile, Int) Direction -> Image State
trainImage (t,i) dir = square trainSize <@<
{ onclick = \span s.
//jsTrace (pathToTileGoesTo (s.tiles !! (neighbourTileInd i dir)) (opDir dir))
{ s & tiles = // we update the tile we leave, and the tile we arrive in
case neighbourTileInd i dir of
Nothing -> s.tiles // we cannot move on borders
Just ni -> // we can move to tile ni
let nbTile = (s.tiles !! ni) in // nbTile is the neighbour tile, index ni in s.tiles
// check for trains!!!!
case pathToTileGoesTo nbTile (opDir dir) of // check where we would end up on ni
Just North -> if (nbTile.tnorth) (s.tiles) // train check
(
updateAt i (setTrain t dir False) // remove our train on i
(updateAt ni {nbTile & tnorth = True} s.tiles) // we add a train on ni
)
Just East -> if (nbTile.teast) (s.tiles) // train check
(
updateAt i (setTrain t dir False) // remove our train on i
(updateAt ni {nbTile & teast = True} s.tiles) // we add a train on ni
)
Just South -> if (nbTile.tsouth) (s.tiles)
(
updateAt i (setTrain t dir False) // remove our train on i
(updateAt ni {nbTile & tsouth = True} s.tiles) // we add a train on ni
)
Just West -> if (nbTile.twest) (s.tiles)
(
updateAt i (setTrain t dir False) // remove our train on i
(updateAt ni {nbTile & twest = True} s.tiles) // we add a train on ni
)
/*{t & tsouth = False}*/
//East ->
_ -> s.tiles // we do nothing
//updateAt ni {s.tiles !! ni & t opDir dir}
//s.tiles // TODO TODO TODO
// check if we move the train, is there an open track?
//updateAt i {tile & north = nextDirN tile} s.tiles
} , local = False
}
//where nbTile = s.tiles !! ni
setTrain t dir b = case dir of
North -> {t & tnorth = b}
East -> {t & teast = b}
South -> {t & tsouth = b}
West -> {t & twest = b}
// if we enter the tile, where on the tile would we end up?, this does not take other trains in account!
pathToTileGoesTo :: Tile Direction -> Maybe Direction
pathToTileGoesTo t fromDir = case fromDir of
North -> case t.north of
Left -> Just East
Middle -> Just South
Right -> Just West
Blocked ->
if (length (opts t fromDir) == 1)
( Just (hd (opts t fromDir)) )
(Nothing)
East -> case t.east of
Left -> Just South
Middle -> Just West
Right -> Just North
Blocked ->
if (length (opts t fromDir) == 1)
( Just (hd (opts t fromDir)) )
(Nothing)
South -> case t.south of
Left -> Just West
Middle -> Just North
Right -> Just East
Blocked ->
if (length (opts t fromDir) == 1)
( Just (hd (opts t fromDir)) )
(Nothing)
West -> case t.west of
Left -> Just North
Middle -> Just East
Right -> Just South
Blocked ->
if (length (opts t fromDir) == 1)
( Just (hd (opts t fromDir)) )
(Nothing)
//_ -> Nothing
//(length (filter id [t.ns,t.ne,t.nw])) >= 2
filteredSwitchList (t,i) = filter (\(_,_,_,active). active) (switchList (t,i))
switchList :: (Tile,Int) -> [(XYAlign,ImageOffset,Image State, Bool)]
switchList (t,i) = [
((AtLeft,AtBottom), (px quarter, zero), switchIndicatorLine False, drawSouth t && drawL t.south),
((AtRight,AtBottom), (px (0.0-quarter),zero), switchIndicatorLine True, drawSouth t && drawR t.south),
((AtMiddleX,AtBottom), (zero, zero), switchIndicatorLine2 False, drawSouth t && drawM t.south),
((AtRight,AtTop), (px (0.0-quarter), zero), switchIndicatorLine False, drawNorth t && drawL t.north),
((AtLeft,AtTop), (px quarter, zero), switchIndicatorLine True, drawNorth t && drawR t.north),
((AtMiddleX,AtTop), (zero, zero), switchIndicatorLine2 False, drawNorth t && drawM t.north),
((AtRight,AtBottom), (zero, px (0.0-quarter)), switchIndicatorLine True, drawEast t && drawL t.east),
((AtRight,AtTop), (zero, px quarter), switchIndicatorLine False, drawEast t && drawR t.east),
((AtRight,AtMiddleY), (zero, zero), switchIndicatorLine2 True, drawEast t && drawM t.east),
((AtLeft,AtTop), (zero, px quarter), switchIndicatorLine True, drawWest t && drawL t.west),
((AtLeft,AtBottom), (zero, px (0.0-quarter)), switchIndicatorLine False, drawWest t && drawR t.west),
((AtLeft,AtMiddleY), (zero, zero), switchIndicatorLine2 True, drawWest t && drawM t.west)
//((AtMiddleX,AtTop), (zero, zero), north t i, drawNorth t),
//((AtRight,AtMiddleY), (zero, zero), east t i, drawEast t),
//((AtMiddleX,AtBottom), (zero, zero), south t i, drawSouth t),
//((AtLeft,AtMiddleY), (zero, zero), west t i, drawWest t)//,
// ((AtLeft, AtTop), (px 0.0, px 0.0), empty (px full) (px full) , True)
//((px 0.0, px (half - strw)), (south t i), drawWest t )
]
drawM dir = case dir of
Middle -> True
_ -> False
drawL dir = case dir of
Left -> True
_ -> False
drawR dir = case dir of
Right -> True
_ -> False
cyanStroke = { stroke = toSVGColor "cyan"}
switchStrokeWidth = { strokewidth = px (strw/2.0)}
switchIndicatorLine2 hor = if hor ln2 ln where
ln = line zero lnWidth
<@< cyanStroke
<@< switchStrokeWidth
ln2 = line lnWidth zero
<@< cyanStroke
<@< switchStrokeWidth
lnWidth = px (sqrt ((quarter^2.0)*2.0))
switchIndicatorLine flp = if flp (flipx ln) ln where
ln = line lnWidth lnWidth
<@< cyanStroke
<@< switchStrokeWidth
lnWidth = px quarter
createTracksOfTile :: (Tile,Int) -> Image State
createTracksOfTile (t,i) = overlay [] offs imgs NoHost where
offs = [(zero, zero): 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, zero), ns t i, t.ns),
( (zero, px half), ew t i, t.ew),
( (px half, zero), ne t i, t.ne),
( (zero, zero), nw t i, t.nw),
( (zero, px half), sw t i, t.sw),
( (px half, px half), se t i, t.se)
]
ne tile i = line (px half) (px half)
<@< { stroke = toSVGColor (if tile.ne activecol inactivecol)}
<@< { strokewidth = (px strw)}
nw tile i = line (px half) (px (0.0-half))
<@< { stroke = toSVGColor (if tile.nw activecol inactivecol)}
<@< { strokewidth = (px strw)}
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))}
ns tile i = line zero (px full)
<@< { stroke = toSVGColor (if tile.ns activecol inactivecol)}
<@< { strokewidth = (px strw)}
ew tile i = line (px full) zero
<@< { stroke = toSVGColor (if tile.ew activecol inactivecol)}
<@< { strokewidth = (px strw)}
//nextDir old = case old of
// Blocked = Left
// Left = Middle
// Middle = Right
// Right = Blocked
drawSouth :: Tile -> Bool
drawSouth t = sOptCount t >= 2
sOptCount t = (length (filter id [t.ns,t.se,t.sw]))
drawNorth :: Tile -> Bool
drawNorth t = nOptCount t >= 2
nOptCount t = (length (filter id [t.ns,t.ne,t.nw]))
trainOptCount :: Tile Direction -> Int
trainOptCount t d = case d of
North -> (length (filter id [t.ns,t.ne,t.nw]))
East -> (length (filter id [t.ne,t.se,t.ew]))
South -> (length (filter id [t.ns,t.se,t.sw]))
West -> (length (filter id [t.nw,t.sw,t.ew]))
opts :: Tile Direction -> [Direction]
opts t d = snd (unzip case d of
North -> filter (\(a,b) -> a) [(t.ns,South),(t.ne, East),(t.nw,West)]
East -> filter (\(a,b) -> a) [(t.ne,North),(t.se,South),(t.ew,West)]
South -> filter (\(a,b) -> a) [(t.ns,North),(t.se,East),(t.sw,West)]
West -> filter (\(a,b) -> a) [(t.nw,North),(t.sw,South),(t.ew,East)]
)
drawEast :: Tile -> Bool
drawEast t = eOptCount t >= 2
eOptCount t = (length (filter id [t.ne,t.se,t.ew]))
drawWest :: Tile -> Bool
drawWest t = wOptCount t >= 2
wOptCount t = (length (filter id [t.nw,t.sw,t.ew]))
//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
......@@ -5,6 +5,7 @@ import iTasks
import designImage
import controllerImage
import driverImage
from iTasks.Extensions.SVG.SVGEditor import fromSVGEditor, :: SVGEditor {..}
from Graphics.Scalable.Types import :: TagSource, :: TagRef, :: ImageTag
......@@ -28,8 +29,14 @@ 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, north = Blocked, south = Blocked, west = Blocked, east = Blocked}
state = sharedStore "sharedState" {tiles = tilelist }
tilelist = updateAt (5) {defaultTile & ew = True, twest = True} (updateAt (4+18) {defaultTile & ns = True, tsouth = True} ( updateAt (4+9) {defaultTile & ns = True, sw = True} (updateAt 4 {defaultTile & tsouth = True, ns = True, se = True} defaultTilelist)))
defaultTilelist = (take (5*9) (repeat defaultTile))
defaultTile = { ne = False, nw = False, se = False, sw = False, ew = False, ns = False // no tracks
, north = Blocked, south = Blocked, west = Blocked, east = Blocked // all switches blocked
, tnorth = False, teast = False, tsouth = False, twest = False // no trains
}
:: LCSMUser = {name :: String, roles :: [String] }
......@@ -61,7 +68,7 @@ setup w = { LCSMWorkflowCollection|workflows = w }
//designTask = viewInformation [] "Designer Task"
//controlTask = viewInformation [] "Controller Task"
driverTask = viewInformation [] "Driver Task"
//driverTask = viewInformation [] "Driver Task"
controlTask =
updateSharedInformation
......@@ -91,6 +98,20 @@ designTask =
})
] state
driverTask =
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.myDriverImage m
, updModel = \m v.v//{m&tiles = v}//\m v.v
})
] state
lcsm_Workflows =
[restrictedWorkflow "Track Management" "This task manages how the tracks look like and how they are connected" ["designer"] designTask
......
......@@ -12,7 +12,11 @@ definition module trackState
, north :: RailroadSwitch
, east :: RailroadSwitch
, south :: RailroadSwitch
, west :: RailroadSwitch
, west :: RailroadSwitch
, tnorth :: Bool
, teast :: Bool
, tsouth :: Bool
, twest :: Bool
}
......
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