module PatienceBoard
( Game (..)
, Board (..)
, amountOfGameStacks
, amountOfEndingStacks
, gameStacksCoord
, endingStacksCoord
, pileCoord

, handleInputs
, initGame

, isInGame
, isInEnding
, isInPile
) where

import CardDeck
import Selector

import InputHandler

----------------------------- Constants ------------------------------

-- Prepresentation of a Patience game
data Game = Game {
    -- The playboard
    board :: Board,
    -- The selector
    selector :: Selector
} deriving (Show, Eq)

-- Representation of a Patience board
data Board = Board {
    -- 7 colums of cards (the 'playing field')
    gameStacks   :: [Stack],
    -- 4 ending stacks (top right corner, usually)
    endingStacks :: [Stack],
    -- Stack of cards that are not yet on the board
    pile         :: Stack
} deriving (Show, Eq)

-- The zones of the board. Represents either the pile, the endingStacks
-- or the gameStacks. It can also be out of the board.
data Zone = Pile | ES | GS | Out

amountOfGameStacks :: Int
amountOfGameStacks = 7

amountOfEndingStacks :: Int
amountOfEndingStacks = 4

-- Coordinate of the GameStacks
gameStacksCoord :: Coordinate
gameStacksCoord = (0, 0)

-- Coordinate of the EndingStacks
endingStacksCoord :: Coordinate
endingStacksCoord = (x, 1)
    where x = amountOfGameStacks - amountOfEndingStacks

-- Coordinate of the Pile
pileCoord :: Coordinate
pileCoord = (0, 1)

-- Step size to rotate the pile of the game
rotateStep :: Int
rotateStep = 3

------------------------------- Init ---------------------------------

-- Split a full deck into 7 gameStacks and one pile of unused cards.
splitDeck :: Stack -> [Stack]
splitDeck = reverse . splitDeck' amountOfGameStacks
    where splitDeck' :: Int -> Stack -> [Stack]
          splitDeck' 0 cs  = [cs]
          splitDeck' n cs  = let (stack,rest) = splitAt n cs
                             in showFirst stack : splitDeck' (n - 1) rest

-- The initial board consisting of a stack of yet-to-be-turned cards
-- and n stacks of increasingly large amount of cards (1, ..., n)
initBoard :: Board
initBoard = Board {
        gameStacks = stacks,
        endingStacks = replicate amountOfEndingStacks [],
        pile = map showCard pile
    }
    where pile:stacks = splitDeck generateShuffledDeck

-- The initial state of the playboard, with a board and a cursor.
initGame :: Game
initGame = Game {
    board    = initBoard,
    selector = initSelector
}

------------------- Coordinate to Card conversion --------------------

-- Check if a coordinate is in the pile.
isInPile :: Coordinate -> Bool
isInPile = (pileCoord == )

-- Check if a coordinate is in an endingStack.
isInEnding :: Coordinate -> Bool
isInEnding (x, y) = leftBound && rightBound && yCheck
    where leftBound  = fst endingStacksCoord <= x
          rightBound = x < amountOfGameStacks
          yCheck     = y == snd endingStacksCoord

-- Check if a coordinate is in a GameStack.
isInGame :: Coordinate -> Game -> Bool
isInGame (x, y) g = horizontalCheck && verticalCheck
    where horizontalCheck = leftBound && rightBound
          verticalCheck   = upBound && downBound
          leftBound       = fst gameStacksCoord <= x
          rightBound      = x < amountOfGameStacks
          upBound         = y <= snd gameStacksCoord
          xStack          = gameStacks (board g) !! x
          downBound       = zero || negate y < length xStack
          zero            = y == 0 && null xStack

-- Get the zone number from a coordinate.
getZoneFromCoord :: Game -> Coordinate -> Zone
getZoneFromCoord game (x, y)
    | isInPile   (x, y)      = Pile
    | isInEnding (x, y)      = ES
    | isInGame   (x, y) game = GS
    | otherwise              = Out

--------------------------- Change cards -----------------------------

-- Show the first of a stack of cards.
showFirst :: Stack -> Stack
showFirst []     = []
showFirst (c:cs) = showCard c : cs

-- Rotate the pile n times.
rotatePile :: Game -> Game
rotatePile g@Game{ board = b } = g{ board = rotatedBoard }
    where rotatedBoard = b{ pile = tail ++ head }
          (head, tail) = splitAt rotateStep $ pile b

-- Check if a card can be placed ontop of a gameStack.
canPlayOn :: Stack -> Int -> Stack -> Bool
canPlayOn [] _     _                = False
canPlayOn cs index []               = v1 == King && vis == Visible
    where (_,v1,vis) = cs !! index
canPlayOn cs index ((t2,v2,vis2):_) = differentColor && predValue && visibility
    where (t1,v1,vis) = cs !! index
          differentColor = not $ (t1,v1,vis) `matchColor` (t2,v2,vis2)
          predValue      = succ v1 == v2
          visibility     = vis == Visible

-- Check if a card can be played ontop of an EndingStack.
canFinishOn :: Stack -> Int -> Stack -> Bool
canFinishOn [] _ _                 = False
canFinishOn cs index []            = v1 == Ace && vis == Visible
    where (_,v1,vis) = cs !! index
canFinishOn cs index ((t2,v2,_):_) = sameType && succValue && visibility
    where (t1,v1,vis) = cs !! index
          sameType  = t1 == t2
          succValue = v1 == succ v2
          visibility = vis == Visible

-- Here is still room for improvement: 
-- Combine these functions into a single function?

-- Move from one gameStack to another.
moveGS2GS :: Coordinate -> Int -> Board -> Board
moveGS2GS fromCoord toStackNr board
    | canPlayOn from (index - 1) to = newBoard
    | otherwise                    = board
    where (fromStackNr, negIndex) = fromCoord
          fromAmount              = length from
          oldGS                   = gameStacks board
          from                    = oldGS !! fromStackNr
          to                      = oldGS !! toStackNr
          index                   = fromAmount - negate negIndex
          (diff, newFrom)         = splitAt index from
          newTo                   = diff ++ to
          tempGS                  = switchStack oldGS fromStackNr (showFirst newFrom)
          newGS                   = switchStack tempGS toStackNr newTo
          newBoard = board{ gameStacks = newGS }

-- Move from a gameStack to an endingStack.
moveGS2ES :: Coordinate -> Int -> Board -> Board
moveGS2ES fromCoord toIndex board
    | canFinishOn from 0 to = newBoard
    | otherwise                  = board
    where (fromIndex, _)    = fromCoord
          oldGS             = gameStacks board
          oldES             = endingStacks board
          from              = oldGS !! fromIndex
          to                = oldES !! toIndex
          (card:newGSStack) = from
          newESStack        = card:to
          newGS             = switchStack oldGS fromIndex (showFirst newGSStack)
          newES             = switchStack oldES toIndex   newESStack
          newBoard = board{ endingStacks = newES, gameStacks = newGS }

-- Move a card between pile and gameStacks.
moveP2GS :: Coordinate -> Int -> Board -> Board
moveP2GS _ toStackNr board
    | canPlayOn oldPile 0 to = newBoard
    | otherwise                = board
    where oldPile        = pile board
          oldGS          = gameStacks board
          to             = oldGS !! toStackNr
          (card:newPile) = oldPile
          newGSStack     = card:to
          newGS          = switchStack oldGS toStackNr newGSStack
          newBoard = board{ gameStacks = newGS, pile = newPile }

-- Move a card between pile and endingStacks.
moveP2ES :: Coordinate -> Int -> Board -> Board
moveP2ES _ toIndex board
    | canFinishOn oldPile 0 to = newBoard
    | otherwise                = board
    where oldPile        = pile board
          oldES          = endingStacks board
          to             = oldES !! toIndex
          (card:newPile) = oldPile
          newESStack     = card:to
          newES          = switchStack oldES toIndex newESStack
          newBoard = board{ pile = newPile, endingStacks = newES }

-- Move a card from an endingStack to a gameStack.
moveES2GS :: Coordinate -> Int -> Board -> Board
moveES2GS fromCoord toStackNr board
    | canPlayOn from 0 to = newBoard
    | otherwise           = board
    where (tempIndex, _)    = fromCoord
          fromIndex         = tempIndex - (amountOfGameStacks - amountOfEndingStacks)
          oldES             = endingStacks board
          oldGS             = gameStacks board
          from              = oldES !! fromIndex
          to                = oldGS !! toStackNr
          (card:newESStack) = from
          newGSStack        = card:to
          newES             = switchStack oldES fromIndex newESStack
          newGS             = switchStack oldGS toStackNr newGSStack
          newBoard = board{ gameStacks = newGS, endingStacks = newES }

-- Move from one endingStack to another.
moveES2ES :: Coordinate -> Int -> Board -> Board
moveES2ES fromCoord toIndex board
    | canFinishOn from 0 to = newBoard
    | otherwise             = board
    where (tempIndex, _)    = fromCoord
          fromIndex         = tempIndex - (amountOfGameStacks - amountOfEndingStacks)
          oldES             = endingStacks board
          from              = oldES !! fromIndex
          to                = oldES !! toIndex
          (card:newESStack) = from
          tempES            = switchStack oldES fromIndex newESStack
          newES             = switchStack tempES toIndex (card:to)
          newBoard = board{ endingStacks = newES }

-- Switch a stack for another stack in a list of stacks.
switchStack :: [Stack] -> Int -> Stack -> [Stack]
switchStack ss index new = front ++ new:back
    where (front, back') = splitAt index ss
          back = tail back'

-- Get the stack that is located in the given zone at the given index.
getStackFromZone :: Game -> Zone -> Int -> Stack
getStackFromZone game Pile index = pile (board game)
getStackFromZone game ES   index = endingStacks (board game) !! index
getStackFromZone game GS   index = gameStacks (board game) !! index
getStackFromZone _    Out  _     = []

-- Move between to zones with two indexes
getMoveFunction :: Zone -> Zone -> Coordinate -> Int -> Board -> Board
getMoveFunction Pile ES coord index = moveP2ES coord index
getMoveFunction Pile GS coord index = moveP2GS coord index
getMoveFunction GS   GS coord index = moveGS2GS coord index
getMoveFunction GS   ES coord index = moveGS2ES coord index
getMoveFunction ES   GS coord index = moveES2GS coord index
getMoveFunction ES   ES coord index = moveES2ES coord index
getMoveFunction _    _  _     _     = id

-- Tranform the index based on the zone.
transformIndex :: Zone -> Int -> Int
transformIndex ES index = index - (amountOfGameStacks - amountOfEndingStacks)
transformIndex Pile _   = 0
transformIndex _  index = index

-- Move a card from Coordinate to Coordinate.
moveCard :: Game -> Coordinate -> Coordinate -> Game 
moveCard game fromCoord toCoord  = game{ board = newBoard }
    where originalBoard          = board game
          (x, _)                 = fromCoord
          (index, _)             = toCoord
          properIndex            = transformIndex toZone index
          fromZone               = getZoneFromCoord game fromCoord
          toZone                 = getZoneFromCoord game toCoord
          fromStack              = getStackFromZone game fromZone x
          toStack                = getStackFromZone game toZone x
          moveFunction           = getMoveFunction fromZone toZone fromCoord properIndex
          newBoard               = moveFunction originalBoard
        
------------------------------ Input ---------------------------------

-- Check if moving in a direction is legal.
isLegalMove :: Direction -> Game -> Bool
isLegalMove dir g = isInPile coord || isInEnding coord || isInGame coord g
    where coord   = position $ move dir $ selector g

-- Move the selector of the game. (Wrapper)
moveSelector :: Direction -> Game -> Game
moveSelector dir g@Game{ selector = s }
    | isLegalMove dir g = g{ selector = move dir s }
    | otherwise         = g

-- Toggle selector. If a card was already selected, try to move it.
toggleSelector :: Game -> Game
toggleSelector g@Game{ selector = s@Selector{ selected = Nothing } } = toggled
    where toggled = g{ selector = toggleSelection s }
toggleSelector g@Game{ selector = s@Selector{ selected = Just coord } } = moved
    where moved = moveCard g{ selector = toggleSelection s } (getSelected s) (position s)

-- Handle all the inputs necessary for patience.
handleInputs :: Event -> Game -> Game
handleInputs = composeInputHandler [
    -- Selector movement
    handleUp    (moveSelector U), 
    handleDown  (moveSelector D),
    handleLeft  (moveSelector L),
    handleRight (moveSelector R), 
    -- Selection handling
    handleSpace toggleSelector,
    -- Pile rotation
    handleEnter rotatePile
    ]