{-# 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 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 = aimx - (fromRational . toRational . tankX $ tank) ay = aimy - (fromRational . toRational . tankY $ tank) move = (x /= 0 || y /= 0) angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing in return (DefaultPlayer keys aimx aimy False, angle, move, aangle, 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)