From d5310478c08e297bfd8cd645d8d95ae8892f8a6c Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 23 Feb 2014 13:32:20 +0100 Subject: [PATCH] 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 --- Pioneers.cabal | 2 +- src/Main.hs | 118 +++++++++++++++++++++++----------------- src/Types.hs | 142 +++++++++++++++++++++++++++++++------------------ 3 files changed, 161 insertions(+), 101 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index f49b250..68b447c 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 3a26626..2bc245f 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs index c896bba..ce9c885 100644 --- a/src/Types.hs +++ b/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 \ No newline at end of file