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