-- |
-- Module      :  Swarm.Game.Terrain
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Terrain types and properties.
module Swarm.Game.Terrain (
  -- * Terrain
  TerrainType (..),
  terrainMap,
) where

import Data.Aeson (FromJSON (..), withText)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Text qualified as T
import Swarm.Game.Display
import Swarm.TUI.Attr
import Text.Read (readMaybe)
import Witch (into)

-- | The different possible types of terrain. Unlike entities and
--   robots, these are hard-coded into the game.
data TerrainType
  = StoneT
  | DirtT
  | GrassT
  | IceT
  | BlankT
  deriving (TerrainType -> TerrainType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerrainType -> TerrainType -> Bool
$c/= :: TerrainType -> TerrainType -> Bool
== :: TerrainType -> TerrainType -> Bool
$c== :: TerrainType -> TerrainType -> Bool
Eq, Eq TerrainType
TerrainType -> TerrainType -> Bool
TerrainType -> TerrainType -> Ordering
TerrainType -> TerrainType -> TerrainType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TerrainType -> TerrainType -> TerrainType
$cmin :: TerrainType -> TerrainType -> TerrainType
max :: TerrainType -> TerrainType -> TerrainType
$cmax :: TerrainType -> TerrainType -> TerrainType
>= :: TerrainType -> TerrainType -> Bool
$c>= :: TerrainType -> TerrainType -> Bool
> :: TerrainType -> TerrainType -> Bool
$c> :: TerrainType -> TerrainType -> Bool
<= :: TerrainType -> TerrainType -> Bool
$c<= :: TerrainType -> TerrainType -> Bool
< :: TerrainType -> TerrainType -> Bool
$c< :: TerrainType -> TerrainType -> Bool
compare :: TerrainType -> TerrainType -> Ordering
$ccompare :: TerrainType -> TerrainType -> Ordering
Ord, Int -> TerrainType -> ShowS
[TerrainType] -> ShowS
TerrainType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerrainType] -> ShowS
$cshowList :: [TerrainType] -> ShowS
show :: TerrainType -> String
$cshow :: TerrainType -> String
showsPrec :: Int -> TerrainType -> ShowS
$cshowsPrec :: Int -> TerrainType -> ShowS
Show, ReadPrec [TerrainType]
ReadPrec TerrainType
Int -> ReadS TerrainType
ReadS [TerrainType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerrainType]
$creadListPrec :: ReadPrec [TerrainType]
readPrec :: ReadPrec TerrainType
$creadPrec :: ReadPrec TerrainType
readList :: ReadS [TerrainType]
$creadList :: ReadS [TerrainType]
readsPrec :: Int -> ReadS TerrainType
$creadsPrec :: Int -> ReadS TerrainType
Read, TerrainType
forall a. a -> a -> Bounded a
maxBound :: TerrainType
$cmaxBound :: TerrainType
minBound :: TerrainType
$cminBound :: TerrainType
Bounded, Int -> TerrainType
TerrainType -> Int
TerrainType -> [TerrainType]
TerrainType -> TerrainType
TerrainType -> TerrainType -> [TerrainType]
TerrainType -> TerrainType -> TerrainType -> [TerrainType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TerrainType -> TerrainType -> TerrainType -> [TerrainType]
$cenumFromThenTo :: TerrainType -> TerrainType -> TerrainType -> [TerrainType]
enumFromTo :: TerrainType -> TerrainType -> [TerrainType]
$cenumFromTo :: TerrainType -> TerrainType -> [TerrainType]
enumFromThen :: TerrainType -> TerrainType -> [TerrainType]
$cenumFromThen :: TerrainType -> TerrainType -> [TerrainType]
enumFrom :: TerrainType -> [TerrainType]
$cenumFrom :: TerrainType -> [TerrainType]
fromEnum :: TerrainType -> Int
$cfromEnum :: TerrainType -> Int
toEnum :: Int -> TerrainType
$ctoEnum :: Int -> TerrainType
pred :: TerrainType -> TerrainType
$cpred :: TerrainType -> TerrainType
succ :: TerrainType -> TerrainType
$csucc :: TerrainType -> TerrainType
Enum)

instance FromJSON TerrainType where
  parseJSON :: Value -> Parser TerrainType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"text" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case forall a. Read a => String -> Maybe a
readMaybe (forall target source. From source target => source -> target
into @String (Text -> Text
T.toTitle Text
t) forall a. [a] -> [a] -> [a]
++ String
"T") of
      Just TerrainType
ter -> forall (m :: * -> *) a. Monad m => a -> m a
return TerrainType
ter
      Maybe TerrainType
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown terrain type: " forall a. [a] -> [a] -> [a]
++ forall target source. From source target => source -> target
into @String Text
t

-- | A map containing a 'Display' record for each different 'TerrainType'.
terrainMap :: Map TerrainType Display
terrainMap :: Map TerrainType Display
terrainMap =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (TerrainType
StoneT, Char -> AttrName -> Display
defaultTerrainDisplay Char
'▒' AttrName
rockAttr)
    , (TerrainType
DirtT, Char -> AttrName -> Display
defaultTerrainDisplay Char
'▒' AttrName
dirtAttr)
    , (TerrainType
GrassT, Char -> AttrName -> Display
defaultTerrainDisplay Char
'▒' AttrName
grassAttr)
    , (TerrainType
IceT, Char -> AttrName -> Display
defaultTerrainDisplay Char
' ' AttrName
iceAttr)
    , (TerrainType
BlankT, Char -> AttrName -> Display
defaultTerrainDisplay Char
' ' AttrName
defAttr)
    ]