{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} module Types.Map where import qualified Data.Vector as V import Linear -- internal imports import Graphics.Types.Texture import Graphics.Types.VertexBuffer import Graphics.Classes.Drawable import Physics.Classes 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 , tileCollided :: Bool } 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 forces _ = V2 0 0 forcesUpdater t _ = t mass _ = recip 0 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 prevPosition t = position t impactForces _ = V2 0 0 impactForcesUpdater t _ = t collisionOccured t = tileCollided t updateCollisionOccurence t coll = t { tileCollided = coll } 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)