module Render ( setup , render ) where import Paths_htanks import Game import MainLoop import Level import Player import Tank import Texture import Model import Control.Monad.State import Data.Fixed import Data.Maybe import Data.Obj3D import Data.Obj3D.GL 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, scale) 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.VertexArrays (clientState, ClientArrayType(..)) import Graphics.Rendering.OpenGL.GL.VertexSpec import Foreign.ForeignPtr import Foreign.Marshal.Array 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 modelPath :: Model -> IO FilePath modelPath t = getDataFileName $ path t where path ModelTank = "model/tank.obj" getModel :: Model -> Main InterleavedObj getModel m = do ms <- gets models let mobj = M.lookup m ms if (isJust mobj) then return $ fromJust mobj else do path <- liftIO $ modelPath m objmod <- liftIO $ loadObjFile path model <- case objmod of Left error -> fail $ show error Right obj -> liftIO $ makeInterleavedArrays obj modify $ \state -> state {models = M.insert m model ms} return model setup :: Main () setup = do liftIO $ do blend $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha) -- cache textures & models getTexture TextureWood getTexture TextureTank getTexture TextureCannon getTexture TextureBullet getTexture TextureCrosshair getModel ModelTank 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 modelTank <- getModel ModelTank (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) texture Texture2D $= Disabled clientState VertexArray $= Enabled clientState NormalArray $= Enabled clientState TextureCoordArray $= Enabled bindInterleavedArrays modelTank 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) scale 0.1 0.1 (0.1 :: GLfloat) rotate rotDir $ Vector3 0 0 (1 :: GLfloat) --textureBinding Texture2D $= Just textureTank unsafePreservingMatrix $ do rotate 90 $ Vector3 1 0 (0 :: GLfloat) drawObject modelTank 1 {-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 unsafePreservingMatrix $ do rotate 90 $ Vector3 1 0 (0 :: GLfloat) drawObject modelTank 0 {-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)-} texture Texture2D $= Enabled 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