From 88fd16d93080801014336ba8946a37919125b90c Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <matthias@gamezock.de>
Date: Tue, 2 Mar 2010 23:22:44 +0100
Subject: [PATCH] Added dump CPU player
---
CPUPlayer.hs | 20 ++++++++++++++++++++
HTanks.hs | 12 +++++++++---
Makefile | 2 +-
Render.hs | 49 ++++++++++++++++++++++++-------------------------
4 files changed, 54 insertions(+), 29 deletions(-)
create mode 100644 CPUPlayer.hs
diff --git a/CPUPlayer.hs b/CPUPlayer.hs
new file mode 100644
index 0000000..e5fa77e
--- /dev/null
+++ b/CPUPlayer.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module CPUPlayer ( CPUPlayer(..)
+ ) where
+
+
+import Data.Fixed
+import Data.Ratio ((%))
+import Data.Typeable
+
+import GLDriver
+import Player
+import Tank
+
+
+data CPUPlayer = CPUPlayer Micro
+ deriving (Typeable, Show)
+
+instance Player CPUPlayer where
+ playerMovement (CPUPlayer angle) _ = (CPUPlayer (if (angle+0.1) > 180 then angle-359.9 else angle+0.1), Just angle, True)
diff --git a/HTanks.hs b/HTanks.hs
index 871b455..1f6ac11 100644
--- a/HTanks.hs
+++ b/HTanks.hs
@@ -5,6 +5,7 @@ import Level
import Render
import Tank
import Player
+import CPUPlayer
import DefaultPlayer
import GLDriver
@@ -42,8 +43,13 @@ main = do
when (initialized gl) $ do
currentTime <- getCurrentTime
- let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = [SomePlayer $ DefaultPlayer S.empty]}
- gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2 360 False], textures = M.empty}
+ let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
+ [ SomePlayer $ DefaultPlayer S.empty
+ , SomePlayer $ CPUPlayer 0
+ ]}
+ gameState = GameState {level = testLevel, tanks = [ Tank 0.0 0.0 0 0 2 360 False
+ , Tank 0.0 (-1.5) 0 0 2 360 False
+ ], textures = M.empty}
runGame gameState $ do
setup 800 600
@@ -82,7 +88,6 @@ mainLoop = do
when runnext mainLoop
-
updateAngle :: Micro -> State Tank ()
updateAngle angle = do
oldangle <- gets dir
@@ -117,6 +122,7 @@ updateAngle angle = do
modify $ \tank -> tank {dir = newangle180}
+
updateTank :: Maybe Micro -> Bool -> State Tank ()
updateTank angle move = do
when (isJust angle) $
diff --git a/Makefile b/Makefile
index 5064c3b..a396650 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
HSCFILES = Bindings/GLX.hsc Bindings/GLPng.hsc
-HSFILES = $(HSCFILES:%.hsc=%.hs) GLDriver.hs GLX.hs Texture.hs Tank.hs Player.hs DefaultPlayer.hs Level.hs Game.hs Render.hs HTanks.hs
+HSFILES = $(HSCFILES:%.hsc=%.hs) GLDriver.hs GLX.hs Texture.hs Tank.hs Player.hs DefaultPlayer.hs CPUPlayer.hs Level.hs Game.hs Render.hs HTanks.hs
all: HTanks
diff --git a/Render.hs b/Render.hs
index 6b3b80b..8832d3b 100644
--- a/Render.hs
+++ b/Render.hs
@@ -20,7 +20,7 @@ import Bindings.GLPng
import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..), Vector3(..))
import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
-import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate, rotate)
+import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, preservingMatrix, ortho, translate, rotate)
import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..))
import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture)
@@ -83,19 +83,15 @@ resize w h = do
render :: Game ()
render = do
- tank <- liftM head $ gets tanks
- let x = fromReal . posx $ tank
- y = fromReal . posy $ tank
- (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
-
+ tanklist <- gets tanks
textureWood <- getTexture TextureWood
textureTank <- getTexture TextureTank
+ (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
+
liftIO $ do
clear [ColorBuffer]
- loadIdentity
-
texture Texture2D $= Enabled
textureBinding Texture2D $= Just textureWood
@@ -111,25 +107,28 @@ render = do
texCoord $ TexCoord2 lh (0 :: GLfloat)
vertex $ Vertex2 (0.5*lw) (-0.5*lh)
-
-
+
textureBinding Texture2D $= Just textureTank
- translate $ Vector3 x y (0 :: GLfloat)
- rotate (90 + (fromReal . dir $ tank)) $ Vector3 0 0 (1 :: GLfloat)
-
- renderPrimitive Quads $ do
- texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
- vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
-
- texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
- vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
-
- texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
- vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
-
- texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
- vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
+ forM_ tanklist $ \tank -> preservingMatrix $ do
+ let x = fromReal . posx $ tank
+ y = fromReal . posy $ tank
+
+ translate $ Vector3 x y (0 :: GLfloat)
+ rotate (90 + (fromReal . dir $ tank)) $ Vector3 0 0 (1 :: GLfloat)
+
+ renderPrimitive Quads $ do
+ texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
+ vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
+
+ texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
+ vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
+
+ texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
+ vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
+
+ texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
+ vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
fromReal :: (Real a, Fractional b) => a -> b
fromReal = fromRational . toRational
\ No newline at end of file