diff --git a/src/Main.hs b/src/Main.hs index 880ffa1..d5acf6f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,7 +22,6 @@ setup w = void $ do UI.addStyleSheet w "bootstrap.min.css" UI.addStyleSheet w "minesweeper.css" - rng <- liftIO newStdGen let b = createBoard 30 0.15 rng :: Board @@ -32,8 +31,10 @@ setup w = void $ do UI.div #. "container" # set UI.id_ "cont" #+ [ UI.h1 #+ [string "Minesweeper"], UI.h4 #+ [string "Jack Harley jharley@tcd.ie"], + UI.p #+ [string "Instructions: Click to uncover, right click to flag"], mkElement "table" # set UI.id_ "table" #+ rows iob b 0 - ]] + ], + mkElement "script" # set (attr "src") "/static/custom.js"] where rows iob b r | r < size b = (mkElement "tr" #+ cells iob b r 0) : rows iob b (r+1) @@ -47,16 +48,25 @@ setup w = void $ do #+ [string $ squareAscii b (r,c)] on UI.click cell $ \_ -> do + liftIO $ putStrLn "click" liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c) - b <- liftIO $ readIORef iob - - table <- getElementById w "table" - let table' = fromJust table - - cont <- getElementById w "cont" - let cont' = return $ fromJust cont - cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0] + refresh iob - delete table' + on UI.contextmenu cell $ \_ -> do + liftIO $ putStrLn "rightclick" + liftIO $ modifyIORef' iob $ \oldB -> flag oldB (r,c) + refresh iob - return cell \ No newline at end of file + return cell + + refresh iob = do + b <- liftIO $ readIORef iob + + table <- getElementById w "table" + let table' = fromJust table + + cont <- getElementById w "cont" + let cont' = return $ fromJust cont + cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0] + + delete table' \ No newline at end of file diff --git a/src/Minesweeper.hs b/src/Minesweeper.hs index eabde00..98dc523 100644 --- a/src/Minesweeper.hs +++ b/src/Minesweeper.hs @@ -52,7 +52,8 @@ isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c | otherwise = True isFlagged :: Board -> Square -> Bool -isFlagged b (r,c) = (flagged b !! r) !! c +isFlagged b (r,c) | validSquare b (r,c) = (flagged b !! r) !! c + | otherwise = False validSquare :: Board -> Square -> Bool validSquare b (r,c) = r >= 0 && c >= 0 && r < size b && c < size b @@ -61,17 +62,18 @@ onEdge :: Board -> Square -> Bool onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == size b squareAscii :: Board -> Square -> String -squareAscii b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "X" - | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c) +squareAscii b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c) | otherwise = "" squareBgColour :: Board -> Square -> String squareBgColour b (r,c) | isUncovered b (r,c) && hasMine b (r,c) = "bomb" | isUncovered b (r,c) = "uncovered" + | isFlagged b (r,c) = "flagged" | otherwise = "covered" squareTextColour :: Board -> Square -> String -squareTextColour b (r,c) | isUncovered b (r,c) && adjacentToCovered b (r,c) = +squareTextColour b (r,c) | hasMine b (r,c) || isFlagged b (r,c) = "" + | isUncovered b (r,c) && adjacentToCovered b (r,c) = case adjacentMines b (r,c) of 1 -> "text-blue" 2 -> "text-green" @@ -119,6 +121,17 @@ uncoverAll :: Board -> [Square] -> Board uncoverAll b [] = b uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c) +flag :: Board -> Square -> Board +flag b (r,c) | not $ validSquare b (r,c) = b + | isUncovered b (r,c) = b + | isFlagged b (r,c) = b + | otherwise = let Board s m u f = b + (rowsA, row : rowsB) = splitAt r f + (cellsA, _ : cellsB) = splitAt c row + newRow = cellsA ++ True : cellsB + newRows = rowsA ++ newRow : rowsB + in Board s m u newRows + -- Functions for turning a board into a string for debug purposes printBoard :: Board -> String diff --git a/view/css/minesweeper.css b/view/css/minesweeper.css index 033a598..4f496d5 100644 --- a/view/css/minesweeper.css +++ b/view/css/minesweeper.css @@ -15,6 +15,10 @@ td { background-color: red; } +.flagged { + background-color: yellow; +} + .covered { background-color: darkgray; } diff --git a/view/custom.js b/view/custom.js new file mode 100644 index 0000000..290865d --- /dev/null +++ b/view/custom.js @@ -0,0 +1 @@ +document.addEventListener('contextmenu', event => event.preventDefault()); \ No newline at end of file