minesweeper-0.9.2.1: GTK/Square.hs
module GTK.Square
( renderSquare
) where
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
-----------------------------------------
saveAndRestore m = do
save
_ <- m
restore
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 = saveAndRestore $ do
scale a b
translate (fromIntegral x - 0.5) (fromIntegral y - 0.5)
setLineCap LineCapSquare
rectangle (-0.5) (-0.5) 1 1
setSourceRGB' background
fill
unless (isBomb squareState) $ do
rectangle (-0.4) (-0.4) 0.8 0.8
setSourceRGB' bg
fill
setSourceRGB' black
when (focused squareState) $ do
setLineWidth 0.02
rectangle (-0.35) (-0.35) 0.7 0.7
setDash [0.1, 0.1] 0
stroke
setDash [] 0
setLineWidth 0.03
case squareState of
NoSign _ _ -> return ()
HiddenSign -> return ()
BusySign _ _ i -> do
setLineCap LineCapSquare
setSourceRGB' yellow
setLineWidth 0.05
let f j = do
let phi = j/5*pi + fromIntegral i/200*2*pi
(x, y) = (0.25* sin phi, 0.25* cos phi)
moveTo x y
lineTo (-x) (-y)
stroke
mapM_ f [1..5]
Bomb _ _ -> do
arc 0 0 0.25 0 (2*pi)
setSourceRGB' bg
fillPreserve
setSourceRGB' black
stroke
Hint _ _ d -> do
let (r1, r2) = radians d
arc 0 0 0.25 r1 r2
setSourceRGB' darkblue
stroke
arc 0 0 0.25 r2 (r1 + 2*pi)
setSourceRGB' white
stroke
HintedBomb _ _ d -> do
let (r1, r2) = radians d
arc 0 0 0.25 0 (2*pi)
setSourceRGB' bg
fill
arc 0 0 0.25 r2 (r1 + 2*pi)
setSourceRGB' white
fill
arc 0 0 0.25 0 (2*pi)
setSourceRGB' black
stroke
Death -> do
moveTo (-0.25) (-0.25)
lineTo 0.25 0.25
stroke
moveTo 0.25 (-0.25)
lineTo (-0.25) 0.25
stroke
Clear _ 0 _ -> do
setLineWidth 0.03
moveTo (-0.2) 0
lineTo 0.2 0
stroke
Clear _ n _ -> do
setLineWidth 0.1
setLineCap LineCapRound
sequence_ $ case n of
1 -> [p5]
2 -> [p4, p6]
3 -> [p2, p7', p9']
4 -> [ p1, p3
, p7, p9 ]
5 -> [ p1, p3
, p5
, p7, p9 ]
6 -> [ p1, p3
, p4, p6
, p7, p9 ]
7 -> [ p1, p3
, p4, p5, p6
, p7, p9 ]
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
------------------
[p1, p2, p3, p4, p5, p6, p7, p8, p9] = [point i j | j<-[-0.2, 0, 0.2], i<-[-0.2, 0, 0.2]]
p7' = point (-0.2) 0.14
p9' = point 0.2 0.14
point :: Double -> Double -> Render ()
point x y = do
moveTo x y
relLineTo 0 0
stroke
radians d = (pi / 2 - d', pi / 2 + d')
where
d' = pi * (1 - fromIntegral d / 100)
setSourceRGB' :: Color -> Render ()
setSourceRGB' (Color r g b) = setSourceRGB (ff r) (ff g) (ff b)
ff i = fromIntegral i / 65535