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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
{-
DOF.hs (adapted from dof.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
This program demonstrates use of the accumulation buffer to create an
out-of-focus depth-of-field effect. The teapots are drawn several times into
the accumulation buffer. The viewing volume is jittered, except at the focal
point, where the viewing volume is at the same position, each time. In this
case, the gold teapot remains in focus.
-}
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
myInit :: IO DisplayList
myInit = do
ambient (Light 0) $= Color4 0 0 0 1
diffuse (Light 0) $= Color4 1 1 1 1
position (Light 0) $= Vertex4 0 3 3 0
lightModelAmbient $= Color4 0.2 0.2 0.2 1
lightModelLocalViewer $= Disabled
frontFace $= CW
lighting $= Enabled
light (Light 0) $= Enabled
autoNormal $= Enabled
normalize $= Enabled
depthFunc $= Just Less
clearColor $= Color4 0 0 0 0
clearAccum $= Color4 0 0 0 0
-- make teapot display list
defineNewList Compile $
renderObject Solid (Teapot 0.5)
-- Move object into position, specify the material properties, draw a teapot.
renderTeapot :: DisplayList -> Vector3 GLfloat -> Color4 GLfloat
-> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> IO ()
renderTeapot teapotList pos amb dif spec shine =
preservingMatrix $ do
translate pos
materialAmbient Front $= amb
materialDiffuse Front $= dif
materialSpecular Front $= spec
materialShininess Front $= shine * 128
callList teapotList
-- 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 :: DisplayList -> DisplayCallback
display teapotList = do
(_, Size w h) <- get viewport
clear [ AccumBuffer ]
flip mapM_ j8 $ \(Vector2 x y) -> do
clear [ ColorBuffer, DepthBuffer ]
accPerspective 45 (fromIntegral w / fromIntegral h) 1 15
(Vector2 0 0) (Vector2 (0.33 * x) (0.33 * y)) 5
-- ruby, gold, silver, emerald, and cyan teapots
renderTeapot teapotList
(Vector3 (-1.1) (-0.5) (-4.5))
(Color4 0.1745 0.01175 0.01175 1)
(Color4 0.61424 0.04136 0.04136 1)
(Color4 0.727811 0.626959 0.626959 1)
0.6
renderTeapot teapotList
(Vector3 (-0.5) (-0.5) (-5.0))
(Color4 0.24725 0.1995 0.0745 1)
(Color4 0.75164 0.60648 0.22648 1)
(Color4 0.628281 0.555802 0.366065 1)
0.4
renderTeapot teapotList
(Vector3 0.2 (-0.5) (-5.5))
(Color4 0.19225 0.19225 0.19225 1)
(Color4 0.50754 0.50754 0.50754 1)
(Color4 0.508273 0.508273 0.508273 1)
0.4
renderTeapot teapotList
(Vector3 1.0 (-0.5) (-6.0))
(Color4 0.0215 0.1745 0.0215 1)
(Color4 0.07568 0.61424 0.07568 1)
(Color4 0.633 0.727811 0.633 1)
0.6
renderTeapot teapotList
(Vector3 1.8 (-0.5) (-6.5))
(Color4 0.0 0.1 0.06 1)
(Color4 0.0 0.50980392 0.50980392 1)
(Color4 0.50196078 0.50196078 0.50196078 1)
0.25
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 400 400
initialWindowPosition $= Position 100 100
createWindow progName
teapotList <- myInit
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
displayCallback $= display teapotList
mainLoop
|
