import Graphics.Rendering.OpenGL import Graphics.UI.GLUT import Data.IORef import Textures main = do (progname, _) <- getArgsAndInitialize initialDisplayMode $= [WithDepthBuffer,DoubleBuffered,RGBAMode] createWindow "Hello World" [notSure] <- getAndCreateTextures ["other"] depthFunc $= Just Less matrixMode $= Projection loadIdentity let near = 1 far = 40 right = 1 top = 1 frustum (-right) right (-top) top near far matrixMode $= Modelview 0 tme <- get elapsedTime lasttime <- newIORef(tme) frame <- newIORef(-1.0) idleCallback $= Just (idle lasttime) windowSize $= Size 800 500 lighting $= Enabled position (Light 0) $= (Vertex4 1 0 (0.8::GLfloat) 1) ambient (Light 0) $= Color4 1 1 1 1 diffuse (Light 0) $= Color4 1 1 1 1 specular (Light 0) $= Color4 1 1 1 1 light (Light 0) $= Enabled displayCallback $= (display notSure frame) mainLoop idle :: IORef(Int) -> IO() idle lasttime = do lTime <- readIORef lasttime currenttime <- get elapsedTime case (currenttime - lTime >= 16) of True -> do writeIORef lasttime currenttime postRedisplay Nothing return () _ -> return () display :: (Maybe TextureObject)->IORef(Float) -> IO() display image f = do frame <- readIORef f clear [ColorBuffer,DepthBuffer] texture Texture2D $= Enabled loadIdentity --currentColor $= (Color4 1 1 1 1) preservingMatrix $ do --currentColor $= Color4 1 0 0 1 let rd = 1.0 gd = 0.0 bd = 0.6 rs = 0.5 gs = 0.5 bs = 0.0 materialDiffuse Front $= Color4 rd gd bd 1.0 materialAmbient Front $= Color4 0.0 0.7 0.8 0.2 materialSpecular Front $= Color4 rs gs bs 1.0 textureBinding Texture2D $= image translate (Vector3 (-0.5) (-0.5) ((-5)::GLfloat)) rotate frame (Vector3 0 1 (1::GLfloat)) cube 1 flush writeIORef f (frame+1) swapBuffers makeVertices ((x,y,z,tx,ty):[]) = do (texCoord (TexCoord2 (tx::GLfloat) ty)) (vertex (Vertex3 x y z)) makeVertices ((x,y,z,tx,ty):xs) = do (texCoord (TexCoord2 (tx::GLfloat) ty)) (vertex (Vertex3 (x::GLfloat) y z)) makeVertices xs cube l = do renderPrimitive Quads (makeVertices corners) where corners = [(l,0,l,0,0),(0,0,l,0,1),(0,l,l,1,0),(l,l,l,1,1) ,(l,l,l,0,0),(l,l,0,0,1),(l,0,0,1,0),(l,0,l,1,1) ,(0,0,0,0,0),(l,0,0,0,1),(l,0,l,1,0),(0,0,l,1,1) ,(l,l,0,0,0),(0,l,0,0,1),(0,0,0,1,0),(l,0,0,1,1) ,(0,l,l,0,0),(l,l,l,0,1),(l,l,0,1,0),(0,l,0,1,1) ,(0,l,l,0,0),(0,l,0,0,1),(0,0,0,1,0),(0,0,l,1,1) ]