merged .. but colors broken..
This commit is contained in:
Stefan Dresselhaus
105
src/Main.hs
105
src/Main.hs
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Main (main) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
@ -9,15 +10,18 @@ import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Text.PrettyPrint
|
||||
import Data.Distributive (distribute)
|
||||
import Foreign (Ptr, castPtr, with)
|
||||
import Foreign.C (CFloat)
|
||||
import Linear as L
|
||||
|
||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
||||
import qualified Graphics.Rendering.OpenGL.Raw.Core31 as GLRaw
|
||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
||||
import qualified Graphics.UI.GLFW as GLFW
|
||||
import qualified Data.Vector.Storable as V
|
||||
|
||||
import Map.Map
|
||||
import Render.Render (initShader)
|
||||
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum, checkError)
|
||||
import Render.Render (initShader, initRendering)
|
||||
import Render.Misc (up, createFrustum, checkError, lookAt)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -43,13 +47,15 @@ data State = State
|
||||
, stateDragStartY :: !Double
|
||||
, stateDragStartXAngle :: !Double
|
||||
, stateDragStartYAngle :: !Double
|
||||
, stateFrustum :: [GL.GLfloat]
|
||||
, stateFrustum :: !(M44 CFloat)
|
||||
-- pointer to bindings for locations inside the compiled shader
|
||||
-- mutable because shaders may be changed in the future.
|
||||
, shdrVertexIndex :: !GL.AttribLocation
|
||||
, shdrColorIndex :: !GL.AttribLocation
|
||||
, shdrNormalIndex :: !GL.AttribLocation
|
||||
, shdrVertexIndex :: !GL.AttribLocation
|
||||
, shdrProjMatIndex :: !GL.UniformLocation
|
||||
, shdrViewMatIndex :: !GL.UniformLocation
|
||||
, shdrModelMatIndex :: !GL.UniformLocation
|
||||
-- the map
|
||||
, stateMap :: !GL.BufferObject
|
||||
, mapVert :: !GL.NumArrayIndices
|
||||
@ -105,13 +111,13 @@ main = do
|
||||
|
||||
(fbWidth, fbHeight) <- GLFW.getFramebufferSize win
|
||||
|
||||
initRendering
|
||||
--generate map vertices
|
||||
(mapBuffer, vert) <- getMapBufferObject
|
||||
(ci, ni, vi, pi) <- initShader
|
||||
(ci, ni, vi, pri, vii, mi) <- initShader
|
||||
|
||||
let zDistClosest = 10
|
||||
zDistFarthest = zDistClosest + 20
|
||||
zDist = zDistClosest + ((zDistFarthest - zDistClosest) / 2)
|
||||
fov = 90 --field of view
|
||||
near = 1 --near plane
|
||||
far = 100 --far plane
|
||||
@ -126,8 +132,8 @@ main = do
|
||||
state = State
|
||||
{ stateWindowWidth = fbWidth
|
||||
, stateWindowHeight = fbHeight
|
||||
, stateXAngle = 0
|
||||
, stateYAngle = 0
|
||||
, stateXAngle = pi/6
|
||||
, stateYAngle = pi/2
|
||||
, stateZAngle = 0
|
||||
, stateZDist = 10
|
||||
, stateMouseDown = False
|
||||
@ -136,10 +142,12 @@ main = do
|
||||
, stateDragStartY = 0
|
||||
, stateDragStartXAngle = 0
|
||||
, stateDragStartYAngle = 0
|
||||
, shdrColorIndex = ci
|
||||
, shdrNormalIndex = ni
|
||||
, shdrVertexIndex = vi
|
||||
, shdrProjMatIndex = pi
|
||||
, shdrNormalIndex = ni
|
||||
, shdrColorIndex = ci
|
||||
, shdrProjMatIndex = pri
|
||||
, shdrViewMatIndex = vii
|
||||
, shdrModelMatIndex = mi
|
||||
, stateMap = mapBuffer
|
||||
, mapVert = vert
|
||||
, stateFrustum = frust
|
||||
@ -210,8 +218,7 @@ charCallback tc win c = atomically $ writeTQueue tc $ EventC
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
runDemo :: Env -> State -> IO ()
|
||||
runDemo env state = do
|
||||
void $ evalRWST (adjustWindow >> run) env state
|
||||
runDemo env state = void $ evalRWST (adjustWindow >> run) env state
|
||||
|
||||
run :: Pioneer ()
|
||||
run = do
|
||||
@ -221,13 +228,12 @@ run = do
|
||||
draw
|
||||
liftIO $ do
|
||||
GLFW.swapBuffers win
|
||||
GL.flush -- not necessary, but someone recommended it
|
||||
GLFW.pollEvents
|
||||
GL.finish
|
||||
-- getEvents & process
|
||||
processEvents
|
||||
|
||||
-- update State
|
||||
|
||||
state <- get
|
||||
if stateDragging state
|
||||
then do
|
||||
@ -238,10 +244,21 @@ run = do
|
||||
(x, y) <- liftIO $ GLFW.getCursorPos win
|
||||
let myrot = (x - sodx) / 2
|
||||
mxrot = (y - sody) / 2
|
||||
-- newXAngle = if newXAngle' > 2*pi then 2*pi else
|
||||
newXAngle = if newXAngle' > 0.45*pi then 0.45*pi else
|
||||
-- if newXAngle' < -2*pi then -2*pi else
|
||||
if newXAngle' < 0 then 0 else
|
||||
newXAngle'
|
||||
newXAngle' = sodxa + mxrot/100
|
||||
newYAngle = if newYAngle' > pi then newYAngle'-2*pi else
|
||||
if newYAngle' < -pi then newYAngle'+2*pi else
|
||||
newYAngle'
|
||||
newYAngle' = sodya + myrot/100
|
||||
put $ state
|
||||
{ stateXAngle = sodxa + mxrot
|
||||
, stateYAngle = sodya + myrot
|
||||
{ stateXAngle = newXAngle
|
||||
, stateYAngle = newYAngle
|
||||
}
|
||||
-- liftIO $ putStrLn $ unwords $ map show $ [newXAngle, newYAngle]
|
||||
else do
|
||||
(kxrot, kyrot) <- liftIO $ getCursorKeyDirections win
|
||||
(jxrot, jyrot) <- liftIO $ getJoystickDirections GLFW.Joystick'1
|
||||
@ -249,6 +266,7 @@ run = do
|
||||
{ stateXAngle = stateXAngle state + (2 * kxrot) + (2 * jxrot)
|
||||
, stateYAngle = stateYAngle state + (2 * kyrot) + (2 * jyrot)
|
||||
}
|
||||
|
||||
{-
|
||||
--modify the state with all that happened in mt time.
|
||||
mt <- liftIO GLFW.getTime
|
||||
@ -376,37 +394,44 @@ draw :: Pioneer ()
|
||||
draw = do
|
||||
env <- ask
|
||||
state <- get
|
||||
let xa = stateXAngle state
|
||||
ya = stateYAngle state
|
||||
let xa = fromRational $ toRational $ stateXAngle state
|
||||
ya = fromRational $ toRational $ stateYAngle state
|
||||
za = stateZAngle state
|
||||
(GL.UniformLocation proj) = shdrProjMatIndex state
|
||||
ci = shdrColorIndex state
|
||||
ni = shdrNormalIndex state
|
||||
(GL.UniformLocation proj) = shdrProjMatIndex state
|
||||
(GL.UniformLocation vmat) = shdrViewMatIndex state
|
||||
vi = shdrVertexIndex state
|
||||
ni = shdrNormalIndex state
|
||||
ci = shdrColorIndex state
|
||||
numVert = mapVert state
|
||||
map' = stateMap state
|
||||
frust = stateFrustum state
|
||||
liftIO $ do
|
||||
GLRaw.glClearDepth 1.0
|
||||
GLRaw.glDisable GLRaw.gl_CULL_FACE
|
||||
--lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1
|
||||
--(vi,GL.UniformLocation proj) <- initShader
|
||||
GL.clearColor GL.$= GL.Color4 0.5 0.1 1 1
|
||||
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
|
||||
--set up projection (= copy from state)
|
||||
with (distribute $ frust) $ \ptr ->
|
||||
glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
|
||||
|
||||
-------------
|
||||
--set up camera
|
||||
|
||||
let fov = 90
|
||||
s = recip (tan $ fov * 0.5 * pi / 180)
|
||||
f = 1000
|
||||
n = 1
|
||||
let ! cam = lookAt (cpos ^+^ at') at' up
|
||||
|
||||
let perspective = V.fromList [ s, 0, 0, 0
|
||||
, 0, s, 0, 0
|
||||
, 0, 0, -(f/(f - n)), -1
|
||||
, 0, 0, -((f*n)/(f-n)), 0
|
||||
]
|
||||
at' = V3 5 0 5
|
||||
upmap = (fromQuaternion $
|
||||
axisAngle (V3 0 1 0) (ya::CFloat) :: M33 CFloat)
|
||||
!* (V3 1 0 0)
|
||||
crot' = (
|
||||
(fromQuaternion $
|
||||
axisAngle upmap (xa::CFloat))
|
||||
!*!
|
||||
(fromQuaternion $
|
||||
axisAngle (V3 0 1 0) (ya::CFloat))
|
||||
) :: M33 CFloat
|
||||
cpos = crot' !* (V3 0 0 (-10))
|
||||
|
||||
V.unsafeWith perspective $ \ptr -> GLRaw.glUniformMatrix4fv proj 1 0 ptr
|
||||
|
||||
---------------
|
||||
with (distribute $ cam) $ \ptr ->
|
||||
glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
|
||||
|
||||
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
|
||||
GL.vertexAttribPointer ci GL.$= fgColorIndex
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
|
||||
module Map.Map
|
||||
|
||||
(
|
||||
@ -47,40 +47,38 @@ lineHeight :: GLfloat
|
||||
lineHeight = 0.8660254
|
||||
|
||||
numComponents :: Int
|
||||
numComponents = 4 --color
|
||||
+3 --normal
|
||||
+3 --vertex
|
||||
numComponents = 10
|
||||
|
||||
mapStride :: Stride
|
||||
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat)) * fromIntegral numComponents
|
||||
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat) * numComponents)
|
||||
|
||||
bufferObjectPtr :: Integral a => a -> Ptr b
|
||||
bufferObjectPtr = plusPtr (nullPtr :: Ptr GLchar) . fromIntegral
|
||||
bufferObjectPtr :: Integral a => a -> Ptr GLfloat
|
||||
bufferObjectPtr = plusPtr (nullPtr :: Ptr GLfloat) . fromIntegral
|
||||
|
||||
mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor a
|
||||
mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat
|
||||
mapVertexArrayDescriptor count' offset =
|
||||
VertexArrayDescriptor count' Float mapStride (bufferObjectPtr (fromIntegral numComponents * offset))
|
||||
VertexArrayDescriptor count' Float mapStride (bufferObjectPtr ((fromIntegral offset)*sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset))
|
||||
|
||||
fgColorIndex :: (IntegerHandling, VertexArrayDescriptor a)
|
||||
fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first
|
||||
|
||||
fgNormalIndex :: (IntegerHandling, VertexArrayDescriptor a)
|
||||
fgNormalIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
|
||||
|
||||
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor a)
|
||||
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
||||
|
||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject = do
|
||||
map' <- testmap
|
||||
map' <- return $ generateTriangles map'
|
||||
! map' <- return $ P.map (*1) (generateTriangles map')
|
||||
putStrLn $ P.unlines $ P.map show (prettyMap map')
|
||||
len <- return $ fromIntegral $ P.length map' `div` numComponents
|
||||
putStrLn $ P.unwords ["num verts",show len]
|
||||
bo <- genObjectName -- create a new buffer
|
||||
bindBuffer ArrayBuffer $= Just bo -- bind buffer
|
||||
withArray map' $ \buffer ->
|
||||
bufferData ArrayBuffer $= (fromIntegral $ sizeOf (0 :: Float)*P.length map',
|
||||
bufferData ArrayBuffer $= (fromIntegral $ sizeOf (0 :: GLfloat)*P.length map',
|
||||
buffer,
|
||||
StaticDraw)
|
||||
checkError "initBuffer"
|
||||
@ -90,6 +88,51 @@ prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfl
|
||||
prettyMap (a:b:c:d:x:y:z:u:v:w:ms) = (a,b,c,d,x,y,z,u,v,w):(prettyMap ms)
|
||||
prettyMap _ = []
|
||||
|
||||
generateCube :: [GLfloat]
|
||||
generateCube = [ -- lower plane
|
||||
-3.0,-3.0,-3.0,
|
||||
3.0,-3.0,3.0,
|
||||
3.0,-3.0,-3.0,
|
||||
-3.0,-3.0,-3.0,
|
||||
-3.0,-3.0,3.0,
|
||||
3.0,-3.0,3.0,
|
||||
-- upper plane
|
||||
-3.0,3.0,-3.0,
|
||||
3.0,3.0,3.0,
|
||||
3.0,3.0,-3.0,
|
||||
-3.0,3.0,-3.0,
|
||||
-3.0,3.0,3.0,
|
||||
3.0,3.0,3.0,
|
||||
-- left plane
|
||||
-3.0,-3.0,-3.0,
|
||||
-3.0,3.0,3.0,
|
||||
-3.0,-3.0,3.0,
|
||||
-3.0,-3.0,-3.0,
|
||||
-3.0,3.0,3.0,
|
||||
-3.0,3.0,-3.0,
|
||||
-- right plane
|
||||
3.0,-3.0,-3.0,
|
||||
3.0,3.0,3.0,
|
||||
3.0,-3.0,3.0,
|
||||
3.0,-3.0,-3.0,
|
||||
3.0,3.0,3.0,
|
||||
3.0,3.0,-3.0,
|
||||
-- front plane
|
||||
-3.0,-3.0,-3.0,
|
||||
3.0,3.0,-3.0,
|
||||
3.0,-3.0,-3.0,
|
||||
-3.0,-3.0,-3.0,
|
||||
3.0,3.0,-3.0,
|
||||
-3.0,3.0,-3.0,
|
||||
-- back plane
|
||||
-3.0,-3.0,3.0,
|
||||
3.0,3.0,3.0,
|
||||
3.0,-3.0,3.0,
|
||||
-3.0,-3.0,3.0,
|
||||
3.0,3.0,3.0,
|
||||
-3.0,3.0,3.0
|
||||
]
|
||||
|
||||
generateTriangles :: PlayMap -> [GLfloat]
|
||||
generateTriangles map' =
|
||||
let ((xl,yl),(xh,yh)) = bounds map' in
|
||||
@ -161,7 +204,7 @@ coordLookup (x,z) y =
|
||||
if even x then
|
||||
(fromIntegral $ x `div` 2, y, fromIntegral (2 * z) * lineHeight)
|
||||
else
|
||||
(fromIntegral (x `div` 2) / 2.0, y, fromIntegral (2 * z + 1) * lineHeight)
|
||||
(fromIntegral (x `div` 2) + 0.5, y, fromIntegral (2 * z + 1) * lineHeight)
|
||||
|
||||
|
||||
-- if writing in ASCII-Format transpose so i,j -> y,x
|
||||
@ -192,14 +235,20 @@ testMapTemplate = T.transpose [
|
||||
|
||||
testMapTemplate2 :: [Text]
|
||||
testMapTemplate2 = T.transpose [
|
||||
"~~~~~~"
|
||||
"~~~~~~~~~~~~"
|
||||
]
|
||||
|
||||
testmap :: IO PlayMap
|
||||
testmap = do
|
||||
g <- getStdGen
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
||||
return $ listArray ((0,0),(19,19)) rawMap
|
||||
|
||||
testmap2 :: IO PlayMap
|
||||
testmap2 = do
|
||||
g <- getStdGen
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
|
||||
return $ listArray ((0,0),(5,0)) rawMap
|
||||
return $ listArray ((0,0),(9,0)) rawMap
|
||||
|
||||
|
||||
parseTemplate :: [Int] -> Text -> [MapEntry]
|
||||
|
||||
@ -4,16 +4,17 @@ import Control.Monad
|
||||
import qualified Data.ByteString as B (ByteString)
|
||||
import Foreign.Marshal.Array (allocaArray,
|
||||
pokeArray)
|
||||
import Foreign.C (CFloat)
|
||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||
import Graphics.Rendering.OpenGL.GL.StringQueries
|
||||
import Graphics.Rendering.OpenGL.GLU.Errors
|
||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Linear
|
||||
|
||||
|
||||
up :: (Double, Double, Double)
|
||||
up = (0.0, 1.0, 1.0)
|
||||
up :: V3 CFloat
|
||||
up = V3 0 1 0
|
||||
|
||||
checkError :: String -> IO ()
|
||||
checkError functionName = get errors >>= mapM_ reportError
|
||||
@ -58,16 +59,21 @@ createProgramUsing shaders = do
|
||||
linkAndCheck program
|
||||
return program
|
||||
|
||||
createFrustum :: Float -> Float -> Float -> Float -> [GLfloat]
|
||||
createFrustum fov n f rat =
|
||||
let s = recip (tan $ fov*0.5 * pi / 180) in
|
||||
|
||||
map (fromRational . toRational) [
|
||||
rat*s,0,0,0,
|
||||
0,rat*s,0,0,
|
||||
0,0,-(f/(f-n)), -1,
|
||||
0,0,-((f*n)/(f-n)), 1
|
||||
]
|
||||
createFrustum :: Float -> Float -> Float -> Float -> M44 CFloat
|
||||
createFrustum fov n' f' rat =
|
||||
let
|
||||
f = realToFrac f'
|
||||
n = realToFrac n'
|
||||
s = realToFrac $ recip (tan $ fov*0.5 * pi / 180)
|
||||
(ratw,rath) = if rat > 1 then
|
||||
(1,1/realToFrac rat)
|
||||
else
|
||||
(realToFrac rat,1)
|
||||
in
|
||||
V4 (V4 (s/ratw) 0 0 0)
|
||||
(V4 0 (s/rath) 0 0)
|
||||
(V4 0 0 (-((f+n)/(f-n))) (-((2*f*n)/(f-n))))
|
||||
(V4 0 0 (-1) 0)
|
||||
|
||||
lookAtUniformMatrix4fv :: (Double, Double, Double) --origin
|
||||
-> (Double, Double, Double) --camera-pos
|
||||
@ -126,9 +132,23 @@ infixl 5 ><
|
||||
]
|
||||
_ >< _ = error "non-conformat matrix-multiplication"
|
||||
|
||||
|
||||
-- from vmath.h
|
||||
lookAt :: V3 CFloat -> V3 CFloat -> V3 CFloat -> M44 CFloat
|
||||
lookAt eye@(V3 ex ey ez) center up =
|
||||
V4
|
||||
(V4 xx xy xz (-dot x eye))
|
||||
(V4 yx yy yz (-dot y eye))
|
||||
(V4 zx zy zz (-dot z eye))
|
||||
(V4 0 0 0 1)
|
||||
where
|
||||
z@(V3 zx zy zz) = normalize (eye ^-^ center)
|
||||
x@(V3 xx xy xz) = normalize (cross up z)
|
||||
y@(V3 yx yy yz) = normalize (cross z x)
|
||||
|
||||
-- generates 4x4-Projection-Matrix
|
||||
lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
|
||||
lookAt at eye up =
|
||||
lookAt_ :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
|
||||
lookAt_ at eye up =
|
||||
map (fromRational . toRational) [
|
||||
xx, yx, zx, 0,
|
||||
xy, yy, zy, 0,
|
||||
|
||||
@ -7,12 +7,13 @@ import Foreign.Storable (sizeOf)
|
||||
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
||||
import Graphics.Rendering.OpenGL.GL.Framebuffer (clearColor)
|
||||
import Graphics.Rendering.OpenGL.GL.ObjectName
|
||||
import Graphics.Rendering.OpenGL.GL.PerFragment
|
||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||
import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability (..),
|
||||
vertexAttribArray)
|
||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
||||
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat)
|
||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
||||
import Render.Misc
|
||||
|
||||
vertexShaderFile :: String
|
||||
@ -33,7 +34,7 @@ initBuffer varray =
|
||||
checkError "initBuffer"
|
||||
return bufferObject
|
||||
|
||||
initShader :: IO (AttribLocation, AttribLocation, AttribLocation, UniformLocation)
|
||||
initShader :: IO (AttribLocation, AttribLocation, AttribLocation, UniformLocation, UniformLocation, UniformLocation)
|
||||
initShader = do
|
||||
! vertexSource <- B.readFile vertexShaderFile
|
||||
! fragmentSource <- B.readFile fragmentShaderFile
|
||||
@ -49,22 +50,35 @@ initShader = do
|
||||
projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")
|
||||
checkError "projMat"
|
||||
|
||||
colorIndex <- get (attribLocation program "fg_Color")
|
||||
vertexAttribArray colorIndex $= Enabled
|
||||
checkError "colorInd"
|
||||
viewMatrixIndex <- get (uniformLocation program "fg_ViewMatrix")
|
||||
checkError "viewMat"
|
||||
|
||||
normalIndex <- get (attribLocation program "fg_Normal")
|
||||
vertexAttribArray normalIndex $= Enabled
|
||||
checkError "normalInd"
|
||||
modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix")
|
||||
checkError "modelMat"
|
||||
|
||||
vertexIndex <- get (attribLocation program "fg_VertexIn")
|
||||
vertexAttribArray vertexIndex $= Enabled
|
||||
checkError "vertexInd"
|
||||
|
||||
normalIndex <- get (attribLocation program "fg_NormalIn")
|
||||
vertexAttribArray normalIndex $= Enabled
|
||||
checkError "normalInd"
|
||||
|
||||
colorIndex <- get (attribLocation program "fg_Color")
|
||||
vertexAttribArray colorIndex $= Enabled
|
||||
checkError "colorInd"
|
||||
|
||||
att <- get (activeAttribs program)
|
||||
|
||||
putStrLn $ unlines $ "Attributes: ":map show att
|
||||
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
|
||||
|
||||
checkError "initShader"
|
||||
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex)
|
||||
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex)
|
||||
|
||||
initRendering :: IO ()
|
||||
initRendering = do
|
||||
clearColor $= Color4 0 0 0 0
|
||||
depthFunc $= Just Less
|
||||
glCullFace gl_BACK
|
||||
checkError "initRendering"
|
||||
|
||||
Reference in New Issue
Block a user