pituicat/src/Types/Map.hs

{-# 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) (mult, a) ->
      let (ris, vs) = toVertices a
          is = V.map (mult * 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)