135 lines
No EOL
4.4 KiB
Haskell
135 lines
No EOL
4.4 KiB
Haskell
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 |