213 lines
8.4 KiB
Haskell
213 lines
8.4 KiB
Haskell
module Render ( setup
|
|
, render
|
|
) where
|
|
|
|
|
|
import Game
|
|
import MainLoop
|
|
import Level
|
|
import Player
|
|
import Tank
|
|
import Texture
|
|
import Model
|
|
import qualified Vector as V
|
|
|
|
import Control.Monad.State
|
|
|
|
import Data.Fixed
|
|
import Data.Maybe
|
|
import Data.Obj3D
|
|
import Data.Obj3D.OpenGL
|
|
import Data.Ratio
|
|
import qualified Data.Map as M
|
|
|
|
import Bindings.GLPng
|
|
|
|
import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..), Vector3(..), Vertex2(..), Vertex4(..))
|
|
import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..))
|
|
import Graphics.Rendering.OpenGL.GL.CoordTrans
|
|
import Graphics.Rendering.OpenGL.GL.Colors
|
|
import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..))
|
|
import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..), depthFunc, ComparisonFunction(..))
|
|
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
|
|
|
|
|
|
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
|
|
|
|
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
|
|
(lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
|
|
|
|
liftIO $ do
|
|
blend $= Enabled
|
|
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
|
|
depthFunc $= Just Lequal
|
|
shadeModel $= Smooth
|
|
lighting $= Enabled
|
|
light (Light 0) $= Enabled
|
|
position (Light 0) $= Vertex4 (-1) (-1) 1.5 (0 :: GLfloat)
|
|
colorMaterial $= Just (Front, AmbientAndDiffuse)
|
|
|
|
clientState VertexArray $= Enabled
|
|
clientState NormalArray $= Enabled
|
|
clientState TextureCoordArray $= Enabled
|
|
|
|
|
|
-- cache textures & models
|
|
getTexture TextureWood
|
|
getTexture TextureTank
|
|
getTexture TextureCannon
|
|
getTexture TextureBullet
|
|
getTexture TextureCrosshair
|
|
|
|
getModel ModelTank
|
|
getModel ModelBullet
|
|
getModel ModelBlock
|
|
|
|
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
|
|
modelBullet <- getModel ModelBullet
|
|
modelBlock <- getModel ModelBlock
|
|
|
|
(lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
|
|
|
|
liftIO $ do
|
|
clear [ColorBuffer, DepthBuffer]
|
|
|
|
depthFunc $= Just Lequal
|
|
|
|
texture Texture2D $= Enabled
|
|
textureBinding Texture2D $= Just textureWood
|
|
|
|
normal $ Normal3 0 0 (1 :: GLfloat)
|
|
|
|
unsafeRenderPrimitive Quads $ do
|
|
texCoord $ TexCoord2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
|
|
vertex $ Vertex2 (-1) (lh+1)
|
|
|
|
texCoord $ TexCoord2 (lw/2+0.5) (-0.5)
|
|
vertex $ Vertex2 (lw+1) (lh+1)
|
|
|
|
texCoord $ TexCoord2 (lw/2+0.5) (lh/2+0.5)
|
|
vertex $ Vertex2 (lw+1) (-1)
|
|
|
|
texCoord $ TexCoord2 (-0.5) (lh/2+0.5)
|
|
vertex $ Vertex2 (-1 :: GLfloat) (-1 :: GLfloat)
|
|
|
|
bindInterleavedArrays modelTank
|
|
|
|
forM_ tanklist $ \tank -> unsafePreservingMatrix $ do
|
|
let x = realToFrac . tankX $ tank
|
|
y = realToFrac . tankY $ tank
|
|
rotDir = realToFrac . V.toAngle . tankDir $ tank
|
|
rotAim = realToFrac . V.toAngle . tankAim $ tank
|
|
|
|
translate $ Vector3 x y (0 :: GLfloat)
|
|
rotate (rotDir*180/pi) $ Vector3 0 0 (1 :: GLfloat)
|
|
|
|
textureBinding Texture2D $= Just textureTank
|
|
|
|
unsafePreservingMatrix $ do
|
|
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
|
|
drawObject modelTank 1
|
|
|
|
rotate ((rotAim-rotDir)*180/pi) $ Vector3 0 0 (1 :: GLfloat)
|
|
|
|
textureBinding Texture2D $= Just textureCannon
|
|
|
|
unsafePreservingMatrix $ do
|
|
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
|
|
drawObject modelTank 0
|
|
|
|
texture Texture2D $= Disabled
|
|
bindInterleavedArrays modelBullet
|
|
|
|
forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
|
|
let x = realToFrac . bulletX $ bullet
|
|
y = realToFrac . bulletY $ bullet
|
|
rotDir = realToFrac . V.toAngle . bulletDir $ bullet
|
|
|
|
translate $ Vector3 x y (0.25 :: GLfloat)
|
|
rotate ((rotDir*180/pi)-90) $ Vector3 0 0 (1 :: GLfloat)
|
|
|
|
unsafePreservingMatrix $ do
|
|
drawObject modelBullet 0
|
|
|
|
bindInterleavedArrays modelBlock
|
|
|
|
texture Texture2D $= Enabled
|
|
textureBinding Texture2D $= Just textureWood
|
|
forM_ [0.5..13.5] $ \x -> unsafePreservingMatrix $ do
|
|
translate $ Vector3 x 8.5 (0.5 :: GLfloat)
|
|
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
|
|
drawObject modelBlock 0
|
|
|
|
forM_ [0.5..13.5] $ \x -> unsafePreservingMatrix $ do
|
|
translate $ Vector3 x (-0.5) (0.5 :: GLfloat)
|
|
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
|
|
drawObject modelBlock 0
|
|
|
|
forM_ [-0.5..8.5] $ \y -> unsafePreservingMatrix $ do
|
|
translate $ Vector3 (-0.5) y (0.5 :: GLfloat)
|
|
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
|
|
drawObject modelBlock 0
|
|
|
|
forM_ [-0.5..8.5] $ \y -> unsafePreservingMatrix $ do
|
|
translate $ Vector3 14.5 y (0.5 :: GLfloat)
|
|
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
|
|
drawObject modelBlock 0
|
|
|
|
depthFunc $= Just Always
|
|
|
|
textureBinding Texture2D $= Just textureCrosshair
|
|
forM_ playerlist renderPlayer
|