diff options
| -rw-r--r-- | HTanks.hs | 2 | ||||
| -rw-r--r-- | Render.hs | 26 | ||||
| -rw-r--r-- | Texture.hs | 2 | ||||
| -rw-r--r-- | tex/Tank.png | bin | 0 -> 423 bytes |
4 files changed, 20 insertions, 10 deletions
@@ -97,7 +97,7 @@ simulationStep = do let dx = (speed oldtank) * fromRational (round (x*1000/length)%1000000) dy = (speed oldtank) * fromRational (round (y*1000/length)%1000000) - let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank} + let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank, dir = fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000} lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)} @@ -18,10 +18,11 @@ import qualified Data.Map as M import Bindings.GLPng -import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..)) +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) +import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, 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) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding, TextureObject(..)) import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) @@ -32,6 +33,7 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec texturePath :: Texture -> String texturePath t | t == TextureWood = "tex/Wood.png" + | t == TextureTank = "tex/Tank.png" getTexture :: Texture -> Game TextureObject getTexture t = do @@ -42,7 +44,7 @@ getTexture t = do then return $ fromJust tobj else do - tex <- liftIO $ pngBind (texturePath t) NoMipmap Solid (Repeated, Repeat) (Linear', Nothing) Linear' >>= return . TextureObject . fromIntegral . fst + tex <- liftIO $ pngBind (texturePath t) BuildMipmap Alpha (Repeated, Repeat) (Linear', Just Linear') Linear' >>= return . TextureObject . fromIntegral . fst modify $ \state -> state {textures = M.insert t tex ts} return tex @@ -50,9 +52,13 @@ getTexture t = do setup :: Int -> Int -> Game () setup w h = do resize w h + liftIO $ do + blend $= Enabled + blendFunc $= (SrcAlpha, OneMinusSrcAlpha) -- cache textures getTexture TextureWood + getTexture TextureTank return () @@ -83,6 +89,7 @@ render = do (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) textureWood <- getTexture TextureWood + textureTank <- getTexture TextureTank liftIO $ do clear [ColorBuffer] @@ -106,20 +113,23 @@ render = do vertex $ Vertex2 (0.5*lw) (-0.5*lh) - texture Texture2D $= Disabled + 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 (x-0.5 :: GLfloat) (y-0.5 :: GLfloat) + vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) - vertex $ Vertex2 (x-0.5 :: GLfloat) (y+0.5 :: GLfloat) + vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) - vertex $ Vertex2 (x+0.5 :: GLfloat) (y+0.5 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) - vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: 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 @@ -4,6 +4,6 @@ module Texture ( Texture(..) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) -data Texture = TextureWood +data Texture = TextureWood | TextureTank deriving (Eq, Ord, Show)
\ No newline at end of file diff --git a/tex/Tank.png b/tex/Tank.png Binary files differnew file mode 100644 index 0000000..0e60bc1 --- /dev/null +++ b/tex/Tank.png |
