Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

WIP-Commit. DOES NOT WORK.

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-03-24 08:21:30 +01:00
parent fd38727c65
commit c1e074934e
11 changed files with 109 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
shaders/fragment.shader → shaders/map/fragment.shader
View File

0
shaders/tessControl.shader → shaders/map/tessControl.shader
View File

0
shaders/tessEval.shader → shaders/map/tessEval.shader
View File

0
shaders/vertex.shader → shaders/map/vertex.shader
View File

8
shaders/ui/fragment.shader Normal file
View File

@ -0,0 +1,8 @@
#version 330
uniform sampler2D blitTexture;
void main(void)
{
}

6
shaders/ui/vertex.shader Normal file
View File

@ -0,0 +1,6 @@
#version 330
void main()
{
//null-program
}

31
src/Main.hs
View File

@ -38,13 +38,15 @@ import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
import Map.Map
import Render.Misc (checkError,
createFrustum, getCam,
curb)
curb, tryWithTexture)
import Render.Render (initRendering,
initShader)
initMapShader)
import UI.Callbacks
import UI.GUIOverlay
import Types
import ThirdParty.Flippers
import qualified Debug.Trace as D (trace)
--------------------------------------------------------------------------------
@ -64,7 +66,7 @@ main = do
initRendering
--generate map vertices
(mapBuffer, vert) <- getMapBufferObject
(ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initShader
(mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initMapShader
putStrLn "foo"
eventQueue <- newTQueueIO :: IO (TQueue Event)
putStrLn "foo"
@ -101,6 +103,7 @@ main = do
, _stateTessellationFactor = 4
, _stateMap = mapBuffer
, _mapVert = vert
, _mapProgram = mapprog
}
env = Env
{ _eventsChan = eventQueue
@ -150,6 +153,9 @@ main = do
, _game = GameState
{
}
, _ui = UIState
{
}
}
putStrLn "init done."
@ -162,6 +168,7 @@ main = do
draw :: Pioneers ()
draw = do
state <- get
env <- ask
let xa = state ^. camera.xAngle
ya = state ^. camera.yAngle
(GL.UniformLocation proj) = state ^. gl.glMap.shdrProjMatIndex
@ -179,6 +186,8 @@ draw = do
camY = state ^. camera.camPosition.y
zDist' = state ^. camera.zDist
tessFac = state ^. gl.glMap.stateTessellationFactor
window = env ^. windowObject
prepareGUI
liftIO $ do
--(vi,GL.UniformLocation proj) <- initShader
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
@ -223,6 +232,12 @@ draw = do
glDrawArrays gl_PATCHES 0 (fromIntegral numVert)
checkError "draw"
{-renderer <- getRenderer (env ^. windowObject)
tryWithTexture
(state ^. gl.hudTexture) --maybe tex
(\tex -> renderCopy renderer tex Nothing Nothing) --function with "hole"
--Nothing == whole source-tex, whole dest-tex
(return ()) --fail-case-}
-- Main game loop
@ -320,7 +335,7 @@ adjustWindow = do
frust = createFrustum fov near far ratio
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
modify $ camera.frustum .~ frust
hudTex <- liftIO $ do
{-hudTex <- liftIO $ do
case state ^. gl.hudTexture of
Just tex -> destroyTexture tex
_ -> return ()
@ -331,7 +346,7 @@ adjustWindow = do
TextureAccessStreaming -- change occasionally
fbWidth -- width
fbHeight -- height
modify $ gl.hudTexture .~ (Just hudTex)
modify $ gl.hudTexture .~ (Just hudTex)-}
processEvents :: Pioneers ()
processEvents = do
@ -344,7 +359,7 @@ processEvents = do
processEvent :: Event -> Pioneers ()
processEvent e = do
return ()
env <- ask
case eventData e of
Window _ winEvent ->
case winEvent of
@ -363,6 +378,10 @@ processEvent e = do
-- need modifiers? use "keyModifiers key" to get them
let aks = keyboard.arrowsPressed in
case keyScancode key of
SDL.R ->
liftIO $ do
r <- getRenderer $ env ^. windowObject
putStrLn $ unwords ["Renderer: ",show r]
Escape ->
modify $ window.shouldClose .~ True
SDL.Left ->

8
src/Render/Misc.hs
View File

@ -8,6 +8,7 @@ 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 Graphics.UI.SDL.Types (Texture)
import System.IO (hPutStrLn, stderr)
import Linear
import Foreign.C (CFloat)
@ -116,3 +117,10 @@ curb l h x
| x < l = l
| x > h = h
| otherwise = x
tryWithTexture :: Maybe Texture -> (Texture -> a) -> a -> a
tryWithTexture t f fail' =
case t of
Just tex -> f tex
_ -> fail'

66
src/Render/Render.hs
View File

@ -16,14 +16,20 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.Raw.Core31
import Render.Misc
vertexShaderFile :: String
vertexShaderFile = "shaders/vertex.shader"
tessControlShaderFile :: String
tessControlShaderFile = "shaders/tessControl.shader"
tessEvalShaderFile :: String
tessEvalShaderFile = "shaders/tessEval.shader"
fragmentShaderFile :: String
fragmentShaderFile = "shaders/fragment.shader"
mapVertexShaderFile :: String
mapVertexShaderFile = "shaders/map/vertex.shader"
mapTessControlShaderFile :: String
mapTessControlShaderFile = "shaders/map/tessControl.shader"
mapTessEvalShaderFile :: String
mapTessEvalShaderFile = "shaders/map/tessEval.shader"
mapFragmentShaderFile :: String
mapFragmentShaderFile = "shaders/map/fragment.shader"
uiVertexShaderFile :: String
uiVertexShaderFile = "shaders/ui/vertex.shader"
uiFragmentShaderFile :: String
uiFragmentShaderFile = "shaders/ui/fragment.shader"
initBuffer :: [GLfloat] -> IO BufferObject
initBuffer varray =
@ -38,8 +44,9 @@ initBuffer varray =
checkError "initBuffer"
return bufferObject
initShader :: IO (
AttribLocation -- ^ color
initMapShader :: IO (
Program -- ^ the GLSL-Program
, AttribLocation -- ^ color
, AttribLocation -- ^ normal
, AttribLocation -- ^ vertex
, UniformLocation -- ^ ProjectionMat
@ -49,17 +56,17 @@ initShader :: IO (
, UniformLocation -- ^ TessLevelInner
, UniformLocation -- ^ TessLevelOuter
)
initShader = do
! vertexSource <- B.readFile vertexShaderFile
! tessControlSource <- B.readFile tessControlShaderFile
! tessEvalSource <- B.readFile tessEvalShaderFile
! fragmentSource <- B.readFile fragmentShaderFile
initMapShader = do
! vertexSource <- B.readFile mapVertexShaderFile
! tessControlSource <- B.readFile mapTessControlShaderFile
! tessEvalSource <- B.readFile mapTessEvalShaderFile
! fragmentSource <- B.readFile mapFragmentShaderFile
vertexShader <- compileShaderSource VertexShader vertexSource
checkError "compile Vertex"
tessControlShader <- compileShaderSource TessControlShader tessControlSource
checkError "compile Vertex"
checkError "compile TessControl"
tessEvalShader <- compileShaderSource TessEvaluationShader tessEvalSource
checkError "compile Vertex"
checkError "compile TessEval"
fragmentShader <- compileShaderSource FragmentShader fragmentSource
checkError "compile Frag"
program <- createProgramUsing [vertexShader, tessControlShader, tessEvalShader, fragmentShader]
@ -104,7 +111,30 @@ initShader = do
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
checkError "initShader"
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
return (program, colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
{-initUIShader :: IO (
Program -- ^ the GLSL-program
, AttribLocation -- ^ the UI-Texture
)
initUIShader = do
! vertexSource <- B.readFile uiVertexShaderFile
! fragmentSource <- B.readFile uiFragmentShaderFile
vertexShader <- compileShaderSource VertexShader vertexSource
checkError "compile Vertex"
fragmentShader <- compileShaderSource FragmentShader fragmentSource
checkError "compile Frag"
program <- createProgramUsing [vertexShader, fragmentShader]
checkError "compile Program"
att <- get (activeAttribs program)
putStrLn $ unlines $ "Attributes: ":map show att
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
checkError "initShader"
return (program, )-}
initRendering :: IO ()
initRendering = do

7
src/Types.hs
View File

@ -84,6 +84,7 @@ data GLMapState = GLMapState
, _stateTessellationFactor :: !Int
, _stateMap :: !GL.BufferObject
, _mapVert :: !GL.NumArrayIndices
, _mapProgram :: !GL.Program
}
data GLState = GLState
@ -91,6 +92,10 @@ data GLState = GLState
, _hudTexture :: Maybe Texture
}
data UIState = UIState
{
}
data State = State
{ _window :: !WindowState
, _camera :: !CameraState
@ -99,6 +104,7 @@ data State = State
, _keyboard :: !KeyboardState
, _gl :: !GLState
, _game :: !GameState
, _ui :: !UIState
}
$(makeLenses ''State)
@ -113,6 +119,7 @@ $(makeLenses ''CameraState)
$(makeLenses ''WindowState)
$(makeLenses ''Position)
$(makeLenses ''Env)
$(makeLenses ''UIState)
type Pioneers = RWST Env () State IO

7
src/UI/Callbacks.hs
View File

@ -24,5 +24,12 @@ alternateClickHandler :: Pixel -> Pioneers ()
alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"]
-- | informs the GUI to prepare a blitting of state ^. gl.hudTexture
--
--TODO: should be done asynchronously at one point.
prepareGUI :: Pioneers ()
prepareGUI = do
return ()
--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
--TODO: Maybe queues are better?