minesweeper 0.8.8.2 → 0.8.8.3
raw patch · 11 files changed
+153/−111 lines, 11 filessetup-changed
Files
- Core/BitField.lhs +5/−0
- Data/PContainer.lhs +4/−0
- Event.hs +36/−18
- GTK.hs +33/−5
- GTK/Square.hs +38/−39
- Setup.hs +0/−2
- Setup.lhs +3/−0
- Transition/Graphics.hs +23/−40
- Transition/Managed.hs +2/−2
- minesweeper.cabal +1/−1
- ms.glade +8/−4
Core/BitField.lhs view
@@ -13,8 +13,13 @@ > import Data.PContainer +#ifdef TEST+ > import Test.LazySmallCheck hiding (empty) > import Number.Peano++#endif+ > import Control.Monad > import Data.Binary > import Data.DeriveTH
Data/PContainer.lhs view
@@ -10,8 +10,12 @@ Import List ----------- +#ifdef TEST+ > import Test.LazySmallCheck hiding (empty) > import Number.Peano++#endif import Control.Monad
Event.hs view
@@ -54,32 +54,50 @@ type Responses = [Response] data Response- = DrawSquares Board [(Square, (Bool, BackGround, Sign))]+ = DrawSquares Board [(Square, SquareState)] | ShowTime String -- gyorsulna szerkezetváltással | ShowInfo String -- gyorsulna szerkezetváltással | PopUpPreferences Configuration | PopUpNewScore Configuration (Maybe Int) [ScoreEntry] [ScoreAttr] deriving (Eq, Ord, Show) -data BackGround - = Blue- | BlueGreen- | Green- | Reddish Int -- ^ 0-100- deriving (Eq, Ord, Show)--data Sign- = NoSign- | Bomb+data SquareState + = HiddenSign | Death- | Clear Int -- ^ 0-8- | Hint Int -- ^ 0-100- | HintedBomb Int -- ^ 0-100- | BusySign Int -- ^ phase 0-100+ | Clear Focused Int Dangerousness -- ^ 0-8+ | NoSign Focused Prelight + | Hint Focused Prelight Int -- ^ 0-100+ | BusySign Focused Prelight Int -- ^ phase 0-100+ | Bomb Focused Prelight + | HintedBomb Focused Prelight Int -- ^ 0-100 deriving (Eq, Ord, Show) +type Focused = Bool -isBomb Bomb = True-isBomb (HintedBomb _) = True-isBomb _ = False+type Prelight = Bool++type Dangerousness = Int -- ^ 0-100++focused HiddenSign = False+focused Death = False+focused (Clear f _ _) = f+focused (NoSign f _) = f+focused (Hint f _ _) = f+focused (BusySign f _ _) = f+focused (Bomb f _) = f+focused (HintedBomb f _ _) = f++prelight HiddenSign = False+prelight Death = False+prelight (Clear _ _ _) = False+prelight (NoSign _ p) = p+prelight (Hint _ p _) = p+prelight (BusySign _ p _) = p+prelight (Bomb _ p) = p+prelight (HintedBomb _ p _) = p+++isBomb (Bomb _ _) = True+isBomb (HintedBomb _ _ _) = True+isBomb _ = False
GTK.hs view
@@ -14,7 +14,7 @@ import GTK.Score import Paths_minesweeper -import Graphics.UI.Gtk+import Graphics.UI.Gtk hiding (event) import Graphics.UI.Gtk.Glade import Graphics.UI.Gtk.Gdk.EventM import Graphics.Rendering.Cairo (liftIO) -- ???@@ -207,21 +207,49 @@ widgetDestroy a -redrawSigns :: GUIState -> Board -> [(Square, (Bool, BackGround, Sign))] -> IO ()+redrawSigns :: GUIState -> Board -> [(Square, SquareState)] -> IO () redrawSigns _ _ [] = return () redrawSigns gst s l = do win <- widgetGetDrawWindow $ table gst+ style <- widgetGetStyle $ table gst+ backgroundColor <- styleGetBackground style StateNormal (width, height) <- drawableGetSize win let ss = (fromIntegral width / fromIntegral (xSize s), fromIntegral height / fromIntegral (ySize s))- mapM_ (drawSquare win ss) l+ mapM_ (drawSquare win (backgroundColor, blue, green, dangerColor, black, white, between 0.5 black blue, color 1 0.9 0.7) ss) l -drawSquare win (a, b) (p, xx) = do+drawSquare win style (a, b) (p, xx) = do let (x, y) = coords p drawWindowBeginPaintRect win $ Rectangle (round $ a*fromIntegral (x-1)) (round $ b*fromIntegral (y-1)) (ceiling a) (ceiling b)- renderWithDrawable win $ renderSquare (a, b) (x, y) xx+ renderWithDrawable win $ renderSquare style (a, b) (x, y) xx drawWindowEndPaint win +------------------------++dangerColor dangerousness = between (realToFrac dangerousness / 100) backgroundColor red++backgroundColor, blue, black, white :: Color+blue = color 0.65 0.8 1+green = color 0.65 0.8 0.6+black = color 0 0 0+white = color 1 1 1+backgroundColor = white -- between 0.9 black white -- TODO: get real background+red = color 1 0.3 0++between :: Double -> Color -> Color -> Color+between pr (Color a b c) (Color a' b' c') = color (f a a') (f b b') (f c c') where++ f i j = max 0 $ min 1 $ i' + pr * (j' - i') where+ i' = ff i+ j' = ff j+++color :: Double -> Double -> Double -> Color+color r g b = Color (f r) (f g) (f b) where++ f x = round (65535*x)++ff i = fromIntegral i / 65535 -------------------------------------------------- helper
GTK/Square.hs view
@@ -5,28 +5,34 @@ import Event import Graphics.Rendering.Cairo+import Graphics.UI.Gtk.Gdk.GC (Color(..))+--import Graphics.UI.Gtk.General.Style+--import Graphics.UI.Gtk.General.Enums (StateType(..)) import Control.Monad ----------------------------------------- -renderSquare :: (Double, Double) -> (Int, Int) -> (Bool, BackGround, Sign) -> Render ()-renderSquare (a, b) (x, y) (focused, bg, sign) = do+renderSquare :: (Color, Color, Color, Int -> Color, Color, Color, Color, Color) ->+ (Double, Double) -> (Int, Int) -> SquareState -> Render ()+renderSquare (background, activeColor, prelightColor, dangerColor, black, white, darkblue, yellow) + (a, b) (x, y) squareState = do scale a b translate (fromIntegral x - 0.5) (fromIntegral y - 0.5) setLineCap LineCapSquare - rectangle (-0.4) (-0.4) 0.8 0.8- setLineWidth 0.03+ rectangle (-0.5) (-0.5) 1 1 setSourceRGB' background- strokePreserve- unless (isBomb sign) $ setSourceRGB' $ toColor bg fill+ unless (isBomb squareState) $ do+ rectangle (-0.4) (-0.4) 0.8 0.8+ setSourceRGB' bg+ fill setSourceRGB' black - when focused $ do+ when (focused squareState) $ do setLineWidth 0.02 rectangle (-0.35) (-0.35) 0.7 0.7 setDash [0.1, 0.1] 0@@ -35,13 +41,15 @@ setLineWidth 0.03 - case sign of+ case squareState of - NoSign -> return ()+ NoSign _ _ -> return () - BusySign i -> do+ HiddenSign -> return ()++ BusySign _ _ i -> do setLineCap LineCapSquare- setSourceRGB' $ Color 1 0.9 0.7 -- between 0.6 white black + setSourceRGB' yellow setLineWidth 0.05 let f j = do let phi = j/5*pi + fromIntegral i/200*2*pi@@ -51,26 +59,26 @@ stroke mapM_ f [1..5] - Bomb -> do+ Bomb _ _ -> do arc 0 0 0.25 0 (2*pi)- setSourceRGB' $ toColor bg+ setSourceRGB' bg fillPreserve setSourceRGB' black stroke - Hint d -> do+ Hint _ _ d -> do let (r1, r2) = radians d arc 0 0 0.25 r1 r2- setSourceRGB' $ between 0.5 black blue + setSourceRGB' darkblue stroke arc 0 0 0.25 r2 (r1 + 2*pi) setSourceRGB' white stroke - HintedBomb d -> do+ HintedBomb _ _ d -> do let (r1, r2) = radians d arc 0 0 0.25 0 (2*pi)- setSourceRGB' $ toColor bg+ setSourceRGB' bg fill arc 0 0 0.25 r2 (r1 + 2*pi) setSourceRGB' white@@ -87,13 +95,13 @@ lineTo (-0.25) 0.25 stroke - Clear 0 -> do+ Clear _ 0 _ -> do setLineWidth 0.03 moveTo (-0.2) 0 lineTo 0.2 0 stroke - Clear n -> do+ Clear _ n _ -> do setLineWidth 0.1 setLineCap LineCapRound @@ -122,7 +130,16 @@ 8 -> [ p1, p2, p3 , p4, p6 , p7, p8, p9 ]+ where + bg | prelight squareState + = prelightColor+ | (Clear _ _ dangerousness) <- squareState+ = dangerColor dangerousness+ | Death <- squareState+ = dangerColor 100+ | otherwise + = activeColor ------------------@@ -141,27 +158,9 @@ where d' = pi * (1 - fromIntegral d / 100) -data Color = Color Double Double Double -background, blue, black, white :: Color-blue = Color 0.65 0.8 1-green = Color 0.65 0.8 0.6-black = Color 0 0 0-white = Color 1 1 1-background = between 0.9 black white--toColor (Reddish r) = between (realToFrac r / 100) background (Color 1 0.3 0)-toColor Blue = blue-toColor BlueGreen = between 0.5 green blue-toColor Green = green---between :: Double -> Color -> Color -> Color-between pr (Color a b c) (Color a' b' c') = Color (f a a') (f b b') (f c c') where-- f i j = max 0 $ min 1 $ i + pr * (j - i)- setSourceRGB' :: Color -> Render ()-setSourceRGB' (Color r g b) = setSourceRGB r g b+setSourceRGB' (Color r g b) = setSourceRGB (ff r) (ff g) (ff b) +ff i = fromIntegral i / 65535
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
Transition/Graphics.hs view
@@ -13,51 +13,34 @@ ------------------------------------------------------------- -renderSquare :: State -> Square -> (Bool, BackGround, Sign)-renderSquare st p = (hasFocus, bg, sign) where -+squareState :: State -> Square -> SquareState+squareState st p + | Just r <- revealing st+ , p == revSquare r+ , Just i <- busyAnimation r+ = BusySign focused prelight i+ | Just h <- hint st+ , Just max <- maxHiddenProb g+ , Just x <- M.lookup p $ hiddenProbs g+ , h == FullHint || x == max || x == 0 || marked'+ = (if marked' then HintedBomb else Hint) focused prelight x+ | marked' + = Bomb focused prelight + | Just Nothing <- revealed+ = Death+ | Just (Just i) <- revealed+ = if hiddenTable st then HiddenSign else Clear focused i dangerousness+ | otherwise + = NoSign focused prelight + where g = game st - hasFocus = p == focus st && focusMoves st- hasMouseFocus = maybe False (== p) (mouseFocus st)+ focused = p == focus st && focusMoves st+ prelight = maybe False (== p) (mouseFocus st) && mouseFocusShown st revealed = M.lookup p $ revealResults g marked' = S.member p $ marked g-- hint'- | Just h <- hint st- , Just max <- maxHiddenProb g- , Just x <- M.lookup p $ hiddenProbs g- , h == FullHint || x == max || x == 0 || marked'- = Just x- | otherwise - = Nothing-- sign - | Just r <- revealing st- , p == revSquare r- , Just i <- busyAnimation r- = BusySign i- | hiddenTable st - = NoSign- | Just x <- hint'- = if marked' then HintedBomb x else Hint x- | marked' - = Bomb- | Just Nothing <- revealed- = Death- | Just (Just i) <- revealed- = Clear i- | otherwise - = NoSign+ dangerousness = head $ [x | (q,x)<-redness st, q==p] ++ [0] - bg | isJust revealed || hiddenTable st && marked'- = Reddish $ head $ [x | (q,x)<-redness st, q==p] ++ [0]- | hasMouseFocus && mouseFocusShown st- = Green--- | hasMouseFocus--- = BlueGreen- | otherwise - = Blue infoString st
Transition/Managed.hs view
@@ -99,12 +99,12 @@ ch | isNothing (changes ost) || e == UpdateTable = [(p, f p) | p <- squares . size_ . state $ st] | Just (ost', l) <- changes ost- , f' <- renderSquare ost' + , f' <- squareState ost' = [(p, q) | p <- nub $ newChanges ++ l, let q = f p, q /= f' p] newChanges = changedSquares e (state ost) (state st) - f = renderSquare $ state st+ f = squareState $ state st responses :: Event -> State -> State -> [Response]
minesweeper.cabal view
@@ -1,5 +1,5 @@ name: minesweeper-version: 0.8.8.2+version: 0.8.8.3 category: Game synopsis: Minesweeper game which is always solvable without guessing description:
ms.glade view
@@ -14,6 +14,7 @@ <widget class="GtkVBox" id="vbox1"> <property name="visible">True</property> <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkMenuBar" id="menubar1"> <property name="visible">True</property>@@ -325,6 +326,7 @@ <widget class="GtkVBox" id="dialog-vbox1"> <property name="visible">True</property> <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="orientation">vertical</property> <property name="spacing">2</property> <child internal-child="action_area"> <widget class="GtkHButtonBox" id="dialog-action_area1">@@ -351,6 +353,7 @@ <widget class="GtkVBox" id="dialog-vbox3"> <property name="visible">True</property> <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="orientation">vertical</property> <property name="spacing">8</property> <child> <widget class="GtkTable" id="table1">@@ -679,7 +682,7 @@ <property name="layout_style">end</property> <child> <widget class="GtkButton" id="button1">- <property name="label" translatable="yes">gtk-cancel</property>+ <property name="label">gtk-cancel</property> <property name="response_id">-6</property> <property name="visible">True</property> <property name="can_focus">True</property>@@ -695,7 +698,7 @@ </child> <child> <widget class="GtkButton" id="button2">- <property name="label" translatable="yes">gtk-ok</property>+ <property name="label">gtk-ok</property> <property name="response_id">-5</property> <property name="visible">True</property> <property name="can_focus">True</property>@@ -730,6 +733,7 @@ <widget class="GtkVBox" id="dialog-vbox4"> <property name="visible">True</property> <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="orientation">vertical</property> <property name="spacing">2</property> <child> <widget class="GtkTextView" id="textview1">@@ -796,7 +800,7 @@ <property name="layout_style">end</property> <child> <widget class="GtkButton" id="button3">- <property name="label" translatable="yes">gtk-ok</property>+ <property name="label">gtk-ok</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property>@@ -987,7 +991,7 @@ <property name="layout_style">end</property> <child> <widget class="GtkButton" id="button1">- <property name="label" translatable="yes">gtk-ok</property>+ <property name="label">gtk-ok</property> <property name="response_id">-5</property> <property name="visible">True</property> <property name="can_focus">True</property>