still WIP.
This commit is contained in:
parent
c1e074934e
commit
9cd0eacd31
14
src/Main.hs
14
src/Main.hs
@ -45,14 +45,14 @@ import UI.Callbacks
|
|||||||
import UI.GUIOverlay
|
import UI.GUIOverlay
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
import ThirdParty.Flippers
|
--import ThirdParty.Flippers
|
||||||
|
|
||||||
import qualified Debug.Trace as D (trace)
|
import qualified Debug.Trace as D (trace)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
SDL.withInit [InitVideo, InitAudio] $ do --also: InitNoParachute -> faster, without parachute!
|
SDL.withInit [InitVideo, InitAudio, InitEvents, InitTimer] $ do --also: InitNoParachute -> faster, without parachute!
|
||||||
SDL.withWindow "Pioneers" (SDL.Position 100 100) (Size 1024 600) [WindowOpengl -- we want openGL
|
SDL.withWindow "Pioneers" (SDL.Position 100 100) (Size 1024 600) [WindowOpengl -- we want openGL
|
||||||
,WindowShown -- window should be visible
|
,WindowShown -- window should be visible
|
||||||
,WindowResizable -- and resizable
|
,WindowResizable -- and resizable
|
||||||
@ -64,10 +64,12 @@ main = do
|
|||||||
--TTF.withInit $ do
|
--TTF.withInit $ do
|
||||||
(Size fbWidth fbHeight) <- glGetDrawableSize window
|
(Size fbWidth fbHeight) <- glGetDrawableSize window
|
||||||
initRendering
|
initRendering
|
||||||
|
renderer <- createRenderer window FirstSupported [Accelerated, TargetTexture]
|
||||||
|
-- mapybe PresentVSync
|
||||||
--generate map vertices
|
--generate map vertices
|
||||||
(mapBuffer, vert) <- getMapBufferObject
|
(mapBuffer, vert) <- getMapBufferObject
|
||||||
(mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initMapShader
|
(mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initMapShader
|
||||||
putStrLn "foo"
|
putStrLn $ show window
|
||||||
eventQueue <- newTQueueIO :: IO (TQueue Event)
|
eventQueue <- newTQueueIO :: IO (TQueue Event)
|
||||||
putStrLn "foo"
|
putStrLn "foo"
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
@ -110,6 +112,7 @@ main = do
|
|||||||
, _windowObject = window
|
, _windowObject = window
|
||||||
, _zDistClosest = zDistClosest
|
, _zDistClosest = zDistClosest
|
||||||
, _zDistFarthest = zDistFarthest
|
, _zDistFarthest = zDistFarthest
|
||||||
|
, _renderer = renderer
|
||||||
--, envFont = font
|
--, envFont = font
|
||||||
}
|
}
|
||||||
state = State
|
state = State
|
||||||
@ -335,7 +338,8 @@ adjustWindow = do
|
|||||||
frust = createFrustum fov near far ratio
|
frust = createFrustum fov near far ratio
|
||||||
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
|
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
|
||||||
modify $ camera.frustum .~ frust
|
modify $ camera.frustum .~ frust
|
||||||
{-hudTex <- liftIO $ do
|
hudTex <- liftIO $ do
|
||||||
|
putStrLn $ show (env ^. windowObject)
|
||||||
case state ^. gl.hudTexture of
|
case state ^. gl.hudTexture of
|
||||||
Just tex -> destroyTexture tex
|
Just tex -> destroyTexture tex
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
@ -346,7 +350,7 @@ adjustWindow = do
|
|||||||
TextureAccessStreaming -- change occasionally
|
TextureAccessStreaming -- change occasionally
|
||||||
fbWidth -- width
|
fbWidth -- width
|
||||||
fbHeight -- height
|
fbHeight -- height
|
||||||
modify $ gl.hudTexture .~ (Just hudTex)-}
|
modify $ gl.hudTexture .~ (Just hudTex) -- -}
|
||||||
|
|
||||||
processEvents :: Pioneers ()
|
processEvents :: Pioneers ()
|
||||||
processEvents = do
|
processEvents = do
|
||||||
|
@ -124,3 +124,4 @@ tryWithTexture t f fail' =
|
|||||||
case t of
|
case t of
|
||||||
Just tex -> f tex
|
Just tex -> f tex
|
||||||
_ -> fail'
|
_ -> fail'
|
||||||
|
|
||||||
|
@ -3,7 +3,7 @@ module Types where
|
|||||||
|
|
||||||
import Control.Concurrent.STM (TQueue)
|
import Control.Concurrent.STM (TQueue)
|
||||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
import qualified Graphics.Rendering.OpenGL.GL as GL
|
||||||
import Graphics.UI.SDL as SDL (Event, Window, Texture)
|
import Graphics.UI.SDL as SDL (Event, Window, Texture, Renderer)
|
||||||
import Foreign.C (CFloat)
|
import Foreign.C (CFloat)
|
||||||
import Data.Time (UTCTime)
|
import Data.Time (UTCTime)
|
||||||
import Linear.Matrix (M44)
|
import Linear.Matrix (M44)
|
||||||
@ -19,6 +19,7 @@ data Env = Env
|
|||||||
, _zDistFarthest :: !Double
|
, _zDistFarthest :: !Double
|
||||||
--, envGLContext :: !GLContext
|
--, envGLContext :: !GLContext
|
||||||
--, envFont :: TTF.TTFFont
|
--, envFont :: TTF.TTFFont
|
||||||
|
, _renderer :: !Renderer
|
||||||
}
|
}
|
||||||
|
|
||||||
--Mutable State
|
--Mutable State
|
||||||
|
Loading…
Reference in New Issue
Block a user