cam now moves with height.
- cam still has NaN-Issues
This commit is contained in:
parent
b7be183c25
commit
d83c87db1d
12
src/Main.hs
12
src/Main.hs
@ -43,6 +43,7 @@ import Render.Render (initRendering,
|
||||
import Render.Types
|
||||
import UI.Callbacks
|
||||
import Map.Graphics
|
||||
import Map.Creation (exportedMap)
|
||||
import Types
|
||||
import Importer.IQM.Parser
|
||||
--import Data.Attoparsec.Char8 (parseTest)
|
||||
@ -53,7 +54,7 @@ import Importer.IQM.Parser
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testParser :: String -> IO ()
|
||||
testParser a = putStrLn . show =<< parseIQM a
|
||||
testParser a = print =<< parseIQM a
|
||||
{-do
|
||||
f <- B.readFile a
|
||||
putStrLn "reading in:"
|
||||
@ -85,7 +86,8 @@ main =
|
||||
(SDL.Size fbWidth fbHeight) <- SDL.glGetDrawableSize window'
|
||||
initRendering
|
||||
--generate map vertices
|
||||
glMap' <- initMapShader 4 =<< getMapBufferObject
|
||||
curMap <- exportedMap
|
||||
glMap' <- initMapShader 4 =<< getMapBufferObject curMap
|
||||
eventQueue <- newTQueueIO :: IO (TQueue SDL.Event)
|
||||
now <- getCurrentTime
|
||||
--font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
|
||||
@ -125,7 +127,7 @@ main =
|
||||
, _yAngle = pi/2
|
||||
, _zDist = 10
|
||||
, _frustum = frust
|
||||
, _camObject = createFlatCam 25 25
|
||||
, _camObject = createFlatCam 25 25 curMap
|
||||
}
|
||||
, _io = IOState
|
||||
{ _clock = now
|
||||
@ -153,7 +155,7 @@ main =
|
||||
, _glFramebuffer = frameBuffer
|
||||
}
|
||||
, _game = GameState
|
||||
{
|
||||
{ _currentMap = curMap
|
||||
}
|
||||
, _ui = UIState
|
||||
{ _uiHasChanged = True
|
||||
@ -216,7 +218,7 @@ run = do
|
||||
- 0.2 * kyrot * mults
|
||||
mody y' = y' + 0.2 * kxrot * mults
|
||||
- 0.2 * kyrot * multc
|
||||
modify $ camera.camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)))
|
||||
modify $ camera.camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (state ^. game.currentMap))
|
||||
|
||||
{-
|
||||
--modify the state with all that happened in mt time.
|
||||
|
||||
@ -85,9 +85,8 @@ fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
|
||||
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
||||
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
||||
|
||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject = do
|
||||
eMap <- exportedMap
|
||||
getMapBufferObject :: PlayMap -> IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject eMap = do
|
||||
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap eMap
|
||||
! myMap <- return $ generateTriangles myMap'
|
||||
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
||||
|
||||
@ -1,8 +1,6 @@
|
||||
module Map.Types
|
||||
where
|
||||
|
||||
import Types
|
||||
|
||||
import Data.Array
|
||||
|
||||
type PlayMap = Array (Xindex, Zindex) Node
|
||||
@ -71,3 +69,64 @@ data TileType = Ocean
|
||||
-- TODO: Record Syntax?
|
||||
data Node = Node (Xindex, Zindex) (XCoord, ZCoord, YCoord) TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
|
||||
deriving (Show)
|
||||
|
||||
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"
|
||||
|
||||
|
||||
@ -24,6 +24,7 @@ import Render.Types
|
||||
import Graphics.GLUtil.BufferObjects (makeBuffer)
|
||||
import Importer.IQM.Parser
|
||||
import Importer.IQM.Types
|
||||
import Map.Map (giveMapHeight)
|
||||
|
||||
mapVertexShaderFile :: String
|
||||
mapVertexShaderFile = "shaders/map/vertex.shader"
|
||||
|
||||
@ -4,6 +4,10 @@ module Render.Types (createFlatCam, createSphereCam, Camera, GLCamera(..)) where
|
||||
import Linear
|
||||
import Foreign.C (CFloat)
|
||||
import Render.Misc (lookAt)
|
||||
import Map.Map (giveMapHeight)
|
||||
import Map.Types (PlayMap)
|
||||
import GHC.Float
|
||||
import qualified Debug.Trace as D
|
||||
|
||||
type Distance = Double
|
||||
type Pitch = Double
|
||||
@ -11,30 +15,32 @@ type Yaw = Double
|
||||
|
||||
class GLCamera a where
|
||||
getCam :: a -> Distance -> Pitch -> Yaw -> M44 CFloat
|
||||
moveBy :: a -> (Position -> Position) -> a
|
||||
move :: a -> Position -> a
|
||||
moveBy :: a -> (Position -> Position) -> PlayMap -> a
|
||||
move :: a -> Position -> PlayMap -> a
|
||||
|
||||
type Position = (Double, Double)
|
||||
|
||||
type Radius = Double
|
||||
|
||||
data Camera = Flat Position
|
||||
type Height = Double
|
||||
|
||||
data Camera = Flat Position Height
|
||||
| Sphere Position Radius
|
||||
|
||||
-- | create a Flatcam-Camera starting at given x/z-Coordinates
|
||||
createFlatCam :: Double -> Double -> Camera
|
||||
createFlatCam x z = Flat (x,z)
|
||||
createFlatCam :: Double -> Double -> PlayMap -> Camera
|
||||
createFlatCam x z map' = Flat (x,z) (float2Double $ giveMapHeight map' (double2Float x,double2Float z))
|
||||
|
||||
-- | create a Flatcam-Camera starting at given pitch/azimuth/radius
|
||||
createSphereCam :: Double -> Double -> Double -> Camera
|
||||
createSphereCam p a r = Sphere (p,a) r
|
||||
createSphereCam p a = Sphere (p,a)
|
||||
|
||||
|
||||
instance GLCamera Camera where
|
||||
getCam (Flat (x',z')) dist' xa' ya' =
|
||||
getCam (Flat (x',z') y') dist' xa' ya' =
|
||||
lookAt (cpos ^+^ at') at' up
|
||||
where
|
||||
at' = V3 x 0 z
|
||||
at' = V3 x y z
|
||||
cpos = crot !* (V3 0 0 (-dist))
|
||||
crot = (
|
||||
(fromQuaternion $ axisAngle upmap (xa::CFloat))
|
||||
@ -44,6 +50,7 @@ instance GLCamera Camera where
|
||||
upmap = ((fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat)) :: M33 CFloat)
|
||||
!* (V3 1 0 0)
|
||||
x = realToFrac x'
|
||||
y = realToFrac y'
|
||||
z = realToFrac z'
|
||||
dist = realToFrac dist'
|
||||
xa = realToFrac xa'
|
||||
@ -68,9 +75,13 @@ instance GLCamera Camera where
|
||||
dist = realToFrac dist'
|
||||
xa = realToFrac xa'
|
||||
ya = realToFrac ya'
|
||||
moveBy (Sphere (inc, az) r) f = undefined
|
||||
moveBy (Flat (x', z')) f = Flat (f (x',z'))
|
||||
move c (x', z') = moveBy c (\(x,z) -> (x+x',z+z'))
|
||||
moveBy (Sphere (inc, az) r) f map = undefined
|
||||
moveBy (Flat (x', z') y) f map = Flat (x,z) (float2Double y)
|
||||
where
|
||||
(x,z) = f (x', z')
|
||||
y = giveMapHeight map (fc x,fc z)
|
||||
fc = double2Float
|
||||
move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map
|
||||
|
||||
sphereToCart :: (Floating a) => a -> a -> a -> V3 a
|
||||
sphereToCart r inc az = V3
|
||||
|
||||
63
src/Types.hs
63
src/Types.hs
@ -15,6 +15,7 @@ import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
|
||||
import Render.Types
|
||||
import Importer.IQM.Types
|
||||
import UI.UIBase
|
||||
import Map.Types (PlayMap)
|
||||
|
||||
data Coord3D a = Coord3D a a a
|
||||
|
||||
@ -56,7 +57,7 @@ data IOState = IOState
|
||||
}
|
||||
|
||||
data GameState = GameState
|
||||
{
|
||||
{ _currentMap :: !PlayMap
|
||||
}
|
||||
|
||||
data MouseState = MouseState
|
||||
@ -186,63 +187,3 @@ $(makeLenses ''Position)
|
||||
$(makeLenses ''Env)
|
||||
$(makeLenses ''UIState)
|
||||
|
||||
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"
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user