diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/Makefile b/Makefile deleted file mode 100644 --- a/Makefile +++ /dev/null @@ -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] diff --git a/README b/README --- a/README +++ b/README @@ -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 diff --git a/Util.hs b/Util.hs --- a/Util.hs +++ b/Util.hs @@ -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 diff --git a/lesson01.hs b/lesson01.hs --- a/lesson01.hs +++ b/lesson01.hs @@ -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 diff --git a/lesson02.hs b/lesson02.hs --- a/lesson02.hs +++ b/lesson02.hs @@ -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 diff --git a/lesson03.hs b/lesson03.hs --- a/lesson03.hs +++ b/lesson03.hs @@ -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 diff --git a/lesson04.hs b/lesson04.hs --- a/lesson04.hs +++ b/lesson04.hs @@ -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 diff --git a/lesson05.hs b/lesson05.hs --- a/lesson05.hs +++ b/lesson05.hs @@ -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 diff --git a/lesson06.hs b/lesson06.hs --- a/lesson06.hs +++ b/lesson06.hs @@ -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 diff --git a/lesson07.hs b/lesson07.hs --- a/lesson07.hs +++ b/lesson07.hs @@ -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 diff --git a/lesson08.hs b/lesson08.hs --- a/lesson08.hs +++ b/lesson08.hs @@ -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 diff --git a/lesson09.hs b/lesson09.hs --- a/lesson09.hs +++ b/lesson09.hs @@ -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 diff --git a/lesson10.hs b/lesson10.hs --- a/lesson10.hs +++ b/lesson10.hs @@ -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 diff --git a/lesson11.hs b/lesson11.hs --- a/lesson11.hs +++ b/lesson11.hs @@ -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 diff --git a/lesson12.hs b/lesson12.hs --- a/lesson12.hs +++ b/lesson12.hs @@ -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 diff --git a/nehe-tuts.cabal b/nehe-tuts.cabal --- a/nehe-tuts.cabal +++ b/nehe-tuts.cabal @@ -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