nehe-tuts 0.1.1 → 0.2.0

raw patch · 17 files changed

+1964/−1646 lines, 17 filesdep +GLFW-bdep +GLURawdep +OpenGLRawdep −GLUTdep −OpenGLdep −haskell98dep ~arraydep ~base

Dependencies added: GLFW-b, GLURaw, OpenGLRaw, bytestring, cereal, directory, random

Dependencies removed: GLUT, OpenGL, haskell98

Dependency ranges changed: array, base

Files

• LICENSE +2/−1
• Makefile +0/−27
• README +7/−27
• Util.hs +41/−84
• lesson01.hs +62/−54
• lesson02.hs +75/−61
• lesson03.hs +78/−65
• lesson04.hs +89/−76
• lesson05.hs +141/−127
• lesson06.hs +160/−134
• lesson07.hs +246/−190
• lesson08.hs +257/−201
• lesson09.hs +191/−149
• lesson10.hs +200/−138
• lesson11.hs +156/−112
• lesson12.hs +157/−128
• nehe-tuts.cabal +102/−72

@@ -1,1 +1,2 @@-This code follows the BSD license.+The code I've written here is covered by a BSD3 license, but the original code is hosted at+NeHe and covered by the licenses specified there.

@@ -1,27 +0,0 @@-GHC = ghc-FLAGS = -Wall -Werror -O2-lessons = lesson*.hs--default: $(lessons)--usage:-	@echo "Usage: make lessonXY"-	@echo "  Or"-	@echo "Usage: make lessonXY.hs"-	@echo "Current lessons available are:" $(lessons)--.PHONY: $(lessons)--#this is nice so you can type "make *"-$(lessons)::-	$(GHC) $(FLAGS) --make $@ -o $(subst .hs,,$@)--#with this rule you can type "make lessonXY"-% :: %.hs-	$(GHC) $(FLAGS) --make $< -o $@--clean:-	rm -rf *.o *.hi--distclean:-	rm -rf *.o *.hi lesson[0-9][0-9]

@@ -1,34 +1,14 @@ These examples were created by Jeff Molofee '99 NeHe of http://nehe.gamedev.net -Converted to Haskell by Jason Dagit, 2005.  As far as I know, all-examples require GHC and the HOpenGL and GLUT libraries. I've tried -not to add anything else as a requirement (although look into the -nehe-tuts.cabal file to make sure).  -This code is tested on OSX and MS Windows only.  If you try it on -another platform and it works for you, then please let me know.--Usage of Makefile:--make lessonXY            # this will build just lessonXY-make lessonXY.hs         # same as above rule, convienent for tab completion.-make                     # build everything-make clean               # gets rid of the .hs and .o files-make distclean           # make clean and get rid of the binaries--Usage of Cabal package:--runhaskell Setup.hs configure-runhaskell Setup.hs build-# And here you are, all the executables ready to run.--If you are having problems with installing OpenGL bindings, or some weird linker-problems during compilation on MS Windows, please see this page:--http://netsuperbrain.com/blog/posts/freeglut-windows-hopengl-hglut/+Converted to Haskell by Jason Dagit, 2005 and 2011. -Make sure to follow all the steps precisely; if something still fails, start from -scratch: you've forgotten a step.+This code is tested on OSX, linux, Windows.  If you try it on+another platform and it works for you, then please let me know. +The current version uses GLFW via the GLFW-b bindings.  Instead of+using the OpenGL bindings, I use OpenGLRaw and GLURaw.  These packages+provide an API that is closer to the C API for OpenGL making it+easier to follow 3rd party documenatation and port examples.  Acknowldegements: I want to thank #haskell on irc.freenode.net for support and general

@@ -1,91 +1,48 @@ module Util ( bitmapLoad, Image(..) ) where -import Data.Word ( Word8, Word16 )-import Data.Int ( Int32 )-import Foreign ( Ptr, allocaBytes, pokeElemOff, peekElemOff, peek, castPtr,-                 Storable, mallocBytes, free, copyBytes )-import Graphics.Rendering.OpenGL ( PixelData(..), PixelFormat(..), Size(..), -                                   DataType(..) )-import System.IO ( IOMode( ReadMode ), openBinaryFile, hSeek, -                   SeekMode( RelativeSeek ), Handle, hGetBuf )-import System.IO.Unsafe ( unsafePerformIO )--data Endian = LittleEndian | BigEndian-              deriving (Eq, Ord, Show)+import Data.Word ( Word8, Word32 )+import Data.Serialize.Get ( Get, runGet, getWord32le, getWord16le+                          , skip, getByteString )+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BSI+import Foreign ( Ptr, pokeElemOff, peekElemOff, plusPtr+               , withForeignPtr ) -data Image = Image Size (PixelData Word8)+data Image = Image !Int !Int !BS.ByteString -bitmapLoad :: String -> IO Image+bitmapLoad :: FilePath -> IO (Maybe Image) bitmapLoad f = do-  handle <- openBinaryFile f ReadMode-  hSeek handle RelativeSeek 18-  width <- readInt handle-  putStrLn ("Width of "++f++": "++show width)-  height <- readInt handle-  putStrLn ("Height of "++f++": "++show height)-  planes <- readShort handle-  bpp <- readShort handle-  size <- return (width*height*(fromIntegral bpp `div` 8))-  hSeek handle RelativeSeek 24-  putStrLn ("Planes = "++(show planes))-  bgrBytes <- (readBytes handle (fromIntegral size) :: IO (Ptr Word8))-  rgbBytes <- bgr2rgb bgrBytes (fromIntegral size)-  return (Image (Size (fromIntegral width) (fromIntegral height))-          (PixelData RGB UnsignedByte rgbBytes))--endian :: Endian-endian = let r = unsafePerformIO (-                 do w <- allocaBytes 4 (\p -> do pokeElemOff p 0 (0::Word8)-                                                 pokeElemOff p 1 (1::Word8)-                                                 pokeElemOff p 2 (2::Word8)-                                                 pokeElemOff p 3 (3::Word8)-                                                 peek (castPtr p) :: IO Int32)-                    return w)-         in case r of 50462976 -> LittleEndian-                      66051    -> BigEndian-                      _        -> undefined--bgr2rgb :: Ptr Word8 -> Int -> IO (Ptr Word8)-bgr2rgb p n = mapM_ (\i -> do b <- peekElemOff p (i+0)-                              g <- peekElemOff p (i+1)-                              r <- peekElemOff p (i+2)-                              pokeElemOff p (i+0) r-                              pokeElemOff p (i+1) g-                              pokeElemOff p (i+2) b) [0,3..n-3] -              >> return p-                  --- This is only needed if you're on PowerPC instead of x86--- if you are on x86 use the following:--- reverseBytes p _ = return p-reverseBytes :: Ptr Word8 -> Int -> IO (Ptr Word8)-reverseBytes p n | endian == BigEndian = -                   do p' <- mallocBytes n-                      mapM_ (\i -> peekElemOff p i >>= pokeElemOff p' (n-i-1)) -                            [0..n-1]-                      return p'-                 | endian == LittleEndian = do p' <- mallocBytes n-                                               copyBytes p' p n-                                               return p'-reverseBytes _ _ = undefined-                            -readBytes :: Storable a => Handle -> Int -> IO (Ptr a)-readBytes h n = do p <- mallocBytes n-                   hGetBuf h p n-                   return p--readShort :: Handle -> IO Word16-readShort h = do p <- readBytes h 2 :: IO (Ptr Word8)-                 p' <- reverseBytes (castPtr p) 2-                 free p-                 r <- peek (castPtr p')-                 free p'-                 return r+  bs <- BS.readFile f+  case runGet getBitmap bs of+    Left  err -> putStrLn err >> return Nothing+    Right i@(Image _ _ bytes) -> do+      let (ptr, offset, len) = BSI.toForeignPtr bytes+      withForeignPtr ptr $ bgr2rgb len offset+      return $! Just i -readInt :: Handle -> IO Int32-readInt h = do p <- readBytes h 4 :: IO (Ptr Word8)-               p' <- reverseBytes (castPtr p) 4-               free p-               r <- peek (castPtr p')-               free p'-               return r+-- | Returns a bitmap in bgr format.+getBitmap :: Get Image+getBitmap = do+  skip 18+  width   <- getWord32le+  height  <- getWord32le+  _planes <- getWord16le+  bpp     <- getWord16le+  let size = fromIntegral $+              width * height * (fromIntegral (bpp `div` 8) :: Word32) :: Int+  skip 24+  bgrBytes <- getByteString size+  return $! Image (fromIntegral width)+                  (fromIntegral height)+                  bgrBytes +bgr2rgb :: Int -> Int -> Ptr Word8 -> IO ()+bgr2rgb n o p = do+  mapM_ (\i -> do+    b <- peekElemOff p' (i+0)+    r <- peekElemOff p' (i+2)+    pokeElemOff p' (i+0) (r::Word8)+    pokeElemOff p' (i+2) (b::Word8))+    [0,3..n-3]+  where+  p' = p `plusPtr` o

@@ -4,77 +4,85 @@  module Main where -import Graphics.UI.GLUT+-- 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.Concurrent ( threadDelay )+import Control.Monad ( forever )  initGL :: IO () initGL = do-  clearColor $= Color4 0 0 0 0 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0--  flush -- finally, we tell opengl to do it.+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view-  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  swapBuffers-  flush+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity  -- reset view+  glFlush -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = do threadDelay 100-                                      return ()+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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize -     -- select type of display mode:-     -- Double buffer-     -- RGBA color-     -- Alpha components supported-     -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]+     True <- GLFW.initialize       -- get a 640 x 480 window-     initialWindowSize $= Size 640 480+     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-     initialWindowPosition $= Position 0 0+     GLFW.setWindowPosition 0 0      -- open a window-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+     GLFW.setWindowTitle "Jeff Molofee's GL Code Tutorial ... NeHe '99"      -- register the function to do all our OpenGL drawing-     displayCallback $= drawScene-     -- go fullscreen. This is as soon as possible.-     fullScreen+     GLFW.setWindowRefreshCallback drawScene      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed-     -- initialize our window.+     GLFW.setKeyCallback keyPressed+     -- register window close handler+     GLFW.setWindowCloseCallback shutdown      initGL      -- start event processing engine-     mainLoop+     forever $ do+       drawScene+       GLFW.swapBuffers

@@ -4,93 +4,107 @@  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-  clearColor $= Color4 0 0 0 0 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0--  flush -- finally, we tell opengl to do it.+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  -- clear the screen and the depth bufer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity -- reset view -  translate (Vector3 (-1.5) 0 (-6.0::GLfloat)) --Move left 1.5 Units and into the screen 6.0+  glTranslatef (-1.5) 0 (-6.0) --Move left 1.5 Units and into the screen 6.0      -- draw a triangle-  renderPrimitive Polygon $  -- start drawing a polygon-    do-       vertex (Vertex3  0      1  (0::GLfloat))  -- top-       vertex (Vertex3  1   (-1)  (0::GLfloat))  -- bottom right-       vertex (Vertex3 (-1) (-1)  (0::GLfloat))  -- bottom left+  glBegin gl_TRIANGLES+  glVertex3f 0      1  0 -- top+  glVertex3f 1    (-1) 0 -- bottom right+  glVertex3f (-1) (-1) 0 -- bottom left+  glEnd -  translate (Vector3 3 0 (0::GLfloat))  -- move right three units-  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do-       vertex (Vertex3 (-1)    1  (0::GLfloat))  -- top left-       vertex (Vertex3  1      1  (0::GLfloat))  -- top right-       vertex (Vertex3  1   (-1)  (0::GLfloat))  -- bottom right-       vertex (Vertex3 (-1) (-1)  (0::GLfloat))  -- bottom left+  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   -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  swapBuffers-  flush+  glFlush -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = return ()+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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     True <- GLFW.initialize      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get a 640 x 480 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+     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-     displayCallback $= drawScene-     -- go fullscreen. This is as soon as possible.-     fullScreen+     GLFW.setWindowRefreshCallback drawScene      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed+     GLFW.setKeyCallback keyPressed+     GLFW.setWindowCloseCallback shutdown      -- initialize our window.      initGL      -- start event processing engine-     mainLoop+     forever $ do+       drawScene+       GLFW.swapBuffers

@@ -4,98 +4,111 @@  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-  clearColor $= Color4 0 0 0 0 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0--  flush -- finally, we tell opengl to do it.+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity -- reset view -  translate (Vector3 (-1.5) 0 (-6.0::GLfloat)) --Move left 1.5 Units and into the screen 6.0+  glTranslatef (-1.5) 0 (-6.0) --Move left 1.5 Units and into the screen 6.0      -- draw a triangle (in smooth coloring mode)-  renderPrimitive Polygon $  -- start drawing a polygon-    do-       color  (Color3 1 0 (0::GLfloat))          -- set The color to Red-       vertex (Vertex3  0      1  (0::GLfloat))  -- top-       color  (Color3 0 1 (0::GLfloat))          -- set The color to Green-       vertex (Vertex3  1   (-1)  (0::GLfloat))  -- bottom right-       color  (Color3 0 0 (1::GLfloat))          -- set The color to Blue-       vertex (Vertex3 (-1) (-1)  (0::GLfloat))  -- bottom left+  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 -  translate (Vector3 3 0 (0::GLfloat))  -- move right three units+  glTranslatef 3 0 0  -- move right three units -  color (Color3 0.5 0.5 (1::GLfloat))  -- set color to a blue shade-  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do-       vertex (Vertex3 (-1)    1  (0::GLfloat))  -- top left-       vertex (Vertex3  1      1  (0::GLfloat))  -- top right-       vertex (Vertex3  1   (-1)  (0::GLfloat))  -- bottom right-       vertex (Vertex3 (-1) (-1)  (0::GLfloat))  -- bottom left+  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   -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  swapBuffers-  flush+  glFlush -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = return ()+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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     True <- GLFW.initialize      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get a 640 x 480 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+     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-     displayCallback $= drawScene-     -- go fullscreen. This is as soon as possible.-     fullScreen+     GLFW.setWindowRefreshCallback drawScene      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed+     GLFW.setKeyCallback keyPressed+     GLFW.setWindowCloseCallback shutdown      -- initialize our window.      initGL      -- start event processing engine-     mainLoop+     forever $ do+      drawScene+      GLFW.swapBuffers

@@ -4,114 +4,127 @@  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 Data.IORef ( IORef, newIORef )+import Control.Monad ( forever )+import Data.IORef ( IORef, newIORef, readIORef, writeIORef )  increment :: GLfloat increment = 1.5  initGL :: IO () initGL = do-  clearColor $= Color4 0 0 0 0 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0--  flush -- finally, we tell opengl to do it.+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity -- reset view -  translate (Vector3 (-1.5) 0 (-6.0::GLfloat)) --Move left 1.5 Units and into the screen 6.0-  rt <- get rtri-  rotate rt (Vector3 0 1 (0::GLfloat)) -- Rotate the triangle on the Y axis+  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)-  renderPrimitive Polygon $  -- start drawing a polygon-    do-       color  (Color3 1 0 (0::GLfloat))          -- set The color to Red-       vertex (Vertex3  0      1  (0::GLfloat))  -- top-       color  (Color3 0 1 (0::GLfloat))          -- set The color to Green-       vertex (Vertex3  1   (-1)  (0::GLfloat))  -- bottom right-       color  (Color3 0 0 (1::GLfloat))          -- set The color to Blue-       vertex (Vertex3 (-1) (-1)  (0::GLfloat))  -- bottom left+  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 -  loadIdentity-  translate (Vector3 1.5 0 (-6::GLfloat))  -- move right three units-  rq <- get rquad-  rotate rq (Vector3 1 0 (0::GLfloat)) -- rotate the quad on the x axis+  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 -  color (Color3 0.5 0.5 (1::GLfloat))  -- set color to a blue shade-  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do-       vertex (Vertex3 (-1)    1  (0::GLfloat))  -- top left-       vertex (Vertex3  1      1  (0::GLfloat))  -- top right-       vertex (Vertex3  1   (-1)  (0::GLfloat))  -- bottom right-       vertex (Vertex3 (-1) (-1)  (0::GLfloat))  -- bottom left-  -  rtri  $= rt + increment --increase the rotation angle for the triangle-  rquad $= rq + increment --increase the rotation angle for the quad+  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 -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  swapBuffers-  flush+  glFlush -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = return ()+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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     True <- GLFW.initialize      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get a 640 x 480 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+     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-     displayCallback $= (drawScene rt rq)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene rt rq)+     GLFW.setWindowRefreshCallback (drawScene rt rq)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed+     GLFW.setKeyCallback keyPressed+     GLFW.setWindowCloseCallback shutdown      -- initialize our window.      initGL      -- start event processing engine-     mainLoop+     forever $ do+       drawScene rt rq+       GLFW.swapBuffers

@@ -4,9 +4,14 @@  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 Data.IORef ( IORef, newIORef )+import Control.Monad ( forever )+import Data.IORef ( IORef, newIORef, readIORef, writeIORef )  tincrement, qincrement :: GLfloat tincrement = 0.2@@ -14,157 +19,166 @@  initGL :: IO () initGL = do-  clearColor $= Color4 0 0 0 0 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0--  flush -- finally, we tell opengl to do it.+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity  -- reset view -  translate (Vector3 (-1.5) 0 (-6.0::GLfloat)) --Move left 1.5 Units and into the screen 6.0-  rt <- get rtri-  rotate rt (Vector3 0 1 (0::GLfloat)) -- Rotate the triangle on the Y axis+  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)-  renderPrimitive Triangles $  -- start drawing a polygon-    do -- first the front-       color  (Color3 1 0 (0::GLfloat))          -- set The color to Red-       vertex (Vertex3  0      1  (0::GLfloat))  -- top of triangle (front)-       color  (Color3 0 1 (0::GLfloat))          -- set The color to Green-       vertex (Vertex3 (-1) (-1)  (1::GLfloat))  -- left of triangle (front)-       color  (Color3 0 0 (1::GLfloat))          -- set The color to Blue-       vertex (Vertex3  1   (-1)  (1::GLfloat))  -- right of triangle (front)-       -- now the right-       color  (Color3 1 0 (0::GLfloat))          -- set The color to Red-       vertex (Vertex3  0      1  (0::GLfloat))  -- top of triangle (right)-       color  (Color3 0 0 (1::GLfloat))          -- set The color to Blue-       vertex (Vertex3  1   (-1)  (1::GLfloat))  -- left of triangle (right)-       color  (Color3 0 1 (0::GLfloat))          -- set The color to Green-       vertex (Vertex3  1  (-1)  (-1::GLfloat))  -- right of triangle (front)-       -- now the back-       color  (Color3 1 0 (0::GLfloat))          -- set The color to Red-       vertex (Vertex3  0      1  (0::GLfloat))  -- top of triangle (back)-       color  (Color3 0 1 (0::GLfloat))          -- set The color to Green-       vertex (Vertex3  1 (-1)   (-1::GLfloat))  -- left of triangle (back)-       color  (Color3 0 0 (1::GLfloat))          -- set The color to Blue-       vertex (Vertex3 (-1) (-1) (-1::GLfloat))  -- right of triangle (back)-       -- now the left-       color  (Color3 1 0 (0::GLfloat))          -- set The color to Red-       vertex (Vertex3  0      1  (0::GLfloat))  -- top of triangle (left)-       color  (Color3 0 0 (1::GLfloat))          -- set The color to Blue-       vertex (Vertex3 (-1) (-1) (-1::GLfloat))  -- left of triangle (left)-       color  (Color3 0 1 (0::GLfloat))          -- set The color to Green-       vertex (Vertex3 (-1) (-1)  (1::GLfloat))  -- right of triangle (left)-+  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        -  loadIdentity-  translate (Vector3 1.5 0 (-7::GLfloat))  -- move right three units-  rq <- get rquad-  rotate rq (Vector3 1 1 (1::GLfloat)) -- rotate the quad on the x axis+  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 -  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do -- first the top-       color (Color3 0 1 (0::GLfloat))  -- set color to green-       vertex (Vertex3  1    1   (-1::GLfloat))  -- top right of quad (Top)-       vertex (Vertex3 (-1)  1   (-1::GLfloat))  -- top left of quad (Top)-       vertex (Vertex3 (-1)  1    (1::GLfloat))  -- bottom left of quad (Top)-       vertex (Vertex3  1    1    (1::GLfloat))  -- bottom right of quad (Top)-       -- now the bottom-       color (Color3 1 0.5 (0::GLfloat))  -- set color to orage-       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- top right of quad (Bottom)-       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- top left of quad (Bottom)-       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Bottom)-       vertex (Vertex3  1   (-1)  (-1::GLfloat))  -- bottom right of quad (Bottom)-       -- now the front-       color (Color3 1 0 (0::GLfloat))  -- set color to red-       vertex (Vertex3  1      1   (1::GLfloat))  -- top right of quad (Bottom)-       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top left of quad (Bottom)-       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom left of quad (Bottom)-       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- bottom right of quad (Bottom)-       -- now the back-       color (Color3 1 1 (0::GLfloat))  -- set color to yellow-       vertex (Vertex3    1 (-1)  (-1::GLfloat))  -- bottom left of quad (Back)-       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom right of quad (Back)-       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top right of quad (Back)-       vertex (Vertex3    1    1  (-1::GLfloat))  -- top left of quad (Back)-       -- now the left-       color (Color3 0 0 (1::GLfloat))  -- set color to blue-       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top right of quad (Left)-       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top left of quad (Left)-       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Left)-       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom right of quad (Left)-       -- now the right-       color (Color3 1 0 (1::GLfloat))  -- set color to violet-       vertex (Vertex3 1    1  (-1::GLfloat))  -- top right of quad (Right)-       vertex (Vertex3 1    1   (1::GLfloat))  -- top left of quad (Right)-       vertex (Vertex3 1 (-1)   (1::GLfloat))  -- bottom left of quad (Right)-       vertex (Vertex3 1 (-1)  (-1::GLfloat))  -- bottom right of quad (Right)+  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   -  rtri  $= rt + tincrement --increase the rotation angle for the triangle-  rquad $= rq + qincrement --increase the rotation angle for the quad+  --increase the rotation angle for the triangle+  writeIORef rtri  $! rt + tincrement+  --increase the rotation angle for the quad+  writeIORef rquad $! rq + qincrement -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  swapBuffers-  flush+  glFlush -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = return ()+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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     True <- GLFW.initialize      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get a 640 x 480 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+     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-     displayCallback $= (drawScene rt rq)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene rt rq)+     GLFW.setWindowRefreshCallback (drawScene rt rq)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed+     GLFW.setKeyCallback keyPressed+     GLFW.setWindowCloseCallback shutdown      -- initialize our window.      initGL      -- start event processing engine-     mainLoop+     forever $ do+       drawScene rt rq+       GLFW.swapBuffers

@@ -4,169 +4,195 @@  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 Monad ( liftM )-import Data.IORef ( IORef, newIORef )+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 System.Directory ( getCurrentDirectory, setCurrentDirectory ) import Util ( Image(..), bitmapLoad ) -initGL :: IO TextureObject+initGL :: IO GLuint initGL = do-  tex <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0--  flush -- finally, we tell opengl to do it.-  return tex+  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 TextureObject+loadGLTextures :: IO GLuint loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/NeHe.bmp"-  texName <- liftM head (genObjectNames 1)-  textureBinding Texture2D $= Just texName-  textureFilter  Texture2D $= ((Nearest, Nothing), Nearest)-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  return texName+  Just (Image w h pd) <- bitmapLoad "Data/NeHe.bmp"+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 :: TextureObject -> IORef GLfloat -> IORef GLfloat -             -> IORef GLfloat -> IO ()+drawScene :: GLuint -> IORef GLfloat -> IORef GLfloat +          -> IORef GLfloat -> IO () drawScene tex xrot yrot zrot = do-  clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity -- reset view -  translate (Vector3 0 0 (-5.0::GLfloat)) --Move left 5 Units into the screen+  glTranslatef 0 0 (-5.0) --Move left 5 Units into the screen -  xr <- get xrot-  yr <- get yrot-  zr <- get zrot-  rotate xr (Vector3 1 0 (0::GLfloat)) -- Rotate the triangle on the Y axis-  rotate yr (Vector3 0 1 (0::GLfloat)) -- Rotate the triangle on the Y axis-  rotate zr (Vector3 0 0 (1::GLfloat)) -- Rotate the triangle on the Y axis+  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 -  textureBinding Texture2D $= Just tex-  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do -       -- first the front-       texCoord (TexCoord2 0 (0::GLfloat)) -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom left of quad (Front)-       texCoord (TexCoord2 1 (0::GLfloat)) -       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- bottom right of quad (Front)-       texCoord (TexCoord2 1 (1::GLfloat)) -       vertex (Vertex3  1      1   (1::GLfloat))  -- top right of quad (Front)-       texCoord (TexCoord2 0 (1::GLfloat)) -       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top left of quad (Front)-       -- now the back-       texCoord (TexCoord2 1 (0::GLfloat)) -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom right of quad (Back)-       texCoord (TexCoord2 1 (1::GLfloat)) -       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top right of quad (Back)-       texCoord (TexCoord2 0 (1::GLfloat)) -       vertex (Vertex3    1    1  (-1::GLfloat))  -- top left of quad (Back)-       texCoord (TexCoord2 0 (0::GLfloat)) -       vertex (Vertex3    1 (-1)  (-1::GLfloat))  -- bottom left of quad (Back)-       -- now the top-       texCoord (TexCoord2 0 (1::GLfloat))-       vertex (Vertex3 (-1)  1   (-1::GLfloat))  -- top left of quad (Top)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1)  1    (1::GLfloat))  -- bottom left of quad (Top)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3  1    1    (1::GLfloat))  -- bottom right of quad (Top)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3  1    1   (-1::GLfloat))  -- top right of quad (Top)-       -- now the bottom-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- top right of quad (Bottom)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- top left of quad (Bottom)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Bottom)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3  1   (-1)  (-1::GLfloat))  -- bottom right of quad (Bottom)-       -- now the right-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3 1 (-1)  (-1::GLfloat))  -- bottom right of quad (Right)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3 1    1  (-1::GLfloat))  -- top right of quad (Right)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 1    1   (1::GLfloat))  -- top left of quad (Right)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 1 (-1)   (1::GLfloat))  -- bottom left of quad (Right)-       -- now the left-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Left)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top left of quad (Left)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top right of quad (Left)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom right of quad (Left)+  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)   -  xrot $= xr + 0.3-  yrot $= yr + 0.2-  zrot $= zr + 0.4+  glEnd+  +  writeIORef xrot $! xr + 0.3+  writeIORef yrot $! yr + 0.2+  writeIORef zrot $! zr + 0.4 -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  glFlush +shutdown :: GLFW.WindowCloseCallback+shutdown = do+  GLFW.closeWindow+  GLFW.terminate+  _ <- exitWith ExitSuccess+  return True -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = return ()+keyPressed :: GLFW.KeyCallback+keyPressed GLFW.KeyEsc True = shutdown >> return ()+keyPressed _           _    = return ()  main :: IO () main = do-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+     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-     -- initialize our window.-     tex <- initGL-     displayCallback $= (drawScene tex xrot yrot zrot)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene tex xrot yrot zrot)+     tex  <- initGL+     GLFW.setWindowRefreshCallback (drawScene tex xrot yrot zrot)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed+     GLFW.setKeyCallback keyPressed+     GLFW.setWindowCloseCallback shutdown+     -- initialize our window.      -- start event processing engine-     mainLoop+     forever $ do+       drawScene tex xrot yrot zrot+       GLFW.swapBuffers

@@ -4,218 +4,274 @@  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, gluBuild2DMipmaps )+import Data.Bits ( (.|.) ) import System.Exit ( exitWith, ExitCode(..) )-import Data.IORef ( IORef, newIORef, writeIORef )+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 System.Directory ( getCurrentDirectory, setCurrentDirectory ) import Util ( Image(..), bitmapLoad ) -lightAmbient :: Color4 GLfloat-lightAmbient = Color4 0.5 0.5 0.5 1.0-lightDiffuse :: Color4 GLfloat-lightDiffuse = Color4 1.0 1.0 1.0 1.0-lightPosition :: Vertex4 GLfloat-lightPosition = Vertex4 0.0 0.0 2.0 1.0+newArray' :: Storable a => [a] -> IO (ForeignPtr a)+newArray' xs = (newArray xs) >>= newForeignPtr_ -initGL :: IO [TextureObject]+glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO ()+glLightfv' l a fp =+  withForeignPtr fp $ glLightfv l a++initGL :: IO [GLuint] initGL = do-  texs <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  hint PerspectiveCorrection $= Nicest-  ambient (Light 1) $= lightAmbient-  diffuse (Light 1) $= lightDiffuse-  position (Light 1) $= lightPosition-  light (Light 1) $= Enabled-  lighting $= Enabled-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0-  flush -- finally, we tell opengl to do it.-  return texs+  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 [TextureObject]+loadGLTextures :: IO [GLuint] loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/Crate.bmp"-  texNames <- genObjectNames 3-  -- create nearest filtered texture-  textureBinding Texture2D $= Just (texNames !! 0)-  textureFilter  Texture2D $= ((Nearest, Nothing), Nearest)-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  -- create linear filtered texture-  textureBinding Texture2D $= Just (texNames !! 1)-  textureFilter  Texture2D $= ((Linear', Nothing), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  -- create mipmap filtered texture-  textureBinding Texture2D $= Just (texNames !! 2)-  textureFilter  Texture2D $= ((Linear', Just Nearest), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  build2DMipmaps Texture2D RGB' w h pd-  return texNames+  Just (Image w h pd) <- bitmapLoad "Data/Crate.bmp"+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 :: [TextureObject] -> IORef GLfloat -> IORef GLfloat-             -> IORef GLfloat -> IORef GLfloat -> IORef GLfloat -             -> IORef Int -> IO ()+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view-  zd <- get zdepth-  translate (Vector3 0 0 (zd::GLfloat)) --Move left 5 Units into the screen+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity -- reset view -  xr <- get xrot-  yr <- get yrot-  rotate xr (Vector3 1 0 (0::GLfloat)) -- Rotate the triangle on the Y axis-  rotate yr (Vector3 0 1 (0::GLfloat)) -- Rotate the triangle on the Y axis-  f <- get filt-  textureBinding Texture2D $= Just (texs!!f)-  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do -       -- first the front-       normal (Normal3 0.0 0.0 (1.0::GLfloat))-       texCoord (TexCoord2 0 (0::GLfloat)) -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom left of quad (Front)-       texCoord (TexCoord2 1 (0::GLfloat)) -       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- bottom right of quad (Front)-       texCoord (TexCoord2 1 (1::GLfloat)) -       vertex (Vertex3  1      1   (1::GLfloat))  -- top right of quad (Front)-       texCoord (TexCoord2 0 (1::GLfloat)) -       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top left of quad (Front)-       -- now the back-       normal (Normal3 0.0 0.0 (-1.0::GLfloat))-       texCoord (TexCoord2 1 (0::GLfloat)) -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom right of quad (Back)-       texCoord (TexCoord2 1 (1::GLfloat)) -       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top right of quad (Back)-       texCoord (TexCoord2 0 (1::GLfloat)) -       vertex (Vertex3    1    1  (-1::GLfloat))  -- top left of quad (Back)-       texCoord (TexCoord2 0 (0::GLfloat)) -       vertex (Vertex3    1 (-1)  (-1::GLfloat))  -- bottom left of quad (Back)-       -- now the top-       normal (Normal3 0.0 1.0 (0.0::GLfloat))-       texCoord (TexCoord2 0 (1::GLfloat))-       vertex (Vertex3 (-1)  1   (-1::GLfloat))  -- top left of quad (Top)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1)  1    (1::GLfloat))  -- bottom left of quad (Top)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3  1    1    (1::GLfloat))  -- bottom right of quad (Top)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3  1    1   (-1::GLfloat))  -- top right of quad (Top)-       -- now the bottom-       normal (Normal3 0.0 (-1.0) (0.0::GLfloat))-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- top right of quad (Bottom)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- top left of quad (Bottom)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Bottom)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3  1   (-1)  (-1::GLfloat))  -- bottom right of quad (Bottom)-       -- now the right-       normal (Normal3 1.0 0.0 (0.0::GLfloat))-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3 1 (-1)  (-1::GLfloat))  -- bottom right of quad (Right)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3 1    1  (-1::GLfloat))  -- top right of quad (Right)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 1    1   (1::GLfloat))  -- top left of quad (Right)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 1 (-1)   (1::GLfloat))  -- bottom left of quad (Right)-       -- now the left-       normal (Normal3 (-1.0) 0.0 (1.0::GLfloat))-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Left)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top left of quad (Left)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top right of quad (Left)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom right of quad (Left)-  xsp <- get xspeed-  ysp <- get yspeed  -  xrot $= xr + xsp-  yrot $= yr + ysp-  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  glTranslatef 0 0 (-5.0) --Move left 5 Units into the screen -keyPressed :: IORef Int -> IORef GLfloat -> IORef GLfloat ->-              IORef GLfloat -> KeyboardMouseCallback--- 27 is ESCAPE-keyPressed _ _ _ _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _ _ _ _ (Char 'L') Down   _ _ = do l <- get lighting -                                              if l == Enabled -                                                 then lighting $= Disabled-                                                 else lighting $= Enabled-                                              return ()-keyPressed filt _ _ _ (Char 'F') Down  _  _ = -  get filt >>= writeIORef filt . (flip mod 3) . (+1)-keyPressed f zd xs ys (Char 'l') d x y = keyPressed f zd xs ys (Char 'L') d x y-keyPressed f zd xs ys (Char 'f') d x y = keyPressed f zd xs ys (Char 'F') d x y-keyPressed _ zdepth _ _ (SpecialKey KeyPageUp) Down _ _ = -  get zdepth >>= writeIORef zdepth . (subtract 0.2)-keyPressed _ zdepth _ _ (SpecialKey KeyPageDown) Down _ _ = -  get zdepth >>= writeIORef zdepth . (+0.2)-keyPressed _ _ xspeed _ (SpecialKey KeyUp) Down _ _ = -  get xspeed >>= writeIORef xspeed . (subtract 0.1)          -keyPressed _ _ xspeed _ (SpecialKey KeyDown) Down _ _ = -  get xspeed >>= writeIORef xspeed . (+ 0.1)-keyPressed _ _ _ yspeed (SpecialKey KeyRight) Down _ _ = do -  get yspeed >>= writeIORef yspeed . (+ 0.1)-keyPressed _ _ _ yspeed (SpecialKey KeyLeft) Down _ _ = do-  get yspeed >>= writeIORef yspeed . (subtract 0.1)-keyPressed _ _ _ _      _       _    _ _ = return ()+  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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"-     -- register the function to do all our OpenGL drawing-     xrot <- newIORef (0::GLfloat)-     yrot <- newIORef (0::GLfloat)-     xspeed <- newIORef (0::GLfloat)-     yspeed <- newIORef (0::GLfloat)-     zdepth <- newIORef (-5.0 :: GLfloat)-     filt <- newIORef 0+     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-     displayCallback $= (drawScene texs xrot yrot xspeed yspeed zdepth filt)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene texs xrot yrot xspeed yspeed zdepth filt)+     GLFW.setWindowRefreshCallback+       (drawScene texs xrot yrot xspeed yspeed zdepth filt)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just (keyPressed filt zdepth xspeed yspeed)-     -- start event processing engine-     mainLoop+     GLFW.setKeyCallback (keyPressed lighting filt zdepth xspeed yspeed)+     GLFW.setWindowCloseCallback shutdown+     forever $ do+       drawScene texs xrot yrot xspeed yspeed zdepth filt+       GLFW.swapBuffers

@@ -4,229 +4,285 @@  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, gluBuild2DMipmaps )+import Data.Bits ( (.|.) ) import System.Exit ( exitWith, ExitCode(..) )-import Data.IORef ( IORef, newIORef, writeIORef )+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 System.Directory ( getCurrentDirectory, setCurrentDirectory ) import Util ( Image(..), bitmapLoad ) -lightAmbient :: Color4 GLfloat-lightAmbient = Color4 0.5 0.5 0.5 1.0-lightDiffuse :: Color4 GLfloat-lightDiffuse = Color4 1.0 1.0 1.0 1.0-lightPosition :: Vertex4 GLfloat-lightPosition = Vertex4 0.0 0.0 2.0 1.0+newArray' :: Storable a => [a] -> IO (ForeignPtr a)+newArray' xs = (newArray xs) >>= newForeignPtr_ -initGL :: IO [TextureObject]-initGL = do-  texs <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc $= Nothing-  blend $= Enabled-  hint PerspectiveCorrection $= Nicest-  ambient (Light 1) $= lightAmbient-  diffuse (Light 1) $= lightDiffuse-  position (Light 1) $= lightPosition-  light (Light 1) $= Enabled-  lighting $= Enabled-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0+glLightfv' :: GLenum -> GLenum -> ForeignPtr GLfloat -> IO ()+glLightfv' l a fp =+  withForeignPtr fp $ glLightfv l a -  color (Color4 1 1 1 (0.5::GLfloat))-  blendFunc $= (SrcAlpha, One)-  flush -- finally, we tell opengl to do it.-  return texs+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 [TextureObject]+loadGLTextures :: IO [GLuint] loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/glass.bmp"-  texNames <- genObjectNames 3-  -- create nearest filtered texture-  textureBinding Texture2D $= Just (texNames !! 0)-  textureFilter  Texture2D $= ((Nearest, Nothing), Nearest)-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  -- create linear filtered texture-  textureBinding Texture2D $= Just (texNames !! 1)-  textureFilter  Texture2D $= ((Linear', Nothing), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  -- create mipmap filtered texture-  textureBinding Texture2D $= Just (texNames !! 2)-  textureFilter  Texture2D $= ((Linear', Just Nearest), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  build2DMipmaps Texture2D RGB' w h pd-  return texNames+  Just (Image w h pd) <- bitmapLoad "Data/glass.bmp"+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 :: [TextureObject] -> IORef GLfloat -> IORef GLfloat-             -> IORef GLfloat -> IORef GLfloat -> IORef GLfloat-             -> IORef Int -> IO ()+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 [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view-  zd <- get zdepth-  translate (Vector3 0 0 (zd::GLfloat)) --Move left 5 Units into the screen+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glLoadIdentity -- reset view -  xr <- get xrot-  yr <- get yrot-  rotate xr (Vector3 1 0 (0::GLfloat)) -- Rotate the triangle on the Y axis-  rotate yr (Vector3 0 1 (0::GLfloat)) -- Rotate the triangle on the Y axis-  f <- get filt-  textureBinding Texture2D $= Just (texs!!f)-  renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    do -       -- first the front-       normal (Normal3 0.0 0.0 (1.0::GLfloat))-       texCoord (TexCoord2 0 (0::GLfloat)) -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom left of quad (Front)-       texCoord (TexCoord2 1 (0::GLfloat)) -       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- bottom right of quad (Front)-       texCoord (TexCoord2 1 (1::GLfloat)) -       vertex (Vertex3  1      1   (1::GLfloat))  -- top right of quad (Front)-       texCoord (TexCoord2 0 (1::GLfloat)) -       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top left of quad (Front)-       -- now the back-       normal (Normal3 0.0 0.0 (-1.0::GLfloat))-       texCoord (TexCoord2 1 (0::GLfloat)) -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom right of quad (Back)-       texCoord (TexCoord2 1 (1::GLfloat)) -       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top right of quad (Back)-       texCoord (TexCoord2 0 (1::GLfloat)) -       vertex (Vertex3    1    1  (-1::GLfloat))  -- top left of quad (Back)-       texCoord (TexCoord2 0 (0::GLfloat)) -       vertex (Vertex3    1 (-1)  (-1::GLfloat))  -- bottom left of quad (Back)-       -- now the top-       normal (Normal3 0.0 1.0 (0.0::GLfloat))-       texCoord (TexCoord2 0 (1::GLfloat))-       vertex (Vertex3 (-1)  1   (-1::GLfloat))  -- top left of quad (Top)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1)  1    (1::GLfloat))  -- bottom left of quad (Top)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3  1    1    (1::GLfloat))  -- bottom right of quad (Top)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3  1    1   (-1::GLfloat))  -- top right of quad (Top)-       -- now the bottom-       normal (Normal3 0.0 (-1.0) (0.0::GLfloat))-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3  1   (-1)   (1::GLfloat))  -- top right of quad (Bottom)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- top left of quad (Bottom)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Bottom)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3  1   (-1)  (-1::GLfloat))  -- bottom right of quad (Bottom)-       -- now the right-       normal (Normal3 1.0 0.0 (0.0::GLfloat))-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3 1 (-1)  (-1::GLfloat))  -- bottom right of quad (Right)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3 1    1  (-1::GLfloat))  -- top right of quad (Right)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 1    1   (1::GLfloat))  -- top left of quad (Right)-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 1 (-1)   (1::GLfloat))  -- bottom left of quad (Right)-       -- now the left-       normal (Normal3 (-1.0) 0.0 (1.0::GLfloat))-       texCoord (TexCoord2 0 (0::GLfloat))  -       vertex (Vertex3 (-1) (-1)  (-1::GLfloat))  -- bottom left of quad (Left)-       texCoord (TexCoord2 1 (0::GLfloat))  -       vertex (Vertex3 (-1)    1  (-1::GLfloat))  -- top left of quad (Left)-       texCoord (TexCoord2 1 (1::GLfloat))  -       vertex (Vertex3 (-1)    1   (1::GLfloat))  -- top right of quad (Left)-       texCoord (TexCoord2 0 (1::GLfloat))  -       vertex (Vertex3 (-1) (-1)   (1::GLfloat))  -- bottom right of quad (Left)-  xsp <- get xspeed-  ysp <- get yspeed  -  xrot $= xr + xsp-  yrot $= yr + ysp-  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  glTranslatef 0 0 (-5.0) --Move left 5 Units into the screen -keyPressed :: IORef Int -> IORef GLfloat -> IORef GLfloat ->-              IORef GLfloat -> KeyboardMouseCallback--- 27 is ESCAPE-keyPressed _ _ _ _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _ _ _ _ (Char 'L') Down   _ _ = do l <- get lighting -                                              if l == Enabled -                                                 then lighting $= Disabled-                                                 else lighting $= Enabled-                                              return ()-keyPressed filt _ _ _ (Char 'F') Down  _  _ = -  get filt >>= writeIORef filt . (flip mod 3) . (+1)-keyPressed _ _ _ _ (Char 'B') Down _ _ = do-  b <- get blend-  if b == Enabled -     then blend $= Disabled >> depthFunc $= Just Less-     else blend $= Enabled >> depthFunc $= Nothing-  return ()-keyPressed f zd xs ys (Char 'l') d x y = keyPressed f zd xs ys (Char 'L') d x y-keyPressed f zd xs ys (Char 'f') d x y = keyPressed f zd xs ys (Char 'F') d x y-keyPressed f zd xs ys (Char 'b') d x y = keyPressed f zd xs ys (Char 'B') d x y-keyPressed _ zdepth _ _ (SpecialKey KeyPageUp) Down _ _ = -  get zdepth >>= writeIORef zdepth . (subtract 0.2)-keyPressed _ zdepth _ _ (SpecialKey KeyPageDown) Down _ _ = -  get zdepth >>= writeIORef zdepth . (+0.2)-keyPressed _ _ xspeed _ (SpecialKey KeyUp) Down _ _ = -  get xspeed >>= writeIORef xspeed . (subtract 0.1)          -keyPressed _ _ xspeed _ (SpecialKey KeyDown) Down _ _ = -  get xspeed >>= writeIORef xspeed . (+ 0.1)-keyPressed _ _ _ yspeed (SpecialKey KeyRight) Down _ _ = do -  get yspeed >>= writeIORef yspeed . (+ 0.1)-keyPressed _ _ _ yspeed (SpecialKey KeyLeft) Down _ _ = do-  get yspeed >>= writeIORef yspeed . (subtract 0.1)-keyPressed _ _ _ _     _       _    _ _ = return ()+  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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"-     -- register the function to do all our OpenGL drawing-     xrot <- newIORef (0::GLfloat)-     yrot <- newIORef (0::GLfloat)-     xspeed <- newIORef (0::GLfloat)-     yspeed <- newIORef (0::GLfloat)-     zdepth <- newIORef (-5.0 :: GLfloat)-     filt <- newIORef 0+     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-     displayCallback $= (drawScene texs xrot yrot xspeed yspeed zdepth filt)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene texs xrot yrot xspeed yspeed zdepth filt)+     GLFW.setWindowRefreshCallback+       (drawScene texs xrot yrot xspeed yspeed zdepth filt)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just (keyPressed filt zdepth xspeed yspeed)-     -- start event processing engine-     mainLoop+     GLFW.setKeyCallback $+       keyPressed lighting blending filt zdepth xspeed yspeed+     GLFW.setWindowCloseCallback shutdown+     forever $ do+       drawScene texs xrot yrot xspeed yspeed zdepth filt+       GLFW.swapBuffers

@@ -4,185 +4,227 @@  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 Data.IORef ( IORef, newIORef, writeIORef )+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 System.Directory ( getCurrentDirectory, setCurrentDirectory ) import Util ( Image(..), bitmapLoad )-import Monad ( when, liftM )-import Random+import System.Random ( getStdRandom, randomR ) -data Star = Star { starColor :: Color3 GLubyte, starDist, -                   starAngle :: GLfloat }+data Star = Star { starColor :: !(GLubyte, GLubyte, GLubyte)+                 , starDist  :: !GLfloat +                 , starAngle :: !GLfloat+                 }             deriving Show  numStars :: Num a => a numStars = 50 -initGL :: IO TextureObject-initGL = do-  tex <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Nothing -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  hint PerspectiveCorrection $= Nicest-  blendFunc $= (SrcAlpha, One)-  blend $= Enabled-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0+newArray' :: Storable a => [a] -> IO (ForeignPtr a)+newArray' xs = (newArray xs) >>= newForeignPtr_ -  flush -- finally, we tell opengl to do it.-  return tex+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 = mapM (\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 = Color3 (fromIntegral r) (fromIntegral g) (fromIntegral b), -                                               starDist  = (i/numStars)*5}))-                [0..numStars-1]+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 TextureObject+loadGLTextures :: IO GLuint loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/Star.bmp"-  texName <- liftM head (genObjectNames 1)-  textureBinding Texture2D $= Just texName-  textureFilter  Texture2D $= ((Linear', Nothing), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  return texName+  Just (Image w h pd) <- bitmapLoad "Data/Star.bmp"+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 -colorUpgrade :: Color3 a -> a -> Color4 a-colorUpgrade (Color3 r g b) a = Color4 r g b a+glColor4ub' :: (GLubyte, GLubyte, GLubyte) -> GLubyte -> IO ()+glColor4ub' (r,g,b) a = glColor4ub r g b a -drawScene :: TextureObject -> IORef GLfloat -> IORef GLfloat -> IORef Bool-             -> IORef GLfloat -> [IORef Star] -> IO ()+drawScene :: GLuint -> IORef GLfloat -> IORef GLfloat+          -> IORef Bool -> IORef GLfloat -> [IORef Star]+          -> IO () drawScene tex zoom tilt twinkle spin stars = do-  clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  textureBinding Texture2D $= Just tex+  -- clear the screen and the depth buffer+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT+  glBindTexture gl_TEXTURE_2D tex -  mapM_ ( \(st1, st2, i) -> -    do loadIdentity       -       s1 <- get st1-       s2 <- get st2-       sp <- get spin-       zo <- get zoom-       ti <- get tilt-       tw <- get twinkle-       translate (Vector3 0 0 (zo::GLfloat))-       rotate ti (Vector3 1 0 (0::GLfloat))-       rotate (starAngle s1) (Vector3 0 1 (0::GLfloat))-       translate (Vector3 (starDist s1) 0 (0::GLfloat))-       rotate (-(starAngle s1)) (Vector3 0 1 (0::GLfloat))-       rotate (-ti) (Vector3 1 0 (0::GLfloat))-       when tw $ -         do color (colorUpgrade (starColor s2) 255)-            renderPrimitive Quads $ -              do texCoord (TexCoord2 0 (0::GLfloat))-                 vertex (Vertex3 (-1) (-1) (0::GLfloat))-                 texCoord (TexCoord2 1 (0::GLfloat))-                 vertex (Vertex3 1 (-1) (0::GLfloat))-                 texCoord (TexCoord2 1 (1::GLfloat))-                 vertex (Vertex3 1 1 (0::GLfloat))-                 texCoord (TexCoord2 0 (1::GLfloat))-                 vertex (Vertex3 (-1) 1 (0::GLfloat))-       rotate sp (Vector3 0 0 (1::GLfloat))-       color (colorUpgrade (starColor s1) 255)-       renderPrimitive Quads $ -         do texCoord (TexCoord2 0 (0::GLfloat))-            vertex (Vertex3 (-1) (-1) (0::GLfloat))-            texCoord (TexCoord2 1 (0::GLfloat))-            vertex (Vertex3 1 (-1) (0::GLfloat))-            texCoord (TexCoord2 1 (1::GLfloat))-            vertex (Vertex3 1 1 (0::GLfloat))-            texCoord (TexCoord2 0 (1::GLfloat))-            vertex (Vertex3 (-1) 1 (0::GLfloat))-       spin $= sp + 0.01-       if starDist s1 < 0 -          then do d <- return ((starDist s1)+5)-                  r <- getStdRandom (randomR (0, 255)) :: IO Int-                  g <- getStdRandom (randomR (0, 255)) :: IO Int-                  b <- getStdRandom (randomR (0, 255)) :: IO Int-                  st1 $= Star { starAngle = (starAngle s1) + i/numStars,-                                starColor = Color3 (fromIntegral r) (fromIntegral g) (fromIntegral b),-                                starDist  = d }-          else do st1 $= Star { starAngle = (starAngle s1) + i/numStars,-                                starColor = (starColor s1),-                                starDist  = (starDist s1)-0.01 }) (zip3 stars (reverse stars) [0..numStars-1]) -- finally the second parameter to mapM_-  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  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 -keyPressed :: IORef Bool -> IORef GLfloat -> IORef GLfloat -              -> KeyboardMouseCallback--- 27 is ESCAPE-keyPressed _ _ _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed t _ _ (Char 'T') Down _  _ = do-  twinkle <- get t-  if twinkle-     then t $= False-     else t $= True-keyPressed tw zo ti (Char 't') Down x y = keyPressed tw zo ti (Char 'T') Down x y-keyPressed _ zoom _ (SpecialKey KeyPageUp) Down _ _ = -  get zoom >>= writeIORef zoom . (subtract 0.2)-keyPressed _ zoom _ (SpecialKey KeyPageDown) Down _ _ = -  get zoom >>= writeIORef zoom . (+0.2)-keyPressed _ _ tilt (SpecialKey KeyUp) Down _ _ = -  get tilt >>= writeIORef tilt . (subtract 0.5)          -keyPressed _ _ tilt (SpecialKey KeyDown) Down _ _ = -  get tilt >>= writeIORef tilt . (+ 0.5)-keyPressed _ _ _ _    _ _ _ = do return ()+    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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"-     -- register the function to do all our OpenGL drawing+     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+     spin    <- newIORef 0+     stars   <- generateStars+     zoom    <- newIORef (-15)+     tilt    <- newIORef 90      -- initialize our window.      tex <- initGL-     displayCallback $= (drawScene tex zoom tilt twinkle spin stars)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene tex zoom tilt twinkle spin stars)+     GLFW.setWindowRefreshCallback+       (drawScene tex zoom tilt twinkle spin stars)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just (keyPressed twinkle zoom tilt)-     -- start event processing engine-     mainLoop+     GLFW.setKeyCallback $+       keyPressed twinkle zoom tilt+     GLFW.setWindowCloseCallback shutdown+     forever $ do+       drawScene tex zoom tilt twinkle spin stars+       GLFW.swapBuffers

@@ -4,29 +4,43 @@  module Main where -import Graphics.UI.GLUT +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 System.Directory ( getCurrentDirectory, setCurrentDirectory ) import Util ( Image(..), bitmapLoad )-import Monad ( when )+import Control.Monad ( when, forM_, forever )  type Sector = [Tri] -data Tri = Tri Vert Vert Vert+data Tri = Tri !Vert !Vert !Vert            deriving (Eq, Ord, Show) -data Vert = Vert { vertPoint :: Vertex3 GLfloat, -                   vertTx, vertTy :: GLfloat }+data Vert = Vert { vertX :: !GLfloat+                 , vertY :: !GLfloat+                 , vertZ :: !GLfloat+                 , vertU :: !GLfloat+                 , vertV :: !GLfloat+                 }             deriving (Eq, Ord, Show)  piover180 :: GLfloat-piover180 = 0.0174532925+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 }+                       filterSelector :: IORef Int,+                       lighting, blend :: IORef Bool } mkGlobal :: IO Global mkGlobal = do xr <- newIORef 0  -- please someone find a nicer way...               yr <- newIORef 0@@ -44,18 +58,21 @@               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 }+                              zdepth = zd, filterSelector = fs, blend = b,+                              lighting = l } -lightAmbient, lightDiffuse :: Color4 GLfloat-lightAmbient = Color4 0.5 0.5 0.5 1-lightDiffuse = Color4 1 1 1 1+newArray' :: Storable a => [a] -> IO (ForeignPtr a)+newArray' xs = (newArray xs) >>= newForeignPtr_ -lightPosition :: Vertex4 GLfloat-lightPosition = Vertex4 0 0 2 1+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@@ -65,78 +82,104 @@                 ls <- (fmap (filter ignorable) ((fmap lines . hGetContents) h))                 let numtris = read ((head . tail . words . head) ls)                 let tris = readTris (tail ls)-                when (length tris /= numtris) $ putStrLn "error reading world.txt" >> exitWith (ExitFailure 1)+                when (length tris /= numtris) $ do+                  putStrLn "error reading world.txt"+                  exitWith (ExitFailure 1)                 return tris   where-  readTris (l1:l2:l3:ls) = Tri (readVert (words l1)) (readVert (words l2))-                               (readVert (words l3)) : readTris ls+  readTris :: [String] -> [Tri]+  readTris (l1:l2:l3:ls) = (Tri (readVert (words l1))+                                (readVert (words l2))+                                (readVert (words l3))) : readTris ls   readTris [] = []   readTris _  = undefined-  readVert (x:y:z:u:v:[]) = Vert (readVertex (x,y,z)) (read u) (read v)+  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-  readVertex (x,y,z) = Vertex3 (read x) (read y) (read z)   ignorable ('/':'/':_) = False   ignorable []          = False   ignorable _           = True                 -initGL :: IO [TextureObject]+initGL :: IO [GLuint] initGL = do-  tex <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  hint PerspectiveCorrection $= Nicest-  ambient (Light 1) $= lightAmbient-  diffuse (Light 1) $= lightDiffuse-  position (Light 1) $= lightPosition-  light (Light 1) $= Enabled-  lighting $= Enabled-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0-  color (Color4 1 1 1 (0.5::GLfloat))-  blendFunc $= (SrcAlpha, One)--  flush -- finally, we tell opengl to do it.-  return tex+  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 -loadGLTextures :: IO [TextureObject]-loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/mud.bmp"-  texNames <- (genObjectNames 3)-  -- create nearest filtered texture-  textureBinding Texture2D $= Just (texNames !! 0)-  textureFilter  Texture2D $= ((Nearest, Nothing), Nearest)-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  -- create linear filtered texture-  textureBinding Texture2D $= Just (texNames !! 1)-  textureFilter  Texture2D $= ((Linear', Nothing), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  -- create mipmap filtered texture-  textureBinding Texture2D $= Just (texNames !! 2)-  textureFilter  Texture2D $= ((Linear', Just Nearest), Linear')-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  build2DMipmaps Texture2D RGB' w h pd-  return texNames+loadTextures :: IO [GLuint]+loadTextures = do+  Just (Image w h pd) <- bitmapLoad "Data/mud.bmp"+  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 :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+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 :: [TextureObject] -> Sector -> Global -> IO ()+drawScene :: [GLuint] -> Sector -> Global -> IO () drawScene texs sector globals = do-  clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  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))@@ -144,74 +187,87 @@   --print sceneroty   look <- readIORef (lookupdown globals)   filt <- readIORef (filterSelector globals)-  rotate look (Vector3 1 0 0)-  rotate sceneroty (Vector3 0 1 0)-  -  translate (Vector3 xtrans ytrans ztrans)-  textureBinding Texture2D $= Just (texs!!filt)-  mapM_ (\t -> renderPrimitive Triangles $-    do normal (Normal3 0 0 (1::GLfloat))-       case t of Tri (Vert (Vertex3 x1 y1 z1) u1 v1) -                     (Vert (Vertex3 x2 y2 z2) u2 v2) -                     (Vert (Vertex3 x3 y3 z3) u3 v3) -> do texCoord (TexCoord2 u1 v1)-                                                           vertex (Vertex3 x1 y1 z1)-                                                           texCoord (TexCoord2 u2 v2)-                                                           vertex (Vertex3 x2 y2 z2)-                                                           texCoord (TexCoord2 u3 v3)-                                                           vertex (Vertex3 x3 y3 z3)) sector+  glRotatef look 1 0 0+  glRotatef sceneroty 0 1 0   -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  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 -> KeyboardMouseCallback--- 27 is ESCAPE-keyPressed _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed g (Char 'B') Down x y = keyPressed g (Char 'b') Down x y-keyPressed _ (Char 'b') Down _ _  = do-  r <- get blend-  if r == Enabled-     then blend $= Disabled >> depthFunc $= (Just Less)-     else blend $= Enabled >> depthFunc $= Nothing-keyPressed g (Char 'f') Down _ _ = modifyIORef (filterSelector g) (\x -> x+1 `mod` 3)-keyPressed g (Char 'F') Down x y = keyPressed g (Char 'f') Down x y-keyPressed g (Char 'L') Down x y = keyPressed g (Char 'l') Down x y-keyPressed _ (Char 'l') Down _ _ = do-  l <- get lighting-  if l == Enabled-     then lighting $= Disabled-     else lighting $= Enabled  -keyPressed g (SpecialKey KeyRight) Down _ _ = modifyIORef (yrot g) (subtract 1.5)-keyPressed g (SpecialKey KeyLeft) Down _ _ = modifyIORef (yrot g) (+ 1.5)-keyPressed g (SpecialKey KeyUp) Down _ _ = do+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 (SpecialKey KeyDown) Down _  _ = do+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 (SpecialKey KeyPageUp) Down _ _ = do+keyPressed g GLFW.KeyPageup True = do   modifyIORef (zdepth g) (subtract 0.2)   modifyIORef (lookupdown g) (subtract 0.2)-keyPressed g (SpecialKey KeyPageDown) Down _ _ = do+keyPressed g GLFW.KeyPagedown True = do   modifyIORef (zdepth g) (+ 0.2)   modifyIORef (lookupdown g) (+ 0.2) -keyPressed _ _           _    _ _ = return ()+keyPressed _ _           _    = return ()  fmod :: RealFrac a => a -> Int -> a fmod x m = (fromIntegral ((floor x :: Int) `mod` m)) + @@ -219,37 +275,43 @@  main :: IO () main = do-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html+     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      sector <- setupWorld--     getArgsAndInitialize       -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"-     -- register the function to do all our OpenGL drawing+     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.-     texs <- initGL-     global <- mkGlobal-     displayCallback $= (drawScene texs sector global)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene texs sector global)+     tex <- initGL+     globals <- mkGlobal+     GLFW.setWindowRefreshCallback+       (drawScene tex sector globals)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just (keyPressed global)-     -- start event processing engine-     mainLoop+     GLFW.setKeyCallback $+       keyPressed globals+     GLFW.setWindowCloseCallback shutdown+     forever $ do+       drawScene tex sector globals+       GLFW.swapBuffers

@@ -3,152 +3,196 @@ --  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 Data.IORef ( IORef, newIORef, modifyIORef )+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 Monad ( liftM, liftM3, when ) import Data.Array.IO ( readArray, IOUArray, newListArray )+import Control.Applicative ( (<$>), (<*>) )+import System.Directory ( getCurrentDirectory, setCurrentDirectory )+import Unsafe.Coerce ( unsafeCoerce )  type Points = IOUArray (Int, Int, Int) Float -initGL :: IO TextureObject+initGL :: IO GLuint initGL = do-  tex <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0-  polygonMode $= (Line, Fill) -- I can only assume that the first one is front and the second one is back.  The documenation doesn't say.-  flush -- finally, we tell opengl to do it.-  return tex+  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 TextureObject+loadGLTextures :: IO GLuint loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/tim.bmp"-  texName <- liftM head (genObjectNames 1)-  textureBinding Texture2D $= Just texName-  textureFilter  Texture2D $= ((Nearest, Nothing), Nearest)-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  return texName+  Just (Image w h pd) <- bitmapLoad "Data/tim.bmp"+  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 -resizeScene :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+shutdown :: GLFW.WindowCloseCallback+shutdown = do+  GLFW.closeWindow+  GLFW.terminate+  _ <- exitWith ExitSuccess+  return True -drawScene :: TextureObject -> IORef GLfloat -> IORef GLfloat -> IORef GLfloat-             -> Points -> IORef Int -> IORef Int -> IO () +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-  clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  loadIdentity  -- reset view+  glClear $ fromIntegral  $  gl_COLOR_BUFFER_BIT+                         .|. gl_DEPTH_BUFFER_BIT -  translate (Vector3 0 0 (-12.0::GLfloat)) --Move left 5 Units into the screen+  glLoadIdentity -  xr <- get xrot-  yr <- get yrot-  zr <- get zrot-  offset <- get offsetRef-  wiggle <- get wiggleRef-  rotate xr (Vector3 1 0 (0::GLfloat)) -- Rotate the triangle on the Y axis-  rotate yr (Vector3 0 1 (0::GLfloat)) -- Rotate the triangle on the Y axis-  rotate zr (Vector3 0 0 (1::GLfloat)) -- Rotate the triangle on the Y axis-  textureBinding Texture2D $= Just tex-  {-# SCC "renderPrimitive" #-}renderPrimitive Quads $  -- start drawing a polygon (4 sided)-    mapM_ ( \(x, y) -> do-       let x' = (x+offset) `mod` 45-       let fx = fromIntegral x/44 :: GLfloat-       let fy = fromIntegral y/44 :: GLfloat-       let fxb = fromIntegral (x+1)/44 :: GLfloat-       let fyb = fromIntegral (y+1)/44 :: GLfloat-       {-# SCC "TexCoord2" #-}texCoord (TexCoord2 fx fy)-       {-# SCC "vertex1" #-}vertex =<< liftM3 Vertex3 (readArray points (x,y,0))-                                 (readArray points (x,y,1))-                                 (readArray points (x',y,2))-       texCoord (TexCoord2 fx fyb)-       {-# SCC "vertex2" #-}vertex =<< liftM3 Vertex3 (readArray points (x,y+1,0))-                                 (readArray points (x,y+1,1))-                                 (readArray points (x',y+1,2))-       texCoord (TexCoord2 fxb fyb)-       {-# SCC "vertex3" #-}vertex =<< liftM3 Vertex3 (readArray points (x+1,y+1,0))-                                 (readArray points (x+1,y+1,1))-                                 (readArray points ((x'+1)`mod`45,y+1,2))-       texCoord (TexCoord2 fxb fy)-       {-# SCC "vertex4" #-}vertex =<< liftM3 Vertex3 (readArray points (x+1,y,0))-                                 (readArray points (x+1,y,1))-                                 (readArray points ((x'+1)`mod`45,y,2)) )-    [(x,y) | x <- [0..43], y<-[0..43]]-  xrot $= xr + 0.3-  yrot $= yr + 0.2-  zrot $= zr + 0.4+  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-    offsetRef $= offset + 1-    wiggleRef $= 0 +    writeIORef offsetRef $! offset + 1+    writeIORef wiggleRef $! 0 -  {-# SCC "modifyIORef" #-}modifyIORef wiggleRef (+ 1)-  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  w <- readIORef wiggleRef+  writeIORef wiggleRef $! w + 1 -keyPressed :: KeyboardMouseCallback--- 27 is ESCAPE-keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed _            _    _ _ = return ()+  glFlush +readArray' :: IOUArray (Int, Int, Int) Float -> (Int, Int, Int) -> IO GLfloat+readArray' a (x,y,z) = do+  r <- readArray a (x,y,z)+  -- This line is extremely slow, because a RULES is missing+  -- in openglraw.  You can replace it with Unsafe.Coerce.unsafeCoerce+  -- on most platforms to get a HUGE speed up.+  return $! unsafeCoerce r++keyPressed :: GLFW.KeyCallback+keyPressed GLFW.KeyEsc True = shutdown >> return ()+keyPressed _           _    = return ()+ main :: IO () main = do-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 640 480-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"-     -- register the function to do all our OpenGL drawing+     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-     elems <- return $ concat [[((fromIntegral x/5)-4.5), -                                ((fromIntegral y/5)-4.5),-                                sin (((fromIntegral x/5)*40/360)*pi*2)] -                                | x <- [0..44]::[Int], y <- [0..44]::[Int] ]+     let elems = concat [[((x/5)-4.5),+                          ((y/5)-4.5),+                          sin (((x/5)*40/360)*pi*2)]+                        | x <- [0..44]::[Float], y <- [0..44]::[Float] ]      points <- newListArray ((0,0,0), (44,44,2)) elems :: IO Points      -- initialize our window.      tex <- initGL-     displayCallback $= (drawScene tex xrot yrot zrot points wiggle offset)-     -- go fullscreen. This is as soon as possible.-     --fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene tex xrot yrot zrot points wiggle offset)+     GLFW.setWindowRefreshCallback+       (drawScene tex xrot yrot zrot points wiggle offset)      -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just keyPressed-     -- start event processing engine-     mainLoop+     GLFW.setKeyCallback $+       keyPressed+     GLFW.setWindowCloseCallback shutdown+     GLFW.getWindowRefreshRate >>= print+     forever $ do+       drawScene tex xrot yrot zrot points wiggle offset+       GLFW.swapBuffers

@@ -4,163 +4,192 @@  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 Data.IORef ( IORef, newIORef, modifyIORef )+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 Monad ( liftM )+import System.Directory ( getCurrentDirectory, setCurrentDirectory ) -boxcol :: [Color3 GLfloat]-boxcol = [Color3 1 0 0, Color3 1 0.5 0, Color3 1 1 0, -          Color3 0 1 0, Color3 0 1 1]-topcol :: [Color3 GLfloat]-topcol = [Color3 0.5 0 0, Color3 0.5 0.25 0, Color3 0.5 0.5 0,-          Color3 0 0.5 0, Color3 0 0.5 0.5]+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 (DisplayList, DisplayList)+buildLists :: IO (GLuint, GLuint) buildLists = do-  box <- defineNewList Compile $ -    do renderPrimitive Quads $ -         do { texCoord (TexCoord2 1 (1::GLfloat)); vertex (Vertex3 (-1) (-1) (-1::GLfloat));-              texCoord (TexCoord2 0.0 (1.0::GLfloat)); vertex(Vertex3 1.0 (-1.0) (-1.0::GLfloat));      -- Top Left Of The Texture and Quad-              texCoord (TexCoord2 0.0 (0.0::GLfloat)); vertex(Vertex3 1.0 (-1.0)  (1.0::GLfloat));      -- Bottom Left Of The Texture and Quad-              texCoord (TexCoord2 1.0 (0.0::GLfloat)); vertex(Vertex3(-1.0) (-1.0)  (1.0::GLfloat));      -- Bottom Right Of The Texture and Quad-              -- Front Face-              texCoord (TexCoord2 0.0 (0.0::GLfloat)); vertex(Vertex3(-1.0) (-1.0)  (1.0::GLfloat));      -- Bottom Left Of The Texture and Quad-              texCoord (TexCoord2 1.0 (0.0::GLfloat)); vertex(Vertex3 1.0 (-1.0)  (1.0::GLfloat));      -- Bottom Right Of The Texture and Quad-              texCoord (TexCoord2 1.0 (1.0::GLfloat)); vertex(Vertex3 1.0  1.0  (1.0::GLfloat));      -- Top Right Of The Texture and Quad-              texCoord (TexCoord2 0.0 (1.0::GLfloat)); vertex(Vertex3(-1.0)  1.0  (1.0::GLfloat));      -- Top Left Of The Texture and Quad-              -- Back Face-              texCoord (TexCoord2 1.0 (0.0::GLfloat)); vertex(Vertex3(-1.0) (-1.0) (-1.0::GLfloat));      -- Bottom Right Of The Texture and Quad-              texCoord (TexCoord2 1.0 (1.0::GLfloat)); vertex(Vertex3(-1.0)  1.0 (-1.0::GLfloat));      -- Top Right Of The Texture and Quad-              texCoord (TexCoord2 0.0 (1.0::GLfloat)); vertex(Vertex3 1.0  1.0 (-1.0::GLfloat));      -- Top Left Of The Texture and Quad-              texCoord (TexCoord2 0.0 (0.0::GLfloat)); vertex(Vertex3 1.0 (-1.0) (-1.0::GLfloat));      -- Bottom Left Of The Texture and Quad-              -- Right face-              texCoord (TexCoord2 1.0 (0.0::GLfloat)); vertex(Vertex3 1.0 (-1.0) (-1.0::GLfloat));      -- Bottom Right Of The Texture and Quad-              texCoord (TexCoord2 1.0 (1.0::GLfloat)); vertex(Vertex3 1.0  1.0 (-1.0::GLfloat));      -- Top Right Of The Texture and Quad-              texCoord (TexCoord2 0.0 (1.0::GLfloat)); vertex(Vertex3 1.0  1.0  (1.0::GLfloat));      -- Top Left Of The Texture and Quad-              texCoord (TexCoord2 0.0 (0.0::GLfloat)); vertex(Vertex3 1.0 (-1.0)  (1.0::GLfloat));      -- Bottom Left Of The Texture and Quad-              -- Left Face-              texCoord (TexCoord2 0.0 (0.0::GLfloat)); vertex(Vertex3(-1.0) (-1.0) (-1.0::GLfloat));      -- Bottom Left Of The Texture and Quad-              texCoord (TexCoord2 1.0 (0.0::GLfloat)); vertex(Vertex3(-1.0) (-1.0)  (1.0::GLfloat));      -- Bottom Right Of The Texture and Quad-              texCoord (TexCoord2 1.0 (1.0::GLfloat)); vertex(Vertex3(-1.0)  1.0  (1.0::GLfloat));      -- Top Right Of The Texture and Quad-              texCoord (TexCoord2 0.0 (1.0::GLfloat)); vertex(Vertex3(-1.0)  1.0 (-1.0::GLfloat));}      -- Top Left Of The Texture and Quad-  top <- defineNewList Compile $ -    do renderPrimitive Quads $ -         do { texCoord (TexCoord2 0 (1::GLfloat)); vertex (Vertex3 (-1) 1 (-1::GLfloat));-              texCoord (TexCoord2 0 (0::GLfloat)); vertex (Vertex3 (-1) 1 (1::GLfloat));-              texCoord (TexCoord2 1 (0::GLfloat)); vertex (Vertex3 1 1 (1::GLfloat));-              texCoord (TexCoord2 1 (1::GLfloat)); vertex (Vertex3 1 1 (-1::GLfloat)); }+  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 TextureObject+initGL :: IO GLuint initGL = do-  tex <- loadGLTextures-  texture Texture2D $= Enabled-  clearColor $= Color4 0 0 0 0.5 -- Clear the background color to black-  clearDepth $= 1 -- enables clearing of the depth buffer-  depthFunc  $= Just Less -- type of depth test-  shadeModel $= Smooth -- enables smooth color shading-  matrixMode $= Projection-  hint PerspectiveCorrection $= Nicest-  loadIdentity  -- reset projection matrix-  Size width height <- get windowSize-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100 -- calculate the aspect ratio of the window-  matrixMode $= Modelview 0-  light (Light 0) $= Enabled-  lighting $= Enabled-  colorMaterial $= Just (FrontAndBack, AmbientAndDiffuse)-  flush -- finally, we tell opengl to do it.+  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 -loadGLTextures :: IO TextureObject-loadGLTextures = do-  (Image (Size w h) pd) <- bitmapLoad "Data/cube.bmp"-  texName <- liftM head (genObjectNames 1)-  textureBinding Texture2D $= Just texName-  textureFilter  Texture2D $= ((Nearest, Nothing), Nearest)-  texImage2D Nothing NoProxy 0 RGB' (TextureSize2D w h) 0 pd-  return texName+loadTextures :: IO GLuint+loadTextures = do+  Just (Image w h pd) <- bitmapLoad "Data/cube.bmp"+  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 -resizeScene :: Size -> IO ()-resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero-resizeScene s@(Size width height) = do-  viewport   $= (Position 0 0, s)-  matrixMode $= Projection-  loadIdentity-  perspective 45 (fromIntegral width/fromIntegral height) 0.1 100-  matrixMode $= Modelview 0-  flush+shutdown :: GLFW.WindowCloseCallback+shutdown = do+  GLFW.closeWindow+  GLFW.terminate+  _ <- exitWith ExitSuccess+  return True -drawScene :: TextureObject -> IORef GLfloat -> IORef GLfloat-             -> DisplayList -> DisplayList -> IO ()-drawScene tex xrot yrot box top = do-  clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer-  textureBinding Texture2D $= Just 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 -  xr <- get xrot-  yr <- get yrot+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 -  mapM_ (\(x,y) -> -    do { loadIdentity;-         let {x' = fromIntegral x;-              y' = fromIntegral y };-         translate (Vector3 (1.4+x'*2.8-y'*1.4) (((6-y')*2.4)-7)  (-20::GLfloat));-         rotate (45.0-(2.0*y')+xr) (Vector3 1 0 (0::GLfloat));-         rotate (45-yr) (Vector3 0 1 (0::GLfloat));-         color (boxcol !! (y-1));-         callList box;-         color (topcol !! (y-1));-         callList top } ) [(x,y) | y <- [1..5], x <- [0..y-1] ]+  xr <- readIORef xrot+  yr <- readIORef yrot -  -- since this is double buffered, swap the buffers to display what was just-  -- drawn-  flush-  swapBuffers+  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 -> KeyboardMouseCallback--- 27 is ESCAPE-keyPressed _ _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyPressed xrot _ (SpecialKey KeyUp) Down _ _ = modifyIORef xrot (subtract 0.8)-keyPressed xrot _ (SpecialKey KeyDown) Down _ _ = modifyIORef xrot (+0.8)-keyPressed _ yrot (SpecialKey KeyLeft) Down _ _ = modifyIORef yrot (subtract 0.8)-keyPressed _ yrot (SpecialKey KeyRight) Down _ _ = modifyIORef yrot (+0.8)-keyPressed _ _ _            _    _ _ = return ()+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-     -- Initialize GLUT state - glut will take any command line arguments-     -- that pertain to it or X windows -- look at its documentation at-     -- http://reality.sgi.com/mjk/spec3/spec3.html-     getArgsAndInitialize +     cd <- getCurrentDirectory+     True <- GLFW.initialize+     setCurrentDirectory cd      -- select type of display mode:      -- Double buffer      -- RGBA color      -- Alpha components supported      -- Depth buffer-     initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, -                             WithAlphaComponent ]-     -- get an 800 x 600 window-     initialWindowSize $= Size 800 600-     -- window starts at upper left corner of the screen-     initialWindowPosition $= Position 0 0+     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-     createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"-     -- register the function to do all our OpenGL drawing+     True <- GLFW.openWindow dspOpts      xrot <- newIORef 0      yrot <- newIORef 0            -- initialize our window.      tex <- initGL      (box, top) <- buildLists-     displayCallback $= (drawScene tex xrot yrot box top)-     -- go fullscreen. This is as soon as possible.-     fullScreen-     -- even if there are no events, redraw our gl scene-     idleCallback $= Just (drawScene tex xrot yrot box top)-     -- register the funciton called when our window is resized-     reshapeCallback $= Just resizeScene+     GLFW.setWindowRefreshCallback $+       drawScene tex xrot yrot box top+     GLFW.setWindowSizeCallback resizeScene      -- register the function called when the keyboard is pressed.-     keyboardMouseCallback $= Just (keyPressed xrot yrot)-     -- start event processing engine-     mainLoop+     GLFW.setKeyCallback $+       keyPressed xrot yrot+     GLFW.setWindowCloseCallback shutdown+     GLFW.getWindowRefreshRate >>= print+     forever $ do+       drawScene tex xrot yrot box top+       GLFW.swapBuffers

@@ -1,72 +1,102 @@-Name:   nehe-tuts
-Version: 0.1.1
-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: dagit@eecs.oregonstate.edu
-License: BSD3
-License-file: LICENSE
-Category: Graphics
-Cabal-Version:  >= 1.2
-Build-type: Simple
-Extra-Source-Files: README, Makefile, Data/Crate.bmp, Data/Star.bmp, Data/glass.bmp, Data/tim.bmp, Data/NeHe.bmp, Data/cube.bmp, Data/mud.bmp, Data/world.txt
-Executable lesson01
-    Main-is: lesson01.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson02
-    Main-is: lesson02.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson03
-    Main-is: lesson03.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson04
-    Main-is: lesson04.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson05
-    Main-is: lesson05.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson06
-    Main-is: lesson06.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2, haskell98
-    GHC-Options: -Wall
-Executable lesson07
-    Main-is: lesson07.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson08
-    Main-is: lesson08.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson09
-    Main-is: lesson09.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson10
-    Main-is: lesson10.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2, array >= 0.2.0.0
-    GHC-Options: -Wall
-Executable lesson11
-    Main-is: lesson11.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
-Executable lesson12
-    Main-is: lesson12.hs
-    Other-Modules: Util
-    Build-Depends: base, OpenGL >= 2.2.1.1, GLUT >= 2.1.1.2
-    GHC-Options: -Wall
+Name:   nehe-tuts+Version: 0.2.0+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/Crate.bmp, Data/Star.bmp, Data/glass.bmp, Data/tim.bmp, Data/NeHe.bmp, Data/cube.bmp, Data/mud.bmp, Data/world.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.0++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+    Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,+                   GLURaw == 1.1.*, GLFW-b == 0.0.*,+                   bytestring == 0.9.*, cereal == 0.3.*,+                   directory == 1.1.*+    GHC-Options: -Wall+Executable lesson07+    Main-is: lesson07.hs+    Other-modules: Util+    Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,+                   GLURaw == 1.1.*, GLFW-b == 0.0.*,+                   bytestring == 0.9.*, cereal == 0.3.*,+                   directory == 1.1.*+    GHC-Options: -Wall+Executable lesson08+    Main-is: lesson08.hs+    Other-modules: Util+    Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,+                   GLURaw == 1.1.*, GLFW-b == 0.0.*,+                   bytestring == 0.9.*, cereal == 0.3.*,+                   directory == 1.1.*+    GHC-Options: -Wall+Executable lesson09+    Main-is: lesson09.hs+    Other-modules: Util+    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.1.*+    GHC-Options: -Wall+Executable lesson10+    Main-is: lesson10.hs+    Other-modules: Util+    Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,+                   GLURaw == 1.1.*, GLFW-b == 0.0.*,+                   bytestring == 0.9.*, cereal == 0.3.*,+                   directory == 1.1.*+    GHC-Options: -Wall+Executable lesson11+    Main-is: lesson11.hs+    Other-modules: Util+    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.1.*+    GHC-Options: -Wall+Executable lesson12+    Main-is: lesson12.hs+    Other-modules: Util+    Build-Depends: base >= 3 && < 5, OpenGLRaw == 1.1.*,+                   GLURaw == 1.1.*, GLFW-b == 0.0.*,+                   bytestring == 0.9.*, cereal == 0.3.*,+                   directory == 1.1.*+    GHC-Options: -Wall