it works...
This commit is contained in:
parent
cde5231e6a
commit
602b20eb6c
@ -26,5 +26,8 @@ executable Pioneers
|
||||
transformers >=0.3.0 && <0.4,
|
||||
mtl >=2.1.2,
|
||||
stm >=2.4.2,
|
||||
vector >=0.10.9 && <0.11
|
||||
vector >=0.10.9 && <0.11,
|
||||
distributive >=0.3.2 && <0.4,
|
||||
linear >=1.3.1 && <1.4,
|
||||
lens >=3.10.1 && <3.11
|
||||
|
||||
|
||||
@ -7,16 +7,25 @@ uniform mat4 fg_ModelMatrix;
|
||||
//vertex-data
|
||||
in vec4 fg_Color;
|
||||
in vec3 fg_VertexIn;
|
||||
//in vec3 fg_Normal;
|
||||
in vec3 fg_NormalIn;
|
||||
|
||||
//output-data for later stages
|
||||
smooth out vec4 fg_SmoothColor;
|
||||
|
||||
void main()
|
||||
{
|
||||
vec3 fg_Normal = fg_NormalIn; //vec3(0,1,0);
|
||||
//transform vec3 into vec4, setting w to 1
|
||||
vec4 fg_Vertex = vec4(fg_VertexIn, 1.0);
|
||||
fg_SmoothColor = fg_Color;
|
||||
// + 0.001* fg_Normal.xyzx;
|
||||
vec4 light = vec4(1.0,1.0,1.0,1.0);
|
||||
vec4 dark = vec4(0.0,0.0,0.0,1.0);
|
||||
//direction to sun from origin
|
||||
vec3 lightDir = normalize(vec3(5.0,5.0,1.0));
|
||||
|
||||
|
||||
float costheta = dot(normalize(fg_Normal), lightDir);
|
||||
float a = costheta * 0.5 + 0.5;
|
||||
|
||||
fg_SmoothColor = fg_Color * mix(dark, light, a);// + 0.001* fg_Normal.xyzx;
|
||||
gl_Position = fg_ProjectionMatrix * fg_ModelMatrix * fg_Vertex;
|
||||
}
|
||||
58
src/Main.hs
58
src/Main.hs
@ -2,13 +2,20 @@ module Main (main) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Concurrent.STM (TQueue, atomically, newTQueueIO, tryReadTQueue, writeTQueue)
|
||||
import Control.Lens
|
||||
import Control.Monad (unless, when, void)
|
||||
import Control.Monad.RWS.Strict (RWST, ask, asks, evalRWST, get, liftIO, modify, put)
|
||||
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, nullPtr, sizeOf, with)
|
||||
import Foreign.C (CFloat)
|
||||
import Linear as L
|
||||
import Linear ((!*!))
|
||||
|
||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
||||
import qualified Graphics.Rendering.OpenGL.Raw as GL
|
||||
@ -17,7 +24,7 @@ import qualified Data.Vector.Storable as V
|
||||
|
||||
import Map.Map
|
||||
import Render.Render (initShader)
|
||||
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum)
|
||||
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum, checkError)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -48,6 +55,7 @@ data State = State
|
||||
-- mutable because shaders may be changed in the future.
|
||||
, shdrVertexIndex :: !GL.AttribLocation
|
||||
, shdrColorIndex :: !GL.AttribLocation
|
||||
, shdrNormalIndex :: !GL.AttribLocation
|
||||
, shdrProjMatIndex :: !GL.UniformLocation
|
||||
, shdrModelMatIndex :: !GL.UniformLocation
|
||||
-- the map
|
||||
@ -107,11 +115,10 @@ main = do
|
||||
|
||||
--generate map vertices
|
||||
(mapBuffer, vert) <- getMapBufferObject
|
||||
(ci, vi, pi, mi) <- initShader
|
||||
(ci, ni, vi, pi, 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
|
||||
@ -137,6 +144,7 @@ main = do
|
||||
, stateDragStartXAngle = 0
|
||||
, stateDragStartYAngle = 0
|
||||
, shdrVertexIndex = vi
|
||||
, shdrNormalIndex = ni
|
||||
, shdrColorIndex = ci
|
||||
, shdrProjMatIndex = pi
|
||||
, shdrModelMatIndex = mi
|
||||
@ -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
|
||||
@ -382,6 +389,7 @@ draw = do
|
||||
(GL.UniformLocation proj) = shdrProjMatIndex state
|
||||
(GL.UniformLocation mmat) = shdrModelMatIndex state
|
||||
vi = shdrVertexIndex state
|
||||
ni = shdrNormalIndex state
|
||||
ci = shdrColorIndex state
|
||||
numVert = mapVert state
|
||||
map' = stateMap state
|
||||
@ -389,27 +397,39 @@ draw = do
|
||||
liftIO $ do
|
||||
--(vi,GL.UniformLocation proj) <- initShader
|
||||
GL.clearColor GL.$= GL.Color4 0.5 0.1 1 1
|
||||
GL.clear [GL.ColorBuffer]
|
||||
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
|
||||
let fov = 90
|
||||
s = recip (tan $ fov * 0.5 * pi / 180)
|
||||
f = 1000
|
||||
n = 1
|
||||
|
||||
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
|
||||
]
|
||||
V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
|
||||
let model = V.fromList [
|
||||
1, 0, 0, 0
|
||||
, 0, 0, 1, 0
|
||||
, 0, 1, 0, 0
|
||||
,-5, -10, -10, 1
|
||||
]
|
||||
V.unsafeWith model $ \ptr -> GL.glUniformMatrix4fv mmat 1 0 ptr
|
||||
let perspective = V4 (V4 s 0 0 0)
|
||||
(V4 0 s 0 0)
|
||||
(V4 0 0 (-(f/(f - n))) (-1))
|
||||
(V4 0 0 (-((f*n)/(f-n))) 1)
|
||||
!*!
|
||||
V4 (V4 1 0 0 0)
|
||||
(V4 0 0 1 0)
|
||||
(V4 0 1 0 0)
|
||||
(V4 0 0 0 1)
|
||||
with (distribute $ perspective) $ \ptr ->
|
||||
GL.glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
|
||||
--V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
|
||||
let cam = crot !*! ctrans
|
||||
ctrans = (eye4 & translation .~ V3 (-5) (-10) (-10)) :: M44 CFloat
|
||||
crot = (m33_to_m44 $
|
||||
(fromQuaternion $
|
||||
axisAngle (V3 1 0 0) (pi/4))
|
||||
!*!
|
||||
(fromQuaternion $
|
||||
axisAngle (V3 0 1 0) (pi/16))
|
||||
) :: M44 CFloat
|
||||
--V.unsafeWith model $ \ptr -> GL.glUniformMatrix4fv mmat 1 0 ptr
|
||||
with (distribute $ cam) $ \ptr ->
|
||||
GL.glUniformMatrix4fv mmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
|
||||
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
|
||||
GL.vertexAttribPointer ci GL.$= fgColorIndex
|
||||
GL.vertexAttribPointer ni GL.$= fgNormalIndex
|
||||
GL.vertexAttribPointer vi GL.$= fgVertexIndex
|
||||
|
||||
GL.drawArrays GL.Triangles 0 numVert
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
|
||||
module Map.Map
|
||||
|
||||
(
|
||||
@ -47,7 +47,7 @@ lineHeight :: GLfloat
|
||||
lineHeight = 0.8660254
|
||||
|
||||
numComponents :: Int
|
||||
numComponents = 7
|
||||
numComponents = 10
|
||||
|
||||
mapStride :: Stride
|
||||
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat) * numComponents)
|
||||
@ -60,18 +60,18 @@ mapVertexArrayDescriptor count' offset =
|
||||
VertexArrayDescriptor count' Float mapStride (bufferObjectPtr ((fromIntegral offset)*sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset))
|
||||
|
||||
fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 3) --color first
|
||||
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first
|
||||
|
||||
fgNormalIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
|
||||
|
||||
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 0) --vertex after normal
|
||||
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
||||
|
||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject = do
|
||||
map' <- testmap
|
||||
map' <- return $ P.map (*1) (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]
|
||||
@ -177,9 +177,9 @@ lookupVertex map' x y =
|
||||
--TODO: calculate normals correctly!
|
||||
in
|
||||
[
|
||||
vx, vy, vz, -- 3 Vertex
|
||||
cr, cg, cb, 1.0 -- RGBA Color
|
||||
--nx, ny, nz, -- 3 Normal
|
||||
cr, cg, cb, 1.0, -- RGBA Color
|
||||
nx, ny, nz, -- 3 Normal
|
||||
vx, vy, vz -- 3 Vertex
|
||||
]
|
||||
|
||||
heightLookup :: PlayMap -> (Int,Int) -> GLfloat
|
||||
@ -233,8 +233,7 @@ testMapTemplate = T.transpose [
|
||||
|
||||
testMapTemplate2 :: [Text]
|
||||
testMapTemplate2 = T.transpose [
|
||||
"~~~~~~~~~~~~",
|
||||
"~SSSSSSSSSS~"
|
||||
"~~~~~~~~~~~~"
|
||||
]
|
||||
|
||||
testmap :: IO PlayMap
|
||||
@ -243,6 +242,12 @@ testmap = do
|
||||
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),(9,0)) rawMap
|
||||
|
||||
|
||||
parseTemplate :: [Int] -> Text -> [MapEntry]
|
||||
parseTemplate (r:rs) t =
|
||||
|
||||
@ -33,7 +33,7 @@ initBuffer varray =
|
||||
checkError "initBuffer"
|
||||
return bufferObject
|
||||
|
||||
initShader :: IO (AttribLocation, AttribLocation, UniformLocation, UniformLocation)
|
||||
initShader :: IO (AttribLocation, AttribLocation, AttribLocation, UniformLocation, UniformLocation)
|
||||
initShader = do
|
||||
! vertexSource <- B.readFile vertexShaderFile
|
||||
! fragmentSource <- B.readFile fragmentShaderFile
|
||||
@ -52,20 +52,25 @@ initShader = do
|
||||
modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix")
|
||||
checkError "modelMat"
|
||||
|
||||
att <- get (activeAttribs program)
|
||||
|
||||
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, vertexIndex, projectionMatrixIndex, modelMatrixIndex)
|
||||
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, modelMatrixIndex)
|
||||
|
||||
initRendering :: IO ()
|
||||
initRendering = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user