module Game.Halma.Board.Draw
( defaultTeamColours
, drawBoard', drawBoard
) where
import Game.Halma.Board
import Math.Geometry.Grid
import Diagrams.Prelude
defaultTeamColours :: Team -> Colour Double
defaultTeamColours North = yellow
defaultTeamColours South = red
defaultTeamColours Northwest = cyan
defaultTeamColours Northeast = orange
defaultTeamColours Southwest = pink
defaultTeamColours Southeast = blue
drawBoard'
:: (V b ~ V2, N b ~ Double, Renderable (Path V2 Double) b)
=> HalmaGrid size
-> ((Int,Int) -> Diagram b)
-> QDiagram b V2 Double (Option (Last (Int, Int)))
drawBoard' grid drawField =
targets `atop`
(mconcat
[ pieces # lw ultraThin
, circles 0.15 # fc gray # lw none
, gridLines # lc gray # lw thin
] # value (Option Nothing))
where dirX = unitX
dirY = rotateBy (1/6) unitX
toCoord (x, y) = p2 $ unr2 $ fromIntegral x *^ dirX ^+^ fromIntegral y *^ dirY
justLast = Option . Just . Last
clickTarget = circle 0.4 # lw none
targets = position $ map (\f -> (toCoord f, clickTarget # value (justLast f))) fields
fields = indices grid
circles r = position $ zip (map toCoord fields) $ repeat $ circle r
gridLines =
mconcat $ map (\(p, q) -> fromVertices [toCoord p, toCoord q]) $
concatMap (\f -> map ((,) f) $ filter (>= f) (neighbours grid f)) fields
pieces = position $ map (\p -> (toCoord p, drawField p)) fields
drawBoard
:: (V b ~ V2, N b ~ Double, Renderable (Path V2 Double) b)
=> HalmaBoard size
-> (Team -> Colour Double)
-> QDiagram b V2 Double (Option (Last (Int, Int)))
drawBoard halmaBoard teamColors = drawBoard' (getGrid halmaBoard) drawField
where drawPiece t =
let c = teamColors t
in circle 0.25 # fc c # lc (darken 0.5 c)
drawField = maybe mempty drawPiece . flip lookupHalmaBoard halmaBoard