blob: bb8cf7503ad97c9a3323e1d6ccd9eb94a90ce9c2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# 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 (fst . fromVector $ Vector x y) else Nothing
adir = if (ax /= 0 || ay /= 0) then Just (fst . fromVector $ 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)
|
