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
|
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Gloss.Internals.Rendering.Common
( gf, gsizei
, withModelview
, withClearBuffer)
where
import Unsafe.Coerce
import Graphics.Gloss.Internals.Data.Color
import Graphics.Gloss.Internals.Rendering.Color
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL.GL as GL
-- | The OpenGL library doesn't seem to provide a nice way convert
-- a Float to a GLfloat, even though they're the same thing
-- under the covers.
--
-- Using realToFrac is too slow, as it doesn't get fused in at
-- least GHC 6.12.1
--
gf :: Float -> GL.GLfloat
gf x = unsafeCoerce x
{-# INLINE gf #-}
-- | Used for similar reasons to above
gsizei :: Int -> GL.GLsizei
gsizei x = unsafeCoerce x
{-# INLINE gsizei #-}
-- | Set up the OpenGL rendering context for orthographic projection and run an
-- action to draw the model.
withModelview
:: (Int, Int) -- ^ Width and height of window.
-> IO () -- ^ Action to perform.
-> IO ()
withModelview (sizeX, sizeY) action
= do
GL.matrixMode $= GL.Projection
GL.preservingMatrix
$ do
-- setup the co-ordinate system
GL.loadIdentity
let (sx, sy) = (fromIntegral sizeX / 2, fromIntegral sizeY / 2)
GL.ortho (-sx) sx (-sy) sy 0 (-100)
-- draw the world
GL.matrixMode $= GL.Modelview 0
action
GL.matrixMode $= GL.Projection
GL.matrixMode $= GL.Modelview 0
-- | Clear the OpenGL buffer with the given background color and run
-- an action to draw the model.
withClearBuffer
:: Color -- ^ Background color
-> IO () -- ^ Action to perform
-> IO ()
withClearBuffer clearColor action
= do
-- initialization (done every time in this case)
-- we don't need the depth buffer for 2d.
GL.depthFunc GL.$= Just GL.Always
-- always clear the buffer to white
GL.clearColor GL.$= glColor4OfColor clearColor
-- on every loop
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
GL.color $ GL.Color4 0 0 0 (1 :: GL.GLfloat)
action
|
