GUI working, basic mines layout, no interactivity yet

This commit is contained in:
Jack Harley 2021-01-28 19:31:39 +00:00
parent 413893d7bc
commit cda669bcc4
7 changed files with 122 additions and 4 deletions

View File

@ -12,6 +12,10 @@ maintainer: jackpharley@gmail.com
copyright: 2020 Jack Harley copyright: 2020 Jack Harley
license: AllRightsReserved license: AllRightsReserved
build-type: Simple build-type: Simple
extra-source-files:
view/css/bootstrap.min.css
view/css/bootstrap.min.css.map
view/css/minesweeper.css
executable Minesweeper executable Minesweeper
main-is: Main.hs main-is: Main.hs
@ -24,4 +28,5 @@ executable Minesweeper
build-depends: build-depends:
base base
, random , random
, threepenny-gui
default-language: Haskell2010 default-language: Haskell2010

View File

@ -10,8 +10,10 @@ description: CSU44012 Assignment 2
dependencies: dependencies:
- base - base
- random - random
- threepenny-gui
#extra-source-files: extra-source-files:
- view/css/*
executables: executables:
Minesweeper: Minesweeper:

View File

@ -1,9 +1,45 @@
module Main where module Main where
import Minesweeper import Control.Monad
import Control.Concurrent (threadDelay)
import System.Random import System.Random
import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core
import Minesweeper
main :: IO () main :: IO ()
main = do main = do
rng <- newStdGen rng <- newStdGen
putStrLn (printBoard $ createBoard 20 0.1 rng) startGUI defaultConfig {jsStatic = Just "view"} $ setup rng
setup :: StdGen -> Window -> UI ()
setup rng w = void $ do
return w # set title "Minesweeper"
UI.addStyleSheet w "bootstrap.min.css"
UI.addStyleSheet w "minesweeper.css"
let board = createBoard 10 0.06 rng
getBody w #+ [
UI.div #. "container" #+ [
UI.h1 #+ [string "Minesweeper"],
--UI.h4 #+ [string "By Jack Harley <jharley@tcd.ie>"],
gameGridTable board
]]
gameGridTable :: Board -> UI Element
gameGridTable b = mkElement "table" #+ rows b
rows :: Board -> [UI Element]
rows b = rows2 b 0
rows2 b r | r < size b = (mkElement "tr" #+ cells b r) : rows2 b (r+1)
| otherwise = []
cells :: Board -> Int -> [UI Element]
cells b r = cells2 b r 0
cells2 b r c | c < size b = mkElement "td" #. squareColour b (r,c) #+ [string $ squareAscii b (r,c)] : cells2 b r (c+1)
| otherwise = []

View File

@ -20,6 +20,7 @@ createGrid :: Int -> Grid
createGrid size = replicate size (replicate size False) createGrid size = replicate size (replicate size False)
-- Functions relating to seeding a grid with mines -- Functions relating to seeding a grid with mines
seedGrid :: StdGen -> Float -> Grid -> Grid seedGrid :: StdGen -> Float -> Grid -> Grid
seedGrid _ _ [] = [] seedGrid _ _ [] = []
seedGrid rng p (l:ls) = newL : seedGrid rng2 p ls seedGrid rng p (l:ls) = newL : seedGrid rng2 p ls
@ -39,7 +40,47 @@ randomlyTrue :: StdGen -> Float -> (Bool, StdGen)
randomlyTrue rng p = (generatedFloat <= p, newRng) randomlyTrue rng p = (generatedFloat <= p, newRng)
where (generatedFloat, newRng) = randomR (0.0, 1.0) rng where (generatedFloat, newRng) = randomR (0.0, 1.0) rng
-- Functions for determing status of a square
-- N.B. (r,c) = (row, column)
hasMine :: Board -> Square -> Bool
hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c
| otherwise = False
isUncovered :: Board -> Square -> Bool
isUncovered b (r,c) = (uncovered b !! r) !! c
isFlagged :: Board -> Square -> Bool
isFlagged b (r,c) = (flagged b !! r) !! c
validSquare :: Board -> Square -> Bool
validSquare b (r,c) = r >= 0 && c >= 0 && r < size b && c < size b
squareAscii :: Board -> Square -> String
squareAscii b (r,c) | hasMine b (r,c) = "X"
| otherwise = show $ adjacentBombs b (r,c)
squareColour :: Board -> Square -> String
squareColour b (r,c) | hasMine b (r,c) = "red"
| otherwise = "green"
adjacentBombs :: Board -> Square -> Int
adjacentBombs board (row,col) = let tl = boolToInt $ hasMine board (row-1,col-1)
t = boolToInt $ hasMine board (row-1,col)
tr = boolToInt $ hasMine board (row-1,col+1)
l = boolToInt $ hasMine board (row,col-1)
r = boolToInt $ hasMine board (row,col+1)
bl = boolToInt $ hasMine board (row+1,col-1)
b = boolToInt $ hasMine board (row+1,col)
br = boolToInt $ hasMine board (row+1,col+1)
in tl + t + tr + l + r + bl + b + br
boolToInt :: Bool -> Int
boolToInt x | x = 1
| otherwise = 0
-- Functions for turning a board into a string for debug purposes -- Functions for turning a board into a string for debug purposes
printBoard :: Board -> String printBoard :: Board -> String
printBoard b = printBoardGrid (mines b) printBoard b = printBoardGrid (mines b)

6
view/css/bootstrap.min.css vendored Normal file

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

27
view/css/minesweeper.css Normal file
View File

@ -0,0 +1,27 @@
body {
font-family: "Helvetica", sans-serif;
}
table {
/*width: 400px;*/
}
tr {
}
td {
width: 30px !important;
height: 30px !important;
text-align: center;
color: black;
border: 1px solid black;
}
.red {
background-color: red;
}
.green {
background-color: lime;
}