{-# 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)