Added tank texture and turn to drive direction

HTanks.hs

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

Render.hs

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

Texture.hs

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