forgot files -.-
This commit is contained in:
parent
1126cfc25a
commit
95a7a5b9f1
71
src/Types.hs
Normal file
71
src/Types.hs
Normal 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
20
src/UI/Callbacks.hs
Normal 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?
|
Loading…
Reference in New Issue
Block a user