nehe-tuts (empty) → 0.1
raw patch · 16 files changed
+2119/−0 lines, 16 filesdep +GLUTdep +OpenGLdep +arraysetup-changed
Dependencies added: GLUT, OpenGL, array, base, haskell98
Files
- LICENSE +1/−0
- Setup.hs +4/−0
- Util.hs +91/−0
- lesson01.hs +80/−0
- lesson02.hs +96/−0
- lesson03.hs +101/−0
- lesson04.hs +117/−0
- lesson05.hs +170/−0
- lesson06.hs +172/−0
- lesson07.hs +221/−0
- lesson08.hs +232/−0
- lesson09.hs +188/−0
- lesson10.hs +255/−0
- lesson11.hs +154/−0
- lesson12.hs +166/−0
- nehe-tuts.cabal +71/−0
+ LICENSE view
@@ -0,0 +1,1 @@+This code follows the BSD license.
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain +
+ Util.hs view
@@ -0,0 +1,91 @@+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)++data Image = Image Size (PixelData Word8)++bitmapLoad :: String -> IO 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++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+
+ lesson01.hs view
@@ -0,0 +1,80 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT+import System.Exit ( exitWith, ExitCode(..) )+import Control.Concurrent ( threadDelay )++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.++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++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++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+keyPressed _ _ _ _ = do threadDelay 100+ 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 ]+ -- get a 640 x 480 window+ initialWindowSize $= Size 640 480+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- initialize our window.+ initGL+ -- start event processing engine+ mainLoop
+ lesson02.hs view
@@ -0,0 +1,96 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT+import System.Exit ( exitWith, ExitCode(..) )++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.++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++drawScene :: IO ()+drawScene = do+ clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer+ loadIdentity -- reset view++ translate (Vector3 (-1.5) 0 (-6.0::GLfloat)) --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++ 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+ + -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ swapBuffers+ flush++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+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 ]+ -- get a 640 x 480 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- initialize our window.+ initGL+ -- start event processing engine+ mainLoop
+ lesson03.hs view
@@ -0,0 +1,101 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT+import System.Exit ( exitWith, ExitCode(..) )++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.++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++drawScene :: IO ()+drawScene = do+ clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer+ loadIdentity -- reset view++ translate (Vector3 (-1.5) 0 (-6.0::GLfloat)) --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++ translate (Vector3 3 0 (0::GLfloat)) -- 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+ + -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ swapBuffers+ flush++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+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 ]+ -- get a 640 x 480 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- initialize our window.+ initGL+ -- start event processing engine+ mainLoop
+ lesson04.hs view
@@ -0,0 +1,117 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT+import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef )++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.++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++drawScene :: IORef GLfloat -> IORef GLfloat -> IO ()+drawScene rtri rquad = do+ clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer+ loadIdentity -- 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++ -- 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++ 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++ 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++ -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ swapBuffers+ flush++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+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 ]+ -- get a 640 x 480 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- initialize our window.+ initGL+ -- start event processing engine+ mainLoop
+ lesson05.hs view
@@ -0,0 +1,170 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT+import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef )++tincrement, qincrement :: GLfloat+tincrement = 0.2+qincrement = -0.15++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.++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++drawScene :: IORef GLfloat -> IORef GLfloat -> IO ()+drawScene rtri rquad = do+ clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer+ loadIdentity -- 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++ -- 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)++ + 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++ 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)+ + rtri $= rt + tincrement --increase the rotation angle for the triangle+ rquad $= rq + qincrement --increase the rotation angle for the quad++ -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ swapBuffers+ flush++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+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 ]+ -- get a 640 x 480 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- initialize our window.+ initGL+ -- start event processing engine+ mainLoop
+ lesson06.hs view
@@ -0,0 +1,172 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import Monad ( liftM )+import Data.IORef ( IORef, newIORef )+import Util ( Image(..), bitmapLoad )++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 $= 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++loadGLTextures :: IO TextureObject+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++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++drawScene :: TextureObject -> 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++ translate (Vector3 0 0 (-5.0::GLfloat)) --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++ 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)+ + xrot $= xr + 0.3+ yrot $= yr + 0.2+ zrot $= zr + 0.4++ -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ flush+ swapBuffers+++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+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 ]+ -- get an 800 x 600 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- start event processing engine+ mainLoop
+ lesson07.hs view
@@ -0,0 +1,221 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef, writeIORef )+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++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 $= 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++loadGLTextures :: IO [TextureObject]+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++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++drawScene :: [TextureObject] -> 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++ 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++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 ()++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 ]+ -- get an 800 x 600 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- 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+ -- 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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just (keyPressed filt zdepth xspeed yspeed)+ -- start event processing engine+ mainLoop
+ lesson08.hs view
@@ -0,0 +1,232 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef, writeIORef )+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++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++ color (Color4 1 1 1 (0.5::GLfloat))+ blendFunc $= (SrcAlpha, One)+ flush -- finally, we tell opengl to do it.+ return texs++loadGLTextures :: IO [TextureObject]+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++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++drawScene :: [TextureObject] -> 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++ 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++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 ()++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 ]+ -- get an 800 x 600 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- 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+ -- 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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just (keyPressed filt zdepth xspeed yspeed)+ -- start event processing engine+ mainLoop
+ lesson09.hs view
@@ -0,0 +1,188 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef, writeIORef )+import Util ( Image(..), bitmapLoad )+import Monad ( when, liftM )+import Random++data Star = Star { starColor :: Color3 GLubyte, starDist, + 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++ flush -- finally, we tell opengl to do it.+ return tex++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]++loadGLTextures :: IO TextureObject+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++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++colorUpgrade :: Color3 a -> a -> Color4 a+colorUpgrade (Color3 r g b) a = Color4 r g b a++drawScene :: TextureObject -> 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++ 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++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 ()++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 ]+ -- get an 800 x 600 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+ -- register the function to do all our OpenGL drawing+ twinkle <- newIORef False+ 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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just (keyPressed twinkle zoom tilt)+ -- start event processing engine+ mainLoop
+ lesson10.hs view
@@ -0,0 +1,255 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import System.IO ( openFile, IOMode(..), hGetContents )+import Data.IORef ( IORef, newIORef, writeIORef, readIORef, modifyIORef )+import Util ( Image(..), bitmapLoad )+import Monad ( when )++type Sector = [Tri]++data Tri = Tri Vert Vert Vert+ deriving (Eq, Ord, Show)++data Vert = Vert { vertPoint :: Vertex3 GLfloat, + vertTx, vertTy :: GLfloat }+ deriving (Eq, Ord, Show)++piover180 :: GLfloat+piover180 = 0.0174532925++data Global = Global { xrot, yrot, xspeed, yspeed, walkbias, walkbiasangle,+ lookupdown, xpos, zpos, camx, camy, camz,+ therotate, heading, zdepth :: IORef GLfloat,+ filterSelector :: IORef Int }+mkGlobal :: IO Global+mkGlobal = do xr <- newIORef 0 -- please someone find a nicer way...+ yr <- newIORef 0+ xs <- newIORef 0+ ys <- newIORef 0+ wb <- newIORef 0+ wba <- newIORef 0+ lud <- newIORef 0+ xp <- newIORef 0+ zp <- newIORef 0+ cx <- newIORef 0+ cy <- newIORef 0+ cz <- newIORef 0+ tr <- newIORef 0+ h <- newIORef 0+ zd <- newIORef 0+ fs <- newIORef 0+ 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 }++lightAmbient, lightDiffuse :: Color4 GLfloat+lightAmbient = Color4 0.5 0.5 0.5 1+lightDiffuse = Color4 1 1 1 1++lightPosition :: Vertex4 GLfloat+lightPosition = Vertex4 0 0 2 1++readRef :: IO (IORef a) -> IO a+readRef r = r >>= readIORef++setupWorld :: IO Sector+setupWorld = do h <- openFile "Data/world.txt" ReadMode+ 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)+ return tris+ where+ 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 _ = undefined+ readVertex (x,y,z) = Vertex3 (read x) (read y) (read z)+ ignorable ('/':'/':_) = False+ ignorable [] = False+ ignorable _ = True+ +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 $= 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++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++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++drawScene :: [TextureObject] -> Sector -> Global -> IO ()+drawScene texs sector globals = do+ clear [ColorBuffer, DepthBuffer] -- clear the screen and the depth bufer+ loadIdentity -- reset view+ xtrans <- fmap negate (readIORef (xpos globals))+ ytrans <- fmap (\y -> -y-0.25) (readIORef (walkbias globals))+ ztrans <- fmap negate (readIORef (zpos globals))+ sceneroty <- fmap (\y -> 360 - y) (readIORef (yrot globals))+ --print sceneroty+ look <- readIORef (lookupdown globals)+ filt <- readIORef (filterSelector globals)+ 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+ + -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ flush+ swapBuffers++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+ 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+ 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+ modifyIORef (zdepth g) (subtract 0.2)+ modifyIORef (lookupdown g) (subtract 0.2)+keyPressed g (SpecialKey KeyPageDown) Down _ _ = do+ modifyIORef (zdepth g) (+ 0.2)+ modifyIORef (lookupdown g) (+ 0.2)++keyPressed _ _ _ _ _ = return ()++fmod :: RealFrac a => a -> Int -> a+fmod x m = (fromIntegral ((floor x :: Int) `mod` m)) + + (x - (fromIntegral (floor x :: Int)))++main :: IO ()+main = do+ -- 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+ 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+ -- open a window+ createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+ -- register the function to do all our OpenGL drawing+ -- 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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just (keyPressed global)+ -- start event processing engine+ mainLoop
+ lesson11.hs view
@@ -0,0 +1,154 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef, modifyIORef )+import Util ( Image(..), bitmapLoad )+import Monad ( liftM, liftM3, when )+import Data.Array.IO ( readArray, IOUArray, newListArray )++type Points = IOUArray (Int, Int, Int) Float++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 $= 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++loadGLTextures :: IO TextureObject+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++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++drawScene :: TextureObject -> 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++ translate (Vector3 0 0 (-12.0::GLfloat)) --Move left 5 Units into the screen++ 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++ when (wiggle == 2) $ do+ offsetRef $= offset + 1+ wiggleRef $= 0 ++ {-# SCC "modifyIORef" #-}modifyIORef wiggleRef (+ 1)+ -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ flush+ swapBuffers++keyPressed :: KeyboardMouseCallback+-- 27 is ESCAPE+keyPressed (Char '\27') Down _ _ = exitWith ExitSuccess+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 ]+ -- get an 800 x 600 window+ initialWindowSize $= Size 640 480+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "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+ 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] ]+ 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)+ -- register the funciton called when our window is resized+ reshapeCallback $= Just resizeScene+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just keyPressed+ -- start event processing engine+ mainLoop
+ lesson12.hs view
@@ -0,0 +1,166 @@+--+-- This code was created by Jeff Molofee '99 (ported to Haskell GHC 2005)+--++module Main where++import Graphics.UI.GLUT +import System.Exit ( exitWith, ExitCode(..) )+import Data.IORef ( IORef, newIORef, modifyIORef )+import Util ( Image(..), bitmapLoad )+import Monad ( liftM )++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]++buildLists :: IO (DisplayList, DisplayList)+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)); }+ return (box, top)++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 $= 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.+ 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++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++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++ xr <- get xrot+ yr <- get yrot++ 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] ]++ -- since this is double buffered, swap the buffers to display what was just+ -- drawn+ flush+ swapBuffers++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 ()++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 ]+ -- get an 800 x 600 window+ initialWindowSize $= Size 800 600+ -- window starts at upper left corner of the screen+ initialWindowPosition $= Position 0 0+ -- open a window+ createWindow "Jeff Molofee's GL Code Tutorial ... NeHe '99"+ -- register the function to do all our OpenGL drawing+ 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+ -- register the function called when the keyboard is pressed.+ keyboardMouseCallback $= Just (keyPressed xrot yrot)+ -- start event processing engine+ mainLoop
+ nehe-tuts.cabal view
@@ -0,0 +1,71 @@+Name: nehe-tuts +Version: 0.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 +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