{-# LANGUAGE ViewPatterns #-}
module TableGraphics
( drawPlace
) where
import Place
import Game (State (..))
import Graphics.Rendering.Cairo
import Control.Monad (when)
-----------------------------------------
drawPlace
:: Bool -- ^ signs are not shown
-> Bool -- ^ highlighted
-> Bool -- ^ focused
-> Place
-> State
-> Render ()
drawPlace bb b foc (coords -> (i,j)) st = do
rectangle (-0.4) (-0.4) 0.8 0.8
setLineWidth 0.03
setSourceRGB' bg
strokePreserve
setSourceRGB' $ case st of
Clear _ _ -> bg
Hidden True _ -> bg
Death -> bg
_ -> if b then bg else blue
fill
setSourceRGB' black
if foc
then do
rectangle (-0.35) (-0.35) 0.7 0.7
setLineWidth 0.02
setDash [0.1,0.1] (if even (i + j) then 0 else 0.1)
stroke
setDash [] 0
else return ()
setLineCap LineCapRound
setLineWidth 0.1
if bb
then return ()
else case st of
Death -> do
setLineCap LineCapSquare
moveTo (-0.25) (-0.25)
lineTo 0.25 0.25
stroke
moveTo 0.25 (-0.25)
lineTo (-0.25) 0.25
stroke
Hidden False (Just d) -> do
setLineWidth 0.03
arc 0 0 0.25 0 (2*pi*(1- realToFrac d))
setSourceRGB' $ Color_ 0.3 0.4 0.5
stroke
arc 0 0 0.25 (2*pi*(1- realToFrac d)) (2*pi)
setSourceRGB' $ Color_ 1 1 1
stroke
Hidden True bbb -> do
setLineWidth 0.03
arc 0 0 0.25 0 (2*pi)
setSourceRGB' $ if b then bg else blue
fillPreserve
setSourceRGB' black
stroke
when (maybe False (/=0) bbb) $ do
setLineCap LineCapSquare
moveTo (-0.25) (-0.25)
lineTo 0.25 0.25
stroke
moveTo 0.25 (-0.25)
lineTo (-0.25) 0.25
stroke
Clear _ n -> do
case n of
0 -> do
setLineCap LineCapSquare
setLineWidth 0.03
moveTo (-0.2) 0
lineTo 0.2 0
stroke
1 -> do
point 0 0
2 -> do
point (-0.2) 0
point 0.2 0
3 -> do
point 0 (-0.20)
point (-0.2) 0.14
point 0.2 0.14
4 -> do
point (-0.2) 0.2
point 0.2 0.2
point (-0.2) (-0.2)
point 0.2 (-0.2)
5 -> do
point 0 0
point (-0.2) 0.2
point 0.2 0.2
point (-0.2) (-0.2)
point 0.2 (-0.2)
6 -> do
point (-0.2) 0
point 0.2 0
point (-0.2) 0.2
point 0.2 0.2
point (-0.2) (-0.2)
point 0.2 (-0.2)
7 -> do
point 0 0
point (-0.2) 0
point 0.2 0
point (-0.2) 0.2
point 0.2 0.2
point (-0.2) (-0.2)
point 0.2 (-0.2)
8 -> do
point (-0.2) 0
point 0.2 0
point 0 (-0.2)
point 0 0.2
point (-0.2) 0.2
point 0.2 0.2
point (-0.2) (-0.2)
point 0.2 (-0.2)
return ()
_ -> return ()
point :: Double -> Double -> Render ()
point x y = do
moveTo x y
relLineTo 0 0
stroke
data Color_ = Color_ Double Double Double
bg, blue, black, white :: Color_
blue = Color_ 0.65 0.8 1
black = Color_ 0 0 0
white = Color_ 1 1 1
bg = Color_ 0.9 0.9 0.9
setSourceRGB' :: Color_ -> Render ()
setSourceRGB' (Color_ r g b) = setSourceRGB r g b
betw ::
Double -> Color_ -> Color_ -> Color_
betw 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)