2014-02-23 12:32:20 +00:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
2014-02-05 20:06:19 +00:00
|
|
|
module Types where
|
|
|
|
|
|
|
|
import Control.Concurrent.STM (TQueue)
|
|
|
|
import qualified Graphics.Rendering.OpenGL.GL as GL
|
2014-04-15 15:03:54 +00:00
|
|
|
import Graphics.UI.SDL as SDL (Event, Window)
|
2014-02-05 20:06:19 +00:00
|
|
|
import Foreign.C (CFloat)
|
2014-04-24 21:42:05 +00:00
|
|
|
import qualified Data.HashMap.Strict as Map
|
2014-02-05 20:06:19 +00:00
|
|
|
import Data.Time (UTCTime)
|
|
|
|
import Linear.Matrix (M44)
|
|
|
|
import Control.Monad.RWS.Strict (RWST)
|
2014-02-23 12:32:20 +00:00
|
|
|
import Control.Lens
|
2014-04-04 09:15:00 +00:00
|
|
|
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
|
2014-04-21 17:46:24 +00:00
|
|
|
import Render.Types
|
2014-04-24 21:42:05 +00:00
|
|
|
import UI.UIBaseData
|
2014-02-05 20:06:19 +00:00
|
|
|
|
|
|
|
|
2014-02-23 12:32:20 +00:00
|
|
|
--Static Read-Only-State
|
|
|
|
data Env = Env
|
|
|
|
{ _eventsChan :: TQueue Event
|
|
|
|
, _windowObject :: !Window
|
|
|
|
, _zDistClosest :: !Double
|
|
|
|
, _zDistFarthest :: !Double
|
|
|
|
--, envGLContext :: !GLContext
|
|
|
|
--, envFont :: TTF.TTFFont
|
2014-04-04 09:18:42 +00:00
|
|
|
-- , _renderer :: !Renderer
|
2014-02-23 12:32:20 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
--Mutable State
|
|
|
|
|
|
|
|
data Position = Position
|
2014-04-07 15:32:13 +00:00
|
|
|
{ __x :: !Double
|
|
|
|
, __y :: !Double
|
2014-02-23 12:32:20 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
data WindowState = WindowState
|
|
|
|
{ _width :: !Int
|
|
|
|
, _height :: !Int
|
|
|
|
, _shouldClose :: !Bool
|
|
|
|
}
|
|
|
|
|
|
|
|
data CameraState = CameraState
|
|
|
|
{ _xAngle :: !Double
|
|
|
|
, _yAngle :: !Double
|
|
|
|
, _zDist :: !Double
|
|
|
|
, _frustum :: !(M44 CFloat)
|
2014-04-21 17:46:24 +00:00
|
|
|
, _camObject :: !Camera
|
2014-02-23 12:32:20 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
data IOState = IOState
|
|
|
|
{ _clock :: !UTCTime
|
|
|
|
}
|
|
|
|
|
|
|
|
data GameState = GameState
|
|
|
|
{
|
|
|
|
}
|
2014-02-05 20:06:19 +00:00
|
|
|
|
2014-02-23 12:32:20 +00:00
|
|
|
data MouseState = MouseState
|
|
|
|
{ _isDown :: !Bool
|
|
|
|
, _isDragging :: !Bool
|
|
|
|
, _dragStartX :: !Double
|
|
|
|
, _dragStartY :: !Double
|
|
|
|
, _dragStartXAngle :: !Double
|
|
|
|
, _dragStartYAngle :: !Double
|
|
|
|
, _mousePosition :: !Position --TODO: Get rid of mouse-prefix
|
|
|
|
}
|
2014-02-05 20:06:19 +00:00
|
|
|
|
|
|
|
data ArrowKeyState = ArrowKeyState {
|
2014-02-23 12:32:20 +00:00
|
|
|
_up :: !Bool
|
|
|
|
,_down :: !Bool
|
|
|
|
,_left :: !Bool
|
|
|
|
,_right :: !Bool
|
2014-02-05 20:06:19 +00:00
|
|
|
}
|
|
|
|
|
2014-02-23 12:32:20 +00:00
|
|
|
data KeyboardState = KeyboardState
|
|
|
|
{ _arrowsPressed :: !ArrowKeyState
|
|
|
|
}
|
|
|
|
|
2014-04-24 12:21:25 +00:00
|
|
|
-- | State in which all map-related Data is stored
|
|
|
|
--
|
|
|
|
-- The map itself is rendered with mapProgram and the shaders given here directly
|
|
|
|
-- This does not include any objects on the map - only the map itself
|
|
|
|
--
|
|
|
|
-- _mapTextures must contain the following Textures (in this ordering) after initialisation:
|
|
|
|
--
|
|
|
|
-- 1. Grass
|
|
|
|
--
|
|
|
|
-- 2. Sand
|
|
|
|
--
|
|
|
|
-- 3. Water
|
|
|
|
--
|
|
|
|
-- 4. Stone
|
|
|
|
--
|
|
|
|
-- 5. Snow
|
|
|
|
--
|
|
|
|
-- 6. Dirt (blended on grass)
|
|
|
|
|
|
|
|
|
2014-02-23 12:32:20 +00:00
|
|
|
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
|
2014-03-24 07:21:30 +00:00
|
|
|
, _mapProgram :: !GL.Program
|
2014-04-24 12:21:25 +00:00
|
|
|
, _renderedMapTexture :: !TextureObject --TODO: Probably move to UI?
|
2014-04-22 14:25:29 +00:00
|
|
|
, _overviewTexture :: !TextureObject
|
2014-04-24 12:21:25 +00:00
|
|
|
, _mapTextures :: ![TextureObject] --TODO: Fix size on list?
|
2014-02-23 12:32:20 +00:00
|
|
|
}
|
|
|
|
|
2014-04-04 09:15:00 +00:00
|
|
|
data GLHud = GLHud
|
2014-04-05 13:53:49 +00:00
|
|
|
{ _hudTexture :: !TextureObject -- ^ HUD-Texture itself
|
|
|
|
, _hudTexIndex :: !GL.UniformLocation -- ^ Position of Overlay-Texture in Shader
|
|
|
|
, _hudBackIndex :: !GL.UniformLocation -- ^ Position of Background-Texture in Shader
|
2014-04-04 09:15:00 +00:00
|
|
|
, _hudVertexIndex :: !GL.AttribLocation -- ^ Position of Vertices in Shader
|
|
|
|
, _hudVert :: !GL.NumArrayIndices -- ^ Number of Vertices to draw
|
|
|
|
, _hudVBO :: !GL.BufferObject -- ^ Vertex-Buffer-Object
|
|
|
|
, _hudEBO :: !GL.BufferObject -- ^ Element-Buffer-Object
|
|
|
|
, _hudProgram :: !GL.Program -- ^ Program for rendering HUD
|
|
|
|
}
|
|
|
|
|
2014-02-23 12:32:20 +00:00
|
|
|
data GLState = GLState
|
|
|
|
{ _glMap :: !GLMapState
|
2014-04-04 09:15:00 +00:00
|
|
|
, _glHud :: !GLHud
|
2014-04-05 13:53:49 +00:00
|
|
|
, _glRenderbuffer :: !GL.RenderbufferObject
|
|
|
|
, _glFramebuffer :: !GL.FramebufferObject
|
2014-02-05 20:06:19 +00:00
|
|
|
}
|
|
|
|
|
2014-03-24 07:21:30 +00:00
|
|
|
data UIState = UIState
|
2014-04-05 21:09:57 +00:00
|
|
|
{ _uiHasChanged :: !Bool
|
2014-04-24 21:42:05 +00:00
|
|
|
, _uiMap :: Map.HashMap UIId (GUIAny Pioneers)
|
2014-04-26 17:16:53 +00:00
|
|
|
, _uiRoots :: [UIId]
|
2014-03-24 07:21:30 +00:00
|
|
|
}
|
|
|
|
|
2014-02-05 20:06:19 +00:00
|
|
|
data State = State
|
2014-02-23 12:32:20 +00:00
|
|
|
{ _window :: !WindowState
|
|
|
|
, _camera :: !CameraState
|
|
|
|
, _io :: !IOState
|
|
|
|
, _mouse :: !MouseState
|
|
|
|
, _keyboard :: !KeyboardState
|
|
|
|
, _gl :: !GLState
|
|
|
|
, _game :: !GameState
|
2014-03-24 07:21:30 +00:00
|
|
|
, _ui :: !UIState
|
2014-02-05 20:06:19 +00:00
|
|
|
}
|
|
|
|
|
2014-04-24 21:42:05 +00:00
|
|
|
type Pioneers = RWST Env () State IO
|
|
|
|
|
|
|
|
-- when using TemplateHaskell order of declaration matters
|
2014-03-05 13:42:26 +00:00
|
|
|
$(makeLenses ''State)
|
|
|
|
$(makeLenses ''GLState)
|
|
|
|
$(makeLenses ''GLMapState)
|
2014-04-04 09:15:00 +00:00
|
|
|
$(makeLenses ''GLHud)
|
2014-03-05 13:42:26 +00:00
|
|
|
$(makeLenses ''KeyboardState)
|
|
|
|
$(makeLenses ''ArrowKeyState)
|
|
|
|
$(makeLenses ''MouseState)
|
|
|
|
$(makeLenses ''GameState)
|
|
|
|
$(makeLenses ''IOState)
|
|
|
|
$(makeLenses ''CameraState)
|
|
|
|
$(makeLenses ''WindowState)
|
|
|
|
$(makeLenses ''Position)
|
|
|
|
$(makeLenses ''Env)
|
2014-03-24 07:21:30 +00:00
|
|
|
$(makeLenses ''UIState)
|
2014-03-05 13:42:26 +00:00
|
|
|
|
2014-04-23 10:11:45 +00:00
|
|
|
data Structure = Flag -- Flag
|
|
|
|
| Woodcutter -- Huts
|
|
|
|
| Forester
|
|
|
|
| Stonemason
|
|
|
|
| Fisher
|
|
|
|
| Hunter
|
|
|
|
| Barracks
|
|
|
|
| Guardhouse
|
|
|
|
| LookoutTower
|
|
|
|
| Well
|
|
|
|
| Sawmill -- Houses
|
|
|
|
| Slaughterhouse
|
|
|
|
| Mill
|
|
|
|
| Bakery
|
|
|
|
| IronSmelter
|
|
|
|
| Metalworks
|
|
|
|
| Armory
|
|
|
|
| Mint
|
|
|
|
| Shipyard
|
|
|
|
| Brewery
|
|
|
|
| Storehouse
|
|
|
|
| Watchtower
|
|
|
|
| Catapult
|
|
|
|
| GoldMine -- Mines
|
|
|
|
| IronMine
|
|
|
|
| GraniteMine
|
|
|
|
| CoalMine
|
|
|
|
| Farm -- Castles
|
|
|
|
| PigFarm
|
|
|
|
| DonkeyBreeder
|
|
|
|
| Harbor
|
|
|
|
| Fortress
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
data Amount = Infinite -- Neverending supply
|
|
|
|
| Finite Int -- Finite supply
|
|
|
|
|
|
|
|
-- Extremely preliminary, expand when needed
|
|
|
|
data Commodity = WoodPlank
|
|
|
|
| Sword
|
|
|
|
| Fish
|
|
|
|
deriving Eq
|
|
|
|
|
|
|
|
data Resource = Coal
|
|
|
|
| Iron
|
|
|
|
| Gold
|
|
|
|
| Granite
|
|
|
|
| Water
|
|
|
|
| Fishes
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
instance Show Amount where
|
|
|
|
show (Infinite) = "inexhaustable supply"
|
|
|
|
show (Finite n) = show n ++ " left"
|
|
|
|
|
|
|
|
instance Show Commodity where
|
|
|
|
show WoodPlank = "wooden plank"
|
|
|
|
show Sword = "sword"
|
|
|
|
show Fish = "fish"
|
|
|
|
|