neocturne/htanks
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added dump CPU player

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

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)

12
HTanks.hs
View file

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

2
Makefile
View file

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

39
Render.hs
View file

@ -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
@ -112,24 +108,27 @@ 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)
forM_ tanklist $ \tank -> preservingMatrix $ do
let x = fromReal . posx $ tank
y = fromReal . posy $ tank
renderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
translate $ Vector3 x y (0 :: GLfloat)
rotate (90 + (fromReal . dir $ tank)) $ Vector3 0 0 (1 :: GLfloat)
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
renderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: 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 (0 :: 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)
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