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

converted Types to Labels

Browse Source 
- 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:
Nicole Dresselhaus 2014-02-23 13:32:20 +01:00
parent 99f7e1593a
commit d5310478c0
3 changed files with 161 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Pioneers.cabal
View File

@ -32,5 +32,5 @@ executable Pioneers
lens >=3.10.1 && <3.11, lens >=3.10.1 && <3.11,
SDL2 >= 0.1.0, SDL2 >= 0.1.0,
time >=1.4.0 && <1.5, time >=1.4.0 && <1.5,
SDL2-ttf >=0.1.0 && <0.2 fclabels >=2.0.0 && <3

118
src/Main.hs
View File

@ -24,9 +24,9 @@ import Control.Lens ((^.))
import Linear as L import Linear as L
-- GUI -- GUI
import Graphics.UI.SDL as SDL import Graphics.UI.SDL as SDL hiding (Position)
import Graphics.UI.SDL.TTF as TTF --import Graphics.UI.SDL.TTF as TTF
import Graphics.UI.SDL.TTF.Types --import Graphics.UI.SDL.TTF.Types
-- Render -- Render
import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.Rendering.OpenGL.GL as GL
@ -58,7 +58,7 @@ main = do
,WindowInputGrabbed-- never let go of input (KB/Mouse) ,WindowInputGrabbed-- never let go of input (KB/Mouse)
] $ \window -> do ] $ \window -> do
withOpenGL window $ do withOpenGL window $ do
TTF.withInit $ do --TTF.withInit $ do
(Size fbWidth fbHeight) <- glGetDrawableSize window (Size fbWidth fbHeight) <- glGetDrawableSize window
initRendering initRendering
--generate map vertices --generate map vertices
@ -69,9 +69,9 @@ main = do
putStrLn "foo" putStrLn "foo"
now <- getCurrentTime now <- getCurrentTime
putStrLn "foo" putStrLn "foo"
font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
TTF.setFontStyle font TTFNormal --TTF.setFontStyle font TTFNormal
TTF.setFontHinting font TTFHNormal --TTF.setFontHinting font TTFHNormal
let zDistClosest = 1 let zDistClosest = 1
zDistFarthest = zDistClosest + 30 zDistFarthest = zDistClosest + 30
@ -82,50 +82,72 @@ main = do
ratio = fromIntegral fbWidth / fromIntegral fbHeight ratio = fromIntegral fbWidth / fromIntegral fbHeight
frust = createFrustum fov near far ratio frust = createFrustum fov near far ratio
aks = ArrowKeyState { aks = ArrowKeyState {
arrowUp = False _up = False
,arrowDown = False , _down = False
,arrowLeft = False , _left = False
,arrowRight = 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 env = Env
{ envEventsChan = eventQueue { _eventsChan = eventQueue
, envWindow = window , _windowObject = window
, envZDistClosest = zDistClosest , _zDistClosest = zDistClosest
, envZDistFarthest = zDistFarthest , _zDistFarthest = zDistFarthest
, envFont = font --, envFont = font
} }
state = State state = State
{ stateWindowWidth = fbWidth { _window = WindowState
, stateWindowHeight = fbHeight { _width = fbWidth
, stateXAngle = pi/6 , _height = fbHeight
, stateYAngle = pi/2 , _shouldClose = False
, stateZDist = 10 }
, statePositionX = 5 , _camera = CameraState
, statePositionY = 5 { _xAngle = pi/6
, stateCursorPosX = 0 , _yAngle = pi/2
, stateCursorPosY = 0 , _zDist = 10
, stateMouseDown = False , _frustum = frust
, stateDragging = False , _camPosition = Position
, stateDragStartX = 0 { Types._x = 5
, stateDragStartY = 0 , Types._y = 5
, stateDragStartXAngle = 0 }
, stateDragStartYAngle = 0 }
, shdrVertexIndex = vi , _io = IOState
, shdrNormalIndex = ni { _clock = now
, shdrColorIndex = ci }
, shdrProjMatIndex = pri , _mouse = MouseState
, shdrViewMatIndex = vii { _isDown = False
, shdrModelMatIndex = mi , _isDragging = False
, shdrNormalMatIndex = nmi , _dragStartX = 0
, shdrTessInnerIndex = tli , _dragStartY = 0
, shdrTessOuterIndex = tlo , _dragStartXAngle = 0
, stateMap = mapBuffer , _dragStartYAngle = 0
, mapVert = vert , _mousePosition = Position
, stateFrustum = frust { Types._x = 5
, stateWinClose = False , Types._y = 5
, stateClock = now }
, stateArrowsPressed = aks }
, stateTessellationFactor = 4 , _keyboard = KeyboardState
{ _arrowsPressed = aks
}
, _gl = GLState
{ _glMap = glMap
}
, _game = GameState
{
}
} }
putStrLn "init done." putStrLn "init done."
@ -138,7 +160,7 @@ main = do
draw :: Pioneers () draw :: Pioneers ()
draw = do draw = do
state <- get state <- get
let xa = stateXAngle state let xa = get (camera . xAngle) state --stateXAngle state
ya = stateYAngle state ya = stateYAngle state
(GL.UniformLocation proj) = shdrProjMatIndex state (GL.UniformLocation proj) = shdrProjMatIndex state
(GL.UniformLocation nmat) = shdrNormalMatIndex state (GL.UniformLocation nmat) = shdrNormalMatIndex state

142
src/Types.hs
View File

@ -1,71 +1,109 @@
{-# LANGUAGE TemplateHaskell #-}
module Types where 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 import Graphics.UI.SDL as SDL (Event, Window)
import Foreign.C (CFloat) import Foreign.C (CFloat)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Linear.Matrix (M44) import Linear.Matrix (M44)
import Control.Monad.RWS.Strict (RWST) 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 --Static Read-Only-State
data Env = Env data Env = Env
{ envEventsChan :: TQueue Event { _eventsChan :: TQueue Event
, envWindow :: !Window , _windowObject :: !Window
, envZDistClosest :: !Double , _zDistClosest :: !Double
, envZDistFarthest :: !Double , _zDistFarthest :: !Double
--, envGLContext :: !GLContext --, envGLContext :: !GLContext
, envFont :: TTF.TTFFont --, envFont :: TTF.TTFFont
} }
--Mutable State --Mutable State
data State = State
{ stateWindowWidth :: !Int data Position = Position
, stateWindowHeight :: !Int { _x :: !Double
, stateWinClose :: !Bool , _y :: !Double
, 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 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 type Pioneers = RWST Env () State IO