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

window opens .. and crashes! :p

Browse Source 
No Events handled yet -.-...
This commit is contained in:
Stefan Dresselhaus
2014-01-20 16:11:34 +01:00
parent c01c776e94
commit 0c1bdad465
2 changed files with 205 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

206
src/Main.hs
View File

@@ -22,7 +22,7 @@ import Control.Lens (transposeOf, (^.))
import Linear as L import Linear as L
-- GUI -- GUI
import Graphics.UI.SDL import Graphics.UI.SDL as SDL
-- Render -- Render
import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.Rendering.OpenGL.GL as GL
@@ -36,7 +36,209 @@ import Render.Misc (checkError,
import Render.Render (initRendering, import Render.Render (initRendering,
initShader) initShader)
--Static Read-Only-State
data Env = Env
{ envEventsChan :: TQueue Event
, envWindow :: !Window
, envZDistClosest :: !Double
, envZDistFarthest :: !Double
}
--Mutable State
data State = State
{ stateWindowWidth :: !Int
, stateWindowHeight :: !Int
, stateWinClose :: !Bool
--- IO
, stateXAngle :: !Double
, stateYAngle :: !Double
, stateZDist :: !Double
, stateMouseDown :: !Bool
, stateDragging :: !Bool
, stateDragStartX :: !Double
, stateDragStartY :: !Double
, stateDragStartXAngle :: !Double
, stateDragStartYAngle :: !Double
, statePositionX :: !Double
, statePositionY :: !Double
, 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
, shdrProjMatIndex :: !GL.UniformLocation
, shdrViewMatIndex :: !GL.UniformLocation
, shdrModelMatIndex :: !GL.UniformLocation
, shdrNormalMatIndex :: !GL.UniformLocation
--- the map
, stateMap :: !GL.BufferObject
, mapVert :: !GL.NumArrayIndices
}
type Pioneers = RWST Env () State IO
--------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = return () main = do
SDL.withInit [InitEverything] $ do --also: InitNoParachute -> faster, without parachute!
window <- SDL.createWindow "Pioneers" (Position 100 100) (Size 1024 768) [WindowOpengl -- we want openGL
,WindowShown -- window should be visible
,WindowResizable -- and resizable
,WindowInputFocus -- focused (=> active)
,WindowMouseFocus -- Mouse into it
--,WindowInputGrabbed-- never let go of input (KB/Mouse)
]
(Size fbWidth fbHeight) <- glGetDrawableSize window
initRendering
--generate map vertices
(mapBuffer, vert) <- getMapBufferObject
(ci, ni, vi, pri, vii, mi, nmi) <- initShader
eventQueue <- newTQueueIO :: IO (TQueue Event)
let zDistClosest = 10
zDistFarthest = zDistClosest + 20
fov = 90 --field of view
near = 1 --near plane
far = 100 --far plane
ratio = fromIntegral fbWidth / fromIntegral fbHeight
frust = createFrustum fov near far ratio
env = Env
{ envEventsChan = eventQueue
, envWindow = window
, envZDistClosest = zDistClosest
, envZDistFarthest = zDistFarthest
}
state = State
{ stateWindowWidth = fbWidth
, stateWindowHeight = fbHeight
, stateXAngle = pi/6
, stateYAngle = pi/2
, stateZDist = 10
, statePositionX = 5
, statePositionY = 5
, stateMouseDown = False
, stateDragging = False
, stateDragStartX = 0
, stateDragStartY = 0
, stateDragStartXAngle = 0
, stateDragStartYAngle = 0
, shdrVertexIndex = vi
, shdrNormalIndex = ni
, shdrColorIndex = ci
, shdrProjMatIndex = pri
, shdrViewMatIndex = vii
, shdrModelMatIndex = mi
, shdrNormalMatIndex = nmi
, stateMap = mapBuffer
, mapVert = vert
, stateFrustum = frust
, stateWinClose = False
}
void $ evalRWST (adjustWindow >> run) env state
destroyWindow window
-- Main game loop
run :: Pioneers ()
run = do
win <- asks envWindow
events <- asks envEventsChan
-- draw Scene
--draw
liftIO $ do
glSwapWindow win
submitEvents events
-- getEvents & process
processEvents
-- update State
state <- get
-- change in camera-angle
{- if stateDragging state
then do
let sodx = stateDragStartX state
sody = stateDragStartY state
sodxa = stateDragStartXAngle state
sodya = stateDragStartYAngle state
(x, y) <- liftIO $ GLFW.getCursorPos win
let myrot = (x - sodx) / 2
mxrot = (y - sody) / 2
newXAngle = curb (pi/12) (0.45*pi) newXAngle'
newXAngle' = sodxa + mxrot/100
newYAngle
| newYAngle' > pi = newYAngle' - 2 * pi
| newYAngle' < (-pi) = newYAngle' + 2 * pi
| otherwise = newYAngle'
newYAngle' = sodya + myrot/100
put $ state
{ stateXAngle = newXAngle
, stateYAngle = newYAngle
}
-- liftIO $ putStrLn $ unwords $ map show $ [newXAngle, newYAngle]
else do
(jxrot, jyrot) <- liftIO $ getJoystickDirections GLFW.Joystick'1
put $ state
{ stateXAngle = stateXAngle state + (2 * jxrot)
, stateYAngle = stateYAngle state + (2 * jyrot)
}
-- get cursor-keys - if pressed
--TODO: Add sin/cos from stateYAngle
(kxrot, kyrot) <- liftIO $ getCursorKeyDirections win
modify $ \s ->
let
multc = cos $ stateYAngle s
mults = sin $ stateYAngle s
in
s {
statePositionX = statePositionX s - 0.2 * kxrot * multc
- 0.2 * kyrot * mults
, statePositionY = statePositionY s + 0.2 * kxrot * mults
- 0.2 * kyrot * multc
}
-}
{-
--modify the state with all that happened in mt time.
mt <- liftIO GLFW.getTime
modify $ \s -> s
{
}
-}
unless (stateWinClose state) run
adjustWindow :: Pioneers ()
adjustWindow = do
state <- get
let fbWidth = stateWindowWidth state
fbHeight = stateWindowHeight state
fov = 90 --field of view
near = 1 --near plane
far = 100 --far plane
ratio = fromIntegral fbWidth / fromIntegral fbHeight
frust = createFrustum fov near far ratio
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
put $ state {
stateFrustum = frust
}
-- | Writes all Events atomically to global Queue for further processing.
submitEvents :: TQueue Event -> IO ()
submitEvents q = do
event <- pollEvent
case event of
Nothing -> return ()
Just e -> do
atomically $ writeTQueue q e
submitEvents q
processEvents :: Pioneers ()
processEvents = do
return ()

17
src/Render/Misc.hs
View File

@@ -112,19 +112,4 @@ getCam (x',z') dist' xa' ya' = lookAt (cpos ^+^ at') at' up
dist = realToFrac dist' dist = realToFrac dist'
xa = realToFrac xa' xa = realToFrac xa'
ya = realToFrac ya' ya = realToFrac ya'