Fixes Temporal Web to not divide by zero when the player tries to slow itself.

parent 26130815
......@@ -37,7 +37,7 @@ import Roguestar.Lib.Data.BehaviorData
-- | Decide which FacingBehavior is most appropriate for for a character's situation.
facingBehavior :: (DBReadable db) => MonsterRef -> Facing -> db FacingBehavior
facingBehavior creature_ref face =
do ((Parent plane_ref,pos) :: (Parent Plane,Position)) <- liftM detail $ getPlanarLocation creature_ref
do ((Parent plane_ref,pos) :: (Parent PlaneData,Position)) <- liftM detail $ getPlanarLocation creature_ref
let facing_pos = offsetPosition (facingToRelative face) pos
t <- terrainAt plane_ref facing_pos
who :: [MonsterRef] <- liftM asChildren $ whatIsOccupying plane_ref facing_pos
......@@ -55,7 +55,7 @@ facingBehavior creature_ref face =
-- will succeed.
isBehaviorAvailable :: (DBReadable db) => Behavior -> MonsterRef -> db Bool
isBehaviorAvailable (FacingBehavior Jump _) creature_ref =
do ((Parent plane_ref,pos) :: (Parent Plane,Position)) <- liftM detail $ getPlanarLocation creature_ref
do ((Parent plane_ref,pos) :: (Parent PlaneData,Position)) <- liftM detail $ getPlanarLocation creature_ref
the_terrain <- terrainAt plane_ref pos
creature_has_teleport_ability <- getMonsterSpecial Teleportation creature_ref
return $
......@@ -156,7 +156,7 @@ dbBehave_ Wait creature_ref = increaseTime creature_ref =<< actionTime creature_
dbBehave_ Vanish creature_ref =
do increaseTime creature_ref =<< actionTime creature_ref
(Parent plane_ref :: Parent Plane) <- liftM detail $ getPlanarLocation creature_ref
(Parent plane_ref :: Parent PlaneData) <- liftM detail $ getPlanarLocation creature_ref
faction <- getMonsterFaction creature_ref
is_visible_to_anyone_else <- liftM (any (genericReference creature_ref `elem`)) $
mapM (\fact -> dbGetVisibleObjectsForFaction (return . const True) fact plane_ref)
......
......@@ -21,7 +21,7 @@ import Data.Maybe
-- True iff any terrain modification actually occured.
modifyFacingTerrain :: (Terrain -> Terrain) -> Facing -> MonsterRef -> DB Bool
modifyFacingTerrain f face creature_ref = liftM (fromMaybe False) $ runMaybeT $
do (Parent plane_ref :: Parent Plane,position :: Position) <- MaybeT $ liftM fromLocation $ asks $ whereIs creature_ref
do (Parent plane_ref :: Parent PlaneData,position :: Position) <- MaybeT $ liftM fromLocation $ asks $ whereIs creature_ref
let target_position = offsetPosition (facingToRelative face) position
prev_terrain <- lift $ terrainAt plane_ref target_position
let new_terrain = f prev_terrain
......
......@@ -9,6 +9,7 @@ module Roguestar.Lib.Behavior.Outcome
where
import Roguestar.Lib.DB
import qualified Data.Set as Set
-- | An effect or consequence in the game world.
class Effect e where
......@@ -28,6 +29,9 @@ class Outcome e where
instance (Effect e) => Effect [e] where
applyEffect es = mapM_ applyEffect es
instance (Effect e) => Effect (Set.Set e) where
applyEffect = applyEffect . Set.toList
instance (Effect a, Effect b) => Effect (a,b) where
applyEffect (a,b) = applyEffect a >> applyEffect b
......
......@@ -21,14 +21,20 @@ import Control.Monad.Reader
import Data.Maybe
import Data.Ord
import Data.List (minimumBy)
import qualified Data.Set as Set
import Roguestar.Lib.Behavior.Outcome
import Roguestar.Lib.Core.Monster
import Roguestar.Lib.Core2.Monster
import Roguestar.Lib.Core.Plane as Plane
import Roguestar.Lib.DB as DB
import Roguestar.Lib.Data.FacingData
import Roguestar.Lib.Data.FactionData
import Roguestar.Lib.Data.MonsterData
import Roguestar.Lib.Data.ReferenceTypes
import Roguestar.Lib.Data.TerrainData
import Roguestar.Lib.Data.TravelData
import Roguestar.Lib.Graph
import Roguestar.Lib.Core2.Realization
import Roguestar.Lib.Logging
import Roguestar.Lib.PlaneVisibility
import Roguestar.Lib.Position as Position
......@@ -198,6 +204,7 @@ instance Effect SetTerrainEffect where
data SlowMonsterEffect = SlowMonsterEffect {
slow_monster_ref :: MonsterRef,
slow_monster_amount :: Rational }
deriving (Eq, Ord)
executeSlowMonster :: SlowMonsterEffect -> DB ()
executeSlowMonster outcome = increaseTime (slow_monster_ref outcome) (slow_monster_amount outcome)
......@@ -226,16 +233,17 @@ resolveStepWithHolographicTrail facing monster_ref =
-- TemporalWeb
--------------------------------------------------------------------------------
resolveStepWithTemporalWeb :: (MonadRandom db, DBReadable db) => Facing -> MonsterRef -> db (OutcomeWithEffect MoveOutcome (MoveOutcome,[SlowMonsterEffect]))
resolveStepWithTemporalWeb :: (MonadRandom db, DBReadable db) => Facing -> MonsterRef -> db (OutcomeWithEffect MoveOutcome (MoveOutcome,Set.Set SlowMonsterEffect))
resolveStepWithTemporalWeb facing monster_ref =
do move_outcome <- stepMonster facing monster_ref
let (plane_ref :: PlaneRef, position :: Position) = (standing_plane $ move_from move_outcome, standing_position $ move_from move_outcome)
t <- getDuration move_outcome
faction <- getMonsterFaction monster_ref
(vobs :: [MonsterRef]) <- liftM (mapMaybe coerceReference) $ dbGetVisibleObjectsForFaction (const $ return True) faction plane_ref
slows <- forM vobs $ \vob ->
do (p :: Position) <- liftM detail $ getPlanarLocation monster_ref
return $ SlowMonsterEffect vob (t / fromInteger (Position.distanceBetweenSquared p position))
me <- realizeMonsterM monster_ref
let slowByDistance :: Monster -> Monster -> SlowMonsterEffect
slowByDistance me enemy = SlowMonsterEffect (toReference enemy) $ t / fromInteger (Position.distanceBetweenSquared me enemy)
slows = Set.map (slowByDistance me) $ enemies me
return $ OutcomeWithEffect
move_outcome
(move_outcome, slows)
......
......@@ -62,7 +62,7 @@ activateBuilding (PowerUp pud) creature_ref building_ref =
do captureNode pud creature_ref building_ref
return True
activateBuilding (TwoWayStargate _) creature_ref building_ref =
do (Parent _ :: Parent Plane,building_position :: Position) <- liftM detail $ getPlanarLocation building_ref
do (Parent _ :: Parent PlaneData,building_position :: Position) <- liftM detail $ getPlanarLocation building_ref
(creature_position :: Position) <- liftM detail $ getPlanarLocation creature_ref
case () of
() | distanceBetweenChessboard creature_position building_position == 1 ->
......@@ -71,7 +71,7 @@ activateBuilding (TwoWayStargate _) creature_ref building_ref =
do throwError $ DBErrorFlag BuildingApproachWrongAngle
return True
activateBuilding (OneWayStargate region) creature_ref building_ref =
do (Parent plane_ref :: Parent Plane,Position (_,by))
do (Parent plane_ref :: Parent PlaneData,Position (_,by))
<- liftM detail $ getPlanarLocation building_ref
(Position (_,cy)) <- liftM detail $ getPlanarLocation creature_ref
_ <- case () of
......
......@@ -56,7 +56,7 @@ generateInitialPlayerMonster species =
-- |
-- Generates a new Monster from the specified Species and adds it to the database.
--
newMonster :: (LocationConstructor l, ReferenceTypeOf l ~ MonsterData) => Faction -> Species -> l -> DB MonsterRef
newMonster :: (LocationConstructor l, ChildTypeOf l ~ MonsterData) => Faction -> Species -> l -> DB MonsterRef
newMonster faction species loc =
do creature <- generateMonster faction species
dbAddMonster creature loc
......
......@@ -39,11 +39,11 @@ import Roguestar.Lib.Data.BuildingData
import Roguestar.Lib.Logging
import Control.Monad.Maybe
dbNewPlane :: (LocationConstructor l, ReferenceTypeOf l ~ Plane) => B.ByteString -> TerrainGenerationData -> l -> DB PlaneRef
dbNewPlane :: (LocationConstructor l, ChildTypeOf l ~ PlaneData) => B.ByteString -> TerrainGenerationData -> l -> DB PlaneRef
dbNewPlane name tg_data l =
do rns <- getRandoms
random_id <- getRandomR (1,1000000)
dbAddPlane (Plane { plane_biome = tg_biome tg_data,
dbAddPlane (PlaneData { plane_biome = tg_biome tg_data,
plane_terrain = generateTerrain tg_data rns,
plane_random_id = random_id,
plane_planet_name = name}) l
......@@ -106,8 +106,8 @@ distanceBetweenSquared :: (DBReadable db,
AlwaysHasIndirectPlanarLocation b) =>
Reference a -> Reference b -> db (Maybe Integer)
distanceBetweenSquared a_ref b_ref =
do (Parent a_parent :: Parent Plane, a_multiposition :: MultiPosition) <- liftM detail $ getPlanarLocation a_ref
(Parent b_parent :: Parent Plane, b_multiposition :: MultiPosition) <- liftM detail $ getPlanarLocation b_ref
do (Parent a_parent :: Parent PlaneData, a_multiposition :: MultiPosition) <- liftM detail $ getPlanarLocation a_ref
(Parent b_parent :: Parent PlaneData, b_multiposition :: MultiPosition) <- liftM detail $ getPlanarLocation b_ref
return $
do guard $ a_parent == b_parent
return $ Position.distanceBetweenSquared a_multiposition b_multiposition
......
module Roguestar.Lib.Graph.Location
module Roguestar.Lib.Core2.Location
(standing)
where
import Roguestar.Lib.Data.FacingData
import Roguestar.Lib.Data.LocationData
import Roguestar.Lib.Data.ReferenceTypes
import Roguestar.Lib.Graph.Classes
standing :: (HasSquare a) => Facing -> a -> Standing
standing face x = Standing (planeReference $ plane $ square x)
standing face x = Standing (toReference $ plane $ square x)
(position $ square x)
face
module Roguestar.Lib.Core2.Monster
(comonsters,
enemies,
isEnemy)
where
import Roguestar.Lib.Graph
import Roguestar.Lib.Data.FactionData
import Roguestar.Lib.Data.MonsterData
import qualified Data.Set as Set
-- | Monsters, other than this monster, on the same plane as this monster.
comonsters :: Monster -> Set.Set Monster
comonsters m = Set.filter (/= m) $ monsters $ plane m
-- | All enemies of this monster, on the same plane as this monster.
enemies :: Monster -> Set.Set Monster
enemies me = Set.filter (isEnemy me) $ comonsters me
instance GetFaction Monster where
getFaction = getFaction . monster_to_data
-- | True if two monsters are from enemy factions.
isEnemy :: Monster -> Monster -> Bool
isEnemy m1 m2 = (getFaction m1 /= getFaction m2)
......@@ -2,6 +2,7 @@
module Roguestar.Lib.Core2.Realization
(realizePlane,
realizeMonster,
realizeMonsterM,
realizeSquare)
where
......@@ -13,6 +14,7 @@ module Roguestar.Lib.Core2.Realization
--
import Prelude hiding (getContents)
import Control.Monad.Reader
import qualified Roguestar.Lib.Data.PlaneData as PlaneData
import Roguestar.Lib.DB
import Roguestar.Lib.Graph
......@@ -31,10 +33,13 @@ realizeMonster db monster_ref = Monster {
monster_to_reference = monster_ref,
monster_to_data = getMonster monster_ref db,
monster_to_square = realizeSquare db plane_ref p }
where (p :: Position, Parent plane_ref :: Parent PlaneData.Plane) = fromMaybe (error "realizeMonster: doesn't have a planar position") $ fromLocation $ whereIs monster_ref db
where (p :: Position, Parent plane_ref :: Parent PlaneData.PlaneData) = fromMaybe (error "realizeMonster: doesn't have a planar position") $ fromLocation $ whereIs monster_ref db
realizeMonsterM :: (DBReadable db) => MonsterRef -> db Monster
realizeMonsterM monster_ref = asks $ flip realizeMonster monster_ref
realizeSquare :: DB_BaseType -> PlaneRef -> Position -> Square
realizeSquare db plane_ref p = Square {
square_to_plane = realizePlane db plane_ref,
square_to_position = p }
\ No newline at end of file
module Roguestar.Lib.Core2.Tests
(testcases)
where
import Test.HUnit
import Roguestar.Lib.Graph.TestExampleEntities
import Roguestar.Lib.Core2.Monster
import qualified Data.Set as Set
testcases :: Test
testcases = TestList $ [testCoMonsters]
testCoMonsters :: Test
testCoMonsters = TestCase $ assertEqual "testCoMonsters" (Set.fromList [twilight, picard]) (comonsters zathras)
......@@ -94,7 +94,7 @@ data DB_BaseType = DB_BaseType { db_player_state :: PlayerState,
db_next_object_ref :: Integer,
db_creatures :: Map MonsterRef MonsterData,
db_player_creature :: Maybe MonsterRef,
db_planes :: Map PlaneRef Plane,
db_planes :: Map PlaneRef PlaneData,
db_tools :: Map ToolRef Tool,
db_buildings :: Map BuildingRef Building,
db_hierarchy :: HD.HierarchicalDatabase Location,
......@@ -282,25 +282,25 @@ dbAddObjectComposable constructReferenceAction updateObjectAction constructLocat
-- |
-- Adds a new Monster to the database.
--
dbAddMonster :: (LocationConstructor l, ReferenceTypeOf l ~ MonsterData) => MonsterData -> l -> DB MonsterRef
dbAddMonster :: (LocationConstructor l, ChildTypeOf l ~ MonsterData) => MonsterData -> l -> DB MonsterRef
dbAddMonster = dbAddObjectComposable MonsterRef dbPutMonster (\r l -> constructLocation r l Nothing)
-- |
-- Adds a new Plane to the database.
--
dbAddPlane :: (LocationConstructor l, ReferenceTypeOf l ~ Plane) => Plane -> l -> DB PlaneRef
dbAddPlane :: (LocationConstructor l, ChildTypeOf l ~ PlaneData) => PlaneData -> l -> DB PlaneRef
dbAddPlane = dbAddObjectComposable PlaneRef dbPutPlane (\r l -> constructLocation r l Nothing)
-- |
-- Adds a new Tool to the database.
--
dbAddTool :: (LocationConstructor l, ReferenceTypeOf l ~ Tool) => Tool -> l -> DB ToolRef
dbAddTool :: (LocationConstructor l, ChildTypeOf l ~ Tool) => Tool -> l -> DB ToolRef
dbAddTool = dbAddObjectComposable ToolRef dbPutTool (\r l -> constructLocation r l Nothing)
-- |
-- Adds a new Tool to the database.
--
dbAddBuilding :: (LocationConstructor l, ReferenceTypeOf l ~ Building) => Building -> l -> DB BuildingRef
dbAddBuilding :: (LocationConstructor l, ChildTypeOf l ~ Building) => Building -> l -> DB BuildingRef
dbAddBuilding = dbAddObjectComposable BuildingRef dbPutBuilding (\r l -> constructLocation r l Nothing)
-- |
......@@ -308,7 +308,7 @@ dbAddBuilding = dbAddObjectComposable BuildingRef dbPutBuilding (\r l -> constru
-- to fail. Accepts a function to move all of the objects nested within the
-- object being deleted.
--
dbUnsafeDeleteObject :: (LocationConstructor l, ReferenceTypeOf l ~ ()) =>
dbUnsafeDeleteObject :: (LocationConstructor l, ChildTypeOf l ~ ()) =>
Reference e ->
(forall m. (DBReadable m) => Reference () -> m l) ->
DB ()
......@@ -341,7 +341,7 @@ dbPutMonster = dbPutObjectComposable db_creatures (\x db_base_type ->
-- |
-- Puts a Plane under an arbitrary PlaneRef
--
dbPutPlane :: PlaneRef -> Plane -> DB ()
dbPutPlane :: PlaneRef -> PlaneData -> DB ()
dbPutPlane = dbPutObjectComposable db_planes $
\x db_base_type -> db_base_type { db_planes = x }
......@@ -375,7 +375,7 @@ getMonster = getObjectComposable "MonsterRef" db_creatures
-- |
-- Gets a Plane from a PlaneRef
--
getPlane :: PlaneRef -> DB_BaseType -> Plane
getPlane :: PlaneRef -> DB_BaseType -> PlaneData
getPlane = getObjectComposable "PlaneRef" db_planes
-- |
......@@ -400,7 +400,7 @@ dbModObjectComposable getter putter f ref = (putter ref . f) =<< (getter ref)
-- |
-- Modifies a Plane based on a PlaneRef.
--
dbModPlane :: (Plane -> Plane) -> PlaneRef -> DB ()
dbModPlane :: (PlaneData -> PlaneData) -> PlaneRef -> DB ()
dbModPlane = dbModObjectComposable (asks . getPlane) dbPutPlane
-- |
......@@ -452,7 +452,7 @@ dbUnwieldMonster c = mapM_ (maybe (return ()) setLocation . returnToInventory) =
-- Moves an object, returning the location of the object before and after
-- the move.
--
move :: (LocationConstructor l, ReferenceTypeOf l ~ e, ReferenceType e) => Reference e -> l -> DB (Location,Location)
move :: (LocationConstructor l, ChildTypeOf l ~ e, ReferenceType e) => Reference e -> l -> DB (Location,Location)
move ref location_data =
do old <- asks $ whereIs ref
let new = constructLocation ref location_data (Just old)
......@@ -463,7 +463,7 @@ move ref location_data =
setTime ref =<< getTime (parentReference new)
return (old,new)
moveAllWithin :: (LocationConstructor l, ReferenceTypeOf l ~ ()) =>
moveAllWithin :: (LocationConstructor l, ChildTypeOf l ~ ()) =>
Reference e ->
(forall m. (DBReadable m) => Reference () -> m l) ->
DB [(Location,Location)]
......
......@@ -82,7 +82,7 @@ facingDistance a b = toInteger $ if enum_distance > 4 then 8 - enum_distance els
-- |
-- A test function to detect when one Position + Facing points directly at another Position.
--
isFacing :: (PositionType a,PositionType b) => (a, Facing) -> b -> Bool
isFacing :: (ToMultiPosition a,ToMultiPosition b) => (a, Facing) -> b -> Bool
isFacing (as,face) bs = or $ map (\(a,b) -> f face (fromPosition a) (fromPosition b)) $ positionPairs as bs
where f :: Facing -> (Integer,Integer) -> (Integer,Integer) -> Bool
f North (x,y) (u,v) = x == u && v >= y
......
{-# LANGUAGE OverloadedStrings #-}
--Data
module Roguestar.Lib.Data.FactionData
(Faction(..),factionPrefix)
(Faction(..),factionPrefix,
GetFaction(..))
where
import qualified Data.ByteString.Char8 as B
......@@ -17,3 +18,9 @@ factionPrefix Player = "Z"
factionPrefix Monsters = "M"
factionPrefix Nonaligned = "P"
factionPrefix Cyborgs = "Y"
class GetFaction faction where
getFaction :: faction -> Faction
instance GetFaction Faction where
getFaction = id
......@@ -173,39 +173,39 @@ instance ReferenceType a => LocationDetail (Child a) where
fromLocation = fmap Child . coerceReference . childReference
class LocationConstructor l where
type ReferenceTypeOf l :: *
constructLocation :: Reference (ReferenceTypeOf l) -> l -> Maybe Location -> Location
type ChildTypeOf l :: *
constructLocation :: Reference (ChildTypeOf l) -> l -> Maybe Location -> Location
instance LocationConstructor Standing where
type ReferenceTypeOf Standing = MonsterData
type ChildTypeOf Standing = MonsterData
constructLocation a l _ = IsStanding a l
instance LocationConstructor Dropped where
type ReferenceTypeOf Dropped = Tool
type ChildTypeOf Dropped = Tool
constructLocation a l _ = IsDropped a l
instance LocationConstructor Inventory where
type ReferenceTypeOf Inventory = Tool
type ChildTypeOf Inventory = Tool
constructLocation a l _ = InInventory a l
instance LocationConstructor Wielded where
type ReferenceTypeOf Wielded = Tool
type ChildTypeOf Wielded = Tool
constructLocation a l _ = IsWielded a l
instance LocationConstructor Constructed where
type ReferenceTypeOf Constructed = Building
type ChildTypeOf Constructed = Building
constructLocation a l _ = IsConstructed a l
instance LocationConstructor TheUniverse where
type ReferenceTypeOf TheUniverse = Plane
type ChildTypeOf TheUniverse = PlaneData
constructLocation a _ _ = InTheUniverse a
instance LocationConstructor Subsequent where
type ReferenceTypeOf Subsequent = Plane
type ChildTypeOf Subsequent = PlaneData
constructLocation a l _ = IsSubsequent a l
instance LocationConstructor Beneath where
type ReferenceTypeOf Beneath = Plane
type ChildTypeOf Beneath = PlaneData
constructLocation a l _ = IsBeneath a l
returnToInventory :: Location -> Maybe Location
......
......@@ -154,3 +154,6 @@ creatureHealth c = case () of
creature_absolute_health = creature_max_health result - creature_absolute_damage result,
creature_absolute_damage = creature_damage c,
creature_max_health = creatureAbilityScore ToughnessTrait c }
instance GetFaction MonsterData where
getFaction = creature_faction
\ No newline at end of file
--Data
module Roguestar.Lib.Data.PlaneData
(Plane(..))
(PlaneData(..))
where
import Roguestar.Lib.Data.TerrainData
import qualified Data.ByteString.Char8 as B
import Roguestar.Lib.Random as Random
data Plane = Plane
data PlaneData = PlaneData
{ plane_biome :: WeightedSet Biome, -- TODO: Get rid of this.
plane_terrain :: TerrainGrid, -- TODO: Use a persistable domain-specific language to procedurally generate these grids
plane_random_id :: Integer, -- Just a random number
......
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}
module Roguestar.Lib.Data.ReferenceTypes
(Reference(..),
unsafeReference,
toUID,
ReferenceType(..),
ToReference(..),
(=:=),
(=/=),
Location(..),
......@@ -45,7 +46,7 @@ data TheUniverse = TheUniverse deriving (Read,Show,Eq,Ord)
type MonsterRef = Reference MonsterData
type ToolRef = Reference Tool
type PlaneRef = Reference Plane
type PlaneRef = Reference PlaneData
type BuildingRef = Reference Building
-- |
......@@ -84,7 +85,7 @@ class ReferenceType a where
instance ReferenceType () where
coerceReference = Just . unsafeReference
instance ReferenceType Plane where
instance ReferenceType PlaneData where
coerceReference (PlaneRef ref) = Just $ PlaneRef ref
coerceReference _ = Nothing
......@@ -116,6 +117,14 @@ instance (ReferenceType a, ReferenceType b) => ReferenceType (Either a b) where
_ -> Nothing
in result
class ToReference a where
type ReferenceTypeOf a :: *
toReference :: a -> Reference (ReferenceTypeOf a)
instance ToReference (Reference a) where
type ReferenceTypeOf (Reference a) = a
toReference = id
-- |
-- The location of a Monster standing on a Plane.
--
......@@ -173,9 +182,7 @@ data Beneath =
-- |
--
-- Represents a location.
--
-- Up to roguestar 0.6, Locations were typed. As of 0.7 locations are untyped, but I added DetailedLocations.
-- Represents a location (parent-child pair with additional data, such as (x,y) coordinates of the child within the parent.
--
data Location =
IsStanding MonsterRef Standing
......
module Roguestar.Lib.Graph
(module Roguestar.Lib.Graph.Graph,
module Roguestar.Lib.Graph.Classes,
module Roguestar.Lib.Graph.Location)
module Roguestar.Lib.Graph.Classes)
where
import Roguestar.Lib.Graph.Graph
import Roguestar.Lib.Graph.Classes
import Roguestar.Lib.Graph.Location
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
module Roguestar.Lib.Graph.Classes
(HasPlane(..),
HasSquare(..),
HasMonsters(..),
HasMonster(..),
comonsters,
position,
planeReference,
monsterReference)
position)
where
import qualified Roguestar.Lib.Data.ReferenceTypes as References
import Roguestar.Lib.Position
import Roguestar.Lib.Graph.Graph
import qualified Data.Set as Set
......@@ -57,16 +53,5 @@ instance HasSquare Monster where
instance HasBuildings Plane where
buildings = plane_to_buildings
-- | Monsters, other than this monster, on the same plane as this monster.
comonsters :: Monster -> Set.Set Monster
comonsters m = Set.filter (/= m) $ monsters $ plane m
position :: (HasSquare a) => a -> Position
position = square_to_position . square
planeReference :: (HasPlane a) => a -> References.PlaneRef
planeReference = plane_to_reference . plane
monsterReference :: (HasMonster a) => a -> References.MonsterRef
monsterReference = monster_to_reference . monster
{-# LANGUAGE TypeFamilies #-}
module Roguestar.Lib.Graph.Graph
(Monster(..),
Plane(..),
......@@ -6,9 +7,9 @@ module Roguestar.Lib.Graph.Graph
where
import qualified Data.Set as Set
import qualified Roguestar.Lib.Data.ReferenceTypes as References
import qualified Roguestar.Lib.Data.MonsterData as MonsterData
import qualified Roguestar.Lib.Data.PlaneData as PlaneData
import Roguestar.Lib.Data.PlaneData as PlaneData
import Roguestar.Lib.Data.ReferenceTypes as References
import Roguestar.Lib.Position
data Monster = Monster {
......@@ -22,7 +23,7 @@ data Square = Square {
data Plane = Plane {
plane_to_reference :: References.PlaneRef,
plane_to_data :: PlaneData.Plane,
plane_to_data :: PlaneData.PlaneData,
plane_to_monsters :: Set.Set Monster,
plane_to_buildings :: Set.Set Building }
......@@ -57,3 +58,23 @@ instance Show Plane where
instance Show Building where
show = show . building_to_reference
instance ToReference Plane where
type ReferenceTypeOf Plane = PlaneData
toReference = plane_to_reference
instance ToReference Monster where
type ReferenceTypeOf Monster = MonsterData.MonsterData
toReference = monster_to_reference
instance ToPosition Square where
toPosition = square_to_position
instance ToMultiPosition Square where
toMultiPosition = toMultiPosition . toPosition
instance ToPosition Monster where
toPosition = toPosition . monster_to_square
instance ToMultiPosition Monster where
toMultiPosition = toMultiPosition . toPosition
\ No newline at end of file
module Roguestar.Lib.Graph.TestExampleEntities
(equestria, picard, twilight, zathras)
where
import qualified Roguestar.Lib.Data.ReferenceTypes as References
import Roguestar.Lib.Graph.Graph
import Roguestar.Lib.Graph.Classes
import qualified Data.Set as Set
import Test.HUnit
equestria :: Plane
equestria = Plane {
plane_to_reference = References.PlaneRef 0,
plane_to_data = error "undefined equestria",
plane_to_monsters = Set.fromList [twilight, picard, zathras],
plane_to_buildings = Set.fromList [] }
twilight :: Monster
twilight = Monster {
monster_to_data = error "undefined twilight",
monster_to_reference = References.MonsterRef 1,
monster_to_square = Square equestria (error "No Position") }
picard :: Monster
picard = Monster {
monster_to_data = error "undefined picard",
monster_to_reference = References.MonsterRef 2,
monster_to_square = Square equestria (error "No Position") }
zathras :: Monster
zathras = Monster {
monster_to_data = error "undefined zathras",
monster_to_reference = References.MonsterRef 3,
monster_to_square = Square equestria (error "No Position") }
module Roguestar.Lib.Graph.Tests
(testcases)
(testcases,
equestria, picard, twilight, zathras)
where
import qualified Roguestar.Lib.Data.ReferenceTypes as References
import Roguestar.Lib.Graph.Graph
import Roguestar.Lib.Graph.Classes
import Roguestar.Lib.Graph.TestExampleEntities
import qualified Data.Set as Set
import Test.HUnit
testcases :: Test
testcases = TestLabel "Roguestar.Lib.Model.Tests" $ TestList [
testPlaneToSelf,
testMonsterToPlane,
testCoMonsters]
equestria :: Plane
equestria = Plane {
plane_to_reference = References.PlaneRef 0,
plane_to_data = error "undefined equestria",
plane_to_monsters = Set.fromList [twilight, picard, zathras],
plane_to_buildings = Set.fromList [] }
twilight :: Monster
twilight = Monster {
monster_to_data = error "undefined twilight",
monster_to_reference = References.MonsterRef 1,
monster_to_square = Square equestria (error "No Position") }
picard :: Monster
picard = Monster {
monster_to_data = error "undefined picard",
monster_to_reference = References.MonsterRef 2,
monster_to_square = Square equestria (error "No Position") }
zathras :: Monster
zathras = Monster {
monster_to_data = error "undefined zathras",
monster_to_reference = References.MonsterRef 3,
monster_to_square = Square equestria (error "No Position") }
testMonsterToPlane]
testPlaneToSelf :: Test
testPlaneToSelf = TestCase $ assertEqual "testPlaneToSelf" equestria (plane equestria)
testMonsterToPlane :: Test
testMonsterToPlane = TestCase $ assertEqual "testMonsterToPlane" equestria (plane picard)
testCoMonsters :: Test
testCoMonsters = TestCase $ assertEqual "testCoMonsters" (Set.fromList [twilight, picard]) (comonsters zathras)
......@@ -39,6 +39,7 @@ import Roguestar.Lib.PlaneVisibility
import Data.Maybe
import Data.List as List
import Data.Map as Map
import qualified Data.Set as Set
import Roguestar.Lib.Data.FacingData
import Roguestar.Lib.Position as Position
import Roguestar.Lib.Data.TerrainData
......@@ -158,7 +159,7 @@ stackVisibleObjects = List.foldr insertVob Map.empty
where insertVob :: VisibleObject -> Map Position [VisibleObject] -> Map Position [VisibleObject]
insertVob vob = List.foldr (\k f -> Map.alter (insertVob_ vob) k . f)
id
(fromMultiPosition $ visibleObjectPosition vob)
(Set.toList $ fromMultiPosition $ visibleObjectPosition vob)