module Render ( setup , resize , 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, 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" 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 :: Int -> Int -> Game () setup w h = do resize w h liftIO $ do blend $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha) -- cache textures getTexture TextureWood getTexture TextureTank return () resize :: Int -> Int -> Game () resize w h = do let wn = fromIntegral w hn = fromIntegral h aspect = fromReal (wn/hn) lvl <- gets level let s = max (0.5*(fromIntegral $ levelWidth lvl)/aspect) (0.5*(fromIntegral $ levelHeight lvl)) :: GLdouble liftIO $ do matrixMode $= Projection loadIdentity ortho (-s*aspect) (s*aspect) (-s) s (-1) 1 matrixMode $= Modelview 0 viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h))) render :: Game () render = do tank <- liftM head $ gets tanks let x = fromReal . posx $ tank y = fromReal . posy $ tank (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) textureWood <- getTexture TextureWood textureTank <- getTexture TextureTank liftIO $ do clear [ColorBuffer] loadIdentity 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) textureBinding Texture2D $= Just textureTank translate $ Vector3 x y (0 :: GLfloat) rotate (90 + (fromReal . dir $ tank)) $ Vector3 0 0 (1 :: GLfloat) 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