diff options
| -rw-r--r-- | CPUPlayer.hs | 20 | ||||
| -rw-r--r-- | HTanks.hs | 12 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | Render.hs | 49 |
4 files changed, 54 insertions, 29 deletions
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) @@ -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) $ @@ -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 @@ -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 |