73 lines
1.4 KiB
Haskell
73 lines
1.4 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
module Types.Map where
|
|
|
|
import Linear (V2)
|
|
|
|
data TileState
|
|
= Wall
|
|
-- | Wind
|
|
| Door
|
|
| Hall
|
|
| Offi
|
|
| Toil
|
|
| Kitc
|
|
| Elev
|
|
| Unde
|
|
deriving (Ord, Eq)
|
|
|
|
instance Show TileState where
|
|
show Wall = "#"
|
|
-- show Wind = "~"
|
|
show Door = "+"
|
|
show Hall = "_"
|
|
show Offi = "."
|
|
show Toil = "o"
|
|
show Kitc = "k"
|
|
show Elev = "x"
|
|
show Unde = " "
|
|
|
|
data FloorConfig = FloorConfig
|
|
{ fcElevator :: V2 Int
|
|
, fcFacilities :: [V2 Int]
|
|
, fcSize :: (Int, Int)
|
|
} deriving (Show)
|
|
|
|
data Boundaries a = Boundaries
|
|
{ matmin :: (a, a)
|
|
, matmax :: (a, a)
|
|
} deriving (Show, Eq, Ord)
|
|
|
|
instance Size (Boundaries Int) where
|
|
size (Boundaries (minr, minc) (maxr, maxc)) =
|
|
fromIntegral ((maxr - minr) * (maxc - minc))
|
|
|
|
instance Size (Boundaries Double) where
|
|
size (Boundaries (minr, minc) (maxr, maxc)) =
|
|
(maxr - minr) * (maxc - minc)
|
|
|
|
data GraphDirection = North | South | East | West
|
|
deriving (Show, Eq)
|
|
|
|
data Graph
|
|
= GHall
|
|
{ connects :: [Graph]
|
|
}
|
|
| GRoom
|
|
{ neighbs :: [(GraphDirection, TileState)]
|
|
, bounds :: Boundaries Int
|
|
, clearance :: Word
|
|
, roomType :: TileState
|
|
}
|
|
deriving (Show)
|
|
|
|
instance Eq Graph where
|
|
(GHall la) == (GHall lb) = la == lb
|
|
(GRoom na ba _ _) == (GRoom nb bb _ _) = na == nb && ba == bb
|
|
_ == _ = False
|
|
|
|
graphIsRoom :: Graph -> Bool
|
|
graphIsRoom (GRoom _ _ _ _) = True
|
|
graphIsRoom _ = False
|
|
|
|
class Size a where
|
|
size :: a -> Double
|