Commit 0144522e authored by Job Cuppen's avatar Job Cuppen

reformat code

parent e2ae16b6
implementation module designImage
import iTasks.Extensions.SVG.SVGEditor
import trackState
import Data.List
import StdEnv
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
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 [] offs imgs NoHost) where
offs = [(px 0.0, px 0.0): fst3 (unzip3 (sortedList (t, i)))]
imgs = [backgroundSquare: snd3 (unzip3 (sortedList (t, i)))]
sortedList (t,i) = sortBy (\(_,_,active) _. not active) (aList (t,i))
henkkk (aoff, aimgs, aact) b = not aact
aList :: (Tile,Int) -> [(ImageOffset,Image State, Bool)]
aList (t,i) = [
( (px half, px 0.0) , (ns t i), t.ns ),
( (zero, px half), (ew t i), t.ew),
( (px half, px 0.0), (ne t i), t.ne),
( (px 0.0, 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 (half))
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & ne = not tile.ne} s.tiles ) } , local = False}
<@< { stroke = toSVGColor (if tile.ne activecol inactivecol)}
<@< { strokewidth = (px (strw))}
nw tile i = line (px (half)) (px (0.0-half))
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & nw = not tile.nw} s.tiles ) } , local = False}
<@< { stroke = toSVGColor (if tile.nw activecol inactivecol)}
<@< { strokewidth = (px (strw))}
sw tile i = line (px (half)) (px (half))
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & sw = not tile.sw} s.tiles ) } , local = False}
<@< { strokewidth = (px (strw))}
<@< { stroke = toSVGColor (if tile.sw activecol inactivecol)}
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)}
<@< { strokewidth = (px (toReal (strw)))}
ns tile i = line (px 0.0) (px full)
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & ns = not tile.ns} s.tiles ) } , local = False}
<@< { stroke = toSVGColor (if tile.ns activecol inactivecol)}
<@< { strokewidth = (px (strw))}
ew tile i = line (px full) (px 0.0)
<@< { onclick = \span s.{s & tiles = (updateAt i {tile & ew = not tile.ew} s.tiles ) } , local = False}
<@< { stroke = toSVGColor (if tile.ew activecol inactivecol)}
<@< { strokewidth = (px (strw))}
backgroundSquare = square (px full)
<@< { strokewidth = (px (strw /4.0))}
<@< { stroke = toSVGColor "dimgray"}
<@< { fill = toSVGColor "forestgreen"}
font = normalFontDef "Ariel" height
height = 40.0
implementation module designImage
import iTasks.Extensions.SVG.SVGEditor
import trackState
import Data.List
import StdEnv
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
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 [] offs imgs NoHost) where
offs = [(px 0.0, px 0.0): fst3 (unzip3 (sortedList (t, i)))]
imgs = [backgroundSquare: snd3 (unzip3 (sortedList (t, i)))]
sortedList (t,i) = sortBy (\(_,_,active) _. not active) (aList (t,i))
henkkk (aoff, aimgs, aact) b = not aact
aList :: (Tile,Int) -> [(ImageOffset,Image State, Bool)]
aList (t,i) = [
( (px half, px 0.0), (ns t i), t.ns ),
( (zero, px half), (ew t i), t.ew),
( (px half, px 0.0), (ne t i), t.ne),
( (px 0.0, 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)
]
:: Direction = NE | NW | SW | SE | NS | EW
ne tile i = addDesignTileAttributes tile i NE (line (px half) (px half))
nw tile i = addDesignTileAttributes tile i NW (line (px half) (px (0.0 - half)))
sw tile i = addDesignTileAttributes tile i SW (line (px half) (px half))
se tile i = addDesignTileAttributes tile i SE (line (px half) (px (0.0 - half)))
ns tile i = addDesignTileAttributes tile i NS (line (px 0.0) (px full))
ew tile i = addDesignTileAttributes tile i EW (line (px full) (px 0.0))
addDesignTileAttributes tile i dirString img = img
<@< { onclick = \span s.{s & tiles = (updateTileAt tile i dirString s.tiles) } , local = False}
<@< { stroke = toSVGColor (if (directionFor dirString tile) activecol inactivecol)}
<@< { strokewidth = (px (strw))}
updateTileAt :: Tile Int Direction [Tile] -> [Tile]
updateTileAt tile i NE tiles = updateAt i {tile & ne = not tile.ne} tiles
updateTileAt tile i NW tiles = updateAt i {tile & nw = not tile.nw} tiles
updateTileAt tile i SW tiles = updateAt i {tile & sw = not tile.sw} tiles
updateTileAt tile i SE tiles = updateAt i {tile & se = not tile.se} tiles
updateTileAt tile i NS tiles = updateAt i {tile & ns = not tile.ns} tiles
updateTileAt tile i EW tiles = updateAt i {tile & ew = not tile.ew} tiles
directionFor :: Direction Tile -> Bool
directionFor NE tile = tile.ne
directionFor NW tile = tile.nw
directionFor SW tile = tile.sw
directionFor SE tile = tile.se
directionFor NS tile = tile.ns
directionFor EW tile = tile.ew
backgroundSquare = square (px full)
<@< { strokewidth = (px (strw /4.0))}
<@< { stroke = toSVGColor "dimgray"}
<@< { fill = toSVGColor "forestgreen"}
font = normalFontDef "Ariel" height
height = 40.0
definition module trackState
:: RailroadSwitch = Left | Middle | Right | Blocked
:: Tile =
{ ne :: Bool
, nw :: Bool
, se :: Bool
, sw :: Bool
, ns :: Bool
, ew :: Bool
, north :: RailroadSwitch
, east :: RailroadSwitch
, south :: RailroadSwitch
, west :: RailroadSwitch
}
:: State =
{ tiles :: [Tile]
}
definition module trackState
:: RailroadSwitch = Left | Middle | Right | Blocked
:: Tile =
{ ne :: Bool
, nw :: Bool
, se :: Bool
, sw :: Bool
, ns :: Bool
, ew :: Bool
, north :: RailroadSwitch
, east :: RailroadSwitch
, south :: RailroadSwitch
, west :: RailroadSwitch
}
:: State =
{ tiles :: [Tile]
}
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