Moved source files to src directory
This commit is contained in:
Matthias Schiffer
parent
2bb8561836
commit
7327695ca3
14 changed files with 3 additions and 6 deletions
167
src/Render.hs
Normal file
167
src/Render.hs
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
module Render ( setup
|
||||
, render
|
||||
) where
|
||||
|
||||
|
||||
import Paths_htanks
|
||||
import Game
|
||||
import Level
|
||||
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, preservingMatrix, 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"
|
||||
|
||||
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
|
||||
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 :: Game ()
|
||||
setup = do
|
||||
liftIO $ do
|
||||
blend $= Enabled
|
||||
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
|
||||
|
||||
-- cache textures
|
||||
getTexture TextureWood
|
||||
getTexture TextureTank
|
||||
getTexture TextureCannon
|
||||
getTexture TextureBullet
|
||||
|
||||
return ()
|
||||
|
||||
|
||||
render :: Game ()
|
||||
render = do
|
||||
tanklist <- gets tanks
|
||||
shootlist <- gets shoots
|
||||
|
||||
textureWood <- getTexture TextureWood
|
||||
textureTank <- getTexture TextureTank
|
||||
textureCannon <- getTexture TextureCannon
|
||||
textureBullet <- getTexture TextureBullet
|
||||
|
||||
(lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
|
||||
|
||||
liftIO $ do
|
||||
clear [ColorBuffer]
|
||||
|
||||
texture Texture2D $= Enabled
|
||||
textureBinding Texture2D $= Just textureWood
|
||||
|
||||
renderPrimitive Quads $ do
|
||||
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
|
||||
vertex $ Vertex2 0 lh
|
||||
|
||||
texCoord $ TexCoord2 lw 0
|
||||
vertex $ Vertex2 lw lh
|
||||
|
||||
texCoord $ TexCoord2 lw lh
|
||||
vertex $ Vertex2 lw 0
|
||||
|
||||
texCoord $ TexCoord2 0 lh
|
||||
vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat)
|
||||
|
||||
forM_ tanklist $ \tank -> preservingMatrix $ do
|
||||
let x = fromReal . tankX $ tank
|
||||
y = fromReal . tankY $ tank
|
||||
rotDir = fromReal . tankDir $ tank
|
||||
rotAim = fromReal . tankAim $ tank
|
||||
|
||||
translate $ Vector3 x y (0 :: GLfloat)
|
||||
rotate rotDir $ Vector3 0 0 (1 :: GLfloat)
|
||||
|
||||
textureBinding Texture2D $= Just textureTank
|
||||
|
||||
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)
|
||||
|
||||
rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat)
|
||||
|
||||
textureBinding Texture2D $= Just textureCannon
|
||||
|
||||
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)
|
||||
|
||||
forM_ shootlist $ \shoot -> preservingMatrix $ do
|
||||
let x = fromReal . shootX $ shoot
|
||||
y = fromReal . shootY $ shoot
|
||||
rotDir = fromReal . shootDir $ shoot
|
||||
|
||||
translate $ Vector3 x y (0 :: GLfloat)
|
||||
rotate rotDir $ Vector3 0 0 (1 :: GLfloat)
|
||||
|
||||
textureBinding Texture2D $= Just textureBullet
|
||||
|
||||
renderPrimitive Quads $ do
|
||||
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
|
||||
vertex $ Vertex2 (-0.2 :: GLfloat) (-0.2 :: GLfloat)
|
||||
|
||||
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
|
||||
vertex $ Vertex2 (-0.2 :: GLfloat) (0.2 :: GLfloat)
|
||||
|
||||
texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
|
||||
vertex $ Vertex2 (0.2 :: GLfloat) (0.2 :: GLfloat)
|
||||
|
||||
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
|
||||
vertex $ Vertex2 (0.2 :: GLfloat) (-0.2 :: GLfloat)
|
||||
|
||||
|
||||
fromReal :: (Real a, Fractional b) => a -> b
|
||||
fromReal = fromRational . toRational
|
||||
Reference in a new issue