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 Types
|
||||
|
||||
import ThirdParty.Flippers
|
||||
--import ThirdParty.Flippers
|
||||
|
||||
import qualified Debug.Trace as D (trace)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
main :: IO ()
|
||||
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
|
||||
,WindowShown -- window should be visible
|
||||
,WindowResizable -- and resizable
|
||||
@ -64,10 +64,12 @@ main = do
|
||||
--TTF.withInit $ do
|
||||
(Size fbWidth fbHeight) <- glGetDrawableSize window
|
||||
initRendering
|
||||
renderer <- createRenderer window FirstSupported [Accelerated, TargetTexture]
|
||||
-- mapybe PresentVSync
|
||||
--generate map vertices
|
||||
(mapBuffer, vert) <- getMapBufferObject
|
||||
(mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initMapShader
|
||||
putStrLn "foo"
|
||||
putStrLn $ show window
|
||||
eventQueue <- newTQueueIO :: IO (TQueue Event)
|
||||
putStrLn "foo"
|
||||
now <- getCurrentTime
|
||||
@ -110,6 +112,7 @@ main = do
|
||||
, _windowObject = window
|
||||
, _zDistClosest = zDistClosest
|
||||
, _zDistFarthest = zDistFarthest
|
||||
, _renderer = renderer
|
||||
--, envFont = font
|
||||
}
|
||||
state = State
|
||||
@ -335,7 +338,8 @@ 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
|
||||
putStrLn $ show (env ^. windowObject)
|
||||
case state ^. gl.hudTexture of
|
||||
Just tex -> destroyTexture tex
|
||||
_ -> return ()
|
||||
@ -346,7 +350,7 @@ adjustWindow = do
|
||||
TextureAccessStreaming -- change occasionally
|
||||
fbWidth -- width
|
||||
fbHeight -- height
|
||||
modify $ gl.hudTexture .~ (Just hudTex)-}
|
||||
modify $ gl.hudTexture .~ (Just hudTex) -- -}
|
||||
|
||||
processEvents :: Pioneers ()
|
||||
processEvents = do
|
||||
|
@ -124,3 +124,4 @@ tryWithTexture t f fail' =
|
||||
case t of
|
||||
Just tex -> f tex
|
||||
_ -> fail'
|
||||
|
||||
|
@ -3,7 +3,7 @@ module Types where
|
||||
|
||||
import Control.Concurrent.STM (TQueue)
|
||||
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 Data.Time (UTCTime)
|
||||
import Linear.Matrix (M44)
|
||||
@ -19,6 +19,7 @@ data Env = Env
|
||||
, _zDistFarthest :: !Double
|
||||
--, envGLContext :: !GLContext
|
||||
--, envFont :: TTF.TTFFont
|
||||
, _renderer :: !Renderer
|
||||
}
|
||||
|
||||
--Mutable State
|
||||
|
Loading…
Reference in New Issue
Block a user