Added dump CPU player

This commit is contained in:
Matthias Schiffer 2010-03-02 23:22:44 +01:00
parent 8586ef7b85
commit 88fd16d930
4 changed files with 54 additions and 29 deletions

20
CPUPlayer.hs Normal file
View file

@ -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)

View file

@ -5,6 +5,7 @@ import Level
import Render import Render
import Tank import Tank
import Player import Player
import CPUPlayer
import DefaultPlayer import DefaultPlayer
import GLDriver import GLDriver
@ -42,8 +43,13 @@ main = do
when (initialized gl) $ do when (initialized gl) $ do
currentTime <- getCurrentTime currentTime <- getCurrentTime
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = [SomePlayer $ DefaultPlayer S.empty]} let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2 360 False], textures = M.empty} [ 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 runGame gameState $ do
setup 800 600 setup 800 600
@ -82,7 +88,6 @@ mainLoop = do
when runnext mainLoop when runnext mainLoop
updateAngle :: Micro -> State Tank () updateAngle :: Micro -> State Tank ()
updateAngle angle = do updateAngle angle = do
oldangle <- gets dir oldangle <- gets dir
@ -117,6 +122,7 @@ updateAngle angle = do
modify $ \tank -> tank {dir = newangle180} modify $ \tank -> tank {dir = newangle180}
updateTank :: Maybe Micro -> Bool -> State Tank () updateTank :: Maybe Micro -> Bool -> State Tank ()
updateTank angle move = do updateTank angle move = do
when (isJust angle) $ when (isJust angle) $

View file

@ -1,5 +1,5 @@
HSCFILES = Bindings/GLX.hsc Bindings/GLPng.hsc 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 all: HTanks

View file

@ -20,7 +20,7 @@ import Bindings.GLPng
import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..), Vector3(..)) import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..), Vector3(..))
import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..)) 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.Framebuffer (clear, ClearBuffer(..))
import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..)) import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture) import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture)
@ -83,19 +83,15 @@ resize w h = do
render :: Game () render :: Game ()
render = do render = do
tank <- liftM head $ gets tanks tanklist <- 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)
textureWood <- getTexture TextureWood textureWood <- getTexture TextureWood
textureTank <- getTexture TextureTank textureTank <- getTexture TextureTank
(lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
liftIO $ do liftIO $ do
clear [ColorBuffer] clear [ColorBuffer]
loadIdentity
texture Texture2D $= Enabled texture Texture2D $= Enabled
textureBinding Texture2D $= Just textureWood textureBinding Texture2D $= Just textureWood
@ -112,9 +108,12 @@ render = do
texCoord $ TexCoord2 lh (0 :: GLfloat) texCoord $ TexCoord2 lh (0 :: GLfloat)
vertex $ Vertex2 (0.5*lw) (-0.5*lh) vertex $ Vertex2 (0.5*lw) (-0.5*lh)
textureBinding Texture2D $= Just textureTank textureBinding Texture2D $= Just textureTank
forM_ tanklist $ \tank -> preservingMatrix $ do
let x = fromReal . posx $ tank
y = fromReal . posy $ tank
translate $ Vector3 x y (0 :: GLfloat) translate $ Vector3 x y (0 :: GLfloat)
rotate (90 + (fromReal . dir $ tank)) $ Vector3 0 0 (1 :: GLfloat) rotate (90 + (fromReal . dir $ tank)) $ Vector3 0 0 (1 :: GLfloat)