{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}

module DefaultPlayer ( DefaultPlayer(..)
                     ) where


import qualified Data.Set as S
import Data.Fixed
import Data.Ratio ((%))
import Data.Typeable
import Graphics.Rendering.OpenGL.GL (GLfloat, Vector3(..), Vertex2(..))
import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (unsafePreservingMatrix, translate, rotate)
import Graphics.Rendering.OpenGL.GL.VertexSpec

import Tank
import GLDriver
import Player
import Vector
import Transformable (Coord)
import Data.VectorSpace

data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool
                     deriving (Typeable, Show)

instance Player DefaultPlayer where
    playerUpdate (DefaultPlayer keys aimx aimy shoot) tank =
        let x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0)
            y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0)
            ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank)
            ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank)
            move = (x /= 0 || y /= 0)
            dir = if move then Just (normalized $ Vector x y) else Nothing
            adir = if (ax /= 0 || ay /= 0) then Just (normalized $ Vector ax ay) else Nothing
        in return (DefaultPlayer keys aimx aimy False, dir, move, adir, shoot)
    
    handleEvent (DefaultPlayer keys aimx aimy shoot) ev
        | Just (KeyPressEvent key)    <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy shoot
        | Just (KeyReleaseEvent key)  <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy shoot
        | Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y shoot
        | Just (MousePressEvent x y) <- fromEvent ev = DefaultPlayer keys x y True
        | otherwise = DefaultPlayer keys aimx aimy shoot
    
    renderPlayer (DefaultPlayer _ aimx aimy _) = unsafePreservingMatrix $ do
                                                   translate $ Vector3 (realToFrac aimx) (realToFrac aimy) (0.2 :: GLfloat)
                                                   rotate 30 $ Vector3 1 0 (0 :: GLfloat)
                                                   
                                                   unsafeRenderPrimitive Quads $ do
                                                                            texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
                                                                            vertex $ Vertex2 (-0.2 :: GLfloat) (-0.2 :: GLfloat)
                                                                            
                                                                            texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
                                                                            vertex $ Vertex2 (-0.2 :: GLfloat) (0.2 :: GLfloat)
                                                                            
                                                                            texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
                                                                            vertex $ Vertex2 (0.2 :: GLfloat) (0.2 :: GLfloat)
                                                                            
                                                                            texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
                                                                            vertex $ Vertex2 (0.2 :: GLfloat) (-0.2 :: GLfloat)