GUI working, basic mines layout, no interactivity yet
This commit is contained in:
parent
413893d7bc
commit
cda669bcc4
|
@ -12,6 +12,10 @@ maintainer: jackpharley@gmail.com
|
|||
copyright: 2020 Jack Harley
|
||||
license: AllRightsReserved
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
view/css/bootstrap.min.css
|
||||
view/css/bootstrap.min.css.map
|
||||
view/css/minesweeper.css
|
||||
|
||||
executable Minesweeper
|
||||
main-is: Main.hs
|
||||
|
@ -24,4 +28,5 @@ executable Minesweeper
|
|||
build-depends:
|
||||
base
|
||||
, random
|
||||
, threepenny-gui
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -10,8 +10,10 @@ description: CSU44012 Assignment 2
|
|||
dependencies:
|
||||
- base
|
||||
- random
|
||||
- threepenny-gui
|
||||
|
||||
#extra-source-files:
|
||||
extra-source-files:
|
||||
- view/css/*
|
||||
|
||||
executables:
|
||||
Minesweeper:
|
||||
|
|
40
src/Main.hs
40
src/Main.hs
|
@ -1,9 +1,45 @@
|
|||
module Main where
|
||||
|
||||
import Minesweeper
|
||||
import Control.Monad
|
||||
import Control.Concurrent (threadDelay)
|
||||
|
||||
import System.Random
|
||||
|
||||
import qualified Graphics.UI.Threepenny as UI
|
||||
import Graphics.UI.Threepenny.Core
|
||||
|
||||
import Minesweeper
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
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 = []
|
|
@ -20,6 +20,7 @@ createGrid :: Int -> Grid
|
|||
createGrid size = replicate size (replicate size False)
|
||||
|
||||
-- Functions relating to seeding a grid with mines
|
||||
|
||||
seedGrid :: StdGen -> Float -> Grid -> Grid
|
||||
seedGrid _ _ [] = []
|
||||
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)
|
||||
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
|
||||
|
||||
printBoard :: Board -> String
|
||||
printBoard b = printBoardGrid (mines b)
|
||||
|
||||
|
|
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
@ -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;
|
||||
}
|
Loading…
Reference in New Issue