1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
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)
import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)
import Graphics.Rendering.OpenGL.GL.VertexSpec
texturePath :: Texture -> String
texturePath t
| t == TextureWood = "tex/Wood.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) NoMipmap Solid (Repeated, Repeat) (Linear', Nothing) 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
-- cache textures
getTexture TextureWood
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
liftIO $ do
clear [ColorBuffer]
renderPrimitive Quads $ do
vertex $ Vertex2 (x-0.5 :: GLfloat) (y-0.5 :: GLfloat)
vertex $ Vertex2 (x-0.5 :: GLfloat) (y+0.5 :: GLfloat)
vertex $ Vertex2 (x+0.5 :: GLfloat) (y+0.5 :: GLfloat)
vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: GLfloat)
fromReal :: (Real a, Fractional b) => a -> b
fromReal = fromRational . toRational
|
