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
|
{-
Multisamp.hs (adapted from multisamp.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 draws shows how to use multisampling to draw anti-aliased
geometric primitives. The same display list, a pinwheel of triangles and
lines of varying widths, is rendered twice. Multisampling is enabled when the
left side is drawn. Multisampling is disabled when the right side is drawn.
Pressing the 'b' key toggles drawing of the checkerboard background.
Antialiasing is sometimes easier to see when objects are rendered over a
contrasting background.
-}
import Control.Monad ( when )
import Data.Char ( toLower )
import Data.IORef ( IORef, newIORef )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
data State = State { bgToggle :: IORef Bool }
makeState :: IO State
makeState = do
b <- newIORef True
return $ State { bgToggle = b }
data DisplayLists = DisplayLists { pinwheelList, backgroundList :: DisplayList }
-- Print out state values related to multisampling. Create display list with
-- "pinwheel" of lines and triangles.
myInit :: IO DisplayLists
myInit = do
clearColor $= Color4 0 0 0 0
sb <- get sampleBuffers
putStrLn ("number of sample buffers is " ++ show sb)
s <- get samples
putStrLn ("number of samples is " ++ show s)
-- resolve overloading, not needed in "real" programs
let color3f = color :: Color3 GLfloat -> IO ()
vertex2f = vertex :: Vertex2 GLfloat -> IO ()
p <- defineNewList Compile $ do
flip mapM_ [ 0 .. 18 ] $ \i ->
preservingMatrix $ do
rotate (360 * fromIntegral i / 19 :: GLfloat) (Vector3 0 0 1)
color3f (Color3 1 1 1)
lineWidth $= fromIntegral ((i `mod` 3 :: Int) + 1)
renderPrimitive Lines $ do
vertex2f (Vertex2 0.25 0.05)
vertex2f (Vertex2 0.9 0.2)
color3f (Color3 0 1 1)
renderPrimitive Triangles $ do
vertex2f (Vertex2 0.25 0)
vertex2f (Vertex2 0.9 0)
vertex2f (Vertex2 0.875 0.1)
b <- defineNewList Compile $ do
color3f (Color3 1 0.5 0)
renderPrimitive Quads $
flip mapM_ [ 0 .. 15 ] $ \i ->
flip mapM_ [ 0 .. 15 ] $ \j ->
when (((i + j) `mod` 2 :: Int) == 0) $ do
let ii = fromIntegral i * 0.25
jj = fromIntegral j * 0.25
vertex2f (Vertex2 (-2.0 + ii) (-2.0 + jj))
vertex2f (Vertex2 (-2.0 + ii) (-1.75 + jj))
vertex2f (Vertex2 (-1.75 + ii) (-1.75 + jj))
vertex2f (Vertex2 (-1.75 + ii) (-2.0 + jj))
return $ DisplayLists { pinwheelList = p, backgroundList = b }
-- Draw two sets of primitives, so that you can compare the user of
-- multisampling against its absence.
--
-- This code enables antialiasing and draws one display list and disables and
-- draws the other display list
display :: State -> DisplayLists -> DisplayCallback
display state displayLists = do
clear [ ColorBuffer ]
t <- get (bgToggle state)
when t $
callList (backgroundList displayLists)
-- resolve overloading, not needed in "real" programs
let translatef = translate :: Vector3 GLfloat -> IO ()
multisample $= Enabled
preservingMatrix $ do
translatef (Vector3 (-1) 0 0)
callList (pinwheelList displayLists)
multisample $= Disabled
preservingMatrix $ do
translatef (Vector3 1 0 0)
callList (pinwheelList displayLists)
swapBuffers
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 <= 2 * h
then ortho2D (-2) 2 (-2*hf/wf) (2*hf/wf)
else ortho2D (-2*wf/hf) (2*wf/hf) (-2) 2
matrixMode $= Modelview 0
loadIdentity
keyboard :: State -> KeyboardMouseCallback
keyboard state (Char c) Down _ _ = case toLower c of
'b' -> do bgToggle state $~ not; postRedisplay Nothing
'\27' -> exitWith ExitSuccess
_ -> return ()
keyboard _ _ _ _ _ = return ()
-- Main Loop: Open window with initial window size, title bar, RGBA display
-- mode, and handle input events.
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ DoubleBuffered, RGBMode, Multisampling ]
initialWindowSize $= Size 600 300
createWindow progName
state <- makeState
displayLists <- myInit
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboard state)
displayCallback $= display state displayLists
mainLoop
|
