--
-- 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