pituicat/src/Types/Map.hs

124 lines
3.2 KiB
Haskell

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module Types.Map where
import qualified Data.Vector as V
import Linear
-- internal imports
import Types.Texture
import Types.Graphics.VertexBuffer
import Classes.Graphics.Drawable
import Classes.Physics
data LevelMap = LevelMap
{ mapLayers :: V.Vector Layer -- ^ Layer stack
, mapWalkLayer :: Word -- ^ Collision layer index in stack
, mapDimensions :: V2 Word -- ^ Dimension of map in tiles
, mapTileMap :: TileMap -- ^ The tile map
, mapStartPos :: V2 Word -- ^ Player start position
}
deriving (Eq, Show)
type Layer = V.Vector Tile
instance Drawable Layer where
-- type VertexList Layer = V.Vector
toVertices vt = V.foldl
(\(acci, accv) (multi, a) ->
let (ris, vs) = toVertices a
is = V.map (multi * 4 +) ris
in (acci V.++ is, accv V.++ vs)
)
(V.empty, V.empty)
(V.zip (V.fromList [0 ..]) vt)
data Tile = Tile
{ tilePosition :: V2 Word -- ^
, tileOffset :: (V2 Float, V2 Float) -- ^ Graphics offset on 'TileMap'
, tileType :: TileType -- ^ Type of tile
}
deriving (Eq, Show)
instance Drawable Tile where
-- type VertexList Tile = V.Vector
toVertices (Tile (V2 x y) (V2 u1 v1, V2 u2 v2) _) =
( V.fromList [ 0, 1, 2, 2, 3, 0 ]
, V.fromList
[ newVertex
(V3 (fromIntegral x * 32) (fromIntegral y * 32) 0)
(V4 1 1 1 1)
(V2 u1 v1)
0
, newVertex
(V3 (fromIntegral (x + 1) * 32) (fromIntegral y * 32) 0)
(V4 1 1 1 1)
(V2 u2 v1)
0
, newVertex
(V3 (fromIntegral (x + 1) * 32) (fromIntegral (y + 1) * 32) 0)
(V4 1 1 1 1)
(V2 u2 v2)
0
, newVertex
(V3 (fromIntegral x * 32) (fromIntegral (y + 1) * 32) 0)
(V4 1 1 1 1)
(V2 u1 v2)
0
]
)
instance Mass Tile where
mass _ = recip 0
acceleration _ = V2 0 0
accelerationUpdater t = const t
velocity _ = V2 0 0
velocityUpdater t = const t
position t =
let (V2 x y) = fromIntegral <$> tilePosition t
in
V2 (x * 32 + 16) (y * 32 + 16)
positionUpdater t = const t
instance Collidible Tile where
boundary _ =
( V2 (-16) (-16)
, V2 16 16
)
data TileType
= Solid
| Platform
| Decoration
deriving (Enum, Ord, Eq, Show)
data TileMap = TileMap
{ tileMapDimensions :: V2 Word -- ^ Dimensions of tile map image in pixels
, tileMapTexture :: Texture -- ^ Texture object on GPU
}
deriving (Eq, Show)
data LevelDescriptor = LevelDescriptor
{ levelLayerPath :: [(Word, FilePath)] -- ^ Indexed paths to the layers
, levelWalkLayer :: Word -- ^ Index of walk layer
, levelTileMap :: FilePath -- ^ Filepath to tile map
, levelStartPos :: (Word, Word) -- ^ Player start position
-- , levelCollectibles :: [(V2 Word, ())] -- ^ TODO; Collectibles and their tile coords
-- , levelEnemies :: [(V2 Word, ())] -- ^ TODO: Enemies and their tile coords
-- , levelInteractables :: [(V2 Word, ())] -- ^ TODO: Interactables and their coords
}
deriving (Eq, Show)