diff options
Diffstat (limited to 'src/Render.hs')
| -rw-r--r-- | src/Render.hs | 167 |
1 files changed, 167 insertions, 0 deletions
diff --git a/src/Render.hs b/src/Render.hs new file mode 100644 index 0000000..d1276a3 --- /dev/null +++ b/src/Render.hs @@ -0,0 +1,167 @@ +module Render ( setup + , render + ) where + + +import Paths_htanks +import Game +import Level +import Texture + +import Control.Monad.State + +import Data.Fixed +import Data.Maybe +import Data.Ratio +import qualified Data.Map as M + +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, 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) +import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding, TextureObject(..)) +import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) +import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget(..)) +import Graphics.Rendering.OpenGL.GL.VertexSpec + + +texturePath :: Texture -> IO FilePath +texturePath t = getDataFileName $ path t + where + path TextureWood = "tex/Wood.png" + path TextureTank = "tex/Tank.png" + path TextureCannon = "tex/Cannon.png" + path TextureBullet = "tex/Bullet.png" + +getTexture :: Texture -> Game TextureObject +getTexture t = do + ts <- gets textures + let tobj = M.lookup t ts + + if (isJust tobj) + then + return $ fromJust tobj + else do + path <- liftIO $ texturePath t + tex <- liftIO $ pngBind path BuildMipmap Alpha (Repeated, Repeat) (Linear', Just Linear') Linear' >>= return . TextureObject . fromIntegral . fst + modify $ \state -> state {textures = M.insert t tex ts} + return tex + + +setup :: Game () +setup = do + liftIO $ do + blend $= Enabled + blendFunc $= (SrcAlpha, OneMinusSrcAlpha) + + -- cache textures + getTexture TextureWood + getTexture TextureTank + getTexture TextureCannon + getTexture TextureBullet + + return () + + +render :: Game () +render = do + tanklist <- gets tanks + shootlist <- gets shoots + + textureWood <- getTexture TextureWood + textureTank <- getTexture TextureTank + textureCannon <- getTexture TextureCannon + textureBullet <- getTexture TextureBullet + + (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) + + liftIO $ do + clear [ColorBuffer] + + texture Texture2D $= Enabled + textureBinding Texture2D $= Just textureWood + + renderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 0 lh + + texCoord $ TexCoord2 lw 0 + vertex $ Vertex2 lw lh + + texCoord $ TexCoord2 lw lh + vertex $ Vertex2 lw 0 + + texCoord $ TexCoord2 0 lh + vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat) + + forM_ tanklist $ \tank -> preservingMatrix $ do + let x = fromReal . tankX $ tank + y = fromReal . tankY $ tank + rotDir = fromReal . tankDir $ tank + rotAim = fromReal . tankAim $ tank + + translate $ Vector3 x y (0 :: GLfloat) + rotate rotDir $ Vector3 0 0 (1 :: GLfloat) + + textureBinding Texture2D $= Just textureTank + + 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) + + rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat) + + textureBinding Texture2D $= Just textureCannon + + 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_ shootlist $ \shoot -> preservingMatrix $ do + let x = fromReal . shootX $ shoot + y = fromReal . shootY $ shoot + rotDir = fromReal . shootDir $ shoot + + translate $ Vector3 x y (0 :: GLfloat) + rotate rotDir $ Vector3 0 0 (1 :: GLfloat) + + textureBinding Texture2D $= Just textureBullet + + renderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (-0.2 :: GLfloat) (-0.2 :: GLfloat) + + texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (-0.2 :: GLfloat) (0.2 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (0.2 :: GLfloat) (0.2 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (0.2 :: GLfloat) (-0.2 :: GLfloat) + + +fromReal :: (Real a, Fractional b) => a -> b +fromReal = fromRational . toRational
\ No newline at end of file |