forgot files -.-

This commit is contained in:
Nicole Dresselhaus 2014-02-05 21:06:19 +01:00
parent 1126cfc25a
commit 95a7a5b9f1
2 changed files with 91 additions and 0 deletions

71
src/Types.hs Normal file
View File

@ -0,0 +1,71 @@
module Types where
import Control.Concurrent.STM (TQueue)
import qualified Graphics.Rendering.OpenGL.GL as GL
import Graphics.UI.SDL as SDL
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
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
--, envGLContext :: !GLContext
, 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
}
type Pioneers = RWST Env () State IO

20
src/UI/Callbacks.hs Normal file
View File

@ -0,0 +1,20 @@
module UI.Callbacks where
import Control.Monad.Trans (liftIO)
import Types
data Pixel = Pixel Int Int
-- | Handler for UI-Inputs.
-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ...
clickHandler :: Pixel -> Pioneers ()
clickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"]
-- | Handler for UI-Inputs.
-- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ...
alternateClickHandler :: Pixel -> Pioneers ()
alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"]
--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
--TODO: Maybe queues are better?