module Render ( setup , render ) where import Game import Level import Tank 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 -> String texturePath t | t == TextureWood = "tex/Wood.png" | t == TextureTank = "tex/Tank.png" | t == TextureCannon = "tex/Cannon.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 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 setup :: Game () setup = do liftIO $ do blend $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha) -- cache textures getTexture TextureWood getTexture TextureTank getTexture TextureCannon return () render :: Game () render = do tanklist <- gets tanks textureWood <- getTexture TextureWood textureTank <- getTexture TextureTank textureCannon <- getTexture TextureCannon (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.5*lw) (-0.5*lh) texCoord $ TexCoord2 0 lw vertex $ Vertex2 (-0.5*lw) (0.5*lh) texCoord $ TexCoord2 lh lw vertex $ Vertex2 (0.5*lw) (0.5*lh) texCoord $ TexCoord2 lh (0 :: GLfloat) vertex $ Vertex2 (0.5*lw) (-0.5*lh) forM_ tanklist $ \tank -> preservingMatrix $ do let x = fromReal . posx $ tank y = fromReal . posy $ tank rotDir = 90 + (fromReal . dir $ tank) rotAim = 90 + (fromReal . aim $ 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) fromReal :: (Real a, Fractional b) => a -> b fromReal = fromRational . toRational