Failed attempt at IORef
This commit is contained in:
parent
4d80480c65
commit
0f9545c64a
46
src/Main.hs
46
src/Main.hs
|
@ -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
|
Loading…
Reference in New Issue