module Draw 
  ( draw, glStyle, board2screen
  ) where

import Chess
import Font
import GameLogic (Move(..), visibleSquares)
import Geometry

import Control.Applicative
import Control.Monad (forM, forM_, guard, unless, when)
import Data.Char (toLower)
import Data.Map ((!))
import FRP.Peakachu.Backend.GLUT (Image(..))
import Graphics.UI.GLUT

piecePix :: DefendFont -> PieceType -> Pix
piecePix font x = font ! map toLower (show x)

board2screen :: BoardPos -> DrawPos
board2screen (bx, by) =
  (r bx, r by)
  where
    r ba = (fromIntegral ba - 3.5) / 4

glStyle :: Image
glStyle = Image $ do
  cursor $= None
  lineSmooth $= Enabled
  polygonSmooth $= Enabled
  hint LineSmooth $= Nicest
  hint PolygonSmooth $= Nicest
  blend $= Enabled

draw
  :: DefendFont -> Board -> Move
  -> DrawPos -> Maybe PieceSide -> Integer -> Image
draw font board drag (cx, cy) me gameIter =
  Image $ do
    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
    lighting $= Enabled
    light (Light 0) $= Enabled
    position (Light 0) $= Vertex4 0 0 (-1) 0
    cullFace $= Just Front
    drawBoard
    mapM_ drawPiece . filter ((`elem` vis) . piecePos) $ boardPieces board
    when srcFirst . drawCursor . moveSrc $ drag
    drawCursor . moveDst $ drag
    unless srcFirst . drawCursor . moveSrc $ drag
  where
    srcFirst = cursorDist (moveSrc drag) < cursorDist (moveDst drag)
    cursorDist = cursorDist' . board2screen
    cursorDist' (x, y) = (cx-x)^(2::Int) + (cy-y)^(2::Int)
    headingUp = normal $ Normal3 0 0 (-1 :: GLfloat)
    drawPiece piece = do
      let
        pix = piecePix font (pieceType piece)
        (px, py) = piecePos piece
        (sx, sy) = board2screen (px, py)
        white :: Color4 GLfloat
        white = Color4 1 1 1 1
        black = Color4 0 0 0 1
        (bodyCol, outlineCol)
          | pieceSide piece == White = (white, black)
          | otherwise = (black, white)
        vert m (vx, vy) =
          vertex $ Vertex4
            (sx + m*vx)
            (sy + m*vy) 0 1
      headingUp
      materialDiffuse Front $= bodyCol
      renderPrimitive Triangles .
        forM_ (pixBody pix) .
        mapM_ $ vert (pieceSize * 0.125)
      materialDiffuse Front $= outlineCol
      renderPrimitive Quads .
        forM (pixOutline pix) $ \outline ->
        forM (polygonEdges
          (zip outline (expandPolygon (-0.06) outline))) $
          \((a, b), (c, d)) ->
          forM [c, d, b, a] . vert $ pieceSize * 0.125
    pieceSize = 0.9
    vis =
      maybe allBoard (`visibleSquares` board) me
    allBoard = [(x, y) | x <- [0..7], y <- [0..7]]
    drawBoard =
      forM_ vis $ \(bx, by) -> do
        let
          col = 0.3 + 0.1 * fromIntegral ((bx + by) `mod` 2)
          r ba va = 0.125*((fromIntegral ba*2+va)-7)
        materialDiffuse Front $= Color4 col col col 1
        headingUp
        renderPrimitive Quads .
          forM square $ \(vx, vy) ->
            vertex $ Vertex4 (r bx vx) (r by vy) 0 1
    drawCursor boardPos = do
      cullFace $= Just Back
      drawCursor' boardPos
      cullFace $= Just Front
      drawCursor' boardPos
    drawCursor' boardPos =
      renderPrimitive Triangles .
      forM_ curPix $ \part ->
      forM_ (polygonEdges part) $
      \((ax, ay), (bx, by)) -> do
        let
          (rx, ry) = board2screen boardPos
          points =
            [[0.9*cx, 0.9*cy, 0.9]
            ,[rx + 0.125*ax, ry + 0.125*ay, 1]
            ,[rx + 0.125*bx, ry + 0.125*by, 1]
            ]
          norml = faceNormal points
          [nx, ny, nz]
            | last norml < 0 = norml
            | otherwise = map negate norml
        normal $ Normal3 nx ny nz
        materialDiffuse Front $=
          case pieceUnderCursor of
            Nothing -> Color4 1 1 0 0.5
            _ -> cursorColor 1
        forM_ (take 1 points) $ \[px, py, pz] ->
          vertex $ Vertex4 px py 0 pz
        materialDiffuse Front $=
          case pieceUnderCursor of
            Nothing -> Color4 1 1 0 0
            _ -> cursorColor 0.5
        forM_ (tail points) $ \[px, py, pz] ->
          vertex $ Vertex4 px py 0 pz
    cursorColor
      | gameIter >= moveIter drag = Color4 0 1 0
      | otherwise = Color4 1 0 0
    pieceUnderCursor = do
      r <- pieceAt board . moveSrc $ drag
      guard . not . (== Just False) . (<$> me) . (==) . pieceSide $ r
      return r
    curPix =
      case pieceUnderCursor of
        Nothing -> [square]
        Just p -> map (map t) . pixOutline . piecePix font $ pieceType p
      where
        t (x, y) = (pieceSize*x, pieceSize*y)
    square = [(-1, -1), (-1, 1), (1, 1), (1, -1)]