Interactivity now working
This commit is contained in:
parent
0f9545c64a
commit
a5859ff737
55
src/Main.hs
55
src/Main.hs
|
@ -3,6 +3,7 @@ module Main where
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
import System.Random
|
import System.Random
|
||||||
|
|
||||||
|
@ -24,41 +25,41 @@ setup w = void $ do
|
||||||
|
|
||||||
rng <- liftIO newStdGen
|
rng <- liftIO newStdGen
|
||||||
|
|
||||||
iob <- liftIO $ newIORef (createBoard 30 0.15 rng :: Board)
|
let b = createBoard 30 0.15 rng :: Board
|
||||||
b <- liftIO $ readIORef iob
|
iob <- liftIO $ newIORef b
|
||||||
|
|
||||||
getBody w #+ [
|
getBody w #+ [
|
||||||
UI.div #. "container" #+ [
|
UI.div #. "container" # set UI.id_ "cont" #+ [
|
||||||
UI.h1 #+ [string "Minesweeper"],
|
UI.h1 #+ [string "Minesweeper"],
|
||||||
UI.h4 #+ [string "Jack Harley jharley@tcd.ie"],
|
UI.h4 #+ [string "Jack Harley jharley@tcd.ie"],
|
||||||
mkElement "table" #+ rows iob 0
|
mkElement "table" # set UI.id_ "grid" #+ rows iob b 0
|
||||||
]]
|
]]
|
||||||
|
|
||||||
rows :: IORef Board -> Int -> [UI Element]
|
|
||||||
rows iob r = do
|
|
||||||
b <- liftIO $ readIORef iob
|
|
||||||
|
|
||||||
rows' iob b r
|
|
||||||
|
|
||||||
where
|
where
|
||||||
rows' iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows' iob b (r+1)
|
rows iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows iob b (r+1)
|
||||||
| otherwise = []
|
| otherwise = []
|
||||||
|
|
||||||
cells :: IORef Board -> Board -> Int -> Int -> [UI Element]
|
cells iob b r c | c < size b = cell iob b (r,c) : cells iob b r (c+1)
|
||||||
cells iob b r c = do
|
| otherwise = []
|
||||||
cells' iob b r c
|
|
||||||
|
cell iob b (r,c) = do
|
||||||
|
cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
|
||||||
|
#+ [string $ squareAscii b (r,c)]
|
||||||
|
|
||||||
where
|
on UI.click cell $ \_ -> do
|
||||||
cells' iob b r c | c < size b = cell iob b (r,c) : cells' iob b r (c+1)
|
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
|
||||||
| otherwise = []
|
b <- liftIO $ readIORef iob
|
||||||
|
|
||||||
|
cont <- getElementById w "cont"
|
||||||
|
let cont' = fromJust cont
|
||||||
|
|
||||||
|
getBody w #+ [
|
||||||
|
UI.div #. "container" # set UI.id_ "cont" # set children [] #+ [
|
||||||
|
UI.h1 #+ [string "Minesweeper"],
|
||||||
|
UI.h4 #+ [string "Jack Harley jharley@tcd.ie"],
|
||||||
|
mkElement "table" # set UI.id_ "grid" #+ rows iob b 0
|
||||||
|
]]
|
||||||
|
|
||||||
|
delete cont'
|
||||||
|
|
||||||
cell :: IORef Board -> Board -> Square -> UI Element
|
return cell
|
||||||
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