module Render ( setup , render ) where import Paths_htanks import Game import MainLoop import Level import Player 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 (unsafeRenderPrimitive, PrimitiveMode(..)) import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, unsafePreservingMatrix, 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" path TextureCrosshair = "tex/Crosshair.png" getTexture :: Texture -> Main 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 :: Main () setup = do liftIO $ do blend $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha) -- cache textures getTexture TextureWood getTexture TextureTank getTexture TextureCannon getTexture TextureBullet getTexture TextureCrosshair return () render :: Main () render = do tanklist <- gets $ tanks . gameState bulletlist <- gets $ bullets . gameState playerlist <- gets players textureWood <- getTexture TextureWood textureTank <- getTexture TextureTank textureCannon <- getTexture TextureCannon textureBullet <- getTexture TextureBullet textureCrosshair <- getTexture TextureCrosshair (lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) liftIO $ do clear [ColorBuffer] texture Texture2D $= Enabled textureBinding Texture2D $= Just textureWood unsafeRenderPrimitive Quads $ do texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) vertex $ Vertex2 0 lh texCoord $ TexCoord2 (lw/2) 0 vertex $ Vertex2 lw lh texCoord $ TexCoord2 (lw/2) (lh/2) vertex $ Vertex2 lw 0 texCoord $ TexCoord2 0 (lh/2) vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat) forM_ tanklist $ \tank -> unsafePreservingMatrix $ do let x = realToFrac . tankX $ tank y = realToFrac . tankY $ tank rotDir = realToFrac . tankDir $ tank rotAim = realToFrac . tankAim $ tank translate $ Vector3 x y (0 :: GLfloat) rotate rotDir $ Vector3 0 0 (1 :: GLfloat) textureBinding Texture2D $= Just textureTank unsafeRenderPrimitive 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 unsafeRenderPrimitive 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_ bulletlist $ \bullet -> unsafePreservingMatrix $ do let x = realToFrac . bulletX $ bullet y = realToFrac . bulletY $ bullet rotDir = realToFrac . bulletDir $ bullet translate $ Vector3 x y (0 :: GLfloat) rotate rotDir $ Vector3 0 0 (1 :: GLfloat) textureBinding Texture2D $= Just textureBullet unsafeRenderPrimitive Quads $ do texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) vertex $ Vertex2 (-0.1 :: GLfloat) (-0.1 :: GLfloat) texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) vertex $ Vertex2 (-0.1 :: GLfloat) (0.1 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) vertex $ Vertex2 (0.1 :: GLfloat) (0.1 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) vertex $ Vertex2 (0.1 :: GLfloat) (-0.1 :: GLfloat) textureBinding Texture2D $= Just textureCrosshair forM_ playerlist renderPlayer