module GTK.Square
( renderSquare
) where
import Event
import Graphics.Rendering.Cairo
import Control.Monad
-----------------------------------------
renderSquare :: (Double, Double) -> (Int, Int) -> (Bool, BackGround, Sign) -> Render ()
renderSquare (a, b) (x, y) (focused, bg, sign) = 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
setSourceRGB' background
strokePreserve
unless (isBomb sign) $ setSourceRGB' $ toColor bg
fill
setSourceRGB' black
when focused $ 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 sign of
NoSign -> return ()
BusySign i -> do
setLineCap LineCapSquare
setSourceRGB' $ Color 1 0.9 0.7 -- between 0.6 white black
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' $ toColor bg
fillPreserve
setSourceRGB' black
stroke
Hint d -> do
let (r1, r2) = radians d
arc 0 0 0.25 r1 r2
setSourceRGB' $ between 0.5 black blue
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' $ toColor 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 ]
------------------
[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)
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