Permalink
Browse files

Maps and movement.

  • Loading branch information...
1 parent a563fc2 commit e0a63d535729550566345e64e2286e48d539023e @clanehin committed Jun 11, 2012
@@ -202,7 +202,7 @@ overweightPenalty = liftM (max 1.0) . inventoryBurden
-- | Multiplier penalty if a creature is injured.
healthPenalty :: (DBReadable db) => CreatureRef -> db Rational
healthPenalty creature_ref =
- do current_health <- getCreatureHealth creature_ref
+ do current_health <- liftM creature_health $ getCreatureHealth creature_ref
raw_speed <- liftM (rawScore Speed) $ dbGetCreature creature_ref
return $ (max 1.0 $ recip $ max (1%raw_speed) current_health) -- maximum health penalty determined by speed
@@ -11,8 +11,6 @@ module Roguestar.Lib.Creature
injureCreature,
healCreature,
getCreatureHealth,
- getCreatureMaxHealth,
- getCreatureAbsoluteHealth,
getDead,
deleteCreature,
sweepDead)
@@ -107,23 +105,12 @@ injureCreature x = dbModCreature $ \c -> c { creature_damage = max 0 $ creature_
healCreature :: Integer -> CreatureRef -> DB ()
healCreature = injureCreature . negate
-getCreatureMaxHealth :: (DBReadable db) => CreatureRef -> db Integer
-getCreatureMaxHealth = liftM (creatureAbilityScore ToughnessTrait) . dbGetCreature
-
--- | Injury difference from maximum health as an integer count of hit points.
-getCreatureInjury :: (DBReadable db) => CreatureRef -> db Integer
-getCreatureInjury = liftM creature_damage . dbGetCreature
-
--- | Health as an integer count of hit points.
-getCreatureAbsoluteHealth :: (DBReadable db) => CreatureRef -> db Integer
-getCreatureAbsoluteHealth creature_ref = liftM (max 0) $ liftM2 (-) (getCreatureMaxHealth creature_ref) (getCreatureInjury creature_ref)
-
-- | Health as a fraction of 1.
-getCreatureHealth :: (DBReadable db) => CreatureRef -> db Rational
-getCreatureHealth creature_ref = liftM2 (%) (getCreatureAbsoluteHealth creature_ref) (getCreatureMaxHealth creature_ref)
+getCreatureHealth :: (DBReadable db) => CreatureRef -> db CreatureHealth
+getCreatureHealth creature_ref = liftM creatureHealth $ dbGetCreature creature_ref
getDead :: (DBReadable db) => Reference a -> db [CreatureRef]
-getDead parent_ref = filterRO (liftM (<= 0) . getCreatureHealth) =<< liftM asChildren (getContents parent_ref)
+getDead parent_ref = filterRO (liftM ((<= 0) . creature_health) . getCreatureHealth) =<< liftM asChildren (getContents parent_ref)
deleteCreature :: CreatureRef -> DB ()
deleteCreature creature_ref =
@@ -133,7 +120,7 @@ deleteCreature creature_ref =
-- | Delete all dead creatures from the database.
sweepDead :: Reference a -> DB ()
sweepDead ref =
- do worst_to_best_critters <- sortByRO getCreatureHealth =<< getDead ref
+ do worst_to_best_critters <- sortByRO (liftM creature_health . getCreatureHealth) =<< getDead ref
flip mapM_ worst_to_best_critters $ \creature_ref ->
do dbPushSnapshot (KilledEvent creature_ref)
deleteCreature creature_ref
@@ -8,14 +8,17 @@ module Roguestar.Lib.CreatureData
CreatureEndo(..),
CreatureScore(..),
FavoredClass(..),
+ CreatureHealth(..),
creatureGender,
+ creatureHealth,
creatureAbilityScore,
isFavoredClass,
empty_creature)
where
import Roguestar.Lib.CharacterData
import Roguestar.Lib.Alignment
+import Data.Ratio
import Data.Maybe
import Roguestar.Lib.FactionData
import Data.Monoid
@@ -74,6 +77,12 @@ instance (CreatureEndo a) => CreatureEndo [a] where
instance CreatureEndo CreatureGender where
applyToCreature g c = c { creature_gender = g }
+data CreatureHealth = CreatureHealth {
+ creature_absolute_health :: Integer,
+ creature_absolute_damage :: Integer,
+ creature_health :: Rational,
+ creature_max_health :: Integer }
+
-- | The seven aptitudes.
data CreatureAptitude =
Strength
@@ -181,3 +190,12 @@ creatureGender = creature_gender
isFavoredClass :: CharacterClass -> Creature -> Bool
isFavoredClass character_class creature = character_class `Set.member` (creature_favored_classes creature)
+-- |
+-- Answers the health/injury/maximum health of this creature.
+creatureHealth :: Creature -> CreatureHealth
+creatureHealth c = result
+ where result = CreatureHealth {
+ creature_health = creature_absolute_health result % creature_max_health result,
+ creature_absolute_health = creature_max_health result - creature_absolute_damage result,
+ creature_absolute_damage = creature_damage c,
+ creature_max_health = creatureAbilityScore ToughnessTrait c }
@@ -108,6 +108,7 @@ type instance LocationAssignmentTable (Child Creature) (Position,Facing)
type instance LocationAssignmentTable (Child Building) (Parent Plane) = Supported
type instance LocationAssignmentTable (Child Building) Position = Supported
type instance LocationAssignmentTable (Child Building) MultiPosition = Supported
+type instance LocationAssignmentTable (Child Building) BuildingShape = Supported
type instance LocationAssignmentTable Beneath (Child Plane) = Supported
type instance LocationAssignmentTable Subsequent (Child Plane) = Supported
type instance LocationAssignmentTable Standing Planar = Supported
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, Rank2Types, FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE ExistentialQuantification, Rank2Types, FlexibleContexts, ScopedTypeVariables, PatternGuards #-}
-- | The Perception monad is a wrapper for roguestar's core
-- monad that reveals only as much information as a character
@@ -8,6 +8,8 @@ module Roguestar.Lib.Perception
(DBPerception,
whoAmI,
runPerception,
+ VisibleObject(..),
+ stackVisibleObjects,
visibleObjects,
visibleTerrain,
myFaction,
@@ -16,7 +18,8 @@ module Roguestar.Lib.Perception
Roguestar.Lib.Perception.whereIs,
localBiome,
compass,
- depth)
+ depth,
+ myHealth)
where
import Control.Monad.Reader
@@ -29,7 +32,9 @@ import Roguestar.Lib.Creature as Creature
import Roguestar.Lib.PlaneVisibility
import Roguestar.Lib.PlaneData
import Data.Maybe
-import Data.List
+import Data.List as List
+import Data.Map as Map
+import Control.Applicative
import Roguestar.Lib.Facing
import Roguestar.Lib.Position as Position
import Roguestar.Lib.TerrainData
@@ -38,6 +43,15 @@ import Roguestar.Lib.Building
import Roguestar.Lib.Plane
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.Building
+import Roguestar.Lib.SpeciesData
+import qualified Data.ByteString.Char8 as B
+import Roguestar.Lib.CreatureData
+import Roguestar.Lib.CharacterData
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Roguestar.Lib.Tool
+import Roguestar.Lib.ToolData
+import qualified Roguestar.Lib.DetailedTravel as DT
newtype (DBReadable db) => DBPerception db a = DBPerception { fromPerception :: (ReaderT CreatureRef db a) }
@@ -77,7 +91,64 @@ visibleTerrain =
faction <- myFaction
liftDB $ dbGetVisibleTerrainForFaction faction plane_ref
-visibleObjects :: (DBReadable db) => (forall m. DBReadable m => Reference () -> DBPerception m Bool) -> DBPerception db [Location]
+data VisibleObject =
+ VisibleTool {
+ visible_tool :: Tool,
+ visible_object_position :: Position }
+ | VisibleCreature {
+ visible_creature_species :: Species,
+ visible_creature_character_classes :: [CharacterClass],
+ visible_creature_wielding :: Maybe Tool,
+ visible_object_position :: Position,
+ visible_creature_faction :: Faction }
+ | VisibleBuilding {
+ visible_building_shape :: BuildingShape,
+ visible_building_occupies :: MultiPosition,
+ visible_object_position :: Position }
+
+convertToVisibleObjectRecord :: (DBReadable db) => Reference () -> db VisibleObject
+convertToVisibleObjectRecord ref | (Just creature_ref) <- coerceReference ref =
+ do species <- liftM creature_species $ dbGetCreature creature_ref
+ classes <- liftM (Map.keys . creature_levels) $ dbGetCreature creature_ref
+ faction <- Creature.getCreatureFaction creature_ref
+ m_tool_ref <- getWielded creature_ref
+ m_wielded <- case m_tool_ref of
+ Just tool_ref -> liftM Just $ dbGetTool tool_ref
+ Nothing -> return Nothing
+ position <- liftM detail $ DT.whereIs creature_ref
+ return $ VisibleCreature species classes m_wielded position faction
+convertToVisibleObjectRecord ref | (Just tool_ref) <- coerceReference ref =
+ do tool <- dbGetTool tool_ref
+ position <- liftM detail $ getPlanarLocation tool_ref
+ return $ VisibleTool tool position
+convertToVisibleObjectRecord ref | (Just building_ref :: Maybe BuildingRef) <- coerceReference ref =
+ do location <- DT.whereIs building_ref
+ return $ VisibleBuilding (detail location) (detail location) (detail location)
+
+stackVisibleObjects :: [VisibleObject] -> Map Position [VisibleObject]
+stackVisibleObjects = foldr insertVob Map.empty
+ where insertVob :: VisibleObject -> Map Position [VisibleObject] -> Map Position [VisibleObject]
+ insertVob vob = foldr (\k f -> Map.alter (insertVob_ vob) k . f)
+ id
+ (fromMultiPosition $ visibleObjectPosition vob)
+ insertVob_ :: VisibleObject -> Maybe [VisibleObject] -> Maybe [VisibleObject]
+ insertVob_ vob m_vobs =
+ (do vobs <- m_vobs
+ return $ sortBy (comparing $ negate . visibleObjectSize) $ vob:vobs)
+ <|>
+ return [vob]
+
+visibleObjectPosition :: VisibleObject -> MultiPosition
+visibleObjectPosition (VisibleBuilding { visible_building_occupies = multi_position }) = multi_position
+visibleObjectPosition vob = toMultiPosition $ visible_object_position vob
+
+visibleObjectSize :: VisibleObject -> Integer
+visibleObjectSize (VisibleTool { visible_tool = t } ) = 0
+visibleObjectSize _ = 1000000
+
+visibleObjects :: (DBReadable db) =>
+ (forall m. DBReadable m => Reference () -> DBPerception m Bool) ->
+ DBPerception db [VisibleObject]
visibleObjects filterF =
do me <- whoAmI
faction <- myFaction
@@ -88,7 +159,7 @@ visibleObjects filterF =
faction
plane_ref
Nothing -> return []
- liftDB $ mapRO DB.whereIs visible_objects
+ liftDB $ mapRO convertToVisibleObjectRecord visible_objects
myFaction :: (DBReadable db) => DBPerception db Faction
myFaction = Roguestar.Lib.Perception.getCreatureFaction =<< whoAmI
@@ -129,4 +200,9 @@ depth :: (DBReadable db) => DBPerception db Integer
depth =
do plane <- whatPlaneAmIOn
liftDB $ planeDepth plane
+
+myHealth :: (DBReadable db) => DBPerception db CreatureHealth
+myHealth =
+ do creature_ref <- whoAmI
+ liftDB $ getCreatureHealth creature_ref
@@ -1,6 +1,6 @@
module Roguestar.Lib.Position
(Position(..),
- MultiPosition,
+ MultiPosition(..),
multiPosition,
PositionType(..),
distanceBetweenSquared,
@@ -59,7 +59,7 @@ distanceBetweenChessboard as bs = minimum $
-- | List all pairs of positions between two MutiPositions.
positionPairs :: (PositionType a,PositionType b) => a -> b -> [(Position,Position)]
-positionPairs as bs =
+positionPairs as bs =
do a <- fromMultiPosition $ toMultiPosition as
b <- fromMultiPosition $ toMultiPosition bs
return (a,b)
@@ -10,7 +10,9 @@ module Roguestar.Lib.Roguestar
Position(..),
Facing(..),
Roguestar.Lib.Roguestar.beginGame,
- perceive)
+ perceive,
+ behave,
+ Behavior(..))
where
import Roguestar.Lib.DB as DB
@@ -25,6 +27,7 @@ import Roguestar.Lib.BeginGame as BeginGame
import Roguestar.Lib.Perception
import Roguestar.Lib.TerrainData
import Roguestar.Lib.Facing
+import Roguestar.Lib.Behavior
data Game = Game {
game_db :: TVar DB_BaseType }
@@ -69,3 +72,8 @@ perceive g f = peek g $
do player_creature <- maybe (fail "No player creature selected yet.") return =<< getPlayerCreature
runPerception player_creature f
+behave :: Game -> Behavior -> IO (Either DBError ())
+behave g b = poke g $
+ do player_creature <- maybe (fail "No player creature selected yet.") return =<< getPlayerCreature
+ dbBehave b player_creature
+
@@ -35,7 +35,7 @@ data Substance =
substances :: [Substance]
substances = map GasSubstance [minBound..maxBound] ++
map MaterialSubstance [minBound..maxBound] ++
- map ChromaliteSubstance [minBound..maxBound]
+ map ChromaliteSubstance [minBound..maxBound]
prettySubstance :: Substance -> B.ByteString
prettySubstance (GasSubstance x) = B.pack $ show x
@@ -65,7 +65,7 @@ data Gas =
| Ammonia
| Iodine
| Chlorine deriving (Eq,Enum,Ord,Show,Read,Bounded)
-
+
data Material =
Aluminum
| Titanium
@@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
-module Roguestar.Lib.ToolData
+module Roguestar.Lib.ToolData
(Tool(..),
+ toolName,
fromSphere,
sphere,
Device,
@@ -32,6 +33,10 @@ data Tool = DeviceTool DeviceFunction Device
| Sphere Substance
deriving (Read,Show,Eq)
+toolName :: Tool -> B.ByteString
+toolName (DeviceTool _ d) = deviceName d
+toolName (Sphere s) = prettySubstance s
+
-- | Get the substance type of a material sphere, if it is one.
fromSphere :: Tool -> Maybe Substance
fromSphere (Sphere s) = Just s
@@ -56,7 +61,7 @@ kindToFunction Pistol = (Gun,1)
kindToFunction Carbine = (Gun,3)
kindToFunction Rifle = (Gun,5)
kindToFunction Fleuret = (Sword,2)
-kindToFunction Sabre = (Sword,4)
+kindToFunction Sabre = (Sword,4)
-- | Any kind of device that is constructed from a power cell, materal, and gas medium,
-- using the various device rules to determine it's power.
@@ -103,19 +103,19 @@ dbPerform1CreatureAITurn :: CreatureRef -> DB ()
dbPerform1CreatureAITurn creature_ref =
do logDB log_turns INFO $ "Performing a creature's AI turn: id=" ++ show (toUID creature_ref)
liftM (const ()) $ atomic (flip dbBehave creature_ref) $ P.runPerception creature_ref $ liftM (fromMaybe Vanish) $ runMaybeT $
- do let isPlayer :: (DBReadable db) => Reference () -> P.DBPerception db Bool
- isPlayer ref | Just (creature_ref :: CreatureRef) <- coerceReference ref =
- do faction <- P.getCreatureFaction creature_ref
- return $ faction == Player
+ do let isPlayer :: forall db. (DBReadable db) => Reference () -> P.DBPerception db Bool
+ isPlayer ref | (Just creature_ref) <- coerceReference ref =
+ do f <- P.getCreatureFaction creature_ref
+ return $ f == Player
isPlayer _ | otherwise = return False
- (visible_player_locations :: [DetailedLocation (Child Creature)]) <- lift $ liftM mapLocations $ P.visibleObjects isPlayer
+ (visible_player_locations :: [Position]) <- lift $ liftM (map P.visible_object_position) $ P.visibleObjects isPlayer
-- FIXME: what if there is more than one player
- player_location <- MaybeT $ return $ listToMaybe visible_player_locations
+ player_position <- MaybeT $ return $ listToMaybe visible_player_locations
(rand_x :: Integer) <- lift $ getRandomR (1,100)
rand_face <- lift $ pickM [minBound..maxBound]
(_,my_position) <- lift P.whereAmI
- let face_to_player = faceAt my_position $ (detail player_location :: Position)
- return $ case distanceBetweenChessboard my_position (detail player_location :: Position) of
+ let face_to_player = faceAt my_position player_position
+ return $ case distanceBetweenChessboard my_position player_position of
_ | rand_x < 5 -> Wait -- if AI gets stuck, this will make sure they waste time so the game doesn't hang
_ | rand_x < 20 -> Step rand_face
1 -> Attack face_to_player
Oops, something went wrong. Retry.

0 comments on commit e0a63d5

Please sign in to comment.