Commit 83aaaaf0 authored by Job Cuppen's avatar Job Cuppen

improved functionality for adding trains

parent 6acdab06
......@@ -50,61 +50,12 @@ 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, t.tsouth && drawL t.south),
// ((AtRight,AtBottom), (px (0.0-quarter),zero), switchIndicatorLine True, t.tsouth && drawR t.south),
// ((AtMiddleX,AtBottom), (zero, zero), switchIndicatorLine2 False, t.tsouth && drawM t.south),
// ((AtRight,AtTop), (px (0.0-quarter), zero), switchIndicatorLine False, t.tnorth && drawL t.north),
// ((AtLeft,AtTop), (px quarter, zero), switchIndicatorLine True, t.tnorth && drawR t.north),
// ((AtMiddleX,AtTop), (zero, zero), switchIndicatorLine2 False, t.tnorth && drawM t.north),
// ((AtRight,AtBottom), (zero, px (0.0-quarter)), switchIndicatorLine True, t.teast && drawL t.east),
// ((AtRight,AtTop), (zero, px quarter), switchIndicatorLine False, t.teast && drawR t.east),
// ((AtRight,AtMiddleY), (zero, zero), switchIndicatorLine2 True, t.teast && drawM t.east),
// ((AtLeft,AtTop), (zero, px quarter), switchIndicatorLine True, t.twest && drawL t.west),
// ((AtLeft,AtBottom), (zero, px (0.0-quarter)), switchIndicatorLine False, t.twest && drawR t.west),
// ((AtLeft,AtMiddleY), (zero, zero), switchIndicatorLine2 True, t.twest && drawM t.west),
((AtMiddleX,AtTop), (zero, zero), train t i, t.tnorth),
((AtRight,AtMiddleY), (zero, zero), train t i, t.teast),
((AtMiddleX,AtBottom), (zero, zero), train t i, t.tsouth),
((AtLeft,AtMiddleY), (zero, zero), train t i, t.twest),
((AtLeft,AtTop), (zero, zero), foregroundSquare t i, True)
// ((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 )
((AtRight,AtMiddleY), (zero, zero), trainEast t i, True),
((AtMiddleX,AtBottom), (zero, zero), trainSouth t i, True),
((AtLeft,AtMiddleY), (zero, zero), trainWest t i, True),
((AtMiddleX,AtTop), (zero, zero), trainNorth t i, True)
]
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)))]
......@@ -148,119 +99,34 @@ ew tile i = line (px full) zero
train tile i = circle (px (strw * 2.0))
<@< { strokewidth = (px 1.0) }
<@< { fill = toSVGColor "black" }
moveTrain tile
| tile.tsouth == True = moveToWest tile
| tile.tnorth == True = moveToEast tile
| tile.twest == True = removeTrain tile
| tile.teast == True = moveToSouth tile
| otherwise = moveToNorth tile
moveToWest tile = {tile & tnorth = False, tsouth = False, teast = False, twest = True}
moveToNorth tile = {tile & tnorth = True, tsouth = False, teast = False, twest = False}
moveToEast tile = {tile & tnorth = False, tsouth = False, teast = True, twest = False}
moveToSouth tile = {tile & tnorth = False, tsouth = True, teast = False, twest = False}
removeTrain tile = {tile & tnorth = False, tsouth = False, teast = False, twest = False}
/*
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 = nextDirS tile} s.tiles )} , local = False}
<@< { opacity = if (drawSouth tile) 1.0 0.0 }
<@< { strokewidth = if (drawSouth tile) (px 1.0) zero }
<@< { fill = case tile.south of
Blocked -> toSVGColor "red"
_ -> toSVGColor "yellow" }
north 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 & north = nextDirN tile} s.tiles )} , local = False}
<@< { opacity = if (drawNorth tile) 1.0 0.0 }
<@< { strokewidth = if (drawNorth tile) (px 1.0) zero }
<@< { fill = case tile.north of
Blocked -> toSVGColor "red"
_ -> toSVGColor "yellow" }
east 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 & east = nextDirE tile} s.tiles )} , local = False}
<@< { opacity = if (drawEast tile) (1.0) (0.0) }
<@< { strokewidth = if (drawEast tile) (px 1.0) zero }
<@< { fill = case tile.east of
Blocked -> toSVGColor "red"
_ -> toSVGColor "yellow" }
west 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 & twest = False, tnorth = True} s.tiles )} , local = False}
<@< { opacity = if (drawWest tile) (1.0) (0.0) }
<@< { strokewidth = if (drawWest tile) (px 1.0) zero }
<@< { fill = case tile.west of
Blocked -> toSVGColor "red"
_ -> toSVGColor "yellow" }
nextDirS tile = case tile.tsouth of
Blocked = if tile.sw Left (if tile.ns Middle (if tile.se Right Blocked))
Left = if tile.ns Middle (if tile.se Right Blocked)
Middle = if tile.se Right Blocked
Right = Blocked
nextDirN tile = case tile.tnorth of
Blocked = if tile.ne Left (if tile.ns Middle (if tile.nw Right Blocked))
Left = if tile.ns Middle (if tile.nw Right Blocked)
Middle = if tile.nw Right Blocked
Right = Blocked
nextDirW tile = case tile.twest of
Blocked = if tile.nw Left (if tile.ew Middle (if tile.sw Right Blocked))
Left = if tile.ew Middle (if tile.sw Right Blocked)
Middle = if tile.sw Right Blocked
Right = Blocked
nextDirE tile = case tile.teast of
True = False
Left = if tile.ew Middle (if tile.ne Right Blocked)
Middle = if tile.ne Right Blocked
Right = Blocked
//nextDir old = case old of
// Blocked = Left
// Left = Middle
// Middle = Right
// Right = Blocked
drawSouth :: Tile -> Bool
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
drawEast :: Tile -> Bool
drawEast t = (length (filter id [t.ne,t.se,t.ew])) >= 2
drawWest :: Tile -> Bool
drawWest t = (length (filter id [t.nw,t.sw,t.ew])) >= 2
//case tile.south of
// Blocked -> toSVGColor "red"
// _ -> toSVGColor "yellow" }
*/
foregroundSquare tile i = square (px full)
<@< { onclick = \span s.{s & tiles = (updateAt i (moveTrain tile) s.tiles )} , local = False}
<@< { opacity = 0.0}
<@< { strokewidth = (px (strw/4.0))}
<@< { stroke = toSVGColor "dimgray"}
<@< { fill = toSVGColor "forestgreen"}
trainNorth tile i = circle (px (strw * 2.0))
<@< { onclick = \span s.{s & tiles = (updateAt i (toggleTrainNorth tile) s.tiles )} , local = False}
<@< { opacity = if tile.tnorth (1.0) (0.0) }
<@< { strokewidth = (px 1.0) }
<@< { fill = toSVGColor "black" }
trainEast tile i = circle (px (strw * 2.0))
<@< { onclick = \span s.{s & tiles = (updateAt i (toggleTrainEast tile) s.tiles )} , local = False}
<@< { opacity = if tile.teast (1.0) (0.0) }
<@< { strokewidth = (px 1.0) }
<@< { fill = toSVGColor "black" }
trainSouth tile i = circle (px (strw * 2.0))
<@< { onclick = \span s.{s & tiles = (updateAt i (toggleTrainSouth tile) s.tiles )} , local = False}
<@< { opacity = if tile.tsouth (1.0) (0.0) }
<@< { strokewidth = (px 1.0) }
<@< { fill = toSVGColor "black" }
trainWest tile i = circle (px (strw * 2.0))
<@< { onclick = \span s.{s & tiles = (updateAt i (toggleTrainWest tile) s.tiles )} , local = False}
<@< { opacity = if tile.twest (1.0) (0.0) }
<@< { strokewidth = (px 1.0) }
<@< { fill = toSVGColor "black" }
toggleTrainNorth t = if (t.ns || t.ne || t.nw) {t & tnorth = (not t.tnorth)} t
toggleTrainEast t = if (t.ne || t.ew || t.se) {t & teast = (not t.teast)} t
toggleTrainSouth t = if (t.ns || t.se || t.sw) {t & tsouth = (not t.tsouth)} t
toggleTrainWest t = if (t.sw || t.ew || t.nw) {t & twest = (not t.twest)} t
backgroundSquare = square (px full)
<@< { strokewidth = (px (strw/4.0))}
......
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