jsEval "curl_module('../compiler/Map.ob')"
Peg Solitaire
We represent the board with a Map
from a pair of ints to a boolean.
The only other state we need is the current selected peg, if there is one.
import Map initBoard :: Map (Int, Int) Bool initBoard = let f x = (x - 3)^2 <= 1 in fromList [((r, c), r /= 3 || c /= 3) | r <- [0..6], c <- [0..6], f r || f c] act :: (Map (Int, Int) Bool, Maybe (Int, Int)) -> (Int, Int) -> (Map (Int, Int) Bool, Maybe (Int, Int)) act (st, sel) p@(r, c) | not $ member p st = (st, Nothing) | Nothing <- sel = (st, if st ! p then Just p else Nothing) | p' == p = (st, Nothing) | st ! p = (st, Just p) | (r' - r)^2 + (c - c')^2 == 4, st ! m = (insert p' False $ insert p True $ insert m False st, Just p) | otherwise = (st, Nothing) where Just p'@(r', c') = sel m = (div (r + r') 2, div (c + c') 2)
This page contains JavaScript helpers to draw on the canvas and add event listeners once our Haskell is compiled:
We write code to draw the board, with a bigger circle around the selected peg if it exists. If there is only one peg remaining and it lies in the center, then we draw a smiley face on it.
sz = 40 :: Int rad = 12 :: Double mid = div sz 2 drawPeg ((x, y), b) = do jsEval_ $ concat [ "spot(", show (mid+x*sz), ", ", show (mid+y*sz), ", ", show rad , ", 'rgb(", show $ bool 0 255 b, ",0,0)');" ] draw (board, sel) = do jsEval_ "ctx.clearRect(0, 0, canvas.width, canvas.height);" case sel of Just (x, y) -> jsEval_ $ concat [ "spot(", show (mid+x*sz), ", ", show (mid+y*sz), ", ", show $ rad + 4 , ", 'rgb(0,127,0)');" ] Nothing -> pure () mapM drawPeg $ assocs board when (map fst (filter snd $ assocs board) == [(3, 3)]) do jsEval_ $ concat [ "smiley(", show $ mid + 3*sz, ", ", show $ mid + 3*sz , ", ", show rad, ");" ]
We make the board and selection available to all IO
functions:
refresh = global >>= draw newGame = setGlobal (initBoard, Nothing) *> refresh click x y = do g <- global setGlobal $ act g (div x sz, div y sz) refresh
Let’s hop to it!
newGame jsEval_ "initGame(repl);"