-- GL_DEPTH_TEST
module Main where
import Graphics.UI.GLUT
import Bindings
import Display
import Data.IORef
import Control.Monad
import Data.Maybe
import Control.Monad(when)
import System.Exit(exitFailure)
import System.IO(withBinaryFile, IOMode(ReadMode), openBinaryFile, hGetBuf)
import Foreign.Marshal.Alloc(allocaBytes, mallocBytes)
loadTexture :: FilePath -> IO TextureObject
loadTexture f = do
withBinaryFile f ReadMode $ \h -> do
let bytes = 256 * 256 * 4
allocaBytes bytes $ \pixels -> do
bytes' <- hGetBuf h pixels bytes
when (bytes' /= bytes) exitFailure
[tex] <- genObjectNames 1
texture Texture2D $= Enabled
textureBinding Texture2D $= Just tex
build2DMipmaps Texture2D RGBA' 256 256
(PixelData RGBA UnsignedByte pixels)
textureFilter Texture2D $= ((Linear', Just Linear'), Linear')
textureWrapMode Texture2D S $= (Repeated, ClampToEdge)
textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
textureBinding Texture2D $= Nothing
texture Texture2D $= Disabled
return tex
myInit :: IO [TextureObject]
myInit = do
lighting $= Enabled
position (Light 0) $= Vertex4 0.0 0 1.0 (0.0)
light (Light 0) $= Enabled
position (Light 1) $= Vertex4 0.0 0 (-1.0) (0.0)
light (Light 1) $= Enabled
position (Light 2) $= Vertex4 0.0 1 0.0 (0.0)
light (Light 2) $= Enabled
position (Light 3) $= Vertex4 0.0 (-1) 0.0 (0.0)
light (Light 3) $= Enabled
position (Light 4) $= Vertex4 1.0 0 0.0 (0.0)
light (Light 4) $= Enabled
position (Light 5) $= Vertex4 (-1.0) 0 0.0 (0.0)
light (Light 5) $= Enabled
position (Light 6) $= Vertex4 (6.0) (5) (8.0) (0.0)
light (Light 6) $= Enabled
-- lookAt (Vertex3 6 5 8) (Vertex3 0 0 0) (Vector3 0 1 0)
depthFunc $= Just Lequal
-- normalize $= Enabled
clearColor $= Color4 0.5 0.5 0.5 0
shadeModel $= Smooth
t0 <- loadTexture "img/Blue256.png.rgba"
t1 <- loadTexture "img/Red256.png.rgba"
t2 <- loadTexture "img/Green256.png.rgba"
t3 <- loadTexture "img/White256.png.rgba"
t4 <- loadTexture "img/Orange256.png.rgba"
t5 <- loadTexture "img/Yellow256.png.rgba"
texture Texture2D $= Enabled
return [t0,t1,t2,t3,t4,t5]
lightDiffuse :: Color4 GLfloat
lightDiffuse = Color4 1.0 1.0 1.0 1.0
lightPosition :: Vertex4 GLfloat
lightPosition = Vertex4 (-6) (-5) (-8) 0.0
initfn :: IO ()
initfn = let light0 = Light 0
in do
light light0 $= Enabled
diffuse light0 $= lightDiffuse
position light0 $= lightPosition
lighting $= Enabled
-- normalize $= Enabled
depthFunc $= Just Lequal
-- matrixMode $= Projection
-- perspective 40.0 1.0 1.0 10.0
-- matrixMode $= Modelview 0
-- lookAt (Vertex3 0.0 0.0 5.0) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
-- translate ((Vector3 0.0 0.0 (-1.0))::Vector3 GLfloat)
-- rotate 60 ((Vector3 1.0 0.0 0.0)::Vector3 GLfloat)
-- rotate (-20) ((Vector3 0.0 0.0 1.0)::Vector3 GLfloat)
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
createWindow progName
textures <- myInit
reshapeCallback $= Just reshape
initial <- newIORef goalState
empty <- newIORef [NO]
noInst <- newIORef [NO]
noRot <- newIORef 0.0
let state = CS { cube = initial, insts = empty, inst = noInst, rot = noRot}
keyboardMouseCallback $= Just (keyboardMouse noInst noRot empty)
idleCallback $= Just idle
displayCallback $= (display state textures)
-- initfn
mainLoop