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

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 | otherwise = []
cells' iob b r c
where cell iob b (r,c) = do
cells' iob b r c | c < size b = cell iob b (r,c) : cells' iob b r (c+1) cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
| otherwise = [] #+ [string $ squareAscii b (r,c)]
on UI.click cell $ \_ -> do
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
b <- liftIO $ readIORef iob
cell :: IORef Board -> Board -> Square -> UI Element cont <- getElementById w "cont"
cell iob b (r,c) = do let cont' = fromJust cont
cell <- mkElement "td" #. (squareBgColour b (r,c) ++ " " ++ squareTextColour b (r,c))
#+ [string $ squareAscii b (r,c)]
on UI.click cell $ \_ -> do getBody w #+ [
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c) 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
]]
return cell delete cont'
return cell