From d83c87db1d671f11c78a08ffba9f8c79a625be62 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 15 May 2014 15:10:10 +0200 Subject: [PATCH] cam now moves with height. - cam still has NaN-Issues --- src/Main.hs | 12 +++++---- src/Map/Graphics.hs | 5 ++-- src/Map/Types.hs | 63 ++++++++++++++++++++++++++++++++++++++++++-- src/Render/Render.hs | 1 + src/Render/Types.hs | 35 +++++++++++++++--------- src/Types.hs | 63 ++------------------------------------------ 6 files changed, 96 insertions(+), 83 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 0d97808..9f6c15e 100644 --- a/src/Main.hs +++ b/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. diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index 0995741..7c9c93f 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -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 diff --git a/src/Map/Types.hs b/src/Map/Types.hs index dd66236..cd3f246 100644 --- a/src/Map/Types.hs +++ b/src/Map/Types.hs @@ -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" + diff --git a/src/Render/Render.hs b/src/Render/Render.hs index b732045..7863ceb 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -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" diff --git a/src/Render/Types.hs b/src/Render/Types.hs index e7273b2..0b60da1 100644 --- a/src/Render/Types.hs +++ b/src/Render/Types.hs @@ -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,12 +75,16 @@ 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 (r * (sin inc) * (cos az)) (r * (sin inc) * (sin az)) - (r * (cos inc)) \ No newline at end of file + (r * (cos inc)) diff --git a/src/Types.hs b/src/Types.hs index f16333c..d9795bf 100644 --- a/src/Types.hs +++ b/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" -