diff --git a/Calculator/CalcEval.hs b/Calculator/CalcEval.hs --- a/Calculator/CalcEval.hs +++ b/Calculator/CalcEval.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- CalcEval.hs -- diff --git a/Calculator/CalcParse.hs b/Calculator/CalcParse.hs --- a/Calculator/CalcParse.hs +++ b/Calculator/CalcParse.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- CalcParse.hs -- diff --git a/Calculator/CalcParseLib.hs b/Calculator/CalcParseLib.hs --- a/Calculator/CalcParseLib.hs +++ b/Calculator/CalcParseLib.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- CalcParseLib.hs -- diff --git a/Calculator/CalcStore.hs b/Calculator/CalcStore.hs --- a/Calculator/CalcStore.hs +++ b/Calculator/CalcStore.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- CalcStore.hs -- diff --git a/Calculator/CalcToplevel.hs b/Calculator/CalcToplevel.hs --- a/Calculator/CalcToplevel.hs +++ b/Calculator/CalcToplevel.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- CalcToplevel.hs -- diff --git a/Calculator/CalcTypes.hs b/Calculator/CalcTypes.hs --- a/Calculator/CalcTypes.hs +++ b/Calculator/CalcTypes.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- CalcTypes.hs -- diff --git a/Chapter1.hs b/Chapter1.hs --- a/Chapter1.hs +++ b/Chapter1.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 1 -- diff --git a/Chapter10.hs b/Chapter10.hs --- a/Chapter10.hs +++ b/Chapter10.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 10 -- diff --git a/Chapter11.hs b/Chapter11.hs --- a/Chapter11.hs +++ b/Chapter11.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 11 -- diff --git a/Chapter12.hs b/Chapter12.hs --- a/Chapter12.hs +++ b/Chapter12.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 12 -- diff --git a/Chapter13.hs b/Chapter13.hs --- a/Chapter13.hs +++ b/Chapter13.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 13 -- diff --git a/Chapter14_1.hs b/Chapter14_1.hs --- a/Chapter14_1.hs +++ b/Chapter14_1.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 14, part 1 -- Also covers the properties in Section 14.7 diff --git a/Chapter14_2.hs b/Chapter14_2.hs --- a/Chapter14_2.hs +++ b/Chapter14_2.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 14, part 2 -- Details of the Simulation case study in the Simulation directory. diff --git a/Chapter15/CodeTable.hs b/Chapter15/CodeTable.hs --- a/Chapter15/CodeTable.hs +++ b/Chapter15/CodeTable.hs @@ -4,7 +4,7 @@ -- -- Converting a Huffman tree to a ord table. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/Coding.hs b/Chapter15/Coding.hs --- a/Chapter15/Coding.hs +++ b/Chapter15/Coding.hs @@ -5,7 +5,7 @@ -- Huffman coding in Haskell. -- The top-level functions for coding and decoding. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/Frequency.hs b/Chapter15/Frequency.hs --- a/Chapter15/Frequency.hs +++ b/Chapter15/Frequency.hs @@ -5,7 +5,7 @@ -- Calculating the frequencies of words in a text, used in -- Huffman coding. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/Main.hs b/Chapter15/Main.hs --- a/Chapter15/Main.hs +++ b/Chapter15/Main.hs @@ -4,7 +4,7 @@ -- -- The main module of the Huffman example -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/MakeCode.hs b/Chapter15/MakeCode.hs --- a/Chapter15/MakeCode.hs +++ b/Chapter15/MakeCode.hs @@ -4,7 +4,7 @@ -- -- Huffman coding in Haskell. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/MakeTree.hs b/Chapter15/MakeTree.hs --- a/Chapter15/MakeTree.hs +++ b/Chapter15/MakeTree.hs @@ -4,7 +4,7 @@ -- -- Turn a frequency table into a Huffman tree -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/Test.hs b/Chapter15/Test.hs --- a/Chapter15/Test.hs +++ b/Chapter15/Test.hs @@ -4,7 +4,7 @@ -- -- The test module of the Huffman example -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter15/Types.hs b/Chapter15/Types.hs --- a/Chapter15/Types.hs +++ b/Chapter15/Types.hs @@ -4,7 +4,7 @@ -- -- The types used in the Huffman coding example. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/QCStoreTest.hs b/Chapter16/QCStoreTest.hs --- a/Chapter16/QCStoreTest.hs +++ b/Chapter16/QCStoreTest.hs @@ -3,7 +3,7 @@ -- QCStoreTest.hs -- -- QuickCheck tests for stores. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Queues1.hs b/Chapter16/Queues1.hs --- a/Chapter16/Queues1.hs +++ b/Chapter16/Queues1.hs @@ -5,7 +5,7 @@ -- An abstract data type of queues, implemented as a list, with -- new elements added at the end of the list. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Queues2.hs b/Chapter16/Queues2.hs --- a/Chapter16/Queues2.hs +++ b/Chapter16/Queues2.hs @@ -5,7 +5,7 @@ -- An abstract data type of queues, implemnted as a list, with -- new elements added at the beginning of the list. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Queues3.hs b/Chapter16/Queues3.hs --- a/Chapter16/Queues3.hs +++ b/Chapter16/Queues3.hs @@ -5,7 +5,7 @@ -- An abstract data type of queues, implemnted as two lists, with -- new elements added at the beginning of the second list. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Store.hs b/Chapter16/Store.hs --- a/Chapter16/Store.hs +++ b/Chapter16/Store.hs @@ -5,7 +5,7 @@ -- An abstract data type of stores of integers, implemented as -- a list of pairs of variables and values. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/StoreFun.hs b/Chapter16/StoreFun.hs --- a/Chapter16/StoreFun.hs +++ b/Chapter16/StoreFun.hs @@ -4,7 +4,7 @@ -- -- An abstract data type of stores of integers, implemented as functions. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/StoreTest.hs b/Chapter16/StoreTest.hs --- a/Chapter16/StoreTest.hs +++ b/Chapter16/StoreTest.hs @@ -5,7 +5,7 @@ -- An abstract data type of stores of integers, together with -- QuickCheck generator. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Tree.hs b/Chapter16/Tree.hs --- a/Chapter16/Tree.hs +++ b/Chapter16/Tree.hs @@ -4,7 +4,7 @@ -- -- Search trees as an ADT -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/UseStore.hs b/Chapter16/UseStore.hs --- a/Chapter16/UseStore.hs +++ b/Chapter16/UseStore.hs @@ -4,7 +4,7 @@ -- -- Using the abstract data type Store of stores of integers. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/UseStoreFun.hs b/Chapter16/UseStoreFun.hs --- a/Chapter16/UseStoreFun.hs +++ b/Chapter16/UseStoreFun.hs @@ -4,7 +4,7 @@ -- -- Using an abstract data type StoreFun of stores of integers. -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter16/UseTree.hs b/Chapter16/UseTree.hs --- a/Chapter16/UseTree.hs +++ b/Chapter16/UseTree.hs @@ -4,7 +4,7 @@ -- -- Using the search tree ADT -- --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- ------------------------------------------------------------------------- diff --git a/Chapter17.hs b/Chapter17.hs --- a/Chapter17.hs +++ b/Chapter17.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 17 -- diff --git a/Chapter18.hs b/Chapter18.hs --- a/Chapter18.hs +++ b/Chapter18.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 18 -- diff --git a/Chapter19.hs b/Chapter19.hs --- a/Chapter19.hs +++ b/Chapter19.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 19 -- diff --git a/Chapter2.hs b/Chapter2.hs --- a/Chapter2.hs +++ b/Chapter2.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 2011. +-- (c) Simon Thompson, 2011. -- -- Chapter 2 -- diff --git a/Chapter20/Pic.hs b/Chapter20/Pic.hs --- a/Chapter20/Pic.hs +++ b/Chapter20/Pic.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Pic.hs -- diff --git a/Chapter20/Pictures.hs b/Chapter20/Pictures.hs --- a/Chapter20/Pictures.hs +++ b/Chapter20/Pictures.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2010. +-- (c) Simon Thompson, 1996-2010. -- -- Pictures.hs -- diff --git a/Chapter20/QC.hs b/Chapter20/QC.hs --- a/Chapter20/QC.hs +++ b/Chapter20/QC.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- QC.hs -- diff --git a/Chapter20/QCfuns.hs b/Chapter20/QCfuns.hs --- a/Chapter20/QCfuns.hs +++ b/Chapter20/QCfuns.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- QCfuns -- diff --git a/Chapter20/RegExp.hs b/Chapter20/RegExp.hs --- a/Chapter20/RegExp.hs +++ b/Chapter20/RegExp.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- RegExp.hs -- diff --git a/Chapter21/Chapter21.hs b/Chapter21/Chapter21.hs --- a/Chapter21/Chapter21.hs +++ b/Chapter21/Chapter21.hs @@ -1,7 +1,7 @@ -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2010. +-- (c) Simon Thompson, 1996-2010. -- Chapter 21 diff --git a/Chapter21/PerformanceI.hs b/Chapter21/PerformanceI.hs --- a/Chapter21/PerformanceI.hs +++ b/Chapter21/PerformanceI.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- PerformanceI.hs -- diff --git a/Chapter21/PerformanceIA.hs b/Chapter21/PerformanceIA.hs --- a/Chapter21/PerformanceIA.hs +++ b/Chapter21/PerformanceIA.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- PerformanceIA.hs -- diff --git a/Chapter21/PerformanceIS.hs b/Chapter21/PerformanceIS.hs --- a/Chapter21/PerformanceIS.hs +++ b/Chapter21/PerformanceIS.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- PerformanceIS.hs -- diff --git a/Chapter3.hs b/Chapter3.hs --- a/Chapter3.hs +++ b/Chapter3.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 3 -- diff --git a/Chapter4.hs b/Chapter4.hs --- a/Chapter4.hs +++ b/Chapter4.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 4 -- diff --git a/Chapter5.hs b/Chapter5.hs --- a/Chapter5.hs +++ b/Chapter5.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 5 -- diff --git a/Chapter6.hs b/Chapter6.hs --- a/Chapter6.hs +++ b/Chapter6.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 6 -- diff --git a/Chapter7.hs b/Chapter7.hs --- a/Chapter7.hs +++ b/Chapter7.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 7 -- diff --git a/Chapter8.hs b/Chapter8.hs --- a/Chapter8.hs +++ b/Chapter8.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 8 -- diff --git a/Chapter9.hs b/Chapter9.hs --- a/Chapter9.hs +++ b/Chapter9.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Chapter 9 -- diff --git a/Craft3e.cabal b/Craft3e.cabal --- a/Craft3e.cabal +++ b/Craft3e.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: Craft3e -version: 0.2.0.5 +version: 0.2.0.6 license: MIT license-file: LICENSE copyright: (c) Simon Thompson @@ -152,4 +152,15 @@ build-depends: base >= 4 && < 5, Craft3e + +executable minesweeperGraphical + main-is: RunGraphicMine.hs + other-modules: GraphicMine + hs-source-dirs: ./Minesweeper/Graphical + default-language: Haskell2010 + build-depends: + base >= 4 && < 5, + Craft3e, + random >= 1.1 && < 1.3, + gloss >= 1.13 && < 1.14 diff --git a/Index.hs b/Index.hs --- a/Index.hs +++ b/Index.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Index -- diff --git a/Minesweeper/Graphical/GraphicMine.hs b/Minesweeper/Graphical/GraphicMine.hs new file mode 100644 --- /dev/null +++ b/Minesweeper/Graphical/GraphicMine.hs @@ -0,0 +1,246 @@ +---------------------------------------------------------- +-- +-- GraphicMine.hs +-- +-- Simon Thompson, June 2002 +-- Modernized to use the `gloss` graphics library, 2026 +-- +---------------------------------------------------------- + +-- A graphical interface to the Minesweeper game defined in +-- Minesweeper5.hs. This single file replaces the four incremental +-- versions (GraphicMine.hs through GraphicMine4.hs) that used to be +-- kept here, each built on a graphics library, GraphicsUtils, that +-- no longer exists anywhere -- neither in this repository nor on +-- Hackage. All of the features those four files added one by one +-- (revealing and flagging cells, starting a new game, and a +-- deduction assist) are built in here from the start, using the +-- actively-maintained `gloss` package instead. +-- +-- To play: run the "minesweeperGraphical" executable (`cabal run +-- minesweeperGraphical`), or load this module and call playGameG +-- directly, e.g. `playGameG 10 8` for a 10-mine, 8x8 board. + +module GraphicMine where + +import Graphics.Gloss hiding ( Point ) +import Graphics.Gloss.Interface.Pure.Game hiding ( Point ) +import System.Random ( StdGen, newStdGen, random ) + +import MineRandom ( randomGridDyn ) +import Minesweeper5 + ( Point, Equations + , countConfig, updateArray, uncoverClosure + , getInfo, fixSplit, makePos, makeNeg, (!!!) + ) + +-- Board geometry +-- ^^^^^^^^^^^^^^ + +cellSize :: Float +cellSize = 40 + +headerHeight :: Float +headerHeight = 60 + +-- Game state +-- ^^^^^^^^^^ + +data Status = Playing | Won | Lost deriving (Eq, Show) + +data World = World + { wSize :: Int + , wMines :: Int + , wGrid :: [[Bool]] -- True where a mine sits + , wCount :: [[Int]] -- adjacency counts + , wShowing :: [[Bool]] -- revealed cells + , wMarked :: [[Bool]] -- flagged cells + , wStatus :: Status + , wGen :: StdGen -- source of the seed for the next new game + } + +-- A fresh board of the given size and mine count, from a seed. + +newBoard :: Int -> Int -> Int -> StdGen -> World +newBoard mines size seed gen + = World + { wSize = size, wMines = mines + , wGrid = grid, wCount = countConfig grid + , wShowing = blank, wMarked = blank + , wStatus = Playing, wGen = gen + } + where + grid = randomGridDyn seed mines size size + blank = replicate size (replicate size False) + +-- Play the game; pass in the number of mines and the (square) board size. + +playGameG :: Int -> Int -> IO () + +playGameG mines size + = do + gen0 <- newStdGen + let (seed, gen1) = random gen0 :: (Int, StdGen) + play (InWindow "Minesweeper" (windowW, windowH) (100, 100)) + white 30 (newBoard mines size seed gen1) render handleEvent (const id) + where + windowW = round (fromIntegral size * cellSize) + windowH = round (fromIntegral size * cellSize + headerHeight) + +-- Turning game state into a picture +-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +render :: World -> Picture + +render w + = pictures (header : [ renderCell w row col + | row <- [0 .. wSize w - 1], col <- [0 .. wSize w - 1] ]) + where + header + = translate (- boardW w / 2) (boardH w / 2 + 10) + $ scale 0.13 0.13 + $ color black + $ Text (statusText w) + +boardW, boardH :: World -> Float +boardW w = fromIntegral (wSize w) * cellSize +boardH w = fromIntegral (wSize w) * cellSize + +statusText :: World -> String +statusText w + = case wStatus w of + Won -> "You win! Press N for a new game." + Lost -> "Boom! Press N for a new game." + Playing -> show (wMines w) ++ + " mines. Click: reveal Right-click: flag N: new game A: assist" + +renderCell :: World -> Int -> Int -> Picture + +renderCell w row col + = translate x y (pictures (box : maybe [] (:[]) label)) + where + x = - boardW w / 2 + (fromIntegral col + 0.5) * cellSize + y = boardH w / 2 - headerHeight - (fromIntegral row + 0.5) * cellSize + + point = (row, col) + revealed = wShowing w !!! point + flagged = wMarked w !!! point + mined = wGrid w !!! point + n = wCount w !!! point + showMine = wStatus w == Lost && mined + + box = color cellColour (rectangleSolid (cellSize - 2) (cellSize - 2)) + cellColour + | showMine = red + | flagged = orange + | revealed = greyN 0.85 + | otherwise = greyN 0.55 + + label + | showMine = Just (cellLabel black "*") + | flagged && not revealed = Just (cellLabel black "F") + | revealed && n > 0 = Just (cellLabel (countColour n) (show n)) + | otherwise = Nothing + + cellLabel colour str + = color colour $ translate (-7) (-7) $ scale 0.13 0.13 $ Text str + +-- The classic Minesweeper colour-per-count convention. + +countColour :: Int -> Color +countColour n + = case n of + 1 -> blue + 2 -> dark green + 3 -> red + 4 -> violet + 5 -> makeColor 0.5 0 0 1 + 6 -> cyan + 7 -> black + _ -> greyN 0.4 + +-- Handling clicks and key presses +-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +handleEvent :: Event -> World -> World + +handleEvent (EventKey (Char 'n') Down _ _) w + = newGame w +handleEvent (EventKey (Char 'N') Down _ _) w + = newGame w +handleEvent (EventKey (Char 'a') Down _ _) w + | wStatus w == Playing = assist w +handleEvent (EventKey (Char 'A') Down _ _) w + | wStatus w == Playing = assist w +handleEvent (EventKey (MouseButton LeftButton) Down _ pos) w + | wStatus w == Playing = maybe w (reveal w) (cellAt w pos) +handleEvent (EventKey (MouseButton RightButton) Down _ pos) w + | wStatus w == Playing = maybe w (flagCell w) (cellAt w pos) +handleEvent _ w = w + +-- Which cell, if any, a click at this window position lands on. + +cellAt :: World -> (Float, Float) -> Maybe Point + +cellAt w (mx, my) + | row >= 0 && row < size && col >= 0 && col < size = Just (row, col) + | otherwise = Nothing + where + size = wSize w + col = floor ((mx + boardW w / 2) / cellSize) + row = floor ((boardH w / 2 - headerHeight - my) / cellSize) + +-- Revealing a cell: losing if it's a mine, otherwise uncovering its +-- closure of neighbouring zero-count cells, exactly as playGameGrid +-- does in Minesweeper5.hs. + +reveal :: World -> Point -> World + +reveal w point + | wMarked w !!! point = w + | wGrid w !!! point = w { wStatus = Lost } + | otherwise = checkWin w { wShowing = uncoverClosure (wCount w) point (wShowing w) } + +-- Toggling a flag on a covered cell. + +flagCell :: World -> Point -> World + +flagCell w point + | wShowing w !!! point = w + | otherwise = w { wMarked = updateArray point (not (wMarked w !!! point)) (wMarked w) } + +-- The game is won once every non-mine cell has been revealed. + +checkWin :: World -> World + +checkWin w + | all and (zipWith (zipWith (||)) (wGrid w) (wShowing w)) = w { wStatus = Won } + | otherwise = w + +-- A new board, same mines/size, using the next seed from wGen. + +newGame :: World -> World + +newGame w = newBoard (wMines w) (wSize w) seed gen' + where + (seed, gen') = random (wGen w) :: (Int, StdGen) + +-- One round of deduction assist: for every equation derivable from +-- the currently-revealed cells (using the same getInfo/fixSplit +-- machinery Minesweeper5.hs's own 's'/'a' commands use), reveal +-- every cell a determined-safe equation names, and flag every cell +-- a determined-mined equation names. + +assist :: World -> World + +assist w + = checkWin w { wShowing = foldr (uncoverClosure (wCount w)) (wShowing w) safe + , wMarked = foldr (\pt -> updateArray pt True) (wMarked w) mines + } + where + shown = [ (r, c) | r <- [0 .. wSize w - 1], c <- [0 .. wSize w - 1] + , wShowing w !!! (r, c) ] + eqs = fixSplit (concatMap (getInfo (wCount w) (wShowing w) (wMarked w)) shown) + :: Equations + safe = makeNeg eqs + mines = makePos eqs diff --git a/Minesweeper/Graphical/RunGraphicMine.hs b/Minesweeper/Graphical/RunGraphicMine.hs new file mode 100644 --- /dev/null +++ b/Minesweeper/Graphical/RunGraphicMine.hs @@ -0,0 +1,17 @@ +---------------------------------------------------------- +-- +-- RunGraphicMine.hs +-- +-- Simon Thompson, 2026 +-- +---------------------------------------------------------- + +-- The executable entry point for the graphical Minesweeper in +-- GraphicMine.hs: `cabal run minesweeperGraphical`. + +module Main where + +import GraphicMine ( playGameG ) + +main :: IO () +main = playGameG 10 8 diff --git a/ParseLib.hs b/ParseLib.hs --- a/ParseLib.hs +++ b/ParseLib.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- ParseLib.hs -- diff --git a/ParsingBasics.hs b/ParsingBasics.hs --- a/ParsingBasics.hs +++ b/ParsingBasics.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Case study: Parsing expressions -- diff --git a/Pic.hs b/Pic.hs --- a/Pic.hs +++ b/Pic.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Pic.hs -- diff --git a/Pictures.hs b/Pictures.hs --- a/Pictures.hs +++ b/Pictures.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2010. +-- (c) Simon Thompson, 1996-2010. -- -- Pictures.hs -- diff --git a/PicturesSVG.hs b/PicturesSVG.hs --- a/PicturesSVG.hs +++ b/PicturesSVG.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- PicturesSVG -- diff --git a/QCfuns.hs b/QCfuns.hs --- a/QCfuns.hs +++ b/QCfuns.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- QCfuns -- diff --git a/RPS.hs b/RPS.hs --- a/RPS.hs +++ b/RPS.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------- -- Haskell: The Craft of Functional Programming -- Simon Thompson --- (c) Addison-Wesley, 1996-2010. +-- (c) Simon Thompson, 1996-2010. -- -- RPS: Rock - Paper - Scissors ----------------------------------------------------------------------- diff --git a/Relation.hs b/Relation.hs --- a/Relation.hs +++ b/Relation.hs @@ -4,7 +4,7 @@ -- -- Building Relations and Graphs on top of the Set ADT. -- --- (c) Addison-Welsey, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- --------------------------------------------------------------------------- diff --git a/Set.hs b/Set.hs --- a/Set.hs +++ b/Set.hs @@ -4,7 +4,7 @@ -- -- ADT of sets, implemented as ordered lists without repetitions. -- --- (c) Addison-Welsey, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- --------------------------------------------------------------------------- diff --git a/Simulation/Base.hs b/Simulation/Base.hs --- a/Simulation/Base.hs +++ b/Simulation/Base.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- The basis of the simulation package. -- diff --git a/Simulation/QueueState.hs b/Simulation/QueueState.hs --- a/Simulation/QueueState.hs +++ b/Simulation/QueueState.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- The queue ADT: its signature is given in comments in the module -- header. diff --git a/Simulation/RandomGen.hs b/Simulation/RandomGen.hs --- a/Simulation/RandomGen.hs +++ b/Simulation/RandomGen.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- Random number generation. -- diff --git a/Simulation/ServerState.hs b/Simulation/ServerState.hs --- a/Simulation/ServerState.hs +++ b/Simulation/ServerState.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- The server ADT: its signature is given in comments in the module -- header. diff --git a/Simulation/TopLevelServe.hs b/Simulation/TopLevelServe.hs --- a/Simulation/TopLevelServe.hs +++ b/Simulation/TopLevelServe.hs @@ -2,7 +2,7 @@ -- -- Haskell: The Craft of Functional Programming, 3e -- Simon Thompson --- (c) Addison-Wesley, 1996-2011. +-- (c) Simon Thompson, 1996-2011. -- -- The top level of the server simulation. --