diff --git a/lesson01.hs b/lesson01.hs --- a/lesson01.hs +++ b/lesson01.hs @@ -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 diff --git a/lesson02.hs b/lesson02.hs --- a/lesson02.hs +++ b/lesson02.hs @@ -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 diff --git a/lesson03.hs b/lesson03.hs --- a/lesson03.hs +++ b/lesson03.hs @@ -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 diff --git a/lesson04.hs b/lesson04.hs --- a/lesson04.hs +++ b/lesson04.hs @@ -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 diff --git a/lesson05.hs b/lesson05.hs --- a/lesson05.hs +++ b/lesson05.hs @@ -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 diff --git a/lesson06.hs b/lesson06.hs --- a/lesson06.hs +++ b/lesson06.hs @@ -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 diff --git a/lesson07.hs b/lesson07.hs --- a/lesson07.hs +++ b/lesson07.hs @@ -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 diff --git a/lesson08.hs b/lesson08.hs --- a/lesson08.hs +++ b/lesson08.hs @@ -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 diff --git a/lesson09.hs b/lesson09.hs --- a/lesson09.hs +++ b/lesson09.hs @@ -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 diff --git a/lesson10.hs b/lesson10.hs --- a/lesson10.hs +++ b/lesson10.hs @@ -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 diff --git a/lesson11.hs b/lesson11.hs --- a/lesson11.hs +++ b/lesson11.hs @@ -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 diff --git a/lesson12.hs b/lesson12.hs --- a/lesson12.hs +++ b/lesson12.hs @@ -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 diff --git a/nehe-tuts.cabal b/nehe-tuts.cabal --- a/nehe-tuts.cabal +++ b/nehe-tuts.cabal @@ -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