Failed attempt at IORef

This commit is contained in:
Jack Harley 2021-01-28 22:59:02 +00:00
parent 4d80480c65
commit 0f9545c64a
1 changed files with 32 additions and 14 deletions

View File

@ -2,6 +2,7 @@ module Main where
import Control.Monad
import Control.Concurrent (threadDelay)
import Data.IORef
import System.Random
@ -22,25 +23,42 @@ setup w = void $ do
UI.addStyleSheet w "minesweeper.css"
rng <- liftIO newStdGen
let board = uncover (createBoard 30 0.15 rng) (4,4)
iob <- liftIO $ newIORef (createBoard 30 0.15 rng :: Board)
b <- liftIO $ readIORef iob
getBody w #+ [
UI.div #. "container" #+ [
UI.h1 #+ [string "Minesweeper"],
--UI.h4 #+ [string "By Jack Harley <jharley@tcd.ie>"],
gameGridTable board
UI.h4 #+ [string "Jack Harley jharley@tcd.ie"],
mkElement "table" #+ rows iob 0
]]
gameGridTable :: Board -> UI Element
gameGridTable b = mkElement "table" #+ rows b
rows :: IORef Board -> Int -> [UI Element]
rows iob r = do
b <- liftIO $ readIORef iob
rows :: Board -> [UI Element]
rows b = rows' b 0
rows' b r | r < size b = (mkElement "tr" #+ cells b r) : rows' b (r+1)
| otherwise = []
rows' iob b r
cells :: Board -> Int -> [UI Element]
cells b r = cells' b r 0
cells' b r c | c < size b = mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
#+ [string $ squareAscii b (r,c)] : cells' b r (c+1)
| otherwise = []
where
rows' iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows' iob b (r+1)
| otherwise = []
cells :: IORef Board -> Board -> Int -> Int -> [UI Element]
cells iob b r c = do
cells' iob b r c
where
cells' iob b r c | c < size b = cell iob b (r,c) : cells' iob b r (c+1)
| otherwise = []
cell :: IORef Board -> Board -> Square -> UI Element
cell iob b (r,c) = do
cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
#+ [string $ squareAscii b (r,c)]
on UI.click cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
return cell