Permalink
Browse files

Pops irrelevant events.

  • Loading branch information...
1 parent c44ec0c commit 94ed04b2e10ead99b91582fecdbe01921bafce97 @clanehin committed Oct 29, 2012
@@ -14,7 +14,7 @@ import Roguestar.Lib.ToolData
import Control.Monad
import Control.Monad.Error
import Roguestar.Lib.SpeciesData
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.Town
import qualified Data.ByteString.Char8 as B ()
import Control.Monad.Random
@@ -14,7 +14,6 @@ import Roguestar.Lib.Position
import Roguestar.Lib.Facing
import Data.Ratio
import Roguestar.Lib.Tool
-import Roguestar.Lib.ToolData
import Control.Monad.Error
import Roguestar.Lib.Behavior.Combat
import Roguestar.Lib.Activate
@@ -25,14 +24,12 @@ import Roguestar.Lib.CreatureData
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlaneVisibility
import Data.List
-import Control.Monad.Maybe
import Roguestar.Lib.TerrainData
import Roguestar.Lib.Behavior.Make
import Roguestar.Lib.Behavior.Construction
import Roguestar.Lib.Building
import Roguestar.Lib.Reference
import Roguestar.Lib.DetailedLocation
-import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlaneData
--
@@ -37,7 +37,6 @@ walkCreature face (x',y') creature_ref =
do l <- DetailedTravel.whereIs creature_ref
let (Parent plane_ref) = detail l
Position (x,y) = detail l
- (Child creature_ref) = identityDetail l
standing = Standing { standing_plane = plane_ref,
standing_position = Position (x+x',y+y'),
standing_facing = face }
@@ -24,7 +24,7 @@ import Control.Monad.Error
import Roguestar.Lib.PowerUpData
import Roguestar.Lib.CharacterAdvancement
import Roguestar.Lib.DetailedLocation
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
-- | The total occupied surface area of a building.
buildingSize :: (DBReadable db) => BuildingRef -> db Integer
@@ -32,7 +32,7 @@ import Control.Monad.Random as Random
import Data.Maybe
import Data.List
import Roguestar.Lib.Position as Position
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.FactionData
import Roguestar.Lib.DetailedLocation
import qualified Data.ByteString.Char8 as B
@@ -27,7 +27,7 @@ import Control.Monad.Random
import Roguestar.Lib.Facing
import Roguestar.Lib.Position
import Roguestar.Lib.Core.Plane
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.Logging
View
@@ -74,7 +74,7 @@ import Roguestar.Lib.TimeCoordinate
import Data.Ord
import Control.Monad.Random as Random
import Roguestar.Lib.Random
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.DBErrorFlag
import Control.Parallel.Strategies
import System.IO.Unsafe
@@ -0,0 +1,111 @@
+module Roguestar.Lib.Data.PlayerState
+ (PlayerState(..),
+ SnapshotEvent(..),
+ HasParticipants(..),
+ GameOverReason(..))
+ where
+
+import Roguestar.Lib.DBData
+import Roguestar.Lib.CreatureData
+import Roguestar.Lib.TravelData
+import Roguestar.Lib.PersistantData
+import Data.Maybe
+
+data PlayerState =
+ SpeciesSelectionState (Maybe Creature)
+ | PlayerCreatureTurn CreatureRef
+ | SnapshotEvent SnapshotEvent
+ | GameOver GameOverReason
+ deriving (Read,Show,Eq)
+
+data GameOverReason = PlayerIsDead | PlayerIsVictorious
+ deriving (Read,Show,Eq)
+
+data SnapshotEvent =
+ AttackEvent {
+ attack_event_source_creature :: CreatureRef,
+ attack_event_source_weapon :: Maybe ToolRef,
+ attack_event_target_creature :: CreatureRef }
+ | MissEvent {
+ miss_event_creature :: CreatureRef,
+ miss_event_weapon :: Maybe ToolRef }
+ | KilledEvent {
+ killed_event_creature :: CreatureRef }
+ | WeaponOverheatsEvent {
+ weapon_overheats_event_creature :: CreatureRef,
+ weapon_overheats_event_weapon :: ToolRef }
+ | WeaponExplodesEvent {
+ weapon_explodes_event_creature :: CreatureRef,
+ weapon_explodes_event_weapon :: ToolRef }
+ | DisarmEvent {
+ disarm_event_source_creature :: CreatureRef,
+ disarm_event_target_creature :: CreatureRef,
+ disarm_event_target_tool :: ToolRef }
+ | SunderEvent {
+ sunder_event_source_creature :: CreatureRef,
+ sunder_event_source_weapon :: ToolRef,
+ sunder_event_target_creature :: CreatureRef,
+ sunder_event_target_tool :: ToolRef }
+ | TeleportEvent {
+ teleport_event_creature :: CreatureRef }
+ | SpawnEvent {
+ spawn_event_creature :: CreatureRef }
+ | ClimbEvent {
+ climb_event_direction :: ClimbDirection,
+ climb_event_creature :: CreatureRef }
+ | HealEvent {
+ heal_event_creature :: CreatureRef }
+ | ExpendToolEvent {
+ expend_tool_event_tool :: ToolRef }
+ | BumpEvent {
+ bump_event_creature :: CreatureRef,
+ bump_event_new_level :: Maybe Integer,
+ bump_event_new_class :: Maybe CharacterClass }
+ deriving (Read,Show,Eq)
+
+class HasParticipants a where
+ subjectOf :: a -> Maybe CreatureRef
+ targetOf :: a -> Maybe CreatureRef
+ participantsOf :: a -> [CreatureRef]
+ participantsOf a = catMaybes $ [subjectOf a, targetOf a]
+
+instance HasParticipants PlayerState where
+ subjectOf (SpeciesSelectionState {}) = Nothing
+ subjectOf (PlayerCreatureTurn x) = Just x
+ subjectOf (SnapshotEvent x) = subjectOf x
+ subjectOf (GameOver {}) = Nothing
+ targetOf (SpeciesSelectionState {}) = Nothing
+ targetOf (PlayerCreatureTurn x) = Just x
+ targetOf (SnapshotEvent x) = targetOf x
+ targetOf (GameOver {}) = Nothing
+
+instance HasParticipants SnapshotEvent where
+ subjectOf event = case event of
+ AttackEvent { attack_event_source_creature = attacker_ref } -> Just attacker_ref
+ MissEvent { miss_event_creature = attacker_ref } -> Just attacker_ref
+ WeaponOverheatsEvent { weapon_overheats_event_creature = attacker_ref } -> Just attacker_ref
+ WeaponExplodesEvent { weapon_explodes_event_creature = attacker_ref } -> Just attacker_ref
+ KilledEvent killed_ref -> Just killed_ref
+ DisarmEvent { disarm_event_source_creature = attacker_ref } -> Just attacker_ref
+ SunderEvent { sunder_event_source_creature = attacker_ref } -> Just attacker_ref
+ TeleportEvent { teleport_event_creature = creature_ref } -> Just creature_ref
+ SpawnEvent { spawn_event_creature = creature_ref } -> Just creature_ref
+ HealEvent { heal_event_creature = creature_ref } -> Just creature_ref
+ ClimbEvent { climb_event_creature = creature_ref } -> Just creature_ref
+ BumpEvent { bump_event_creature = creature_ref } -> Just creature_ref
+ ExpendToolEvent {} -> Nothing
+ targetOf event = case event of
+ AttackEvent { attack_event_target_creature = target_ref } -> Just target_ref
+ MissEvent {} -> Nothing
+ WeaponOverheatsEvent {} -> Nothing
+ WeaponExplodesEvent {} -> Nothing
+ KilledEvent {} -> Nothing
+ DisarmEvent { disarm_event_target_creature = target_ref } -> Just target_ref
+ SunderEvent { sunder_event_target_creature = target_ref } -> Just target_ref
+ TeleportEvent {} -> Nothing
+ SpawnEvent {} -> Nothing
+ HealEvent {} -> Nothing
+ ClimbEvent {} -> Nothing
+ BumpEvent {} -> Nothing
+ ExpendToolEvent {} -> Nothing
+
@@ -1,90 +0,0 @@
---Data
-module Roguestar.Lib.PlayerState
- (PlayerState(..),
- SnapshotEvent(..),
- HasSubject(..),
- GameOverReason(..))
- where
-
-import Roguestar.Lib.DBData
-import Roguestar.Lib.CreatureData
-import Roguestar.Lib.TravelData
-import Roguestar.Lib.PersistantData
-
-data PlayerState =
- SpeciesSelectionState (Maybe Creature)
- | PlayerCreatureTurn CreatureRef
- | SnapshotEvent SnapshotEvent
- | GameOver GameOverReason
- deriving (Read,Show,Eq)
-
-data GameOverReason = PlayerIsDead | PlayerIsVictorious
- deriving (Read,Show,Eq)
-
-data SnapshotEvent =
- AttackEvent {
- attack_event_source_creature :: CreatureRef,
- attack_event_source_weapon :: Maybe ToolRef,
- attack_event_target_creature :: CreatureRef }
- | MissEvent {
- miss_event_creature :: CreatureRef,
- miss_event_weapon :: Maybe ToolRef }
- | KilledEvent {
- killed_event_creature :: CreatureRef }
- | WeaponOverheatsEvent {
- weapon_overheats_event_creature :: CreatureRef,
- weapon_overheats_event_weapon :: ToolRef }
- | WeaponExplodesEvent {
- weapon_explodes_event_creature :: CreatureRef,
- weapon_explodes_event_weapon :: ToolRef }
- | DisarmEvent {
- disarm_event_source_creature :: CreatureRef,
- disarm_event_target_creature :: CreatureRef,
- disarm_event_target_tool :: ToolRef }
- | SunderEvent {
- sunder_event_source_creature :: CreatureRef,
- sunder_event_source_weapon :: ToolRef,
- sunder_event_target_creature :: CreatureRef,
- sunder_event_target_tool :: ToolRef }
- | TeleportEvent {
- teleport_event_creature :: CreatureRef }
- | SpawnEvent {
- spawn_event_creature :: CreatureRef }
- | ClimbEvent {
- climb_event_direction :: ClimbDirection,
- climb_event_creature :: CreatureRef }
- | HealEvent {
- heal_event_creature :: CreatureRef }
- | ExpendToolEvent {
- expend_tool_event_tool :: ToolRef }
- | BumpEvent {
- bump_event_creature :: CreatureRef,
- bump_event_new_level :: Maybe Integer,
- bump_event_new_class :: Maybe CharacterClass }
- deriving (Read,Show,Eq)
-
-class HasSubject a where
- subjectOf :: a -> Maybe CreatureRef
-
-instance HasSubject PlayerState where
- subjectOf (SpeciesSelectionState {}) = Nothing
- subjectOf (PlayerCreatureTurn x) = Just x
- subjectOf (SnapshotEvent x) = subjectOf x
- subjectOf (GameOver {}) = Nothing
-
-instance HasSubject SnapshotEvent where
- subjectOf event = case event of
- AttackEvent { attack_event_source_creature = attacker_ref } -> Just attacker_ref
- MissEvent { miss_event_creature = attacker_ref } -> Just attacker_ref
- WeaponOverheatsEvent { weapon_overheats_event_creature = attacker_ref } -> Just attacker_ref
- WeaponExplodesEvent { weapon_explodes_event_creature = attacker_ref } -> Just attacker_ref
- KilledEvent killed_ref -> Just killed_ref
- DisarmEvent { disarm_event_source_creature = attacker_ref } -> Just attacker_ref
- SunderEvent { sunder_event_source_creature = attacker_ref } -> Just attacker_ref
- TeleportEvent { teleport_event_creature = creature_ref } -> Just creature_ref
- SpawnEvent { spawn_event_creature = creature_ref } -> Just creature_ref
- HealEvent { heal_event_creature = creature_ref } -> Just creature_ref
- ClimbEvent { climb_event_creature = creature_ref } -> Just creature_ref
- BumpEvent { bump_event_creature = creature_ref } -> Just creature_ref
- ExpendToolEvent {} -> Nothing
-
@@ -31,12 +31,13 @@ module Roguestar.Lib.Roguestar
import System.UUID.V4 as V4
import Data.Map as Map
+import Data.List as List
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Roguestar.Lib.DB as DB
import Control.Concurrent.STM
import Control.Monad
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.Creature
import Roguestar.Lib.CreatureData
@@ -46,9 +47,12 @@ import Roguestar.Lib.TerrainData
import Roguestar.Lib.Facing
import Roguestar.Lib.Behavior as Behavior
import Roguestar.Lib.Turns
+import Roguestar.Lib.Core.Plane
import Data.Text as T
import System.Time
import Control.Concurrent
+import Roguestar.Lib.FactionData
+import Roguestar.Lib.PlaneVisibility
-- Session timeout information.
data GameConfiguration = GameConfiguration {
@@ -104,7 +108,7 @@ doCleanup config game_state =
do last_touched <- readTVar $ game_last_touched value
when (game_config_current_clock_time_seconds config > last_touched + game_config_timeout_seconds config) $
writeTVar (game_state_gamelist game_state) =<< liftM (Map.delete key) (readTVar $ game_state_gamelist game_state)
-
+
createGame :: GameConfiguration -> GameState -> IO BS.ByteString
createGame config game_state =
do cleanupGameState config game_state
@@ -139,13 +143,34 @@ peek g f =
poke :: Game -> DB a -> IO (Either DBError a)
poke g f =
do game <- atomically $ readTVar (game_db g)
- result <- runDB f game
+ result <- flip runDB game $
+ do result <- f
+ cleanupNonPlayerSnapshots
+ return result
case result of
Left err -> return $ Left err
Right (a,next_db) ->
do atomically $ writeTVar (game_db g) next_db
return $ Right a
+cleanupNonPlayerSnapshots :: DB ()
+cleanupNonPlayerSnapshots =
+ do has_snapshot <- DB.hasSnapshot
+ is_relevant <- DB.peepOldestSnapshot $
+ do participants <- liftM (List.map genericReference . participantsOf) playerState
+ m_plane_ref <- getCurrentPlane
+ case m_plane_ref of
+ _ | List.null participants -> return False
+ Nothing -> return True
+ Just plane_ref ->
+ liftM (not . List.null) $ dbGetVisibleObjectsForFaction
+ (return . (`elem` participants))
+ Player
+ plane_ref
+ when (has_snapshot && not is_relevant) $
+ do DB.popOldestSnapshot
+ cleanupNonPlayerSnapshots
+
getPlayerState :: Game -> IO (Either DBError PlayerState)
getPlayerState g = peek g playerState
@@ -206,7 +231,7 @@ putMessage :: Game -> T.Text -> IO ()
putMessage g t = atomically $
do ts <- readTVar $ game_message_text g
writeTVar (game_message_text g) $ Prelude.take max_messages $ t:ts
-
+
getMessages :: Game -> IO [T.Text]
getMessages g = readTVarIO (game_message_text g)
@@ -22,7 +22,7 @@ import Data.Maybe
import Roguestar.Lib.Behavior
import qualified Roguestar.Lib.Perception as P
import Roguestar.Lib.Position
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.Logging
import Roguestar.Lib.DetailedLocation
import Control.Monad.Random
@@ -105,8 +105,8 @@ dbPerform1CreatureAITurn creature_ref =
do logDB log_turns INFO $ "dbPerform1CreatureAITurn; 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 :: forall db. (DBReadable db) => Reference () -> P.DBPerception db Bool
- isPlayer ref | (Just creature_ref) <- coerceReference ref =
- do f <- P.getCreatureFaction creature_ref
+ isPlayer ref | (Just might_be_the_player_creature_ref) <- coerceReference ref =
+ do f <- P.getCreatureFaction might_be_the_player_creature_ref
return $ f == Player
isPlayer _ | otherwise = return False
(visible_player_locations :: [Position]) <- lift $ liftM (map P.visible_object_position) $ P.visibleObjects isPlayer
@@ -9,7 +9,7 @@ import Data.Maybe
import Control.Concurrent
import System.IO
import Roguestar.Lib.DB
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Control.Monad.Reader.Class
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.TerrainData
@@ -31,7 +31,7 @@ import Data.Ord
import qualified Data.List as List
import qualified Data.Map as Map
import Roguestar.Lib.Roguestar
-import Roguestar.Lib.PlayerState
+import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.DBErrorFlag
import Roguestar.Lib.Perception
import Roguestar.Lib.SpeciesData
Oops, something went wrong.

0 comments on commit 94ed04b

Please sign in to comment.