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