Yes
This commit is contained in:
parent
aa602c2b7f
commit
0ba5b018ec
Binary file not shown.
|
|
@ -1,6 +1,6 @@
|
|||
\documentclass[11pt]{article}
|
||||
|
||||
\usepackage[margin=0.7in]{geometry}
|
||||
\usepackage[margin=0.5in]{geometry}
|
||||
\usepackage{titling}
|
||||
\usepackage{listings}
|
||||
\usepackage{graphicx}
|
||||
|
|
@ -33,7 +33,7 @@
|
|||
urlcolor=black
|
||||
}
|
||||
|
||||
\setlength{\droptitle}{-6em}
|
||||
\setlength{\droptitle}{-5em}
|
||||
\setlength{\parindent}{0cm}
|
||||
\setlength{\righthyphenmin}{62}
|
||||
\setlength{\lefthyphenmin}{62}
|
||||
|
|
@ -104,8 +104,7 @@ type Square = (Int, Int)
|
|||
|
||||
\begin{lstlisting}
|
||||
createBoard :: Int -> Float -> StdGen -> Board
|
||||
createBoard size mineRatio rng = Board size
|
||||
(seedGrid rng mineRatio (createGrid False size))
|
||||
createBoard size mineRatio rng = Board size (seedGrid rng mineRatio (createGrid False size))
|
||||
(createGrid False size)
|
||||
(createGrid False size)
|
||||
\end{lstlisting}
|
||||
|
|
@ -144,6 +143,8 @@ uncover b (r,c) | not $ validSquare b (r,c) = b
|
|||
|
||||
The final guard handles normal cases where the Square clicked is safe. It reconstructs the uncovered Grid, replacing the Square at (r,c) with a True status. It then also calls the uncoverAdjacentsIfSafe function on the modified Board:
|
||||
|
||||
\newpage
|
||||
|
||||
\begin{lstlisting}
|
||||
uncoverAdjacentsIfSafe :: Board -> Square -> Board
|
||||
uncoverAdjacentsIfSafe b (r,c) | adjacentMines b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
|
||||
|
|
@ -174,6 +175,99 @@ flag b (r,c) | not $ validSquare b (r,c) = b
|
|||
|
||||
Then we use the same procedure to replace the flagged Grid with a new grid, with the right clicked square's status changed to True.
|
||||
|
||||
\subsection{Rendering the UI}
|
||||
\subsection{Program Startup}
|
||||
The entry point for the program is the main function. It calls startGUI with the setup function as a parameter. ThreePenny then initialises using the setup function.
|
||||
|
||||
Setup registers two stylesheets: the minified bootstrap.min.css I use in all of my web related projects and a minesweeper.css file I wrote to give some styling to the page and the game board.
|
||||
|
||||
Setup then creates a new pseudo random number generator and initialises a new game board. It then stores the game board state into a global IORef. This IORef will be modified when updating state due to a user action, and read from during a re-render of the board. The unwrapped Board instance (b) is also maintained and passed to the rendering functions for the initial render:
|
||||
|
||||
\begin{lstlisting}
|
||||
rng <- liftIO newStdGen
|
||||
let b = createBoard 20 0.08 rng :: Board
|
||||
iob <- liftIO $ newIORef b
|
||||
\end{lstlisting}
|
||||
|
||||
The body of the page is then rendered, one part to note is the custom JS I include at the bottom of the body:
|
||||
|
||||
\begin{lstlisting}
|
||||
mkElement "script" # set (attr "src") "/static/custom.js"]
|
||||
\end{lstlisting}
|
||||
|
||||
This custom.js script is a one-liner which prevents right clicks from opening a menu when playing the game:
|
||||
|
||||
\begin{lstlisting}
|
||||
document.addEventListener('contextmenu', event => event.preventDefault());
|
||||
\end{lstlisting}
|
||||
|
||||
\newpage
|
||||
|
||||
\subsection{Rendering the Game Board}
|
||||
|
||||
The board itself is rendered as a table with ID "table" in a div with ID "gameCont":
|
||||
|
||||
\begin{lstlisting}
|
||||
UI.div # set UI.id_ "gameCont" #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
|
||||
\end{lstlisting}
|
||||
|
||||
This calls the rows function with an IORef Board and an already unwrapped copy of the Board. Rows then recursively calls cells to render each row of cells, and cells calls the cell function to render the individual cells:
|
||||
|
||||
\begin{lstlisting}
|
||||
rows iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows iob b (r+1)
|
||||
| otherwise = []
|
||||
|
||||
cells iob b r c | c < size b = cell iob b (r,c) : cells iob b r (c+1)
|
||||
| otherwise = []
|
||||
\end{lstlisting}
|
||||
|
||||
The cell function receives an (r,c) pair and renders that specific cell, calling functions from Minesweeper.hs to determine the desired background colour, text colour and text to display in each cell.
|
||||
|
||||
Two event handlers are also attached on to the cell to handle left and right clicks, triggering an update of the IORef Board by uncovering or flagging a square respectively.
|
||||
|
||||
\begin{lstlisting}
|
||||
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)
|
||||
refresh iob
|
||||
|
||||
on UI.contextmenu cell $ \_ -> do
|
||||
liftIO $ modifyIORef' iob $ \oldB -> flag oldB (r,c)
|
||||
refresh iob
|
||||
|
||||
return cell
|
||||
\end{lstlisting}
|
||||
|
||||
You will note that after an update to the IORef Board due to a player move, the refresh function is called. This function reads an up to date copy of the Board state from the IORef Board and re-renders the game board, replacing the old copy:
|
||||
|
||||
\begin{lstlisting}
|
||||
refresh iob = do
|
||||
b <- liftIO $ readIORef iob
|
||||
|
||||
table <- getElementById w "table"
|
||||
let table' = fromJust table
|
||||
|
||||
cont <- getElementById w "gameCont"
|
||||
let cont' = return $ fromJust cont
|
||||
cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
|
||||
|
||||
delete table'
|
||||
\end{lstlisting}
|
||||
|
||||
\newpage
|
||||
|
||||
\section{Reflection}
|
||||
This was an interesting project and I have learned a lot from it.
|
||||
|
||||
On reflection I'm not hugely happy with the core data structures I chose to represent the game state and believe I fell into the trap of thinking like an imperative programmer when designing them. 2D lists initially seemed like an intuitive and efficient way to store the state. However, when it came to writing the uncover and flag functions I realised it was not a particularly optimal choice. Modification of a single element required splitting the lists up two levels deep which made for some overly complex code. I also suspect that this approach is not particularly efficient for data access or modification.
|
||||
|
||||
If I was to entirely redesign the project I would try implementing it with a different core data structure. Possible options include a 2D Data.Array structure that would function somewhat similarly to the current approach, or possible an association list or Data.Map based structure (which would be indexed by the (row,col) tuples).
|
||||
|
||||
I found working with ThreePenny difficult initially, there are limited examples on the web for usage and it took me quite a bit of time wrestling with it before I had some code with a reasonable structure for the main interface setup section. I would've liked to see a method of including static HTML into a page without having to write all of it in the ThreePenny eDSL and an ability to prevent the default action triggered by a browser event occurring (in my case right click opening a context menu) without having to embed a custom script.
|
||||
|
||||
|
||||
|
||||
|
||||
\end{document}
|
||||
13
src/Main.hs
13
src/Main.hs
|
|
@ -1,7 +1,6 @@
|
|||
module Main where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Data.IORef
|
||||
import Data.Maybe
|
||||
|
||||
|
|
@ -13,8 +12,7 @@ import Graphics.UI.Threepenny.Core
|
|||
import Minesweeper
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
startGUI defaultConfig {jsStatic = Just "view"} setup
|
||||
main = startGUI defaultConfig {jsStatic = Just "view"} setup
|
||||
|
||||
setup :: Window -> UI ()
|
||||
setup w = void $ do
|
||||
|
|
@ -22,10 +20,9 @@ setup w = void $ do
|
|||
|
||||
UI.addStyleSheet w "bootstrap.min.css"
|
||||
UI.addStyleSheet w "minesweeper.css"
|
||||
|
||||
rng <- liftIO newStdGen
|
||||
|
||||
let b = createBoard 20 0.08 rng :: Board
|
||||
liftIO $ putStrLn $ printBoard b
|
||||
let b = createBoard 20 0.08 rng
|
||||
iob <- liftIO $ newIORef b
|
||||
|
||||
getBody w #+ [
|
||||
|
|
@ -59,12 +56,12 @@ setup w = void $ do
|
|||
#+ [string $ squareAscii b (r,c)]
|
||||
|
||||
on UI.click cell $ \_ -> do
|
||||
liftIO $ putStrLn $ "Click (" ++ show r ++ "," ++ show c ++ ")"
|
||||
--liftIO $ putStrLn $ "Click (" ++ show r ++ "," ++ show c ++ ")"
|
||||
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
|
||||
refresh iob
|
||||
|
||||
on UI.contextmenu cell $ \_ -> do
|
||||
liftIO $ putStrLn $ "Right Click (" ++ show r ++ "," ++ show c ++ ")"
|
||||
--liftIO $ putStrLn $ "Right Click (" ++ show r ++ "," ++ show c ++ ")"
|
||||
liftIO $ modifyIORef' iob $ \oldB -> flag oldB (r,c)
|
||||
refresh iob
|
||||
|
||||
|
|
|
|||
|
|
@ -11,6 +11,9 @@ data Board = Board { size :: Int
|
|||
, flagged :: Grid
|
||||
}
|
||||
|
||||
instance Show Board where
|
||||
show b = printBoard b
|
||||
|
||||
--
|
||||
-- Functions related to creating and initialising a board
|
||||
--
|
||||
|
|
@ -179,6 +182,7 @@ uncoverAll :: Board -> [Square] -> Board
|
|||
uncoverAll b [] = b
|
||||
uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)
|
||||
|
||||
-- marks a square as flagged
|
||||
flag :: Board -> Square -> Board
|
||||
flag b (r,c) | not $ validSquare b (r,c) = b
|
||||
| isUncovered b (r,c) = b
|
||||
|
|
|
|||
Loading…
Reference in New Issue