forked from dagit/nehe-tuts
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathlesson05.hs
173 lines (158 loc) · 6.53 KB
/
lesson05.hs
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
--
-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)
--
module Main where
import qualified Graphics.UI.GLFW as GLFW
-- everything from here starts with gl or GL
import Graphics.Rendering.OpenGL.Raw
import Graphics.Rendering.GLU.Raw ( gluPerspective )
import Data.Bits ( (.|.) )
import System.Exit ( exitWith, ExitCode(..) )
import Control.Monad ( forever )
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
tincrement, qincrement :: GLfloat
tincrement = 0.2
qincrement = -0.15
initGL :: GLFW.Window -> IO ()
initGL win = do
glShadeModel gl_SMOOTH -- enables smooth color shading
glClearColor 0 0 0 0 -- Clear the background color to black
glClearDepth 1 -- enables clearing of the depth buffer
glEnable gl_DEPTH_TEST
glDepthFunc gl_LEQUAL -- type of depth test
glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST
(w,h) <- GLFW.getFramebufferSize win
resizeScene win w h
resizeScene :: GLFW.WindowSizeCallback
resizeScene win w 0 = resizeScene win w 1 -- prevent divide by zero
resizeScene _ width height = do
glViewport 0 0 (fromIntegral width) (fromIntegral height)
glMatrixMode gl_PROJECTION
glLoadIdentity
gluPerspective 45 (fromIntegral width/fromIntegral height) 0.1 100
glMatrixMode gl_MODELVIEW
glLoadIdentity
glFlush
drawScene :: IORef GLfloat -> IORef GLfloat -> GLFW.Window -> IO ()
drawScene rtri rquad _ = do
-- clear the screen and the depth buffer
glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT
.|. gl_DEPTH_BUFFER_BIT
glLoadIdentity -- reset view
glTranslatef (-1.5) 0 (-6.0) --Move left 1.5 Units and into the screen 6.0
rt <- readIORef rtri
glRotatef rt 0 1 0 -- Rotate the triangle on the Y axis
-- draw a triangle (in smooth coloring mode)
glBegin gl_TRIANGLES -- start drawing a polygon
-- first the front
glColor3f 1 0 0 -- set The color to Red
glVertex3f 0 1 0 -- top of triangle (front)
glColor3f 0 1 0 -- set The color to Green
glVertex3f (-1) (-1) 1 -- left of triangle (front)
glColor3f 0 0 1 -- set The color to Blue
glVertex3f 1 (-1) 1 -- right of triangle (front)
-- now the right
glColor3f 1 0 0 -- set The color to Red
glVertex3f 0 1 0 -- top of triangle (right)
glColor3f 0 0 1 -- set The color to Blue
glVertex3f 1 (-1) 1 -- left of triangle (right)
glColor3f 0 1 0 -- set The color to Green
glVertex3f 1 (-1) (-1) -- right of triangle (front)
-- now the back
glColor3f 1 0 0 -- set The color to Red
glVertex3f 0 1 0 -- top of triangle (back)
glColor3f 0 1 0 -- set The color to Green
glVertex3f 1 (-1) (-1) -- left of triangle (back)
glColor3f 0 0 1 -- set The color to Blue
glVertex3f (-1) (-1) (-1) -- right of triangle (back)
-- now the left
glColor3f 1 0 0 -- set The color to Red
glVertex3f 0 1 0 -- top of triangle (left)
glColor3f 0 0 1 -- set The color to Blue
glVertex3f (-1) (-1) (-1) -- left of triangle (left)
glColor3f 0 1 0 -- set The color to Green
glVertex3f (-1) (-1) 1 -- right of triangle (left)
glEnd
glLoadIdentity
glTranslatef 1.5 0 (-7) -- move right three units
rq <- readIORef rquad
glRotatef rq 1 1 1 -- rotate the quad on the x axis
glBegin gl_QUADS -- start drawing a polygon (4 sided)
-- first the top
glColor3f 0 1 0 -- set color to green
glVertex3f 1 1 (-1) -- top right of quad (Top)
glVertex3f (-1) 1 (-1) -- top left of quad (Top)
glVertex3f (-1) 1 1 -- bottom left of quad (Top)
glVertex3f 1 1 1 -- bottom right of quad (Top)
-- now the bottom
glColor3f 1 0.5 0 -- set color to orage
glVertex3f 1 (-1) 1 -- top right of quad (Bottom)
glVertex3f (-1) (-1) 1 -- top left of quad (Bottom)
glVertex3f (-1) (-1) (-1) -- bottom left of quad (Bottom)
glVertex3f 1 (-1) (-1) -- bottom right of quad (Bottom)
-- now the front
glColor3f 1 0 0 -- set color to red
glVertex3f 1 1 1 -- top right of quad (Bottom)
glVertex3f (-1) 1 1 -- top left of quad (Bottom)
glVertex3f (-1) (-1) 1 -- bottom left of quad (Bottom)
glVertex3f 1 (-1) 1 -- bottom right of quad (Bottom)
-- now the back
glColor3f 1 1 0 -- set color to yellow
glVertex3f 1 (-1) (-1) -- bottom left of quad (Back)
glVertex3f (-1) (-1) (-1) -- bottom right of quad (Back)
glVertex3f (-1) 1 (-1) -- top right of quad (Back)
glVertex3f 1 1 (-1) -- top left of quad (Back)
-- now the left
glColor3f 0 0 1 -- set color to blue
glVertex3f (-1) 1 1 -- top right of quad (Left)
glVertex3f (-1) 1 (-1) -- top left of quad (Left)
glVertex3f (-1) (-1) (-1) -- bottom left of quad (Left)
glVertex3f (-1) (-1) 1 -- bottom right of quad (Left)
-- now the right
glColor3f 1 0 1 -- set color to violet
glVertex3f 1 1 (-1) -- top right of quad (Right)
glVertex3f 1 1 1 -- top left of quad (Right)
glVertex3f 1 (-1) 1 -- bottom left of quad (Right)
glVertex3f 1 (-1) (-1) -- bottom right of quad (Right)
glEnd
--increase the rotation angle for the triangle
writeIORef rtri $! rt + tincrement
--increase the rotation angle for the quad
writeIORef rquad $! rq + qincrement
glFlush
shutdown :: GLFW.WindowCloseCallback
shutdown win = do
GLFW.destroyWindow win
GLFW.terminate
_ <- exitWith ExitSuccess
return ()
keyPressed :: GLFW.KeyCallback
keyPressed win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win
keyPressed _ _ _ _ _ = return ()
main :: IO ()
main = do
True <- GLFW.init
-- select type of display mode:
-- Double buffer
-- RGBA color
-- Alpha components supported
-- Depth buffer
-- open a window
Just win <- GLFW.createWindow 800 600 "Lesson 5" Nothing Nothing
GLFW.makeContextCurrent (Just win)
-- register the function to do all our OpenGL drawing
rt <- newIORef 0
rq <- newIORef 0
GLFW.setWindowRefreshCallback win (Just (drawScene rt rq))
-- register the funciton called when our window is resized
GLFW.setFramebufferSizeCallback win (Just resizeScene)
-- register the function called when the keyboard is pressed.
GLFW.setKeyCallback win (Just keyPressed)
GLFW.setWindowCloseCallback win (Just shutdown)
-- initialize our window.
initGL win
-- start event processing engine
forever $ do
GLFW.pollEvents
drawScene rt rq win
GLFW.swapBuffers win