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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
{-
AccPersp.hs (adapted from accpersp.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
Use the accumulation buffer to do full-scene antialiasing on a scene with
perspective projection, using the special routines accFrustum and
accPerspective.
-}
import Data.List ( genericLength )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
-- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a
-- gaussian distribution around the origin. Use these to do model jittering for
-- scene anti-aliasing and view volume jittering for depth of field effects. Use
-- in conjunction with the accwindow routine.
j8 :: [Vector2 GLdouble]
j8 = [
Vector2 (-0.334818) 0.435331 ,
Vector2 0.286438 (-0.393495),
Vector2 0.459462 0.141540 ,
Vector2 (-0.414498) (-0.192829),
Vector2 (-0.183790) 0.082102 ,
Vector2 (-0.079263) (-0.317383),
Vector2 0.102254 0.299133 ,
Vector2 0.164216 (-0.054399) ]
-- The first 6 arguments are identical to the frustum call. pixD is anti-alias
-- jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD is
-- depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field
-- effects. focus is distance from eye to plane in focus. focus must be greater
-- than, but not equal to 0. Note that accFrustum calls translate. You will
-- probably want to insure that your ModelView matrix has been initialized to
-- identity before calling accFrustum.
accFrustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble
-> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()
accFrustum left right bottom top zNear zFar
(Vector2 pixDx pixDy) (Vector2 eyeDx eyeDy) focus = do
(_, Size w h) <- get viewport
let xWSize = right - left;
yWSize = top - bottom;
dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)
dy = -(pixDy * yWSize / fromIntegral h + eyeDy * zNear / focus)
matrixMode $= Projection
loadIdentity
frustum (left + dx) (right + dx) (bottom + dy) (top + dy) zNear zFar
matrixMode $= Modelview 0
loadIdentity
translate (Vector3 (-eyeDx) (-eyeDy) 0)
-- The first 4 arguments are identical to the perspective call. pixD is
-- anti-alias jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD
-- is depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field
-- effects. focus is distance from eye to plane in focus. focus must be greater
-- than, but not equal to 0. Note that accPerspective calls accFrustum.
accPerspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble
-> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()
accPerspective fovY aspect zNear zFar pixD eyeD focus = do
let fov2 = ((fovY * pi) / 180) / 2
top = zNear / (cos fov2 / sin fov2)
bottom = -top
right = top * aspect
left = -right
accFrustum left right bottom top zNear zFar pixD eyeD focus
-- Initialize lighting and other values.
myInit :: IO ()
myInit = do
materialAmbient Front $= Color4 1 1 1 1
materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 50
position (Light 0) $= Vertex4 0 0 10 1
lightModelAmbient $= Color4 0.2 0.2 0.2 1
lighting $= Enabled
light (Light 0) $= Enabled
depthFunc $= Just Less
shadeModel $= Flat
clearColor $= Color4 0 0 0 0
clearAccum $= Color4 0 0 0 0
displayObjects :: IO ()
displayObjects = do
-- resolve overloading, not needed in "real" programs
let translatef = translate :: Vector3 GLfloat -> IO ()
rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()
preservingMatrix $ do
translatef (Vector3 0 0 (-5))
rotatef 30 (Vector3 1 0 0)
preservingMatrix $ do
translatef (Vector3 (-0.80) 0.35 0)
rotatef 100 (Vector3 1 0 0)
materialDiffuse Front $= Color4 0.7 0.7 0 1
renderObject Solid (Torus 0.275 0.85 16 16)
preservingMatrix $ do
translatef (Vector3 (-0.75) (-0.50) 0)
rotatef 45 (Vector3 0 0 1)
rotatef 45 (Vector3 1 0 0)
materialDiffuse Front $= Color4 0 0.7 0.7 1
renderObject Solid (Cube 1.5)
preservingMatrix $ do
translatef (Vector3 0.75 0.60 0)
rotatef 30 (Vector3 1 0 0)
materialDiffuse Front $= Color4 0.7 0 0.7 1
renderObject Solid (Sphere' 1 16 16)
preservingMatrix $ do
translatef (Vector3 0.70 (-0.90) 0.25)
materialDiffuse Front $= Color4 0.7 0.4 0.4 1
renderObject Solid Octahedron
-- display draws 5 teapots into the accumulation buffer several times; each time
-- with a jittered perspective. The focal point is at z = 5.0, so the gold
-- teapot will stay in focus. The amount of jitter is adjusted by the magnitude
-- of the accPerspective jitter; in this example, 0.33. In this example, the
-- teapots are drawn 8 times.
display :: DisplayCallback
display = do
(_, Size w h) <- get viewport
clear [ AccumBuffer ]
flip mapM_ j8 $ \(Vector2 x y) -> do
clear [ ColorBuffer, DepthBuffer ]
accPerspective 50 (fromIntegral w / fromIntegral h) 1 15
(Vector2 x y) (Vector2 0 0) 1
displayObjects
accum Accum (recip (genericLength j8))
accum Return 1
flush
reshape :: ReshapeCallback
reshape size = do
viewport $= (Position 0 0, size)
keyboard :: KeyboardMouseCallback
keyboard (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
-- Main Loop: Be certain you request an accumulation buffer.
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]
initialWindowSize $= Size 250 250
initialWindowPosition $= Position 100 100
createWindow progName
myInit
reshapeCallback $= Just reshape
displayCallback $= display
keyboardMouseCallback $= Just keyboard
mainLoop
|
