Frame-Bufferul este o zonă de memorie alocată procesorului grafic. Este utilizată pentru stocarea pixelilor randaţi înainte de a fi afişaţi pe monitor.
{-
Stencil.hs (adapted from stencil.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
Stencil.hs (adapted from stencil.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
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 stencil buffer for masking
nonrectangular regions. Whenever the window is redrawn, a value of 1 is drawn
into a diamond-shaped region in the stencil buffer. Elsewhere in the stencil
buffer, the value is 0. Then a blue sphere is drawn where the stencil value
is 1, and yellow torii are drawn where the stencil value is not 1.
-}
nonrectangular regions. Whenever the window is redrawn, a value of 1 is drawn
into a diamond-shaped region in the stencil buffer. Elsewhere in the stencil
buffer, the value is 0. Then a blue sphere is drawn where the stencil value
is 1, and yellow torii are drawn where the stencil value is not 1.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import Graphics.UI.GLUT
data DisplayLists = DisplayLists { yellowMat, blueMat :: DisplayList }
myInit :: IO DisplayLists
myInit = do
y <- defineNewList Compile $ do
materialDiffuse Front $= Color4 0.7 0.7 0 1
materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 64
myInit = do
y <- defineNewList Compile $ do
materialDiffuse Front $= Color4 0.7 0.7 0 1
materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 64
b <- defineNewList Compile $ do
materialDiffuse Front $= Color4 0.1 0.1 0.7 1
materialSpecular Front $= Color4 0.1 1 1 1
materialShininess Front $= 45
materialDiffuse Front $= Color4 0.1 0.1 0.7 1
materialSpecular Front $= Color4 0.1 1 1 1
materialShininess Front $= 45
position (Light 0) $= Vertex4 1 1 1 0
light (Light 0) $= Enabled
lighting $= Enabled
depthFunc $= Just Less
lighting $= Enabled
depthFunc $= Just Less
clearStencil $= 0
stencilTest $= Enabled
stencilTest $= Enabled
return $ DisplayLists { yellowMat = y, blueMat = b }
— Draw a sphere in a diamond-shaped section in the middle of a window with 2
— torii.
display :: DisplayLists -> DisplayCallback
display displayLists = do
clear [ ColorBuffer, DepthBuffer ]
— torii.
display :: DisplayLists -> DisplayCallback
display displayLists = do
clear [ ColorBuffer, DepthBuffer ]
— draw blue sphere where the stencil is 1
stencilFunc $= (Equal, 1, 1)
stencilOp $= (OpKeep, OpKeep, OpKeep)
callList (blueMat displayLists)
renderObject Solid (Sphere’ 0.5 15 15)
stencilFunc $= (Equal, 1, 1)
stencilOp $= (OpKeep, OpKeep, OpKeep)
callList (blueMat displayLists)
renderObject Solid (Sphere’ 0.5 15 15)
— resolve overloading, not needed in “real” programs
let rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()
let rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()
— draw the tori where the stencil is not 1
stencilFunc $= (Notequal, 1, 1)
preservingMatrix $ do
rotatef 45 (Vector3 0 0 1)
rotatef 45 (Vector3 0 1 0)
callList (yellowMat displayLists)
renderObject Solid (Torus 0.275 0.85 15 15)
preservingMatrix $ do
rotatef 90 (Vector3 1 0 0)
renderObject Solid (Torus 0.275 0.85 15 15)
stencilFunc $= (Notequal, 1, 1)
preservingMatrix $ do
rotatef 45 (Vector3 0 0 1)
rotatef 45 (Vector3 0 1 0)
callList (yellowMat displayLists)
renderObject Solid (Torus 0.275 0.85 15 15)
preservingMatrix $ do
rotatef 90 (Vector3 1 0 0)
renderObject Solid (Torus 0.275 0.85 15 15)
flush
— Whenever the window is reshaped, redefine the coordinate system and redraw
— the stencil area.
reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
— the stencil area.
reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
— create a diamond shaped stencil area
matrixMode $= Projection
loadIdentity
let wf = fromIntegral w
hf = fromIntegral h
if w <= h
then ortho2D (-3) 3 (-3*hf/wf) (3*hf/wf)
else ortho2D (-3*wf/hf) (3*wf/hf) (-3) 3
matrixMode $= Modelview 0
loadIdentity
matrixMode $= Projection
loadIdentity
let wf = fromIntegral w
hf = fromIntegral h
if w <= h
then ortho2D (-3) 3 (-3*hf/wf) (3*hf/wf)
else ortho2D (-3*wf/hf) (3*wf/hf) (-3) 3
matrixMode $= Modelview 0
loadIdentity
— resolve overloading, not needed in “real” programs
let vertex2f = vertex :: Vertex2 GLfloat -> IO ()
translatef = translate :: Vector3 GLfloat -> IO ()
let vertex2f = vertex :: Vertex2 GLfloat -> IO ()
translatef = translate :: Vector3 GLfloat -> IO ()
clear [ StencilBuffer ]
stencilFunc $= (Always, 1, 1)
stencilOp $= (OpReplace, OpReplace, OpReplace)
renderPrimitive Quads $ do
vertex2f (Vertex2 (-1) 0)
vertex2f (Vertex2 0 1)
vertex2f (Vertex2 1 0)
vertex2f (Vertex2 0 (-1))
stencilFunc $= (Always, 1, 1)
stencilOp $= (OpReplace, OpReplace, OpReplace)
renderPrimitive Quads $ do
vertex2f (Vertex2 (-1) 0)
vertex2f (Vertex2 0 1)
vertex2f (Vertex2 1 0)
vertex2f (Vertex2 0 (-1))
matrixMode $= Projection
loadIdentity
perspective 45 (wf/hf) 3 7
matrixMode $= Modelview 0
loadIdentity
translatef (Vector3 0 0 (-5))
loadIdentity
perspective 45 (wf/hf) 3 7
matrixMode $= Modelview 0
loadIdentity
translatef (Vector3 0 0 (-5))
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
— Main Loop: Be certain to request stencil bits.
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer, WithStencilBuffer ]
initialWindowSize $= Size 400 400
initialWindowPosition $= Position 100 100
_ <- createWindow progName
displayLists <- myInit
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
displayCallback $= display displayLists
mainLoop
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer, WithStencilBuffer ]
initialWindowSize $= Size 400 400
initialWindowPosition $= Position 100 100
_ <- createWindow progName
displayLists <- myInit
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
displayCallback $= display displayLists
mainLoop
{-
AccPersp.hs (adapted from accpersp.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
AccPersp.hs (adapted from accpersp.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
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.
-}
perspective projection, using the special routines accFrustum and
accPerspective.
-}
import Data.List ( genericLength )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
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) ]
— 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
— 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;
yWSize = top – bottom;
dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)
dy = -(pixDy * yWSize / fromIntegral h + eyeDy * 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)
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
— 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
bottom = -top
right = top * aspect
left = -right
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
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
light (Light 0) $= Enabled
depthFunc $= Just Less
shadeModel $= Flat
clearColor $= Color4 0 0 0 0
clearAccum $= 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 ()
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)
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)
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)
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)
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
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 ]
— 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))
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
flush
reshape :: ReshapeCallback
reshape size = do
viewport $= (Position 0 0, size)
reshape size = do
viewport $= (Position 0 0, size)
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
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
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
{-
AccAnti.hs (adapted from accanti.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
AccAnti.hs (adapted from accanti.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
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
orthographic parallel projection.
-}
orthographic parallel projection.
-}
import Data.List ( genericLength )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
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) ]
— 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) ]
— 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
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
light (Light 0) $= Enabled
depthFunc $= Just Less
shadeModel $= Flat
clearColor $= Color4 0 0 0 0
clearAccum $= 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 ()
displayObjects = do
— resolve overloading, not needed in “real” programs
let translatef = translate :: Vector3 GLfloat -> IO ()
rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()
preservingMatrix $ do
rotatef 30 (Vector3 1 0 0)
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)
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)
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)
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
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 ]
— 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 ]
preservingMatrix $ do
— Note that 4.5 is the distance in world space between left and right
— and bottom and top. This formula converts fractional pixel movement
— to world coordinates.
translate (Vector3 (x*4.5/fromIntegral w) (y*4.5/fromIntegral h) 0)
displayObjects
accum Accum (recip (genericLength j8))
clear [ ColorBuffer, DepthBuffer ]
preservingMatrix $ do
— Note that 4.5 is the distance in world space between left and right
— and bottom and top. This formula converts fractional pixel movement
— to world coordinates.
translate (Vector3 (x*4.5/fromIntegral w) (y*4.5/fromIntegral h) 0)
displayObjects
accum Accum (recip (genericLength j8))
accum Return 1
flush
flush
reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
let wf = fromIntegral w
hf = fromIntegral h
if w <= h
then ortho (-2.25) 2.25 (-2.25*hf/wf) (2.25*hf/wf) (-10) 10
else ortho (-2.25*wf/hf) (2.25*wf/hf) (-2.25) 2.25 (-10) 10
matrixMode $= Modelview 0
loadIdentity
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
let wf = fromIntegral w
hf = fromIntegral h
if w <= h
then ortho (-2.25) 2.25 (-2.25*hf/wf) (2.25*hf/wf) (-10) 10
else ortho (-2.25*wf/hf) (2.25*wf/hf) (-2.25) 2.25 (-10) 10
matrixMode $= Modelview 0
loadIdentity
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
— Main Loop: Be certain to 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
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
{-
DOF.hs (adapted from dof.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
DOF.hs (adapted from dof.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
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.
-}
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
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) ]
— 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
— 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;
yWSize = top – bottom;
dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)
dy = -(pixDy * yWSize / fromIntegral h + eyeDy * 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)
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
— 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
bottom = -top
right = top * aspect
left = -right
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
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
lightModelLocalViewer $= Disabled
frontFace $= CW
lighting $= Enabled
light (Light 0) $= Enabled
autoNormal $= Enabled
normalize $= Enabled
depthFunc $= Just Less
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)
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
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 ]
— 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
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))
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
flush
reshape :: ReshapeCallback
reshape size = do
viewport $= (Position 0 0, size)
reshape size = do
viewport $= (Position 0 0, size)
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
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
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
InfoCad Blog 