nehe-tuts 0.2.3 → 0.2.4
raw patch · 13 files changed
+2285/−2422 lines, 13 filesdep ~GLFW-bdep ~GLURawdep ~OpenGLRaw
Dependency ranges changed: GLFW-b, GLURaw, OpenGLRaw, array, bytestring, cereal, directory, random
Files
- lesson01.hs +78/−88
- lesson02.hs +100/−110
- lesson03.hs +104/−114
- lesson04.hs +120/−130
- lesson05.hs +173/−184
- lesson06.hs +188/−198
- lesson07.hs +262/−276
- lesson08.hs +272/−287
- lesson09.hs +217/−229
- lesson10.hs +300/−318
- lesson11.hs +178/−188
- lesson12.hs +187/−194
- nehe-tuts.cabal +106/−106
lesson01.hs view
@@ -1,88 +1,78 @@------ This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)-----module Main where---- import Graphics.UI.GLUT-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 )--initGL :: IO ()-initGL = 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--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 :: IO ()-drawScene = do- -- clear the screen and the depth buffer- glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT- .|. gl_DEPTH_BUFFER_BIT- glLoadIdentity -- reset view- glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: GLFW.KeyCallback -keyPressed GLFW.KeyEsc True = shutdown >> return ()-keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize - -- get a 640 x 480 window- let dspOpts = GLFW.defaultDisplayOptions- { GLFW.displayOptions_width = 640- , GLFW.displayOptions_height = 480- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- } - -- initialize our window.- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- -- open a window- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- register the function to do all our OpenGL drawing- GLFW.setWindowRefreshCallback drawScene- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback keyPressed- -- register window close handler- GLFW.setWindowCloseCallback shutdown- initGL- -- start event processing engine- forever $ do- drawScene- GLFW.swapBuffers+-- +-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005) +-- + +module Main where + +-- import Graphics.UI.GLUT +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 ) + +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 :: GLFW.Window -> IO () +drawScene _ = do + -- clear the screen and the depth buffer + glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT + .|. gl_DEPTH_BUFFER_BIT + glLoadIdentity -- reset view + 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 + GLFW.defaultWindowHints + -- get a 640 x 480 window + -- initialize our window. + Just win <- GLFW.createWindow 640 480 "Lesson 1" Nothing Nothing + GLFW.makeContextCurrent (Just win) + -- register the function to do all our OpenGL drawing + GLFW.setWindowRefreshCallback win (Just drawScene) + -- 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) + -- register window close handler + GLFW.setWindowCloseCallback win (Just shutdown) + initGL win + -- start event processing engine + forever $ do + GLFW.pollEvents + drawScene win + GLFW.swapBuffers win
lesson02.hs view
@@ -1,110 +1,100 @@------ 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 )--initGL :: IO ()-initGL = 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--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 :: IO ()-drawScene = do- -- clear the screen and the depth bufer- 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- - -- draw a triangle- glBegin gl_TRIANGLES- glVertex3f 0 1 0 -- top- glVertex3f 1 (-1) 0 -- bottom right- glVertex3f (-1) (-1) 0 -- bottom left- glEnd-- glTranslatef 3 0 0 -- move right three units-- glBegin gl_QUADS- glVertex3f (-1) 1 0 -- top left- glVertex3f 1 1 0 -- top right- glVertex3f 1 (-1) 0 -- bottom right- glVertex3f (-1) (-1) 0 -- bottom left- glEnd- - glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: GLFW.KeyCallback-keyPressed GLFW.KeyEsc True = shutdown >> return ()-keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- register the function to do all our OpenGL drawing- GLFW.setWindowRefreshCallback drawScene- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback keyPressed- GLFW.setWindowCloseCallback shutdown- -- initialize our window.- initGL- -- start event processing engine- forever $ do- drawScene- GLFW.swapBuffers+-- +-- 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 ) + +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.FramebufferSizeCallback +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 :: GLFW.Window -> IO () +drawScene _ = do + -- clear the screen and the depth bufer + 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 + + -- draw a triangle + glBegin gl_TRIANGLES + glVertex3f 0 1 0 -- top + glVertex3f 1 (-1) 0 -- bottom right + glVertex3f (-1) (-1) 0 -- bottom left + glEnd + + glTranslatef 3 0 0 -- move right three units + + glBegin gl_QUADS + glVertex3f (-1) 1 0 -- top left + glVertex3f 1 1 0 -- top right + glVertex3f 1 (-1) 0 -- bottom right + glVertex3f (-1) (-1) 0 -- bottom left + glEnd + + 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 2" Nothing Nothing + GLFW.makeContextCurrent (Just win) + -- register the function to do all our OpenGL drawing + GLFW.setWindowRefreshCallback win (Just drawScene) + -- 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 win + GLFW.swapBuffers win
lesson03.hs view
@@ -1,114 +1,104 @@------ 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 )--initGL :: IO ()-initGL = 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--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 :: IO ()-drawScene = 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- - -- draw a triangle (in smooth coloring mode)- glBegin gl_TRIANGLES- glColor3f 1 0 0- glVertex3f 0 1 0- glColor3f 0 1 0- glVertex3f 1 (-1) 0- glColor3f 0 0 1- glVertex3f (-1) (-1) 0- glEnd-- glTranslatef 3 0 0 -- move right three units-- glColor3f 0.5 0.5 1 -- set color to a blue shade- glBegin gl_QUADS -- start drawing a polygon (4 sided)- glVertex3f (-1) 1 0 -- top left- glVertex3f 1 1 0 -- top right- glVertex3f 1 (-1) 0 -- bottom right- glVertex3f (-1) (-1) 0 -- bottom left- glEnd- - glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: GLFW.KeyCallback-keyPressed GLFW.KeyEsc True = shutdown >> return ()-keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- register the function to do all our OpenGL drawing- GLFW.setWindowRefreshCallback drawScene- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback keyPressed- GLFW.setWindowCloseCallback shutdown- -- initialize our window.- initGL- -- start event processing engine- forever $ do- drawScene- GLFW.swapBuffers+-- +-- 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 ) + +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 :: GLFW.Window -> IO () +drawScene _ = 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 + + -- draw a triangle (in smooth coloring mode) + glBegin gl_TRIANGLES + glColor3f 1 0 0 + glVertex3f 0 1 0 + glColor3f 0 1 0 + glVertex3f 1 (-1) 0 + glColor3f 0 0 1 + glVertex3f (-1) (-1) 0 + glEnd + + glTranslatef 3 0 0 -- move right three units + + glColor3f 0.5 0.5 1 -- set color to a blue shade + glBegin gl_QUADS -- start drawing a polygon (4 sided) + glVertex3f (-1) 1 0 -- top left + glVertex3f 1 1 0 -- top right + glVertex3f 1 (-1) 0 -- bottom right + glVertex3f (-1) (-1) 0 -- bottom left + glEnd + + 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 3" Nothing Nothing + GLFW.makeContextCurrent (Just win) + -- register the function to do all our OpenGL drawing + GLFW.setWindowRefreshCallback win (Just drawScene) + -- 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 win + GLFW.swapBuffers win
lesson04.hs view
@@ -1,130 +1,120 @@------ 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 )--increment :: GLfloat-increment = 1.5--initGL :: IO ()-initGL = 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--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 -> 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- glColor3f 1 0 0 -- set the color to Red- glVertex3f 0 1 0 -- top- glColor3f 0 1 0 -- set the color to Green- glVertex3f 1 (-1) 0 -- bottom right- glColor3f 0 0 1 -- set the color to Blue- glVertex3f (-1) (-1) 0 -- bottom left- glEnd-- glLoadIdentity- glTranslatef 1.5 0 (-6) -- move right three units- rq <- readIORef rquad- glRotatef rq 1 0 0 -- rotate the quad on the x axis-- glColor3f 0.5 0.5 1 -- set color to a blue shade- glBegin gl_QUADS -- start drawing a polygon (4 sided)- glVertex3f (-1) 1 0 -- top left- glVertex3f 1 1 0 -- top right- glVertex3f 1 (-1) 0 -- bottom right- glVertex3f (-1) (-1) 0 -- bottom left- glEnd- - -- increase the rotation angle for the triangle- writeIORef rtri $! rt + increment- -- increase the rotation angle for the quad- writeIORef rquad $! rq + increment-- glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: GLFW.KeyCallback-keyPressed GLFW.KeyEsc True = shutdown >> return ()-keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- register the function to do all our OpenGL drawing- rt <- newIORef 0- rq <- newIORef 0- GLFW.setWindowRefreshCallback (drawScene rt rq)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback keyPressed- GLFW.setWindowCloseCallback shutdown- -- initialize our window.- initGL- -- start event processing engine- forever $ do- drawScene rt rq- GLFW.swapBuffers+-- +-- 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 ) + +increment :: GLfloat +increment = 1.5 + +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 + glColor3f 1 0 0 -- set the color to Red + glVertex3f 0 1 0 -- top + glColor3f 0 1 0 -- set the color to Green + glVertex3f 1 (-1) 0 -- bottom right + glColor3f 0 0 1 -- set the color to Blue + glVertex3f (-1) (-1) 0 -- bottom left + glEnd + + glLoadIdentity + glTranslatef 1.5 0 (-6) -- move right three units + rq <- readIORef rquad + glRotatef rq 1 0 0 -- rotate the quad on the x axis + + glColor3f 0.5 0.5 1 -- set color to a blue shade + glBegin gl_QUADS -- start drawing a polygon (4 sided) + glVertex3f (-1) 1 0 -- top left + glVertex3f 1 1 0 -- top right + glVertex3f 1 (-1) 0 -- bottom right + glVertex3f (-1) (-1) 0 -- bottom left + glEnd + + -- increase the rotation angle for the triangle + writeIORef rtri $! rt + increment + -- increase the rotation angle for the quad + writeIORef rquad $! rq + increment + + 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 4" 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
lesson05.hs view
@@ -1,184 +1,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 :: IO ()-initGL = 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--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 -> 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 = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: GLFW.KeyCallback-keyPressed GLFW.KeyEsc True = shutdown >> return () -keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- register the function to do all our OpenGL drawing- rt <- newIORef 0- rq <- newIORef 0- GLFW.setWindowRefreshCallback (drawScene rt rq)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback keyPressed- GLFW.setWindowCloseCallback shutdown- -- initialize our window.- initGL- -- start event processing engine- forever $ do- drawScene rt rq- GLFW.swapBuffers+-- +-- 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
lesson06.hs view
@@ -1,198 +1,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 :: IO GLuint-initGL = 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- 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 w 0 = resizeScene 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 -> 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 = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: GLFW.KeyCallback-keyPressed GLFW.KeyEsc True = shutdown >> return ()-keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- register the function to do all our OpenGL drawing- xrot <- newIORef 0- yrot <- newIORef 0- zrot <- newIORef 0- tex <- initGL- GLFW.setWindowRefreshCallback (drawScene tex xrot yrot zrot)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback keyPressed- GLFW.setWindowCloseCallback shutdown- -- initialize our window.- -- start event processing engine- forever $ do- drawScene tex xrot yrot zrot- GLFW.swapBuffers+-- +-- 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
lesson07.hs view
@@ -1,276 +1,262 @@------ 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, gluBuild2DMipmaps )-import Data.Bits ( (.|.) )-import System.Exit ( exitWith, ExitCode(..) )-import Control.Monad ( forever )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import Foreign ( withForeignPtr, plusPtr- , ForeignPtr, newForeignPtr_ )-import Foreign.Storable ( Storable )-import Foreign.Marshal.Array ( newArray, allocaArray, peekArray )-import qualified Data.ByteString.Internal as BSI-import Util ( Image(..), bitmapLoad )-import Paths_nehe_tuts--newArray' :: Storable a => [a] -> IO (ForeignPtr a)-newArray' xs = (newArray xs) >>= newForeignPtr_--glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO ()-glLightfv' l a fp =- withForeignPtr fp $ glLightfv l a--initGL :: IO [GLuint]-initGL = 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- lightAmbient <- newArray' [0.5, 0.5, 0.5, 1.0] - lightDiffuse <- newArray' [1.0, 1.0, 1.0, 1.0]- lightPosition <- newArray' [0.0, 0.0, 2.0, 1.0]- glLightfv' gl_LIGHT1 gl_AMBIENT lightAmbient- glLightfv' gl_LIGHT1 gl_DIFFUSE lightDiffuse- glLightfv' gl_LIGHT1 gl_POSITION lightPosition- glEnable gl_LIGHT1- loadGLTextures--loadGLTextures :: IO [GLuint]-loadGLTextures = do- fp <- getDataFileName "Crate.bmp"- Just (Image w h pd) <- bitmapLoad fp- let numTextures = 3- texs <- allocaArray numTextures $ \p -> do- glGenTextures (fromIntegral numTextures) p- peekArray numTextures p- let (ptr, off, _) = BSI.toForeignPtr pd- _ <- withForeignPtr ptr $ \p -> do- let p' = p `plusPtr` off- glNearest = fromIntegral gl_NEAREST- glLinear = fromIntegral gl_LINEAR- -- create nearest filtered texture- glBindTexture gl_TEXTURE_2D (texs!!0)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest- -- create linear filtered texture- glBindTexture gl_TEXTURE_2D (texs!!1)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear- -- create mipmap filtered texture- glBindTexture gl_TEXTURE_2D (texs!!2)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear - glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER- (fromIntegral gl_LINEAR_MIPMAP_NEAREST)- gluBuild2DMipmaps gl_TEXTURE_2D 3 (fromIntegral w)- (fromIntegral h) gl_RGB gl_UNSIGNED_BYTE p'- return texs--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 -> IORef GLfloat -> IORef GLfloat - -> IORef Int -> IO ()-drawScene texs xrot yrot xspeed yspeed zdepth filt = 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-- zd <- readIORef zdepth- glTranslatef 0 0 zd --Move left 5 Units into the screen-- xr <- readIORef xrot- yr <- readIORef yrot- glRotatef xr 1 0 0 -- Rotate the triangle on the Y axis- glRotatef yr 0 1 0 -- Rotate the triangle on the Y axis- f <- readIORef filt- glBindTexture gl_TEXTURE_2D (texs!!f)- - glBegin gl_QUADS -- start drawing a polygon (4 sided)- -- first the front- glNormal3f 0 0 1- 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- glNormal3f 0 0 (-1)- 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- glNormal3f 0 1 0- 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- glNormal3f 0 (-1) 0- 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- glNormal3f 1 0 0- 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- glNormal3f (-1) 0 1- 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-- xsp <- readIORef xspeed- ysp <- readIORef yspeed - writeIORef xrot $! xr + xsp- writeIORef yrot $! yr + ysp- - glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: IORef Bool -> IORef Int -> IORef GLfloat- -> IORef GLfloat -> IORef GLfloat -> GLFW.KeyCallback-keyPressed _ _ _ _ _ GLFW.KeyEsc True = shutdown >> return ()-keyPressed l _ _ _ _ (GLFW.CharKey 'L') True = do- le <- readIORef l- if le == True- then glEnable gl_LIGHTING- else glDisable gl_LIGHTING- writeIORef l $! not le-keyPressed _ filt _ _ _ (GLFW.CharKey 'F') True = do- f <- readIORef filt- writeIORef filt $! (f + 1) `mod` 3-keyPressed l f zd xs ys (GLFW.CharKey 'l') d =- keyPressed l f zd xs ys (GLFW.CharKey 'L') d-keyPressed l f zd xs ys (GLFW.CharKey 'f') d =- keyPressed l f zd xs ys (GLFW.CharKey 'F') d-keyPressed _ _ zdepth _ _ GLFW.KeyPageup True = do- zd <- readIORef zdepth- writeIORef zdepth $! zd - 0.2-keyPressed _ _ zdepth _ _ GLFW.KeyPagedown True = do- zd <- readIORef zdepth- writeIORef zdepth $! zd + 0.2-keyPressed _ _ _ xspeed _ GLFW.KeyUp True = do- xs <- readIORef xspeed- writeIORef xspeed $! xs - 0.1-keyPressed _ _ _ xspeed _ GLFW.KeyDown True = do- xs <- readIORef xspeed- writeIORef xspeed $! xs + 0.1-keyPressed _ _ _ _ yspeed GLFW.KeyRight True = do- xs <- readIORef yspeed- writeIORef yspeed $! xs + 0.1-keyPressed _ _ _ _ yspeed GLFW.KeyLeft True = do- ys <- readIORef yspeed- writeIORef yspeed $! ys - 0.1-keyPressed _ _ _ _ _ _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- lighting <- newIORef True- xrot <- newIORef (0::GLfloat)- yrot <- newIORef (0::GLfloat)- xspeed <- newIORef (0::GLfloat)- yspeed <- newIORef (0::GLfloat)- zdepth <- newIORef (-5.0 :: GLfloat)- filt <- newIORef (0::Int)- -- initialize our window.- texs <- initGL- GLFW.setWindowRefreshCallback- (drawScene texs xrot yrot xspeed yspeed zdepth filt)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback (keyPressed lighting filt zdepth xspeed yspeed)- GLFW.setWindowCloseCallback shutdown- forever $ do- drawScene texs xrot yrot xspeed yspeed zdepth filt- GLFW.swapBuffers+-- +-- 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, gluBuild2DMipmaps ) +import Data.Bits ( (.|.) ) +import System.Exit ( exitWith, ExitCode(..) ) +import Control.Monad ( forever ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Foreign ( withForeignPtr, plusPtr + , ForeignPtr, newForeignPtr_ ) +import Foreign.Storable ( Storable ) +import Foreign.Marshal.Array ( newArray, allocaArray, peekArray ) +import qualified Data.ByteString.Internal as BSI +import Util ( Image(..), bitmapLoad ) +import Paths_nehe_tuts + +newArray' :: Storable a => [a] -> IO (ForeignPtr a) +newArray' xs = (newArray xs) >>= newForeignPtr_ + +glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO () +glLightfv' l a fp = + withForeignPtr fp $ glLightfv l a + +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 + lightAmbient <- newArray' [0.5, 0.5, 0.5, 1.0] + lightDiffuse <- newArray' [1.0, 1.0, 1.0, 1.0] + lightPosition <- newArray' [0.0, 0.0, 2.0, 1.0] + glLightfv' gl_LIGHT1 gl_AMBIENT lightAmbient + glLightfv' gl_LIGHT1 gl_DIFFUSE lightDiffuse + glLightfv' gl_LIGHT1 gl_POSITION lightPosition + glEnable gl_LIGHT1 + (w,h) <- GLFW.getFramebufferSize win + resizeScene win w h + loadGLTextures + +loadGLTextures :: IO [GLuint] +loadGLTextures = do + fp <- getDataFileName "Crate.bmp" + Just (Image w h pd) <- bitmapLoad fp + let numTextures = 3 + texs <- allocaArray numTextures $ \p -> do + glGenTextures (fromIntegral numTextures) p + peekArray numTextures p + let (ptr, off, _) = BSI.toForeignPtr pd + _ <- withForeignPtr ptr $ \p -> do + let p' = p `plusPtr` off + glNearest = fromIntegral gl_NEAREST + glLinear = fromIntegral gl_LINEAR + -- create nearest filtered texture + glBindTexture gl_TEXTURE_2D (texs!!0) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest + -- create linear filtered texture + glBindTexture gl_TEXTURE_2D (texs!!1) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear + -- create mipmap filtered texture + glBindTexture gl_TEXTURE_2D (texs!!2) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER + (fromIntegral gl_LINEAR_MIPMAP_NEAREST) + gluBuild2DMipmaps gl_TEXTURE_2D 3 (fromIntegral w) + (fromIntegral h) gl_RGB gl_UNSIGNED_BYTE p' + return texs + +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 -> IORef GLfloat -> IORef GLfloat + -> IORef Int -> GLFW.Window -> IO () +drawScene texs xrot yrot xspeed yspeed zdepth filt _ = 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 + + zd <- readIORef zdepth + glTranslatef 0 0 zd --Move left 5 Units into the screen + + xr <- readIORef xrot + yr <- readIORef yrot + glRotatef xr 1 0 0 -- Rotate the triangle on the Y axis + glRotatef yr 0 1 0 -- Rotate the triangle on the Y axis + f <- readIORef filt + glBindTexture gl_TEXTURE_2D (texs!!f) + + glBegin gl_QUADS -- start drawing a polygon (4 sided) + -- first the front + glNormal3f 0 0 1 + 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 + glNormal3f 0 0 (-1) + 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 + glNormal3f 0 1 0 + 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 + glNormal3f 0 (-1) 0 + 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 + glNormal3f 1 0 0 + 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 + glNormal3f (-1) 0 1 + 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 + + xsp <- readIORef xspeed + ysp <- readIORef yspeed + writeIORef xrot $! xr + xsp + writeIORef yrot $! yr + ysp + + glFlush + +shutdown :: GLFW.WindowCloseCallback +shutdown win = do + GLFW.destroyWindow win + GLFW.terminate + _ <- exitWith ExitSuccess + return () + +keyPressed :: IORef Bool -> IORef Int -> IORef GLfloat + -> IORef GLfloat -> IORef GLfloat -> GLFW.KeyCallback +keyPressed _ _ _ _ _ win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win +keyPressed l _ _ _ _ _ GLFW.Key'L _ GLFW.KeyState'Pressed _ = do + le <- readIORef l + if le == True + then glEnable gl_LIGHTING + else glDisable gl_LIGHTING + writeIORef l $! not le +keyPressed _ filt _ _ _ _ GLFW.Key'F _ GLFW.KeyState'Pressed _ = do + f <- readIORef filt + writeIORef filt $! (f + 1) `mod` 3 +keyPressed _ _ zdepth _ _ _ GLFW.Key'PageUp _ GLFW.KeyState'Pressed _ = do + zd <- readIORef zdepth + writeIORef zdepth $! zd - 0.2 +keyPressed _ _ zdepth _ _ _ GLFW.Key'PageDown _ GLFW.KeyState'Pressed _ = do + zd <- readIORef zdepth + writeIORef zdepth $! zd + 0.2 +keyPressed _ _ _ xspeed _ _ GLFW.Key'Up _ GLFW.KeyState'Pressed _ = do + xs <- readIORef xspeed + writeIORef xspeed $! xs - 0.1 +keyPressed _ _ _ xspeed _ _ GLFW.Key'Down _ GLFW.KeyState'Pressed _ = do + xs <- readIORef xspeed + writeIORef xspeed $! xs + 0.1 +keyPressed _ _ _ _ yspeed _ GLFW.Key'Right _ GLFW.KeyState'Pressed _ = do + xs <- readIORef yspeed + writeIORef yspeed $! xs + 0.1 +keyPressed _ _ _ _ yspeed _ GLFW.Key'Left _ GLFW.KeyState'Pressed _ = do + ys <- readIORef yspeed + writeIORef yspeed $! ys - 0.1 +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 7" Nothing Nothing + GLFW.makeContextCurrent (Just win) + lighting <- newIORef True + xrot <- newIORef (0::GLfloat) + yrot <- newIORef (0::GLfloat) + xspeed <- newIORef (0::GLfloat) + yspeed <- newIORef (0::GLfloat) + zdepth <- newIORef (-5.0 :: GLfloat) + filt <- newIORef (0::Int) + -- initialize our window. + texs <- initGL win + GLFW.setWindowRefreshCallback win $ + Just (drawScene texs xrot yrot xspeed yspeed zdepth filt) + -- 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 lighting filt zdepth xspeed yspeed)) + GLFW.setWindowCloseCallback win (Just shutdown) + forever $ do + GLFW.pollEvents + drawScene texs xrot yrot xspeed yspeed zdepth filt win + GLFW.swapBuffers win
lesson08.hs view
@@ -1,287 +1,272 @@------ 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, gluBuild2DMipmaps )-import Data.Bits ( (.|.) )-import System.Exit ( exitWith, ExitCode(..) )-import Control.Monad ( forever )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import Foreign ( withForeignPtr, plusPtr- , ForeignPtr, newForeignPtr_ )-import Foreign.Storable ( Storable )-import Foreign.Marshal.Array ( newArray, allocaArray, peekArray )-import qualified Data.ByteString.Internal as BSI-import Util ( Image(..), bitmapLoad )-import Paths_nehe_tuts--newArray' :: Storable a => [a] -> IO (ForeignPtr a)-newArray' xs = (newArray xs) >>= newForeignPtr_--glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO ()-glLightfv' l a fp =- withForeignPtr fp $ glLightfv l a--initGL :: IO [GLuint]-initGL = do- glEnable gl_TEXTURE_2D- glShadeModel gl_SMOOTH- glClearColor 0 0 0 0.5- glClearDepth 1- glEnable gl_DEPTH_TEST- glDepthFunc gl_LEQUAL- glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST- lightAmbient <- newArray' [0.5, 0.5, 0.5, 1.0] - lightDiffuse <- newArray' [1.0, 1.0, 1.0, 1.0]- lightPosition <- newArray' [0.0, 0.0, 2.0, 1.0]- glLightfv' gl_LIGHT1 gl_AMBIENT lightAmbient- glLightfv' gl_LIGHT1 gl_DIFFUSE lightDiffuse- glLightfv' gl_LIGHT1 gl_POSITION lightPosition- glEnable gl_LIGHT1- glBlendFunc gl_SRC_ALPHA gl_ONE- loadGLTextures--loadGLTextures :: IO [GLuint]-loadGLTextures = do- fp <- getDataFileName "glass.bmp"- Just (Image w h pd) <- bitmapLoad fp- let numTextures = 3- texs <- allocaArray numTextures $ \p -> do- glGenTextures (fromIntegral numTextures) p- peekArray numTextures p- let (ptr, off, _) = BSI.toForeignPtr pd- _ <- withForeignPtr ptr $ \p -> do- let p' = p `plusPtr` off- glNearest = fromIntegral gl_NEAREST- glLinear = fromIntegral gl_LINEAR- -- create nearest filtered texture- glBindTexture gl_TEXTURE_2D (texs!!0)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest- -- create linear filtered texture- glBindTexture gl_TEXTURE_2D (texs!!1)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear- -- create mipmap filtered texture- glBindTexture gl_TEXTURE_2D (texs!!2)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear - glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER- (fromIntegral gl_LINEAR_MIPMAP_NEAREST)- gluBuild2DMipmaps gl_TEXTURE_2D 3 (fromIntegral w)- (fromIntegral h) gl_RGB gl_UNSIGNED_BYTE p'- return texs--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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 -> IORef GLfloat -> IORef GLfloat - -> IORef Int -> IO ()-drawScene texs xrot yrot xspeed yspeed zdepth filt = 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-- zd <- readIORef zdepth- glTranslatef 0 0 zd --Move left 5 Units into the screen-- xr <- readIORef xrot- yr <- readIORef yrot- glRotatef xr 1 0 0 -- Rotate the triangle on the Y axis- glRotatef yr 0 1 0 -- Rotate the triangle on the Y axis- f <- readIORef filt- glBindTexture gl_TEXTURE_2D (texs!!f)- - glBegin gl_QUADS -- start drawing a polygon (4 sided)- -- first the front- glNormal3f 0 0 1- 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- glNormal3f 0 0 (-1)- 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- glNormal3f 0 1 0- 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- glNormal3f 0 (-1) 0- 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- glNormal3f 1 0 0- 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- glNormal3f (-1) 0 1- 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-- xsp <- readIORef xspeed- ysp <- readIORef yspeed - writeIORef xrot $! xr + xsp- writeIORef yrot $! yr + ysp- - glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: IORef Bool -> IORef Bool -> IORef Int -> IORef GLfloat- -> IORef GLfloat -> IORef GLfloat -> GLFW.KeyCallback-keyPressed _ _ _ _ _ _ GLFW.KeyEsc True = shutdown >> return ()-keyPressed l _ _ _ _ _ (GLFW.CharKey 'L') True = do- le <- readIORef l- if le == True- then glEnable gl_LIGHTING- else glDisable gl_LIGHTING- writeIORef l $! not le-keyPressed _ _ filt _ _ _ (GLFW.CharKey 'F') True = do- f <- readIORef filt- writeIORef filt $! (f + 1) `mod` 3-keyPressed l b f zd xs ys (GLFW.CharKey 'l') d =- keyPressed l b f zd xs ys (GLFW.CharKey 'L') d-keyPressed l b f zd xs ys (GLFW.CharKey 'f') d =- keyPressed l b f zd xs ys (GLFW.CharKey 'F') d-keyPressed l b f zd xs ys (GLFW.CharKey 'b') d =- keyPressed l b f zd xs ys (GLFW.CharKey 'B') d-keyPressed _ b _ _ _ _ (GLFW.CharKey 'B') True = do- bp <- readIORef b- if bp == True- then glEnable gl_BLEND >> glDisable gl_DEPTH_TEST- else glDisable gl_BLEND >> glEnable gl_DEPTH_TEST- writeIORef b $! not bp-keyPressed _ _ _ zdepth _ _ GLFW.KeyPageup True = do- zd <- readIORef zdepth- writeIORef zdepth $! zd - 0.2-keyPressed _ _ _ zdepth _ _ GLFW.KeyPagedown True = do- zd <- readIORef zdepth- writeIORef zdepth $! zd + 0.2-keyPressed _ _ _ _ xspeed _ GLFW.KeyUp True = do- xs <- readIORef xspeed- writeIORef xspeed $! xs - 0.1-keyPressed _ _ _ _ xspeed _ GLFW.KeyDown True = do- xs <- readIORef xspeed- writeIORef xspeed $! xs + 0.1-keyPressed _ _ _ _ _ yspeed GLFW.KeyRight True = do- xs <- readIORef yspeed- writeIORef yspeed $! xs + 0.1-keyPressed _ _ _ _ _ yspeed GLFW.KeyLeft True = do- ys <- readIORef yspeed- writeIORef yspeed $! ys - 0.1-keyPressed _ _ _ _ _ _ _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- lighting <- newIORef True- blending <- newIORef True- xrot <- newIORef (0::GLfloat)- yrot <- newIORef (0::GLfloat)- xspeed <- newIORef (0::GLfloat)- yspeed <- newIORef (0::GLfloat)- zdepth <- newIORef (-5.0 :: GLfloat)- filt <- newIORef (0::Int)- -- initialize our window.- texs <- initGL- GLFW.setWindowRefreshCallback- (drawScene texs xrot yrot xspeed yspeed zdepth filt)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback $- keyPressed lighting blending filt zdepth xspeed yspeed- GLFW.setWindowCloseCallback shutdown- forever $ do- drawScene texs xrot yrot xspeed yspeed zdepth filt- GLFW.swapBuffers+-- +-- 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, gluBuild2DMipmaps ) +import Data.Bits ( (.|.) ) +import System.Exit ( exitWith, ExitCode(..) ) +import Control.Monad ( forever ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Foreign ( withForeignPtr, plusPtr + , ForeignPtr, newForeignPtr_ ) +import Foreign.Storable ( Storable ) +import Foreign.Marshal.Array ( newArray, allocaArray, peekArray ) +import qualified Data.ByteString.Internal as BSI +import Util ( Image(..), bitmapLoad ) +import Paths_nehe_tuts + +newArray' :: Storable a => [a] -> IO (ForeignPtr a) +newArray' xs = (newArray xs) >>= newForeignPtr_ + +glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO () +glLightfv' l a fp = + withForeignPtr fp $ glLightfv l a + +initGL :: GLFW.Window -> IO [GLuint] +initGL win = do + glEnable gl_TEXTURE_2D + glShadeModel gl_SMOOTH + glClearColor 0 0 0 0.5 + glClearDepth 1 + glEnable gl_DEPTH_TEST + glDepthFunc gl_LEQUAL + glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST + lightAmbient <- newArray' [0.5, 0.5, 0.5, 1.0] + lightDiffuse <- newArray' [1.0, 1.0, 1.0, 1.0] + lightPosition <- newArray' [0.0, 0.0, 2.0, 1.0] + glLightfv' gl_LIGHT1 gl_AMBIENT lightAmbient + glLightfv' gl_LIGHT1 gl_DIFFUSE lightDiffuse + glLightfv' gl_LIGHT1 gl_POSITION lightPosition + glEnable gl_LIGHT1 + glBlendFunc gl_SRC_ALPHA gl_ONE + (w,h) <- GLFW.getFramebufferSize win + resizeScene win w h + loadGLTextures + +loadGLTextures :: IO [GLuint] +loadGLTextures = do + fp <- getDataFileName "glass.bmp" + Just (Image w h pd) <- bitmapLoad fp + let numTextures = 3 + texs <- allocaArray numTextures $ \p -> do + glGenTextures (fromIntegral numTextures) p + peekArray numTextures p + let (ptr, off, _) = BSI.toForeignPtr pd + _ <- withForeignPtr ptr $ \p -> do + let p' = p `plusPtr` off + glNearest = fromIntegral gl_NEAREST + glLinear = fromIntegral gl_LINEAR + -- create nearest filtered texture + glBindTexture gl_TEXTURE_2D (texs!!0) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest + -- create linear filtered texture + glBindTexture gl_TEXTURE_2D (texs!!1) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear + -- create mipmap filtered texture + glBindTexture gl_TEXTURE_2D (texs!!2) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER + (fromIntegral gl_LINEAR_MIPMAP_NEAREST) + gluBuild2DMipmaps gl_TEXTURE_2D 3 (fromIntegral w) + (fromIntegral h) gl_RGB gl_UNSIGNED_BYTE p' + return texs + +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 -> IORef GLfloat -> IORef GLfloat + -> IORef Int -> GLFW.Window -> IO () +drawScene texs xrot yrot xspeed yspeed zdepth filt _ = 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 + + zd <- readIORef zdepth + glTranslatef 0 0 zd --Move left 5 Units into the screen + + xr <- readIORef xrot + yr <- readIORef yrot + glRotatef xr 1 0 0 -- Rotate the triangle on the Y axis + glRotatef yr 0 1 0 -- Rotate the triangle on the Y axis + f <- readIORef filt + glBindTexture gl_TEXTURE_2D (texs!!f) + + glBegin gl_QUADS -- start drawing a polygon (4 sided) + -- first the front + glNormal3f 0 0 1 + 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 + glNormal3f 0 0 (-1) + 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 + glNormal3f 0 1 0 + 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 + glNormal3f 0 (-1) 0 + 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 + glNormal3f 1 0 0 + 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 + glNormal3f (-1) 0 1 + 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 + + xsp <- readIORef xspeed + ysp <- readIORef yspeed + writeIORef xrot $! xr + xsp + writeIORef yrot $! yr + ysp + + glFlush + +shutdown :: GLFW.WindowCloseCallback +shutdown win = do + GLFW.destroyWindow win + GLFW.terminate + _ <- exitWith ExitSuccess + return () + +keyPressed :: IORef Bool -> IORef Bool -> IORef Int -> IORef GLfloat + -> IORef GLfloat -> IORef GLfloat -> GLFW.KeyCallback +keyPressed _ _ _ _ _ _ win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win +keyPressed l _ _ _ _ _ _ GLFW.Key'L _ GLFW.KeyState'Pressed _ = do + le <- readIORef l + if le == True + then glEnable gl_LIGHTING + else glDisable gl_LIGHTING + writeIORef l $! not le +keyPressed _ _ filt _ _ _ _ GLFW.Key'F _ GLFW.KeyState'Pressed _ = do + f <- readIORef filt + writeIORef filt $! (f + 1) `mod` 3 +keyPressed _ b _ _ _ _ _ GLFW.Key'B _ GLFW.KeyState'Pressed _ = do + bp <- readIORef b + if bp == True + then glEnable gl_BLEND >> glDisable gl_DEPTH_TEST + else glDisable gl_BLEND >> glEnable gl_DEPTH_TEST + writeIORef b $! not bp +keyPressed _ _ _ zdepth _ _ _ GLFW.Key'PageUp _ GLFW.KeyState'Pressed _ = do + zd <- readIORef zdepth + writeIORef zdepth $! zd - 0.2 +keyPressed _ _ _ zdepth _ _ _ GLFW.Key'PageDown _ GLFW.KeyState'Pressed _ = do + zd <- readIORef zdepth + writeIORef zdepth $! zd + 0.2 +keyPressed _ _ _ _ xspeed _ _ GLFW.Key'Up _ GLFW.KeyState'Pressed _ = do + xs <- readIORef xspeed + writeIORef xspeed $! xs - 0.1 +keyPressed _ _ _ _ xspeed _ _ GLFW.Key'Down _ GLFW.KeyState'Pressed _ = do + xs <- readIORef xspeed + writeIORef xspeed $! xs + 0.1 +keyPressed _ _ _ _ _ yspeed _ GLFW.Key'Right _ GLFW.KeyState'Pressed _ = do + xs <- readIORef yspeed + writeIORef yspeed $! xs + 0.1 +keyPressed _ _ _ _ _ yspeed _ GLFW.Key'Left _ GLFW.KeyState'Pressed _ = do + ys <- readIORef yspeed + writeIORef yspeed $! ys - 0.1 +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 8" Nothing Nothing + GLFW.makeContextCurrent (Just win) + -- window starts at upper left corner of the screen + lighting <- newIORef True + blending <- newIORef True + xrot <- newIORef (0::GLfloat) + yrot <- newIORef (0::GLfloat) + xspeed <- newIORef (0::GLfloat) + yspeed <- newIORef (0::GLfloat) + zdepth <- newIORef (-5.0 :: GLfloat) + filt <- newIORef (0::Int) + -- initialize our window. + texs <- initGL win + GLFW.setWindowRefreshCallback win $ + Just (drawScene texs xrot yrot xspeed yspeed zdepth filt) + -- 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 lighting blending filt zdepth xspeed yspeed) + GLFW.setWindowCloseCallback win (Just shutdown) + forever $ do + GLFW.pollEvents + drawScene texs xrot yrot xspeed yspeed zdepth filt win + GLFW.swapBuffers win
lesson09.hs view
@@ -1,229 +1,217 @@------ 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, when, forM, forM_ )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import Foreign ( withForeignPtr, plusPtr- , ForeignPtr, newForeignPtr_- , alloca, peek )-import Foreign.Storable ( Storable )-import Foreign.Marshal.Array ( newArray )-import qualified Data.ByteString.Internal as BSI-import Util ( Image(..), bitmapLoad )-import System.Random ( getStdRandom, randomR )-import Paths_nehe_tuts--data Star = Star { starColor :: !(GLubyte, GLubyte, GLubyte)- , starDist :: !GLfloat - , starAngle :: !GLfloat- }- deriving Show--numStars :: Num a => a-numStars = 50--newArray' :: Storable a => [a] -> IO (ForeignPtr a)-newArray' xs = (newArray xs) >>= newForeignPtr_--glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO ()-glLightfv' l a fp =- withForeignPtr fp $ glLightfv l a--initGL :: IO GLuint-initGL = do- glEnable gl_TEXTURE_2D- glShadeModel gl_SMOOTH- glClearColor 0 0 0 0.5- glClearDepth 1- glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST- glBlendFunc gl_SRC_ALPHA gl_ONE- glEnable gl_BLEND- loadGLTextures--generateStars :: IO [IORef Star]-generateStars = forM [0 .. numStars -1] $ \i -> do- r <- getStdRandom (randomR (0, 255)) :: IO Int- g <- getStdRandom (randomR (0, 255)) :: IO Int- b <- getStdRandom (randomR (0, 255)) :: IO Int- newIORef (Star { starAngle = 0- , starColor = (fromIntegral r,fromIntegral g,fromIntegral b)- , starDist = (i/numStars)*5})--loadGLTextures :: IO GLuint-loadGLTextures = do- fp <- getDataFileName "Star.bmp"- Just (Image w h pd) <- bitmapLoad fp- tex <- alloca $ \p -> do- glGenTextures 1 p- peek p- let (ptr, off, _) = BSI.toForeignPtr pd- _ <- withForeignPtr ptr $ \p -> do- let p' = p `plusPtr` off- glLinear = fromIntegral gl_LINEAR- -- create linear filtered texture- glBindTexture gl_TEXTURE_2D tex- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear- return tex--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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--glColor4ub' :: (GLubyte, GLubyte, GLubyte) -> GLubyte -> IO ()-glColor4ub' (r,g,b) a = glColor4ub r g b a--drawScene :: GLuint -> IORef GLfloat -> IORef GLfloat- -> IORef Bool -> IORef GLfloat -> [IORef Star]- -> IO ()-drawScene tex zoom tilt twinkle spin stars = do- -- clear the screen and the depth buffer- glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT- .|. gl_DEPTH_BUFFER_BIT- glBindTexture gl_TEXTURE_2D tex-- let starTuples = zip3 stars- (reverse stars)- [0 .. numStars -1]- forM_ starTuples $ \(st1, st2, i) -> do- glLoadIdentity- s1 <- readIORef st1- s2 <- readIORef st2- sp <- readIORef spin- zo <- readIORef zoom- ti <- readIORef tilt- tw <- readIORef twinkle- glTranslatef 0 0 zo- glRotatef ti 1 0 0- glRotatef (starAngle s1) 0 1 0- glTranslatef (starDist s1) 0 0- glRotatef (-(starAngle s1)) 0 1 0- glRotatef (-ti) 1 0 0- when tw $ do- glColor4ub' (starColor s2) 255- glBegin gl_QUADS- glTexCoord2f 0 0 >> glVertex3f (-1) (-1) 0- glTexCoord2f 1 0 >> glVertex3f 1 (-1) 0- glTexCoord2f 1 1 >> glVertex3f 1 1 0- glTexCoord2f 0 1 >> glVertex3f (-1) 1 0- glEnd- glRotatef sp 0 0 1- glColor4ub' (starColor s1) 255- glBegin gl_QUADS- glTexCoord2f 0 0 >> glVertex3f (-1) (-1) 0- glTexCoord2f 1 0 >> glVertex3f 1 (-1) 0- glTexCoord2f 1 1 >> glVertex3f 1 1 0- glTexCoord2f 0 1 >> glVertex3f (-1) 1 0- glEnd-- writeIORef spin $! sp + 0.01- if starDist s1 < 0- then do- let d = starDist s1 + 5- r <- getStdRandom (randomR (0, 255)) :: IO Int- g <- getStdRandom (randomR (0, 255)) :: IO Int- b <- getStdRandom (randomR (0, 255)) :: IO Int- writeIORef st1 $! Star- { starAngle = starAngle s1 + i/numStars- , starColor = (fromIntegral r,fromIntegral g, fromIntegral b)- , starDist = d- }- else do- writeIORef st1 $! Star- { starAngle = starAngle s1 + i/numStars- , starColor = starColor s1- , starDist = (starDist s1)-0.01 }-- glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--keyPressed :: IORef Bool -> IORef GLfloat -> IORef GLfloat- -> GLFW.KeyCallback-keyPressed _ _ _ GLFW.KeyEsc True = shutdown >> return ()-keyPressed t _ _ (GLFW.CharKey 'T') True = do- twinkle <- readIORef t- writeIORef t $! not twinkle-keyPressed tw zo ti (GLFW.CharKey 't') d =- keyPressed tw zo ti (GLFW.CharKey 'T') d-keyPressed _ zoom _ GLFW.KeyPageup True = do- zd <- readIORef zoom- writeIORef zoom $! zd - 0.2-keyPressed _ zoom _ GLFW.KeyPagedown True = do- zd <- readIORef zoom- writeIORef zoom $! zd + 0.2-keyPressed _ _ tilt GLFW.KeyUp True = do- xs <- readIORef tilt - writeIORef tilt $! xs - 0.5-keyPressed _ _ tilt GLFW.KeyDown True = do- xs <- readIORef tilt- writeIORef tilt $! xs + 0.5-keyPressed _ _ _ _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 24- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- twinkle <- newIORef False- spin <- newIORef 0- stars <- generateStars- zoom <- newIORef (-15)- tilt <- newIORef 90- -- initialize our window.- tex <- initGL- GLFW.setWindowRefreshCallback- (drawScene tex zoom tilt twinkle spin stars)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback $- keyPressed twinkle zoom tilt- GLFW.setWindowCloseCallback shutdown- forever $ do- drawScene tex zoom tilt twinkle spin stars- GLFW.swapBuffers+-- +-- 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, when, forM, forM_ ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Foreign ( withForeignPtr, plusPtr + , ForeignPtr, newForeignPtr_ + , alloca, peek ) +import Foreign.Storable ( Storable ) +import Foreign.Marshal.Array ( newArray ) +import qualified Data.ByteString.Internal as BSI +import Util ( Image(..), bitmapLoad ) +import System.Random ( getStdRandom, randomR ) +import Paths_nehe_tuts + +data Star = Star { starColor :: !(GLubyte, GLubyte, GLubyte) + , starDist :: !GLfloat + , starAngle :: !GLfloat + } + deriving Show + +numStars :: Num a => a +numStars = 50 + +newArray' :: Storable a => [a] -> IO (ForeignPtr a) +newArray' xs = (newArray xs) >>= newForeignPtr_ + +glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO () +glLightfv' l a fp = + withForeignPtr fp $ glLightfv l a + +initGL :: GLFW.Window -> IO GLuint +initGL win = do + glEnable gl_TEXTURE_2D + glShadeModel gl_SMOOTH + glClearColor 0 0 0 0.5 + glClearDepth 1 + glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST + glBlendFunc gl_SRC_ALPHA gl_ONE + glEnable gl_BLEND + (w,h) <- GLFW.getFramebufferSize win + resizeScene win w h + loadGLTextures + +generateStars :: IO [IORef Star] +generateStars = forM [0 .. numStars -1] $ \i -> do + r <- getStdRandom (randomR (0, 255)) :: IO Int + g <- getStdRandom (randomR (0, 255)) :: IO Int + b <- getStdRandom (randomR (0, 255)) :: IO Int + newIORef (Star { starAngle = 0 + , starColor = (fromIntegral r,fromIntegral g,fromIntegral b) + , starDist = (i/numStars)*5}) + +loadGLTextures :: IO GLuint +loadGLTextures = do + fp <- getDataFileName "Star.bmp" + Just (Image w h pd) <- bitmapLoad fp + tex <- alloca $ \p -> do + glGenTextures 1 p + peek p + let (ptr, off, _) = BSI.toForeignPtr pd + _ <- withForeignPtr ptr $ \p -> do + let p' = p `plusPtr` off + glLinear = fromIntegral gl_LINEAR + -- create linear filtered texture + glBindTexture gl_TEXTURE_2D tex + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_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 + +glColor4ub' :: (GLubyte, GLubyte, GLubyte) -> GLubyte -> IO () +glColor4ub' (r,g,b) a = glColor4ub r g b a + +drawScene :: GLuint -> IORef GLfloat -> IORef GLfloat + -> IORef Bool -> IORef GLfloat -> [IORef Star] + -> GLFW.Window -> IO () +drawScene tex zoom tilt twinkle spin stars _ = do + -- clear the screen and the depth buffer + glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT + .|. gl_DEPTH_BUFFER_BIT + glBindTexture gl_TEXTURE_2D tex + + let starTuples = zip3 stars + (reverse stars) + [0 .. numStars -1] + forM_ starTuples $ \(st1, st2, i) -> do + glLoadIdentity + s1 <- readIORef st1 + s2 <- readIORef st2 + sp <- readIORef spin + zo <- readIORef zoom + ti <- readIORef tilt + tw <- readIORef twinkle + glTranslatef 0 0 zo + glRotatef ti 1 0 0 + glRotatef (starAngle s1) 0 1 0 + glTranslatef (starDist s1) 0 0 + glRotatef (-(starAngle s1)) 0 1 0 + glRotatef (-ti) 1 0 0 + when tw $ do + glColor4ub' (starColor s2) 255 + glBegin gl_QUADS + glTexCoord2f 0 0 >> glVertex3f (-1) (-1) 0 + glTexCoord2f 1 0 >> glVertex3f 1 (-1) 0 + glTexCoord2f 1 1 >> glVertex3f 1 1 0 + glTexCoord2f 0 1 >> glVertex3f (-1) 1 0 + glEnd + glRotatef sp 0 0 1 + glColor4ub' (starColor s1) 255 + glBegin gl_QUADS + glTexCoord2f 0 0 >> glVertex3f (-1) (-1) 0 + glTexCoord2f 1 0 >> glVertex3f 1 (-1) 0 + glTexCoord2f 1 1 >> glVertex3f 1 1 0 + glTexCoord2f 0 1 >> glVertex3f (-1) 1 0 + glEnd + + writeIORef spin $! sp + 0.01 + if starDist s1 < 0 + then do + let d = starDist s1 + 5 + r <- getStdRandom (randomR (0, 255)) :: IO Int + g <- getStdRandom (randomR (0, 255)) :: IO Int + b <- getStdRandom (randomR (0, 255)) :: IO Int + writeIORef st1 $! Star + { starAngle = starAngle s1 + i/numStars + , starColor = (fromIntegral r,fromIntegral g, fromIntegral b) + , starDist = d + } + else do + writeIORef st1 $! Star + { starAngle = starAngle s1 + i/numStars + , starColor = starColor s1 + , starDist = (starDist s1)-0.01 } + + glFlush + +shutdown :: GLFW.WindowCloseCallback +shutdown win = do + GLFW.destroyWindow win + GLFW.terminate + _ <- exitWith ExitSuccess + return () + +keyPressed :: IORef Bool -> IORef GLfloat -> IORef GLfloat + -> GLFW.KeyCallback +keyPressed _ _ _ win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win +keyPressed t _ _ _ GLFW.Key'T _ GLFW.KeyState'Pressed _ = do + twinkle <- readIORef t + writeIORef t $! not twinkle +keyPressed _ zoom _ _ GLFW.Key'PageUp _ GLFW.KeyState'Pressed _ = do + zd <- readIORef zoom + writeIORef zoom $! zd - 0.2 +keyPressed _ zoom _ _ GLFW.Key'PageDown _ GLFW.KeyState'Pressed _ = do + zd <- readIORef zoom + writeIORef zoom $! zd + 0.2 +keyPressed _ _ tilt _ GLFW.Key'Up _ GLFW.KeyState'Pressed _ = do + xs <- readIORef tilt + writeIORef tilt $! xs - 0.5 +keyPressed _ _ tilt _ GLFW.Key'Down _ GLFW.KeyState'Pressed _ = do + xs <- readIORef tilt + writeIORef tilt $! xs + 0.5 +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 + GLFW.defaultWindowHints + Just win <- GLFW.createWindow 800 600 "Lesson 9" Nothing Nothing + GLFW.makeContextCurrent (Just win) + twinkle <- newIORef False + spin <- newIORef 0 + stars <- generateStars + zoom <- newIORef (-15) + tilt <- newIORef 90 + -- initialize our window. + tex <- initGL win + GLFW.setWindowRefreshCallback win $ + Just (drawScene tex zoom tilt twinkle spin stars) + -- 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 twinkle zoom tilt) + GLFW.setWindowCloseCallback win (Just shutdown) + forever $ do + GLFW.pollEvents + drawScene tex zoom tilt twinkle spin stars win + GLFW.swapBuffers win
lesson10.hs view
@@ -1,318 +1,300 @@------ This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)-----module Main where--import qualified Graphics.UI.GLFW as GLFW-import Graphics.Rendering.OpenGL.Raw-import Graphics.Rendering.GLU.Raw ( gluPerspective, gluBuild2DMipmaps )-import Data.Bits ( (.|.) )-import System.Exit ( exitWith, ExitCode(..) )-import System.IO ( openFile, IOMode(..), hGetContents )-import Data.IORef ( IORef, newIORef, writeIORef, readIORef, modifyIORef )-import Foreign ( ForeignPtr, withForeignPtr, newForeignPtr_- , plusPtr )-import Foreign.Storable ( Storable )-import Foreign.Marshal.Array ( allocaArray, peekArray, newArray )-import qualified Data.ByteString.Internal as BSI-import Util ( Image(..), bitmapLoad )-import Control.Monad ( when, forM_, forever )-import Paths_nehe_tuts--type Sector = [Tri]--data Tri = Tri !Vert !Vert !Vert- deriving (Eq, Ord, Show)--data Vert = Vert { vertX :: !GLfloat- , vertY :: !GLfloat- , vertZ :: !GLfloat- , vertU :: !GLfloat- , vertV :: !GLfloat- }- deriving (Eq, Ord, Show)--piover180 :: GLfloat-piover180 = pi/180.0--data Global = Global { xrot, yrot, xspeed, yspeed, walkbias, walkbiasangle,- lookupdown, xpos, zpos, camx, camy, camz,- therotate, heading, zdepth :: IORef GLfloat,- filterSelector :: IORef Int,- lighting, blend :: IORef Bool }-mkGlobal :: IO Global-mkGlobal = do xr <- newIORef 0 -- please someone find a nicer way...- yr <- newIORef 0- xs <- newIORef 0- ys <- newIORef 0- wb <- newIORef 0- wba <- newIORef 0- lud <- newIORef 0- xp <- newIORef 0- zp <- newIORef 0- cx <- newIORef 0- cy <- newIORef 0- cz <- newIORef 0- tr <- newIORef 0- h <- newIORef 0- zd <- newIORef 0- fs <- newIORef 0- b <- newIORef True- l <- newIORef True- return Global { xrot = xr, yrot = yr, xspeed = xs, yspeed = ys,- walkbias = wb, walkbiasangle = wba, lookupdown =- lud, xpos = xp, zpos = zp, camx = cx, camy = cy,- camz = cz, therotate = tr, heading = h,- zdepth = zd, filterSelector = fs, blend = b,- lighting = l }--newArray' :: Storable a => [a] -> IO (ForeignPtr a)-newArray' xs = (newArray xs) >>= newForeignPtr_--glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO ()-glLightfv' l a fp =- withForeignPtr fp $ glLightfv l a--readRef :: IO (IORef a) -> IO a-readRef r = r >>= readIORef--setupWorld :: IO Sector-setupWorld = do- fp <- getDataFileName "world.txt"- h <- openFile fp ReadMode- ls <- (fmap (filter ignorable) ((fmap lines . hGetContents) h))- let numtris = read ((head . tail . words . head) ls)- tris = readTris (tail ls)- when (length tris /= numtris) $ do- putStrLn "error reading world.txt"- exitWith (ExitFailure 1)- return tris- where- readTris :: [String] -> [Tri]- readTris (l1:l2:l3:ls) = (Tri (readVert (words l1))- (readVert (words l2))- (readVert (words l3))) : readTris ls- readTris [] = []- readTris _ = undefined- readVert :: [String] -> Vert- readVert (x:y:z:u:v:[]) = Vert { vertX = read x- , vertY = read y- , vertZ = read z- , vertU = read u- , vertV = read v- }- readVert _ = undefined- ignorable ('/':'/':_) = False- ignorable [] = False- ignorable _ = True--initGL :: IO [GLuint]-initGL = do- glEnable gl_TEXTURE_2D- glShadeModel gl_SMOOTH- glClearColor 0 0 0 0.5- glClearDepth 1- glEnable gl_DEPTH_TEST- glDepthFunc gl_LEQUAL- glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST- lightAmbient <- newArray' [0.5, 0.5, 0.5, 1]- lightDiffuse <- newArray' [1, 1, 1, 1]- lightPosition <- newArray' [0, 0, 2, 1]- glLightfv' gl_LIGHT1 gl_AMBIENT lightAmbient- glLightfv' gl_LIGHT1 gl_DIFFUSE lightDiffuse- glLightfv' gl_LIGHT1 gl_POSITION lightPosition- glEnable gl_LIGHTING- glEnable gl_LIGHT1- glBlendFunc gl_SRC_ALPHA gl_ONE- glEnable gl_BLEND- loadTextures--loadTextures :: IO [GLuint]-loadTextures = do- fp <- getDataFileName "mud.bmp"- Just (Image w h pd) <- bitmapLoad fp- let numTexs = 3 :: Int- texs <- allocaArray (fromIntegral numTexs) $ \p -> do- glGenTextures (fromIntegral numTexs) p- peekArray numTexs p- let (ptr, off, _) = BSI.toForeignPtr pd- _ <- withForeignPtr ptr $ \p -> do- let p' = p `plusPtr` off- glLinear = fromIntegral gl_LINEAR- glNearest = fromIntegral gl_NEAREST- -- create nearest filter texture- glBindTexture gl_TEXTURE_2D (texs!!0)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest- -- create linear filtered texture- glBindTexture gl_TEXTURE_2D (texs!!1)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear- -- create mipmap filtered texture- glBindTexture gl_TEXTURE_2D (texs!!2)- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER- (fromIntegral gl_LINEAR_MIPMAP_NEAREST)- gluBuild2DMipmaps gl_TEXTURE_2D 3 (fromIntegral w)- (fromIntegral h) gl_RGB gl_UNSIGNED_BYTE p'- return texs--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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] -> Sector -> Global -> IO ()-drawScene texs sector globals = do- glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT- .|. gl_DEPTH_BUFFER_BIT- glLoadIdentity -- reset view- xtrans <- fmap negate (readIORef (xpos globals))- ytrans <- fmap (\y -> -y-0.25) (readIORef (walkbias globals))- ztrans <- fmap negate (readIORef (zpos globals))- sceneroty <- fmap (\y -> 360 - y) (readIORef (yrot globals))- --print sceneroty- look <- readIORef (lookupdown globals)- filt <- readIORef (filterSelector globals)- glRotatef look 1 0 0- glRotatef sceneroty 0 1 0- - glTranslatef xtrans ytrans ztrans- glBindTexture gl_TEXTURE_2D (texs!!filt)- forM_ sector $ \(Tri (Vert x1 y1 z1 u1 v1)- (Vert x2 y2 z2 u2 v2)- (Vert x3 y3 z3 u3 v3)) -> do- glBegin gl_TRIANGLES- glNormal3f 0 0 1- glTexCoord2f u1 v1 >> glVertex3f x1 y1 z1- glTexCoord2f u2 v2 >> glVertex3f x2 y2 z2- glTexCoord2f u3 v3 >> glVertex3f x3 y3 z3- glEnd - glFlush--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--updateIORef :: Show a => IO (IORef a) -> (a -> a) -> IO ()-updateIORef ioref f = do ref <- ioref- r <- readIORef ref- print r- writeIORef ref (f r)--keyPressed :: Global -> GLFW.KeyCallback-keyPressed _ GLFW.KeyEsc True = shutdown >> return ()-keyPressed g (GLFW.CharKey 'B') d =- keyPressed g (GLFW.CharKey 'b') d-keyPressed g (GLFW.CharKey 'b') True = do- r <- readIORef (blend g)- if r- then do- glDisable gl_BLEND- glEnable gl_DEPTH_TEST- else do- glEnable gl_BLEND- glDisable gl_DEPTH_TEST- writeIORef (blend g) $! not r-keyPressed g (GLFW.CharKey 'f') True =- modifyIORef (filterSelector g) (\x -> (x+1) `mod` 3)-keyPressed g (GLFW.CharKey 'F') True =- keyPressed g (GLFW.CharKey 'f') True-keyPressed g (GLFW.CharKey 'L') True =- keyPressed g (GLFW.CharKey 'l') True-keyPressed g (GLFW.CharKey 'l') True = do- l <- readIORef (lighting g)- if l- then glDisable gl_LIGHTING- else glEnable gl_LIGHTING - writeIORef (lighting g) $! not l-keyPressed g GLFW.KeyRight True =- modifyIORef (yrot g) (subtract 1.5)-keyPressed g GLFW.KeyLeft True =- modifyIORef (yrot g) (+ 1.5)-keyPressed g GLFW.KeyUp True = do- h <- readIORef (yrot g)- modifyIORef (xpos g) (subtract ((sin (h * piover180))*0.05))- modifyIORef (zpos g) (subtract ((cos (h * piover180))*0.05))- modifyIORef (walkbiasangle g) (\w -> (w+10) `fmod` 360)- wba <- readIORef (walkbiasangle g)- modifyIORef (walkbias g) (\_ -> ((sin (wba * piover180))/20))-keyPressed g GLFW.KeyDown True = do- h <- readIORef (yrot g)- modifyIORef (xpos g) (+ (sin (h * piover180))*0.05)- modifyIORef (zpos g) (+ (cos (h * piover180))*0.05)- modifyIORef (walkbiasangle g) (\w -> (w-10) `fmod` 360)- wba <- readIORef (walkbiasangle g)- modifyIORef (walkbias g) (\_ -> ((sin (wba * piover180))/20))-keyPressed g GLFW.KeyPageup True = do- modifyIORef (zdepth g) (subtract 0.2)- modifyIORef (lookupdown g) (subtract 0.2)-keyPressed g GLFW.KeyPagedown True = do- modifyIORef (zdepth g) (+ 0.2)- modifyIORef (lookupdown g) (+ 0.2)--keyPressed _ _ _ = return ()--fmod :: RealFrac a => a -> Int -> a-fmod x m = (fromIntegral ((floor x :: Int) `mod` m)) + - (x - (fromIntegral (floor x :: Int)))--main :: IO ()-main = do- True <- GLFW.initialize- sector <- setupWorld- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 1- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- -- initialize our window.- tex <- initGL- globals <- mkGlobal- GLFW.setWindowRefreshCallback- (drawScene tex sector globals)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback $- keyPressed globals- GLFW.setWindowCloseCallback shutdown- forever $ do- drawScene tex sector globals- GLFW.swapBuffers+-- +-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005) +-- + +module Main where + +import qualified Graphics.UI.GLFW as GLFW +import Graphics.Rendering.OpenGL.Raw +import Graphics.Rendering.GLU.Raw ( gluPerspective, gluBuild2DMipmaps ) +import Data.Bits ( (.|.) ) +import System.Exit ( exitWith, ExitCode(..) ) +import System.IO ( openFile, IOMode(..), hGetContents ) +import Data.IORef ( IORef, newIORef, writeIORef, readIORef, modifyIORef ) +import Foreign ( ForeignPtr, withForeignPtr, newForeignPtr_ + , plusPtr ) +import Foreign.Storable ( Storable ) +import Foreign.Marshal.Array ( allocaArray, peekArray, newArray ) +import qualified Data.ByteString.Internal as BSI +import Util ( Image(..), bitmapLoad ) +import Control.Monad ( when, forM_, forever ) +import Paths_nehe_tuts + +type Sector = [Tri] + +data Tri = Tri !Vert !Vert !Vert + deriving (Eq, Ord, Show) + +data Vert = Vert { vertX :: !GLfloat + , vertY :: !GLfloat + , vertZ :: !GLfloat + , vertU :: !GLfloat + , vertV :: !GLfloat + } + deriving (Eq, Ord, Show) + +piover180 :: GLfloat +piover180 = pi/180.0 + +data Global = Global { xrot, yrot, xspeed, yspeed, walkbias, walkbiasangle, + lookupdown, xpos, zpos, camx, camy, camz, + therotate, heading, zdepth :: IORef GLfloat, + filterSelector :: IORef Int, + lighting, blend :: IORef Bool } +mkGlobal :: IO Global +mkGlobal = do xr <- newIORef 0 -- please someone find a nicer way... + yr <- newIORef 0 + xs <- newIORef 0 + ys <- newIORef 0 + wb <- newIORef 0 + wba <- newIORef 0 + lud <- newIORef 0 + xp <- newIORef 0 + zp <- newIORef 0 + cx <- newIORef 0 + cy <- newIORef 0 + cz <- newIORef 0 + tr <- newIORef 0 + h <- newIORef 0 + zd <- newIORef 0 + fs <- newIORef 0 + b <- newIORef True + l <- newIORef True + return Global { xrot = xr, yrot = yr, xspeed = xs, yspeed = ys, + walkbias = wb, walkbiasangle = wba, lookupdown = + lud, xpos = xp, zpos = zp, camx = cx, camy = cy, + camz = cz, therotate = tr, heading = h, + zdepth = zd, filterSelector = fs, blend = b, + lighting = l } + +newArray' :: Storable a => [a] -> IO (ForeignPtr a) +newArray' xs = (newArray xs) >>= newForeignPtr_ + +glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO () +glLightfv' l a fp = + withForeignPtr fp $ glLightfv l a + +readRef :: IO (IORef a) -> IO a +readRef r = r >>= readIORef + +setupWorld :: IO Sector +setupWorld = do + fp <- getDataFileName "world.txt" + h <- openFile fp ReadMode + ls <- (fmap (filter ignorable) ((fmap lines . hGetContents) h)) + let numtris = read ((head . tail . words . head) ls) + tris = readTris (tail ls) + when (length tris /= numtris) $ do + putStrLn "error reading world.txt" + exitWith (ExitFailure 1) + return tris + where + readTris :: [String] -> [Tri] + readTris (l1:l2:l3:ls) = (Tri (readVert (words l1)) + (readVert (words l2)) + (readVert (words l3))) : readTris ls + readTris [] = [] + readTris _ = undefined + readVert :: [String] -> Vert + readVert (x:y:z:u:v:[]) = Vert { vertX = read x + , vertY = read y + , vertZ = read z + , vertU = read u + , vertV = read v + } + readVert _ = undefined + ignorable ('/':'/':_) = False + ignorable [] = False + ignorable _ = True + +initGL :: GLFW.Window -> IO [GLuint] +initGL win = do + glEnable gl_TEXTURE_2D + glShadeModel gl_SMOOTH + glClearColor 0 0 0 0.5 + glClearDepth 1 + glEnable gl_DEPTH_TEST + glDepthFunc gl_LEQUAL + glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST + lightAmbient <- newArray' [0.5, 0.5, 0.5, 1] + lightDiffuse <- newArray' [1, 1, 1, 1] + lightPosition <- newArray' [0, 0, 2, 1] + glLightfv' gl_LIGHT1 gl_AMBIENT lightAmbient + glLightfv' gl_LIGHT1 gl_DIFFUSE lightDiffuse + glLightfv' gl_LIGHT1 gl_POSITION lightPosition + glEnable gl_LIGHTING + glEnable gl_LIGHT1 + glBlendFunc gl_SRC_ALPHA gl_ONE + glEnable gl_BLEND + (w,h) <- GLFW.getFramebufferSize win + resizeScene win w h + loadTextures + +loadTextures :: IO [GLuint] +loadTextures = do + fp <- getDataFileName "mud.bmp" + Just (Image w h pd) <- bitmapLoad fp + let numTexs = 3 :: Int + texs <- allocaArray (fromIntegral numTexs) $ \p -> do + glGenTextures (fromIntegral numTexs) p + peekArray numTexs p + let (ptr, off, _) = BSI.toForeignPtr pd + _ <- withForeignPtr ptr $ \p -> do + let p' = p `plusPtr` off + glLinear = fromIntegral gl_LINEAR + glNearest = fromIntegral gl_NEAREST + -- create nearest filter texture + glBindTexture gl_TEXTURE_2D (texs!!0) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest + -- create linear filtered texture + glBindTexture gl_TEXTURE_2D (texs!!1) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glLinear + -- create mipmap filtered texture + glBindTexture gl_TEXTURE_2D (texs!!2) + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glLinear + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER + (fromIntegral gl_LINEAR_MIPMAP_NEAREST) + gluBuild2DMipmaps gl_TEXTURE_2D 3 (fromIntegral w) + (fromIntegral h) gl_RGB gl_UNSIGNED_BYTE p' + return texs + +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] -> Sector -> Global -> GLFW.Window -> IO () +drawScene texs sector globals _ = do + glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT + .|. gl_DEPTH_BUFFER_BIT + glLoadIdentity -- reset view + xtrans <- fmap negate (readIORef (xpos globals)) + ytrans <- fmap (\y -> -y-0.25) (readIORef (walkbias globals)) + ztrans <- fmap negate (readIORef (zpos globals)) + sceneroty <- fmap (\y -> 360 - y) (readIORef (yrot globals)) + --print sceneroty + look <- readIORef (lookupdown globals) + filt <- readIORef (filterSelector globals) + glRotatef look 1 0 0 + glRotatef sceneroty 0 1 0 + + glTranslatef xtrans ytrans ztrans + glBindTexture gl_TEXTURE_2D (texs!!filt) + forM_ sector $ \(Tri (Vert x1 y1 z1 u1 v1) + (Vert x2 y2 z2 u2 v2) + (Vert x3 y3 z3 u3 v3)) -> do + glBegin gl_TRIANGLES + glNormal3f 0 0 1 + glTexCoord2f u1 v1 >> glVertex3f x1 y1 z1 + glTexCoord2f u2 v2 >> glVertex3f x2 y2 z2 + glTexCoord2f u3 v3 >> glVertex3f x3 y3 z3 + glEnd + glFlush + +shutdown :: GLFW.WindowCloseCallback +shutdown win = do + GLFW.destroyWindow win + GLFW.terminate + _ <- exitWith ExitSuccess + return () + +updateIORef :: Show a => IO (IORef a) -> (a -> a) -> IO () +updateIORef ioref f = do ref <- ioref + r <- readIORef ref + print r + writeIORef ref (f r) + +keyPressed :: Global -> GLFW.KeyCallback +keyPressed _ win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win +keyPressed g _ GLFW.Key'B _ GLFW.KeyState'Pressed _ = do + r <- readIORef (blend g) + if r + then do + glDisable gl_BLEND + glEnable gl_DEPTH_TEST + else do + glEnable gl_BLEND + glDisable gl_DEPTH_TEST + writeIORef (blend g) $! not r +keyPressed g _ GLFW.Key'F _ GLFW.KeyState'Pressed _ = + modifyIORef (filterSelector g) (\x -> (x+1) `mod` 3) +keyPressed g _ GLFW.Key'L _ GLFW.KeyState'Pressed _ = do + l <- readIORef (lighting g) + if l + then glDisable gl_LIGHTING + else glEnable gl_LIGHTING + writeIORef (lighting g) $! not l +keyPressed g _ GLFW.Key'Right _ GLFW.KeyState'Pressed _ = + modifyIORef (yrot g) (subtract 1.5) +keyPressed g _ GLFW.Key'Left _ GLFW.KeyState'Pressed _ = + modifyIORef (yrot g) (+ 1.5) +keyPressed g _ GLFW.Key'Up _ GLFW.KeyState'Pressed _ = do + h <- readIORef (yrot g) + modifyIORef (xpos g) (subtract ((sin (h * piover180))*0.05)) + modifyIORef (zpos g) (subtract ((cos (h * piover180))*0.05)) + modifyIORef (walkbiasangle g) (\w -> (w+10) `fmod` 360) + wba <- readIORef (walkbiasangle g) + modifyIORef (walkbias g) (\_ -> ((sin (wba * piover180))/20)) +keyPressed g _ GLFW.Key'Down _ GLFW.KeyState'Pressed _ = do + h <- readIORef (yrot g) + modifyIORef (xpos g) (+ (sin (h * piover180))*0.05) + modifyIORef (zpos g) (+ (cos (h * piover180))*0.05) + modifyIORef (walkbiasangle g) (\w -> (w-10) `fmod` 360) + wba <- readIORef (walkbiasangle g) + modifyIORef (walkbias g) (\_ -> ((sin (wba * piover180))/20)) +keyPressed g _ GLFW.Key'PageUp _ GLFW.KeyState'Pressed _ = do + modifyIORef (zdepth g) (subtract 0.2) + modifyIORef (lookupdown g) (subtract 0.2) +keyPressed g _ GLFW.Key'PageDown _ GLFW.KeyState'Pressed _ = do + modifyIORef (zdepth g) (+ 0.2) + modifyIORef (lookupdown g) (+ 0.2) +keyPressed _ _ _ _ _ _ = return () + +fmod :: RealFrac a => a -> Int -> a +fmod x m = (fromIntegral ((floor x :: Int) `mod` m)) + + (x - (fromIntegral (floor x :: Int))) + +main :: IO () +main = do + True <- GLFW.init + sector <- setupWorld + -- select type of display mode: + -- Double buffer + -- RGBA color + -- Alpha components supported + -- Depth buffer + -- open a window + Just win <- GLFW.createWindow 800 600 "Lesson 10" Nothing Nothing + GLFW.makeContextCurrent (Just win) + -- initialize our window. + tex <- initGL win + globals <- mkGlobal + GLFW.setWindowRefreshCallback win $ + Just (drawScene tex sector globals) + -- 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 globals) + GLFW.setWindowCloseCallback win (Just shutdown) + forever $ do + GLFW.pollEvents + drawScene tex sector globals win + GLFW.swapBuffers win
lesson11.hs view
@@ -1,188 +1,178 @@------ 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, when, forM_, join )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import Foreign ( withForeignPtr, plusPtr, alloca, peek )-import qualified Data.ByteString.Internal as BSI-import Util ( Image(..), bitmapLoad )-import Data.Array.IO ( readArray, IOArray, newListArray )-import Control.Applicative ( (<$>), (<*>) )-import Paths_nehe_tuts--type Points = IOArray (Int, Int, Int) GLfloat--initGL :: IO GLuint-initGL = do- glEnable gl_TEXTURE_2D- glShadeModel gl_SMOOTH- glClearColor 0 0 0 0.5- glClearDepth 1- glEnable gl_DEPTH_TEST- glDepthFunc gl_LEQUAL- glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST- -- On some video cards/drivers this looks terrible- -- So if you get an ugly image, try commenting out- -- these two glPolygonMode lines- glPolygonMode gl_BACK gl_FILL- glPolygonMode gl_FRONT gl_LINE- loadGLTextures--loadGLTextures :: IO GLuint-loadGLTextures = do- fp <- getDataFileName "tim.bmp"- Just (Image w h pd) <- bitmapLoad fp- putStrLn $ "Image w = " ++ show w- putStrLn $ "Image h = " ++ 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- glNearest = fromIntegral gl_NEAREST- -- create linear filtered texture- glBindTexture gl_TEXTURE_2D tex- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest- return tex--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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- -> Points -> IORef Int -> IORef Int -> IO () -drawScene tex xrot yrot zrot points wiggleRef offsetRef = do- glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT- .|. gl_DEPTH_BUFFER_BIT-- glLoadIdentity-- glTranslatef 0 0 (-12)-- xr <- readIORef xrot- yr <- readIORef yrot- zr <- readIORef zrot- offset <- readIORef offsetRef- wiggle <- readIORef wiggleRef- glRotatef xr 1 0 0- glRotatef yr 0 1 0- glRotatef zr 0 0 1- glBindTexture gl_TEXTURE_2D tex- glBegin gl_QUADS- forM_ [(x,y) | x <- [0..43], y<-[0..43]] $ \(x,y) -> do- let x' = (x+offset) `mod` 45- fx = fromIntegral x/44 :: GLfloat- fy = fromIntegral y/44 :: GLfloat- fxb = fromIntegral (x+1)/44 :: GLfloat- fyb = fromIntegral (y+1)/44 :: GLfloat- glTexCoord2f fx fy- join $ glVertex3f <$> (readArray points (x,y,0))- <*> (readArray points (x,y,1))- <*> (readArray points (x',y,2))- glTexCoord2f fx fyb- join $ glVertex3f <$> (readArray points (x,y+1,0))- <*> (readArray points (x,y+1,1))- <*> (readArray points (x',y+1,2))- glTexCoord2f fxb fyb- join $ glVertex3f <$> (readArray points (x+1,y+1,0))- <*> (readArray points (x+1,y+1,1))- <*> (readArray points ((x'+1)`mod`45,y+1,2))- glTexCoord2f fxb fy- join $ glVertex3f <$> (readArray points (x+1,y,0))- <*> (readArray points (x+1,y,1))- <*> (readArray points ((x'+1)`mod`45,y,2))- glEnd-- writeIORef xrot $! xr + 0.3- writeIORef yrot $! yr + 0.2- writeIORef zrot $! zr + 0.4-- when (wiggle == 2) $ do- writeIORef offsetRef $! offset + 1- writeIORef wiggleRef $! 0-- w <- readIORef wiggleRef- writeIORef wiggleRef $! w + 1-- glFlush--keyPressed :: GLFW.KeyCallback-keyPressed GLFW.KeyEsc True = shutdown >> return ()-keyPressed _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 24- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- -- window starts at upper left corner of the screen- GLFW.setWindowPosition 0 0- GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"- xrot <- newIORef 0- yrot <- newIORef 0- zrot <- newIORef 0- wiggle <- newIORef 0- offset <- newIORef 0- let elems = concat [[((x/5)-4.5),- ((y/5)-4.5),- sin (((x/5)*40/360)*pi*2)]- | x <- [0..44]::[GLfloat], y <- [0..44]::[GLfloat] ]- points <- newListArray ((0,0,0), (44,44,2)) elems :: IO Points- -- initialize our window.- tex <- initGL- GLFW.setWindowRefreshCallback- (drawScene tex xrot yrot zrot points wiggle offset)- -- register the funciton called when our window is resized- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback $- keyPressed- GLFW.setWindowCloseCallback shutdown- GLFW.getWindowRefreshRate >>= print- forever $ do- drawScene tex xrot yrot zrot points wiggle offset- GLFW.swapBuffers+-- +-- 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, when, forM_, join ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Foreign ( withForeignPtr, plusPtr, alloca, peek ) +import qualified Data.ByteString.Internal as BSI +import Util ( Image(..), bitmapLoad ) +import Data.Array.IO ( readArray, IOArray, newListArray ) +import Control.Applicative ( (<$>), (<*>) ) +import Paths_nehe_tuts + +type Points = IOArray (Int, Int, Int) GLfloat + +initGL :: GLFW.Window -> IO GLuint +initGL win = do + glEnable gl_TEXTURE_2D + glShadeModel gl_SMOOTH + glClearColor 0 0 0 0.5 + glClearDepth 1 + glEnable gl_DEPTH_TEST + glDepthFunc gl_LEQUAL + glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST + -- On some video cards/drivers this looks terrible + -- So if you get an ugly image, try commenting out + -- these two glPolygonMode lines + glPolygonMode gl_BACK gl_FILL + glPolygonMode gl_FRONT gl_LINE + (w,h) <- GLFW.getFramebufferSize win + resizeScene win w h + loadGLTextures + +loadGLTextures :: IO GLuint +loadGLTextures = do + fp <- getDataFileName "tim.bmp" + Just (Image w h pd) <- bitmapLoad fp + putStrLn $ "Image w = " ++ show w + putStrLn $ "Image h = " ++ 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 + glNearest = fromIntegral gl_NEAREST + -- create linear filtered texture + glBindTexture gl_TEXTURE_2D tex + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest + return tex + +shutdown :: GLFW.WindowCloseCallback +shutdown win = do + GLFW.destroyWindow win + GLFW.terminate + _ <- exitWith ExitSuccess + return () + +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 + -> Points -> IORef Int -> IORef Int -> GLFW.Window -> IO () +drawScene tex xrot yrot zrot points wiggleRef offsetRef _ = do + glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT + .|. gl_DEPTH_BUFFER_BIT + + glLoadIdentity + + glTranslatef 0 0 (-12) + + xr <- readIORef xrot + yr <- readIORef yrot + zr <- readIORef zrot + offset <- readIORef offsetRef + wiggle <- readIORef wiggleRef + glRotatef xr 1 0 0 + glRotatef yr 0 1 0 + glRotatef zr 0 0 1 + glBindTexture gl_TEXTURE_2D tex + glBegin gl_QUADS + forM_ [(x,y) | x <- [0..43], y<-[0..43]] $ \(x,y) -> do + let x' = (x+offset) `mod` 45 + fx = fromIntegral x/44 :: GLfloat + fy = fromIntegral y/44 :: GLfloat + fxb = fromIntegral (x+1)/44 :: GLfloat + fyb = fromIntegral (y+1)/44 :: GLfloat + glTexCoord2f fx fy + join $ glVertex3f <$> (readArray points (x,y,0)) + <*> (readArray points (x,y,1)) + <*> (readArray points (x',y,2)) + glTexCoord2f fx fyb + join $ glVertex3f <$> (readArray points (x,y+1,0)) + <*> (readArray points (x,y+1,1)) + <*> (readArray points (x',y+1,2)) + glTexCoord2f fxb fyb + join $ glVertex3f <$> (readArray points (x+1,y+1,0)) + <*> (readArray points (x+1,y+1,1)) + <*> (readArray points ((x'+1)`mod`45,y+1,2)) + glTexCoord2f fxb fy + join $ glVertex3f <$> (readArray points (x+1,y,0)) + <*> (readArray points (x+1,y,1)) + <*> (readArray points ((x'+1)`mod`45,y,2)) + glEnd + + writeIORef xrot $! xr + 0.3 + writeIORef yrot $! yr + 0.2 + writeIORef zrot $! zr + 0.4 + + when (wiggle == 2) $ do + writeIORef offsetRef $! offset + 1 + writeIORef wiggleRef $! 0 + + w <- readIORef wiggleRef + writeIORef wiggleRef $! w + 1 + + glFlush + +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 11" Nothing Nothing + GLFW.makeContextCurrent (Just win) + -- window starts at upper left corner of the screen + xrot <- newIORef 0 + yrot <- newIORef 0 + zrot <- newIORef 0 + wiggle <- newIORef 0 + offset <- newIORef 0 + let elems = concat [[((x/5)-4.5), + ((y/5)-4.5), + sin (((x/5)*40/360)*pi*2)] + | x <- [0..44]::[GLfloat], y <- [0..44]::[GLfloat] ] + points <- newListArray ((0,0,0), (44,44,2)) elems :: IO Points + -- initialize our window. + tex <- initGL win + GLFW.setWindowRefreshCallback win $ + Just (drawScene tex xrot yrot zrot points wiggle offset) + -- 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) + forever $ do + GLFW.pollEvents + drawScene tex xrot yrot zrot points wiggle offset win + GLFW.swapBuffers win
lesson12.hs view
@@ -1,194 +1,187 @@------ 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, forM_ )-import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )-import Foreign ( withForeignPtr, plusPtr, alloca, peek )-import qualified Data.ByteString.Internal as BSI-import Util ( Image(..), bitmapLoad )-import Paths_nehe_tuts--boxcol :: [(GLfloat, GLfloat, GLfloat)]-boxcol = [(1, 0, 0), (1, 0.5, 0), (1, 1, 0), - (0, 1, 0), (0, 1, 1)]-topcol :: [(GLfloat, GLfloat, GLfloat)]-topcol = [(0.5, 0, 0), (0.5, 0.25, 0), (0.5, 0.5, 0),- (0, 0.5, 0), (0, 0.5, 0.5)]--buildLists :: IO (GLuint, GLuint)-buildLists = do- box <- glGenLists 2- glNewList box gl_COMPILE- glBegin gl_QUADS- glTexCoord2f 1 1 >> glVertex3f (-1) (-1) (-1) -- Top Right Of The Texture and Quad- glTexCoord2f 0.0 1.0 >> glVertex3f 1.0 (-1.0) (-1.0) -- Top Left Of The Texture and Quad- glTexCoord2f 0.0 0.0 >> glVertex3f 1.0 (-1.0) 1.0 -- Bottom Left Of The Texture and Quad- glTexCoord2f 1.0 0.0 >> glVertex3f (-1.0) (-1.0) 1.0 -- Bottom Right Of The Texture and Quad- -- Front Face- glTexCoord2f 0.0 0.0 >> glVertex3f (-1.0) (-1.0) 1.0 -- Bottom Left Of The Texture and Quad- glTexCoord2f 1.0 0.0 >> glVertex3f 1.0 (-1.0) 1.0 -- Bottom Right Of The Texture and Quad- glTexCoord2f 1.0 1.0 >> glVertex3f 1.0 1.0 1.0 -- Top Right Of The Texture and Quad- glTexCoord2f 0.0 1.0 >> glVertex3f (-1.0) 1.0 1.0 -- Top Left Of The Texture and Quad- -- Back Face- glTexCoord2f 1.0 0.0 >> glVertex3f (-1.0) (-1.0) (-1.0) -- Bottom Right Of The Texture and Quad- glTexCoord2f 1.0 1.0 >> glVertex3f (-1.0) 1.0 (-1.0) -- Top Right Of The Texture and Quad- glTexCoord2f 0.0 1.0 >> glVertex3f 1.0 1.0 (-1.0) -- Top Left Of The Texture and Quad- glTexCoord2f 0.0 0.0 >> glVertex3f 1.0 (-1.0) (-1.0) -- Bottom Left Of The Texture and Quad- -- Right face- glTexCoord2f 1.0 0.0 >> glVertex3f 1.0 (-1.0) (-1.0) -- Bottom Right Of The Texture and Quad- glTexCoord2f 1.0 1.0 >> glVertex3f 1.0 1.0 (-1.0) -- Top Right Of The Texture and Quad- glTexCoord2f 0.0 1.0 >> glVertex3f 1.0 1.0 1.0 -- Top Left Of The Texture and Quad- glTexCoord2f 0.0 0.0 >> glVertex3f 1.0 (-1.0) 1.0 -- Bottom Left Of The Texture and Quad- -- Left Face- glTexCoord2f 0.0 0.0 >> glVertex3f (-1.0) (-1.0) (-1.0) -- Bottom Left Of The Texture and Quad- glTexCoord2f 1.0 0.0 >> glVertex3f (-1.0) (-1.0) 1.0 -- Bottom Right Of The Texture and Quad- glTexCoord2f 1.0 1.0 >> glVertex3f (-1.0) 1.0 1.0 -- Top Right Of The Texture and Quad- glTexCoord2f 0.0 1.0 >> glVertex3f (-1.0) 1.0 (-1.0) -- Top Left Of The Texture and Quad-- glEndList- let top = box + 1- glNewList top gl_COMPILE- glBegin gl_QUADS- glTexCoord2f 0 1 >> glVertex3f (-1) 1 (-1)- glTexCoord2f 0 0 >> glVertex3f (-1) 1 1- glTexCoord2f 1 0 >> glVertex3f 1 1 1- glTexCoord2f 1 1 >> glVertex3f 1 1 (-1)- glEnd- glEndList- return (box, top)--initGL :: IO GLuint-initGL = do- tex <- loadTextures- glEnable gl_TEXTURE_2D- glShadeModel gl_SMOOTH- glClearColor 0 0 0 0.5- glClearDepth 1- glEnable gl_DEPTH_TEST- glEnable gl_LEQUAL- glEnable gl_LIGHT0- glEnable gl_LIGHTING- glEnable gl_COLOR_MATERIAL- glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST- return tex--loadTextures :: IO GLuint-loadTextures = do- fp <- getDataFileName "cube.bmp"- Just (Image w h pd) <- bitmapLoad fp- putStrLn $ "Image w = " ++ show w- putStrLn $ "Image h = " ++ 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- glNearest = fromIntegral gl_NEAREST- -- create linear filtered texture- glBindTexture gl_TEXTURE_2D tex- glTexImage2D gl_TEXTURE_2D 0 3- (fromIntegral w) (fromIntegral h)- 0 gl_RGB gl_UNSIGNED_BYTE p'- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest- glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest- return tex--shutdown :: GLFW.WindowCloseCallback-shutdown = do- GLFW.closeWindow- GLFW.terminate- _ <- exitWith ExitSuccess- return True--resizeScene :: GLFW.WindowSizeCallback-resizeScene w 0 = resizeScene 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- -> GLuint -> GLuint -> IO ()-drawScene tex xrot yrot box top = do- glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT- .|. gl_DEPTH_BUFFER_BIT- glBindTexture gl_TEXTURE_2D tex-- xr <- readIORef xrot- yr <- readIORef yrot-- forM_ [(x,y) | y <- [1..5], x <- [0..y-1] ] $ \(x,y) -> do- glLoadIdentity- let x' = fromIntegral x- y' = fromIntegral y- color (r,g,b) = glColor3f r g b- glTranslatef (1.4+x'*2.8-y'*1.4) (((6-y')*2.4)-7) (-20)- glRotatef (45.0-(2.0*y')+xr) 1 0 0- glRotatef (45-yr) 0 1 0- color (boxcol !! (y-1))- glCallList box- color (topcol !! (y-1))- glCallList top - glFlush--keyPressed :: IORef GLfloat -> IORef GLfloat -> GLFW.KeyCallback-keyPressed _ _ GLFW.KeyEsc True = shutdown >> return ()-keyPressed xrot _ GLFW.KeyUp True = modifyIORef xrot (subtract 0.8)-keyPressed xrot _ GLFW.KeyDown True = modifyIORef xrot (+0.8)-keyPressed _ yrot GLFW.KeyLeft True = modifyIORef yrot (subtract 0.8)-keyPressed _ yrot GLFW.KeyRight True = modifyIORef yrot (+0.8)-keyPressed _ _ _ _ = return ()--main :: IO ()-main = do- True <- GLFW.initialize- -- select type of display mode:- -- Double buffer- -- RGBA color- -- Alpha components supported- -- Depth buffer- let dspOpts = GLFW.defaultDisplayOptions- -- get a 800 x 600 window- { GLFW.displayOptions_width = 800- , GLFW.displayOptions_height = 600- -- Set depth buffering and RGBA colors- , GLFW.displayOptions_numRedBits = 8- , GLFW.displayOptions_numGreenBits = 8- , GLFW.displayOptions_numBlueBits = 8- , GLFW.displayOptions_numAlphaBits = 8- , GLFW.displayOptions_numDepthBits = 24- -- , GLFW.displayOptions_displayMode = GLFW.Fullscreen- }- -- open a window- True <- GLFW.openWindow dspOpts- xrot <- newIORef 0- yrot <- newIORef 0- - -- initialize our window.- tex <- initGL- (box, top) <- buildLists- GLFW.setWindowRefreshCallback $- drawScene tex xrot yrot box top- GLFW.setWindowSizeCallback resizeScene- -- register the function called when the keyboard is pressed.- GLFW.setKeyCallback $- keyPressed xrot yrot- GLFW.setWindowCloseCallback shutdown- GLFW.getWindowRefreshRate >>= print- forever $ do- drawScene tex xrot yrot box top- GLFW.swapBuffers+-- +-- 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, forM_ ) +import Data.IORef ( IORef, newIORef, readIORef, modifyIORef ) +import Foreign ( withForeignPtr, plusPtr, alloca, peek ) +import qualified Data.ByteString.Internal as BSI +import Util ( Image(..), bitmapLoad ) +import Paths_nehe_tuts + +boxcol :: [(GLfloat, GLfloat, GLfloat)] +boxcol = [(1, 0, 0), (1, 0.5, 0), (1, 1, 0), + (0, 1, 0), (0, 1, 1)] +topcol :: [(GLfloat, GLfloat, GLfloat)] +topcol = [(0.5, 0, 0), (0.5, 0.25, 0), (0.5, 0.5, 0), + (0, 0.5, 0), (0, 0.5, 0.5)] + +buildLists :: IO (GLuint, GLuint) +buildLists = do + box <- glGenLists 2 + glNewList box gl_COMPILE + glBegin gl_QUADS + glTexCoord2f 1 1 >> glVertex3f (-1) (-1) (-1) -- Top Right Of The Texture and Quad + glTexCoord2f 0.0 1.0 >> glVertex3f 1.0 (-1.0) (-1.0) -- Top Left Of The Texture and Quad + glTexCoord2f 0.0 0.0 >> glVertex3f 1.0 (-1.0) 1.0 -- Bottom Left Of The Texture and Quad + glTexCoord2f 1.0 0.0 >> glVertex3f (-1.0) (-1.0) 1.0 -- Bottom Right Of The Texture and Quad + -- Front Face + glTexCoord2f 0.0 0.0 >> glVertex3f (-1.0) (-1.0) 1.0 -- Bottom Left Of The Texture and Quad + glTexCoord2f 1.0 0.0 >> glVertex3f 1.0 (-1.0) 1.0 -- Bottom Right Of The Texture and Quad + glTexCoord2f 1.0 1.0 >> glVertex3f 1.0 1.0 1.0 -- Top Right Of The Texture and Quad + glTexCoord2f 0.0 1.0 >> glVertex3f (-1.0) 1.0 1.0 -- Top Left Of The Texture and Quad + -- Back Face + glTexCoord2f 1.0 0.0 >> glVertex3f (-1.0) (-1.0) (-1.0) -- Bottom Right Of The Texture and Quad + glTexCoord2f 1.0 1.0 >> glVertex3f (-1.0) 1.0 (-1.0) -- Top Right Of The Texture and Quad + glTexCoord2f 0.0 1.0 >> glVertex3f 1.0 1.0 (-1.0) -- Top Left Of The Texture and Quad + glTexCoord2f 0.0 0.0 >> glVertex3f 1.0 (-1.0) (-1.0) -- Bottom Left Of The Texture and Quad + -- Right face + glTexCoord2f 1.0 0.0 >> glVertex3f 1.0 (-1.0) (-1.0) -- Bottom Right Of The Texture and Quad + glTexCoord2f 1.0 1.0 >> glVertex3f 1.0 1.0 (-1.0) -- Top Right Of The Texture and Quad + glTexCoord2f 0.0 1.0 >> glVertex3f 1.0 1.0 1.0 -- Top Left Of The Texture and Quad + glTexCoord2f 0.0 0.0 >> glVertex3f 1.0 (-1.0) 1.0 -- Bottom Left Of The Texture and Quad + -- Left Face + glTexCoord2f 0.0 0.0 >> glVertex3f (-1.0) (-1.0) (-1.0) -- Bottom Left Of The Texture and Quad + glTexCoord2f 1.0 0.0 >> glVertex3f (-1.0) (-1.0) 1.0 -- Bottom Right Of The Texture and Quad + glTexCoord2f 1.0 1.0 >> glVertex3f (-1.0) 1.0 1.0 -- Top Right Of The Texture and Quad + glTexCoord2f 0.0 1.0 >> glVertex3f (-1.0) 1.0 (-1.0) -- Top Left Of The Texture and Quad + + glEndList + let top = box + 1 + glNewList top gl_COMPILE + glBegin gl_QUADS + glTexCoord2f 0 1 >> glVertex3f (-1) 1 (-1) + glTexCoord2f 0 0 >> glVertex3f (-1) 1 1 + glTexCoord2f 1 0 >> glVertex3f 1 1 1 + glTexCoord2f 1 1 >> glVertex3f 1 1 (-1) + glEnd + glEndList + return (box, top) + +initGL :: GLFW.Window -> IO GLuint +initGL win = do + tex <- loadTextures + glEnable gl_TEXTURE_2D + glShadeModel gl_SMOOTH + glClearColor 0 0 0 0.5 + glClearDepth 1 + glEnable gl_DEPTH_TEST + glEnable gl_LEQUAL + glEnable gl_LIGHT0 + glEnable gl_LIGHTING + glEnable gl_COLOR_MATERIAL + glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST + (w,h) <- GLFW.getFramebufferSize win + resizeScene win w h + return tex + +loadTextures :: IO GLuint +loadTextures = do + fp <- getDataFileName "cube.bmp" + Just (Image w h pd) <- bitmapLoad fp + putStrLn $ "Image w = " ++ show w + putStrLn $ "Image h = " ++ 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 + glNearest = fromIntegral gl_NEAREST + -- create linear filtered texture + glBindTexture gl_TEXTURE_2D tex + glTexImage2D gl_TEXTURE_2D 0 3 + (fromIntegral w) (fromIntegral h) + 0 gl_RGB gl_UNSIGNED_BYTE p' + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER glNearest + glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER glNearest + return tex + +shutdown :: GLFW.WindowCloseCallback +shutdown win = do + GLFW.destroyWindow win + GLFW.terminate + _ <- exitWith ExitSuccess + return () + +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 + -> GLuint -> GLuint -> GLFW.Window -> IO () +drawScene tex xrot yrot box top _ = do + glClear $ fromIntegral $ gl_COLOR_BUFFER_BIT + .|. gl_DEPTH_BUFFER_BIT + glBindTexture gl_TEXTURE_2D tex + + xr <- readIORef xrot + yr <- readIORef yrot + + forM_ [(x,y) | y <- [1..5], x <- [0..y-1] ] $ \(x,y) -> do + glLoadIdentity + let x' = fromIntegral x + y' = fromIntegral y + color (r,g,b) = glColor3f r g b + glTranslatef (1.4+x'*2.8-y'*1.4) (((6-y')*2.4)-7) (-20) + glRotatef (45.0-(2.0*y')+xr) 1 0 0 + glRotatef (45-yr) 0 1 0 + color (boxcol !! (y-1)) + glCallList box + color (topcol !! (y-1)) + glCallList top + glFlush + +keyPressed :: IORef GLfloat -> IORef GLfloat -> GLFW.KeyCallback +keyPressed _ _ win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win +keyPressed xrot _ _ GLFW.Key'Up _ GLFW.KeyState'Pressed _ = modifyIORef xrot (subtract 0.8) +keyPressed xrot _ _ GLFW.Key'Down _ GLFW.KeyState'Pressed _ = modifyIORef xrot (+0.8) +keyPressed _ yrot _ GLFW.Key'Left _ GLFW.KeyState'Pressed _ = modifyIORef yrot (subtract 0.8) +keyPressed _ yrot _ GLFW.Key'Right _ GLFW.KeyState'Pressed _ = modifyIORef yrot (+0.8) +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 12" Nothing Nothing + GLFW.makeContextCurrent (Just win) + xrot <- newIORef 0 + yrot <- newIORef 0 + + -- initialize our window. + tex <- initGL win + (box, top) <- buildLists + GLFW.setWindowRefreshCallback win $ + Just (drawScene tex xrot yrot box top) + GLFW.setFramebufferSizeCallback win (Just resizeScene) + -- register the function called when the keyboard is pressed. + GLFW.setKeyCallback win $ + Just (keyPressed xrot yrot) + GLFW.setWindowCloseCallback win (Just shutdown) + -- GLFW.getWindowRefreshRate >>= print + forever $ do + GLFW.pollEvents + drawScene tex xrot yrot box top win + GLFW.swapBuffers win
nehe-tuts.cabal view
@@ -1,106 +1,106 @@-Name: nehe-tuts-Version: 0.2.3-Synopsis: Port of the NeHe OpenGL tutorials to Haskell.-Description: Port of the NeHe OpenGL tutorials to Haskell; so far only lessons 1-12 have been ported.-Author: Jason Dagit-Maintainer: dagitj@gmail.com-License: BSD3-License-file: LICENSE-Category: Graphics-Cabal-Version: >= 1.8-Build-type: Simple-Extra-Source-Files: README-data-dir: Data-data-files: *.bmp, *.txt-source-repository head- type: git- location: https://github.com/dagit/nehe-tuts--source-repository this- type: git- location: https://github.com/dagit/nehe-tuts- tag: 0.2.3--Executable lesson01- Main-is: lesson01.hs- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*- GHC-Options: -Wall-Executable lesson02- Main-is: lesson02.hs- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*- GHC-Options: -Wall-Executable lesson03- Main-is: lesson03.hs- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*- GHC-Options: -Wall-Executable lesson04- Main-is: lesson04.hs- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*- GHC-Options: -Wall-Executable lesson05- Main-is: lesson05.hs- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*- GHC-Options: -Wall-Executable lesson06- Main-is: lesson06.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall-Executable lesson07- Main-is: lesson07.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall-Executable lesson08- Main-is: lesson08.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall-Executable lesson09- Main-is: lesson09.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- random == 1.0.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall-Executable lesson10- Main-is: lesson10.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall-Executable lesson11- Main-is: lesson11.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- array == 0.3.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall-Executable lesson12- Main-is: lesson12.hs- Other-modules: Util, Paths_nehe_tuts- Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,- GLURaw == 1.1.*, GLFW-b == 0.0.*,- bytestring == 0.9.*, cereal == 0.3.*,- directory >= 1.0 && < 1.2- GHC-Options: -Wall+Name: nehe-tuts +Version: 0.2.4 +Synopsis: Port of the NeHe OpenGL tutorials to Haskell. +Description: Port of the NeHe OpenGL tutorials to Haskell; so far only lessons 1-12 have been ported. +Author: Jason Dagit +Maintainer: dagitj@gmail.com +License: BSD3 +License-file: LICENSE +Category: Graphics +Cabal-Version: >= 1.8 +Build-type: Simple +Extra-Source-Files: README +data-dir: Data +data-files: *.bmp, *.txt +source-repository head + type: git + location: https://github.com/dagit/nehe-tuts + +source-repository this + type: git + location: https://github.com/dagit/nehe-tuts + tag: 0.2.3 + +Executable lesson01 + Main-is: lesson01.hs + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0 + GHC-Options: -Wall +Executable lesson02 + Main-is: lesson02.hs + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0 + GHC-Options: -Wall +Executable lesson03 + Main-is: lesson03.hs + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0 + GHC-Options: -Wall +Executable lesson04 + Main-is: lesson04.hs + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0 + GHC-Options: -Wall +Executable lesson05 + Main-is: lesson05.hs + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0 + GHC-Options: -Wall +Executable lesson06 + Main-is: lesson06.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + directory + GHC-Options: -Wall +Executable lesson07 + Main-is: lesson07.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + directory + GHC-Options: -Wall +Executable lesson08 + Main-is: lesson08.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + directory + GHC-Options: -Wall +Executable lesson09 + Main-is: lesson09.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + random, + directory + GHC-Options: -Wall +Executable lesson10 + Main-is: lesson10.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + directory + GHC-Options: -Wall +Executable lesson11 + Main-is: lesson11.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + array, + directory + GHC-Options: -Wall +Executable lesson12 + Main-is: lesson12.hs + Other-modules: Util, Paths_nehe_tuts + Build-Depends: base >= 3 && < 5, OpenGLRaw, + GLURaw, GLFW-b >= 1.0.0, + bytestring, cereal, + directory + GHC-Options: -Wall