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

-----------------------------------------

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.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