{-# LANGUAGE ViewPatterns #-}
module Table 
    ( GameTable
    , newTable
    , stopTable
    , resumeTable
    , setFixTable
    , resizeTable
    , adjustButts
    , adjustButtsInc
    , getFocusPos 
    ) where

import TableGraphics
import Place
import PlaceSet
import Game

import Graphics.Rendering.Cairo
import Graphics.UI.Gtk.Gdk.EventM

import Graphics.UI.Gtk hiding (Clear, fill)

import Control.Monad (when)
import Control.Concurrent.MVar

import qualified Data.Map as M

import Data.Maybe

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

-- ez van kivetítve
data IState  = IState
    { size_     :: (Int, Int)
    , board_    :: Board
    , focusPos  :: Place
    , workState :: St
    } 

data St 
    = Stopped 
    | Fixed 
    | Normal (Maybe Place)
    deriving Eq

data GameTable 
    = T 
        { frame     :: AspectFrame
        , area      :: DrawingArea 
        , states    :: MVar IState
        , flag_     :: Place -> IO ()
        , reveal    :: Place -> IO ()
        }

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

newTable :: AspectFrame -> (Place -> IO ()) -> (Place -> IO ()) -> IO GameTable
newTable asp fA rA = do
    canvas <- drawingAreaNew
    m <- newMVar undefined
    let g = T asp canvas m fA rA

    containerAdd asp canvas
    set canvas [widgetCanFocus := True]
    widgetAddEvents canvas [LeaveNotifyMask, PointerMotionMask, KeyPressMask]

    canvas `on` exposeEvent       $ updateCanvas  g
    canvas `on` leaveNotifyEvent  $ changeCanvas_ g
    canvas `on` motionNotifyEvent $ changeCanvas  g
    canvas `on` buttonPressEvent  $ changeCanvas' g
    canvas `on` keyPressEvent     $ changeCanvasKey g
    return g

getFocusPos :: GameTable -> IO Place
getFocusPos g = fmap focusPos $ readMVar (states g)

stopTable g =  setTableSt g $ \s -> if s == Fixed then s else Stopped
resumeTable g =  setTableSt g $ \s -> if s == Fixed then s else Normal Nothing
setFixTable g b = setTableSt g f where
    
    f _     | b     = Fixed
    f Fixed | not b = Normal Nothing
    f x             = x


setTableSt :: GameTable -> (St -> St) -> IO ()
setTableSt g fx = redrawButts_ g f where
    f ss
        | x == x'   = ([], ss)
        | Stopped `elem` [x, x']
            = (M.toList $ board_ ss, ss')
        | otherwise 
            = ([(p, board_ ss M.! p) | p <- focusPos ss: ff x ++ ff x'], ss')
      where
        ss' = ss { workState = x' }

        x = workState ss
        x' = fx x

        ff (Normal (Just x)) = [x]
        ff _  = []


resizeTable :: (Int, Int) -> GameTable ->  IO ()
resizeTable s@(xS, yS) g = do

    set (frame g) [aspectFrameRatio := fromIntegral xS / fromIntegral yS]

    swapMVar (states g) $ IState
        { size_     = s
        , board_    = M.fromList $ zip (placeSetToList $ places s) $ repeat $ Hidden False Nothing
        , focusPos  = place 1 1
        , workState    = Normal Nothing
        } 

    win <- drawingAreaGetDrawWindow' g
    drawWindowClear win
    updateCanvas' g

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

updateCanvas :: GameTable -> EventM EExpose Bool
updateCanvas g = do
    liftIO $ updateCanvas' g
    return True

updateCanvas' g = do
    redrawButts_ g $ \ss -> (M.toList $ board_ ss, ss)

adjustButts :: GameTable -> Board -> IO ()
adjustButts g b =
    redrawButts_ g $ \ss -> ([p | (p,y) <- zip (M.assocs b) (M.elems $ board_ ss), snd p /= y], ss { board_ = b })


adjustButtsInc :: GameTable -> [(Place, State)] -> IO ()
adjustButtsInc g [] = return ()
adjustButtsInc g ((p, s):ps) = do

    redrawButts_ g $ \ss -> ([(p, s)], ss { board_ = M.insert p s $ board_ ss })
    adjustButtsInc g ps

redrawButts :: GameTable -> [Place] -> IO ()
redrawButts g l 
    = redrawButts_ g $ \ss -> ([(p, board_ ss M.! p)| p <- l], ss)


redrawButts_ :: GameTable -> (IState -> ([(Place, State)], IState)) -> IO ()
redrawButts_ g f = do

    ss <- takeMVar (states g)
    let (ps, ss') = f ss
    redrawButts__ g ss' ps
    putMVar (states g) $ ss'


redrawButts__ :: GameTable -> IState -> [(Place, State)] -> IO ()
redrawButts__ gg g l = do
    win <- drawingAreaGetDrawWindow' gg
    let
        size = size_ g
        m   = board_ g
        b   = workState g
        pp = case b of
            Normal x    -> x
            _           -> Nothing
        foc = focusPos g
    let f (p, s) = do
            renderWithDrawable' p size win $ drawPlace (b == Stopped) (isNormal b && pp == Just p) (p == foc && isNormal b) p s
    mapM_ f l
    
isNormal (Normal _) = True
isNormal _ = False

renderWithDrawable' (coords -> (x,y)) (xx, yy) win m = do
    (width, height) <- drawableGetSize_ win
    let
        a = width/fromIntegral xx
        b = height/fromIntegral yy
    drawWindowBeginPaintRect win $ Rectangle (round $ a*fromIntegral (x-1)) (round $ b*fromIntegral (y-1)) (round a) (round b)
    renderWithDrawable win $ do
        scale a b
        translate (fromIntegral x - 0.5) (fromIntegral y - 0.5)
        m
    drawWindowEndPaint win


drawableGetSize_ win = do 
    (width, height) <- drawableGetSize win
    return (realToFrac width, realToFrac height)

changeCanvas :: GameTable -> EventM EMotion Bool
changeCanvas g = do
    pos <- eventCoordinates
    liftIO $ do
        n <- calcPos_ pos g
        changeC n g


changeCanvas_ :: GameTable -> EventM ECrossing Bool
changeCanvas_ g = liftIO $ do
    let n = Nothing
    changeC n g

changeC n g = do
    ss <- readMVar (states g)
    case workState ss of
        Normal m -> do
            ss <- takeMVar (states g)
            putMVar (states g) $ ss { workState = Normal n }

            if m /= n  
                then redrawButts g $ catMaybes [m, n]
                else return ()
        _ -> return ()
    return True


changeCanvas' :: GameTable -> EventM EButton Bool
changeCanvas' g = do
    pos <- eventCoordinates
    b <- eventButton
    liftIO $ do
        ss <- readMVar (states g)
        when (isNormal (workState ss)) $ do
            n <- calcPos_ pos g
            case (n, b) of
                (Just p, LeftButton)    -> reveal g p
                (Just p, RightButton)   -> flag_  g p
                _                       -> return ()
    return True



changeCanvasKey :: GameTable -> EventM EKey Bool
changeCanvasKey g = do
    k <- eventKeyName
    liftIO $ do
        case k of
            "Right" -> moveFocus ( 1, 0)
            "Left"  -> moveFocus (-1, 0)
            "Down"  -> moveFocus ( 0, 1)
            "Up"    -> moveFocus ( 0,-1)
            _        -> return False
 where
    moveFocus (dx, dy) = do
        ss <- readMVar (states g)
        when (isNormal (workState ss)) $ do
            ss <- takeMVar (states g)
            let 
                foc@(coords -> (x, y)) = focusPos ss
                (sx, sy)    = size_ ss
                foc' = place (max 1 $ min sx $ dx + x) (max 1 $ min sy $ dy + y)
            putMVar (states g) $ ss { focusPos = foc' }
            if foc /= foc'
                then redrawButts g [foc, foc']
                else return ()
        return True


drawingAreaGetDrawWindow' = widgetGetDrawWindow . area

calcPos_ pos g = do
    win <- drawingAreaGetDrawWindow' g
    ss <- readMVar (states g)

    (width, height) <- drawableGetSize_ win
    return $ calcPos (size_ ss) (width, height) pos

calcPos (xx, yy) (width, height) (x,y)
    | i + 1 `between` (1, xx) && j + 1 `between` (1, yy)  {- && ii>0 && ii<9 && jj>0 && jj<9 -}     
        = Just $ place (i+1) (j+1)
    | otherwise = Nothing
 where
    a = floor (x/width*10* fromIntegral xx)
    b = floor (y/height*10* fromIntegral yy)

    (i,_ii) = a `divMod` 10
    (j,_jj) = b `divMod` 10

infix 4 `between`
a `between` (b, c) = b <= a && a <= c