-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathlesson06.hs
188 lines (172 loc) · 6.26 KB
/
lesson06.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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
--
-- 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 )
import Foreign ( withForeignPtr, plusPtr, peek, alloca )
import qualified Data.ByteString.Internal as BSI
import Util ( Image(..), bitmapLoad )
import Paths_nehe_tuts
initGL :: GLFW.Window -> IO GLuint
initGL win = do
glEnable gl_TEXTURE_2D
glShadeModel gl_SMOOTH
glClearColor 0 0 0 0
glClearDepth 1
glEnable gl_DEPTH_TEST
glDepthFunc gl_LEQUAL
glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST
(w,h) <- GLFW.getFramebufferSize win
resizeScene win w h
loadGLTextures
loadGLTextures :: IO GLuint
loadGLTextures = do
fp <- getDataFileName "NeHe.bmp"
putStrLn $ "loading texture: " ++ fp
Just (Image w h pd) <- bitmapLoad fp
putStrLn $ "Image width = " ++ show w
putStrLn $ "Image height = " ++ show h
tex <- alloca $ \p -> do
glGenTextures 1 p
peek p
let (ptr, off, _) = BSI.toForeignPtr pd
withForeignPtr ptr $ \p -> do
let p' = p `plusPtr` off
glBindTexture gl_TEXTURE_2D tex
glTexImage2D gl_TEXTURE_2D 0 3
(fromIntegral w) (fromIntegral h) 0 gl_RGB gl_UNSIGNED_BYTE
p'
let glLinear = fromIntegral gl_LINEAR
glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear
glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear
return tex
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 :: GLuint -> IORef GLfloat -> IORef GLfloat
-> IORef GLfloat -> GLFW.Window -> IO ()
drawScene tex xrot yrot zrot _ = do
-- clear the screen and the depth buffer
glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT
.|. gl_DEPTH_BUFFER_BIT
glLoadIdentity -- reset view
glTranslatef 0 0 (-5.0) --Move left 5 Units into the screen
xr <- readIORef xrot
yr <- readIORef yrot
zr <- readIORef zrot
glRotatef xr 1 0 0 -- Rotate the triangle on the Y axis
glRotatef yr 0 1 0 -- Rotate the triangle on the Y axis
glRotatef zr 0 0 1 -- Rotate the triangle on the Y axis
glBindTexture gl_TEXTURE_2D tex
glBegin gl_QUADS -- start drawing a polygon (4 sided)
-- first the front
glTexCoord2f 0 0
glVertex3f (-1) (-1) 1 -- bottom left of quad (Front)
glTexCoord2f 1 0
glVertex3f 1 (-1) 1 -- bottom right of quad (Front)
glTexCoord2f 1 1
glVertex3f 1 1 1 -- top right of quad (Front)
glTexCoord2f 0 1
glVertex3f (-1) 1 1 -- top left of quad (Front)
-- now the back
glTexCoord2f 1 0
glVertex3f (-1) (-1) (-1) -- bottom right of quad (Back)
glTexCoord2f 1 1
glVertex3f (-1) 1 (-1) -- top right of quad (Back)
glTexCoord2f 0 1
glVertex3f 1 1 (-1) -- top left of quad (Back)
glTexCoord2f 0 0
glVertex3f 1 (-1) (-1) -- bottom left of quad (Back)
-- now the top
glTexCoord2f 0 1
glVertex3f (-1) 1 (-1) -- top left of quad (Top)
glTexCoord2f 0 0
glVertex3f (-1) 1 1 -- bottom left of quad (Top)
glTexCoord2f 1 0
glVertex3f 1 1 1 -- bottom right of quad (Top)
glTexCoord2f 1 1
glVertex3f 1 1 (-1) -- top right of quad (Top)
-- now the bottom
glTexCoord2f 1 1
glVertex3f 1 (-1) 1 -- top right of quad (Bottom)
glTexCoord2f 0 1
glVertex3f (-1) (-1) 1 -- top left of quad (Bottom)
glTexCoord2f 0 0
glVertex3f (-1) (-1) (-1) -- bottom left of quad (Bottom)
glTexCoord2f 1 0
glVertex3f 1 (-1) (-1) -- bottom right of quad (Bottom)
-- now the right
glTexCoord2f 1 0
glVertex3f 1 (-1) (-1) -- bottom right of quad (Right)
glTexCoord2f 1 1
glVertex3f 1 1 (-1) -- top right of quad (Right)
glTexCoord2f 0 1
glVertex3f 1 1 1 -- top left of quad (Right)
glTexCoord2f 0 0
glVertex3f 1 (-1) 1 -- bottom left of quad (Right)
-- now the left
glTexCoord2f 0 0
glVertex3f (-1) (-1) (-1) -- bottom left of quad (Left)
glTexCoord2f 1 0
glVertex3f (-1) 1 (-1) -- top left of quad (Left)
glTexCoord2f 1 1
glVertex3f (-1) 1 1 -- top right of quad (Left)
glTexCoord2f 0 1
glVertex3f (-1) (-1) 1 -- bottom right of quad (Left)
glEnd
writeIORef xrot $! xr + 0.3
writeIORef yrot $! yr + 0.2
writeIORef zrot $! zr + 0.4
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
GLFW.defaultWindowHints
-- open a window
Just win <- GLFW.createWindow 800 600 "Lesson 6" Nothing Nothing
GLFW.makeContextCurrent (Just win)
-- register the function to do all our OpenGL drawing
xrot <- newIORef 0
yrot <- newIORef 0
zrot <- newIORef 0
tex <- initGL win
GLFW.setWindowRefreshCallback win (Just (drawScene tex xrot yrot zrot))
-- 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.
-- start event processing engine
forever $ do
GLFW.pollEvents
drawScene tex xrot yrot zrot win
GLFW.swapBuffers win