Added dump CPU player
This commit is contained in:
parent
8586ef7b85
commit
88fd16d930
4 changed files with 54 additions and 29 deletions
20
CPUPlayer.hs
Normal file
20
CPUPlayer.hs
Normal 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)
|
12
HTanks.hs
12
HTanks.hs
|
@ -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) $
|
||||||
|
|
2
Makefile
2
Makefile
|
@ -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
|
||||||
|
|
||||||
|
|
17
Render.hs
17
Render.hs
|
@ -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)
|
||||||
|
|
||||||
|
|
Reference in a new issue