jack
/
Minesweeper
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Interactivity now working

This commit is contained in:
Jack Harley 2021-01-28 23:38:42 +00:00
parent 0f9545c64a
commit a5859ff737
1 changed files with 28 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Main.hs
View File

@ -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
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 = [] | otherwise = []
cell iob b (r,c) = do
cell :: IORef Board -> Board -> Square -> UI Element
cell iob b (r,c) = do
cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c)) cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
#+ [string $ squareAscii b (r,c)] #+ [string $ squareAscii b (r,c)]
on UI.click cell $ \_ -> do on UI.click cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c) liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
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'
return cell return cell