converted Types to Labels
- Types is converted to Lebles (monomorphic lenses) - Main initializes type now - All other stuff in Main still calls old syntax. refs #467 @3h
This commit is contained in:
parent
99f7e1593a
commit
d5310478c0
@ -32,5 +32,5 @@ executable Pioneers
|
||||
lens >=3.10.1 && <3.11,
|
||||
SDL2 >= 0.1.0,
|
||||
time >=1.4.0 && <1.5,
|
||||
SDL2-ttf >=0.1.0 && <0.2
|
||||
fclabels >=2.0.0 && <3
|
||||
|
||||
|
||||
118
src/Main.hs
118
src/Main.hs
@ -24,9 +24,9 @@ import Control.Lens ((^.))
|
||||
import Linear as L
|
||||
|
||||
-- GUI
|
||||
import Graphics.UI.SDL as SDL
|
||||
import Graphics.UI.SDL.TTF as TTF
|
||||
import Graphics.UI.SDL.TTF.Types
|
||||
import Graphics.UI.SDL as SDL hiding (Position)
|
||||
--import Graphics.UI.SDL.TTF as TTF
|
||||
--import Graphics.UI.SDL.TTF.Types
|
||||
|
||||
-- Render
|
||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
||||
@ -58,7 +58,7 @@ main = do
|
||||
,WindowInputGrabbed-- never let go of input (KB/Mouse)
|
||||
] $ \window -> do
|
||||
withOpenGL window $ do
|
||||
TTF.withInit $ do
|
||||
--TTF.withInit $ do
|
||||
(Size fbWidth fbHeight) <- glGetDrawableSize window
|
||||
initRendering
|
||||
--generate map vertices
|
||||
@ -69,9 +69,9 @@ main = do
|
||||
putStrLn "foo"
|
||||
now <- getCurrentTime
|
||||
putStrLn "foo"
|
||||
font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
|
||||
TTF.setFontStyle font TTFNormal
|
||||
TTF.setFontHinting font TTFHNormal
|
||||
--font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
|
||||
--TTF.setFontStyle font TTFNormal
|
||||
--TTF.setFontHinting font TTFHNormal
|
||||
|
||||
let zDistClosest = 1
|
||||
zDistFarthest = zDistClosest + 30
|
||||
@ -82,50 +82,72 @@ main = do
|
||||
ratio = fromIntegral fbWidth / fromIntegral fbHeight
|
||||
frust = createFrustum fov near far ratio
|
||||
aks = ArrowKeyState {
|
||||
arrowUp = False
|
||||
,arrowDown = False
|
||||
,arrowLeft = False
|
||||
,arrowRight = False
|
||||
_up = False
|
||||
, _down = False
|
||||
, _left = False
|
||||
, _right = False
|
||||
}
|
||||
glMap = GLMapState
|
||||
{ _shdrVertexIndex = vi
|
||||
, _shdrNormalIndex = ni
|
||||
, _shdrColorIndex = ci
|
||||
, _shdrProjMatIndex = pri
|
||||
, _shdrViewMatIndex = vii
|
||||
, _shdrModelMatIndex = mi
|
||||
, _shdrNormalMatIndex = nmi
|
||||
, _shdrTessInnerIndex = tli
|
||||
, _shdrTessOuterIndex = tlo
|
||||
, _stateTessellationFactor = 4
|
||||
, _stateMap = mapBuffer
|
||||
, _mapVert = vert
|
||||
}
|
||||
env = Env
|
||||
{ envEventsChan = eventQueue
|
||||
, envWindow = window
|
||||
, envZDistClosest = zDistClosest
|
||||
, envZDistFarthest = zDistFarthest
|
||||
, envFont = font
|
||||
{ _eventsChan = eventQueue
|
||||
, _windowObject = window
|
||||
, _zDistClosest = zDistClosest
|
||||
, _zDistFarthest = zDistFarthest
|
||||
--, envFont = font
|
||||
}
|
||||
state = State
|
||||
{ stateWindowWidth = fbWidth
|
||||
, stateWindowHeight = fbHeight
|
||||
, stateXAngle = pi/6
|
||||
, stateYAngle = pi/2
|
||||
, stateZDist = 10
|
||||
, statePositionX = 5
|
||||
, statePositionY = 5
|
||||
, stateCursorPosX = 0
|
||||
, stateCursorPosY = 0
|
||||
, 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
|
||||
, shdrTessInnerIndex = tli
|
||||
, shdrTessOuterIndex = tlo
|
||||
, stateMap = mapBuffer
|
||||
, mapVert = vert
|
||||
, stateFrustum = frust
|
||||
, stateWinClose = False
|
||||
, stateClock = now
|
||||
, stateArrowsPressed = aks
|
||||
, stateTessellationFactor = 4
|
||||
{ _window = WindowState
|
||||
{ _width = fbWidth
|
||||
, _height = fbHeight
|
||||
, _shouldClose = False
|
||||
}
|
||||
, _camera = CameraState
|
||||
{ _xAngle = pi/6
|
||||
, _yAngle = pi/2
|
||||
, _zDist = 10
|
||||
, _frustum = frust
|
||||
, _camPosition = Position
|
||||
{ Types._x = 5
|
||||
, Types._y = 5
|
||||
}
|
||||
}
|
||||
, _io = IOState
|
||||
{ _clock = now
|
||||
}
|
||||
, _mouse = MouseState
|
||||
{ _isDown = False
|
||||
, _isDragging = False
|
||||
, _dragStartX = 0
|
||||
, _dragStartY = 0
|
||||
, _dragStartXAngle = 0
|
||||
, _dragStartYAngle = 0
|
||||
, _mousePosition = Position
|
||||
{ Types._x = 5
|
||||
, Types._y = 5
|
||||
}
|
||||
}
|
||||
, _keyboard = KeyboardState
|
||||
{ _arrowsPressed = aks
|
||||
}
|
||||
, _gl = GLState
|
||||
{ _glMap = glMap
|
||||
}
|
||||
, _game = GameState
|
||||
{
|
||||
}
|
||||
}
|
||||
|
||||
putStrLn "init done."
|
||||
@ -138,7 +160,7 @@ main = do
|
||||
draw :: Pioneers ()
|
||||
draw = do
|
||||
state <- get
|
||||
let xa = stateXAngle state
|
||||
let xa = get (camera . xAngle) state --stateXAngle state
|
||||
ya = stateYAngle state
|
||||
(GL.UniformLocation proj) = shdrProjMatIndex state
|
||||
(GL.UniformLocation nmat) = shdrNormalMatIndex state
|
||||
|
||||
142
src/Types.hs
142
src/Types.hs
@ -1,71 +1,109 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Types where
|
||||
|
||||
import Control.Concurrent.STM (TQueue)
|
||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
||||
import Graphics.UI.SDL as SDL
|
||||
import Graphics.UI.SDL as SDL (Event, Window)
|
||||
import Foreign.C (CFloat)
|
||||
import Data.Time (UTCTime)
|
||||
import Linear.Matrix (M44)
|
||||
import Control.Monad.RWS.Strict (RWST)
|
||||
import Graphics.UI.SDL.TTF.Types as TTF
|
||||
--import Graphics.UI.SDL.TTF.Types as TTF
|
||||
import Control.Lens
|
||||
import Data.Label
|
||||
|
||||
|
||||
|
||||
|
||||
data ArrowKeyState = ArrowKeyState {
|
||||
arrowUp :: !Bool
|
||||
,arrowDown :: !Bool
|
||||
,arrowLeft :: !Bool
|
||||
,arrowRight :: !Bool
|
||||
}
|
||||
|
||||
--Static Read-Only-State
|
||||
data Env = Env
|
||||
{ envEventsChan :: TQueue Event
|
||||
, envWindow :: !Window
|
||||
, envZDistClosest :: !Double
|
||||
, envZDistFarthest :: !Double
|
||||
{ _eventsChan :: TQueue Event
|
||||
, _windowObject :: !Window
|
||||
, _zDistClosest :: !Double
|
||||
, _zDistFarthest :: !Double
|
||||
--, envGLContext :: !GLContext
|
||||
, envFont :: TTF.TTFFont
|
||||
--, envFont :: TTF.TTFFont
|
||||
}
|
||||
|
||||
--Mutable State
|
||||
data State = State
|
||||
{ stateWindowWidth :: !Int
|
||||
, stateWindowHeight :: !Int
|
||||
, stateWinClose :: !Bool
|
||||
, stateClock :: !UTCTime
|
||||
--- IO
|
||||
, stateXAngle :: !Double
|
||||
, stateYAngle :: !Double
|
||||
, stateZDist :: !Double
|
||||
, stateMouseDown :: !Bool
|
||||
, stateDragging :: !Bool
|
||||
, stateDragStartX :: !Double
|
||||
, stateDragStartY :: !Double
|
||||
, stateDragStartXAngle :: !Double
|
||||
, stateDragStartYAngle :: !Double
|
||||
, statePositionX :: !Double
|
||||
, statePositionY :: !Double
|
||||
, stateCursorPosX :: !Double
|
||||
, stateCursorPosY :: !Double
|
||||
, stateArrowsPressed :: !ArrowKeyState
|
||||
, 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
|
||||
, shdrTessInnerIndex :: !GL.UniformLocation
|
||||
, shdrTessOuterIndex :: !GL.UniformLocation
|
||||
, stateTessellationFactor :: !Int
|
||||
--- the map
|
||||
, stateMap :: !GL.BufferObject
|
||||
, mapVert :: !GL.NumArrayIndices
|
||||
|
||||
data Position = Position
|
||||
{ _x :: !Double
|
||||
, _y :: !Double
|
||||
}
|
||||
|
||||
data WindowState = WindowState
|
||||
{ _width :: !Int
|
||||
, _height :: !Int
|
||||
, _shouldClose :: !Bool
|
||||
}
|
||||
|
||||
data CameraState = CameraState
|
||||
{ _xAngle :: !Double
|
||||
, _yAngle :: !Double
|
||||
, _zDist :: !Double
|
||||
, _frustum :: !(M44 CFloat)
|
||||
, _camPosition :: !Position --TODO: Get rid of cam-prefix
|
||||
}
|
||||
|
||||
data IOState = IOState
|
||||
{ _clock :: !UTCTime
|
||||
}
|
||||
|
||||
data GameState = GameState
|
||||
{
|
||||
}
|
||||
|
||||
data MouseState = MouseState
|
||||
{ _isDown :: !Bool
|
||||
, _isDragging :: !Bool
|
||||
, _dragStartX :: !Double
|
||||
, _dragStartY :: !Double
|
||||
, _dragStartXAngle :: !Double
|
||||
, _dragStartYAngle :: !Double
|
||||
, _mousePosition :: !Position --TODO: Get rid of mouse-prefix
|
||||
}
|
||||
|
||||
data ArrowKeyState = ArrowKeyState {
|
||||
_up :: !Bool
|
||||
,_down :: !Bool
|
||||
,_left :: !Bool
|
||||
,_right :: !Bool
|
||||
}
|
||||
|
||||
data KeyboardState = KeyboardState
|
||||
{ _arrowsPressed :: !ArrowKeyState
|
||||
}
|
||||
|
||||
data GLMapState = GLMapState
|
||||
{ _shdrVertexIndex :: !GL.AttribLocation
|
||||
, _shdrColorIndex :: !GL.AttribLocation
|
||||
, _shdrNormalIndex :: !GL.AttribLocation
|
||||
, _shdrProjMatIndex :: !GL.UniformLocation
|
||||
, _shdrViewMatIndex :: !GL.UniformLocation
|
||||
, _shdrModelMatIndex :: !GL.UniformLocation
|
||||
, _shdrNormalMatIndex :: !GL.UniformLocation
|
||||
, _shdrTessInnerIndex :: !GL.UniformLocation
|
||||
, _shdrTessOuterIndex :: !GL.UniformLocation
|
||||
, _stateTessellationFactor :: !Int
|
||||
, _stateMap :: !GL.BufferObject
|
||||
, _mapVert :: !GL.NumArrayIndices
|
||||
}
|
||||
|
||||
data GLState = GLState
|
||||
{ _glMap :: !GLMapState
|
||||
}
|
||||
|
||||
data State = State
|
||||
{ _window :: !WindowState
|
||||
, _camera :: !CameraState
|
||||
, _io :: !IOState
|
||||
, _mouse :: !MouseState
|
||||
, _keyboard :: !KeyboardState
|
||||
, _gl :: !GLState
|
||||
, _game :: !GameState
|
||||
}
|
||||
|
||||
$(mkLabels [''State, ''GLState, ''GLMapState, ''KeyboardState, ''ArrowKeyState,
|
||||
''MouseState, ''GameState, ''IOState, ''CameraState, ''WindowState,
|
||||
''Position, ''Env])
|
||||
|
||||
type Pioneers = RWST Env () State IO
|
||||
Loading…
Reference in New Issue
Block a user