1{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} 2 3module Types where 4 5import Control.Monad.ST 6import Control.Monad.State.Strict 7import Data.Vector.Mutable (MVector) 8import Data.Vector (Vector) 9import Data.Default 10import Data.Tuple 11import Data.Set (Set) 12import qualified Data.Set as S 13import qualified Data.Map as M 14import Data.CaseInsensitive (CI) 15import UI.NCurses (Event) 16import System.Random (StdGen) 17 18-- Most code that updates the world runs in this monad stack. 19type M = StateT S (ST RealWorld) 20 21-- User input. 22type Input = Char 23 24-- Game state. 25data S = S 26 { world :: World 27 , flipSide :: World 28 , player :: Player 29 , bottomBuffer :: (World, World) 30 , topBuffer :: Int 31 , peruser :: Peruser 32 , randSource :: Rand 33 , helpShown :: Bool 34 , messages :: [String] 35 , spells :: Set Spell 36 , poisons :: M.Map (CI Char) PoisonEffect 37 , windows :: [Window] 38 } 39 40data Window = Window Pos [String] 41 42data Rand = Rand StdGen | DefRand StdGen | NoRand 43 44data Side = CurrentSide | FlipSide | InSide 45 deriving (Eq) 46 47type Vec2 a = MVector RealWorld (MVector RealWorld a) 48type World = Vec2 Char 49 50-- View of the game to display. 51data View = View 52 { viewVisible :: Vector (Vector Char) 53 , viewPlayer :: Player 54 , viewWindows :: [Window] 55 , viewForceRedraw :: Bool 56 } 57 58type Pos = (Int, Int) -- x, y (from upper left corner) 59 60type Offset = (Int -> Int, Int -> Int) 61 62data Peruser = Peruser 63 { peruseSpeed :: Int -- ^ lower is faster 64 , peruseCountDown :: Int -- ^ next scroll at 0 65 } 66 67instance Default Peruser where 68 def = Peruser 5 10 -- 10 gives extra time before first at start of game 69 70data Player = Player 71 { playerHead :: Pos 72 , playerSwallowing :: Maybe Char 73 , playerBody :: [Segment] -- ^ first segment is next to head 74 , playerLen :: Int -- ^ including head 75 , spellCaster :: Bool 76 , playerSpells :: Set Spell 77 , playerEnergized :: Bool 78 , playerBerzerk :: Bool 79 , playerStaggering :: Bool 80 } 81 82instance Default Player where 83 def = Player 84 { playerHead = (6,6) 85 , playerSwallowing = Nothing 86 , playerBody = [] 87 , playerLen = 5 88 , spellCaster = False 89 , playerSpells = S.empty 90 , playerEnergized = False 91 , playerBerzerk = False 92 , playerStaggering = False 93 } 94 95data Segment = Segment 96 { segmentPos :: Pos 97 , segmentDirection :: Direction 98 , segmentSide :: Side 99 , segmentSwallowed :: Maybe Char 100 , segmentInvoked :: Bool 101 } 102 103data Direction = DLeft | DRight | DUp | DDown | DDive 104 deriving (Eq, Ord, Show, Bounded, Enum) 105 106bodyChar :: Direction -> Char 107bodyChar DLeft = '<' 108bodyChar DRight = '>' 109bodyChar DUp = '^' 110bodyChar DDown = 'v' 111-- not visible, but this prevents accidentially genociding it 112bodyChar DDive = '|' 113 114directionOffset :: Direction -> Offset 115directionOffset DLeft = (pred, id) 116directionOffset DRight = (succ, id) 117directionOffset DUp = (id, pred) 118directionOffset DDown = (id, succ) 119directionOffset DDive = (id, id) 120 121type PoisonEffect = Char -> M NextStep -> M NextStep 122 123data Spell = Spell 124 { spellName :: SpellName 125 , spellHint :: String 126 , spellIngredients :: Set (CI Char) 127 , spellWord :: String -- same as ingredients, but ordered 128 , spellAction :: (M NextStep -> M NextStep) 129 } 130 131type SpellName = String 132 133instance Eq Spell where 134 a == b = (spellName a, spellIngredients a) == (spellName b, spellIngredients b) 135 136instance Ord Spell where 137 compare a b = (spellName a, spellIngredients a) `compare` (spellName b, spellIngredients b) 138 139-- Calculates a new state of the world based on the provided Input. 140-- Returns new View, and a continuation to handle the next step. 141type Step = Event -> M NextStep 142data NextStep = NextStep View (Maybe Step) 143 144type Level = [String] 145 146-- Flips to the other side of the scroll. 147class Flippable a where 148 flipOver :: a -> a 149 150instance Flippable Side where 151 flipOver CurrentSide = FlipSide 152 flipOver FlipSide = CurrentSide 153 flipOver InSide = InSide 154 155instance Flippable S where 156 flipOver s = s 157 { world = flipSide s 158 , flipSide = world s 159 , player = flipOver (player s) 160 , bottomBuffer = swap (bottomBuffer s) 161 } 162 163instance Flippable Player where 164 flipOver p = p { playerBody = map flipOver (playerBody p) } 165 166instance Flippable Segment where 167 flipOver s = s { segmentSide = flipOver (segmentSide s) } 168 169class Positioned a where 170 getPos :: a -> Pos 171 offsetPos :: Offset -> a -> a 172 173instance Positioned Pos where 174 getPos = id 175 offsetPos (fx, fy) (x, y) = (fx x, fy y) 176 177instance Positioned Player where 178 getPos = playerHead 179 offsetPos f p = p 180 { playerHead = offsetPos f (playerHead p) 181 , playerBody = map (offsetPos f) (playerBody p) 182 } 183 184instance Positioned Segment where 185 getPos = segmentPos 186 offsetPos f s = s { segmentPos = offsetPos f (segmentPos s) } 187 188data Difficulty 189 = Easy 190 | Medium 191 | Hard 192