8b97683f6e
Allow the itemType raw to have density and volume fields, both of which represent *intervals* of both density and volume (because both can hypothetically vary a bit). The idea here is that when we're making an *instance* of one of these items, we pick a random value in the range. Lots of stuff in this commit is datatype and typeclass instances to support things like intervals being fields on datatypes that get serialized to saved games - including a manual definition of Ord for Item since Ord isn't well-defined for intervals Change-Id: Ia088f2f75cdce9d00560297e5c269e3310b85bc3 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3225 Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
76 lines
2.8 KiB
Haskell
76 lines
2.8 KiB
Haskell
--------------------------------------------------------------------------------
|
|
module Xanthous.App.Autocommands
|
|
( runAutocommand
|
|
, autoStep
|
|
) where
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Prelude
|
|
--------------------------------------------------------------------------------
|
|
import Control.Concurrent (threadDelay)
|
|
import qualified Data.Aeson as A
|
|
import Data.Aeson (object)
|
|
import Data.List.NonEmpty (nonEmpty)
|
|
import qualified Data.List.NonEmpty as NE
|
|
import Control.Monad.State (gets)
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.App.Common
|
|
import Xanthous.App.Time
|
|
import Xanthous.Data
|
|
import Xanthous.Data.App
|
|
import Xanthous.Entities.Character (speed, isFullyHealed)
|
|
import Xanthous.Entities.Creature (Creature, creatureType)
|
|
import Xanthous.Entities.RawTypes (hostile)
|
|
import Xanthous.Game.State
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Step the given autocommand forward once
|
|
autoStep :: Autocommand -> AppM ()
|
|
autoStep (AutoMove dir) = do
|
|
newPos <- uses characterPosition $ move dir
|
|
collisionAt newPos >>= \case
|
|
Nothing -> do
|
|
characterPosition .= newPos
|
|
stepGameBy =<< uses (character . speed) (|*| (1 :: Tiles))
|
|
describeEntitiesAt newPos
|
|
cancelIfDanger
|
|
Just _ -> cancelAutocommand
|
|
|
|
autoStep AutoRest = do
|
|
done <- uses character isFullyHealed
|
|
if done
|
|
then say_ ["autocommands", "doneResting"] >> cancelAutocommand
|
|
else stepGame >> cancelIfDanger
|
|
|
|
-- | Cancel the autocommand if the character is in danger
|
|
cancelIfDanger :: AppM ()
|
|
cancelIfDanger = do
|
|
maybeVisibleEnemies <- nonEmpty <$> enemiesInSight
|
|
for_ maybeVisibleEnemies $ \visibleEnemies -> do
|
|
say ["autocommands", "enemyInSight"]
|
|
$ object [ "firstEntity" A..= NE.head visibleEnemies ]
|
|
cancelAutocommand
|
|
where
|
|
enemiesInSight :: AppM [Creature]
|
|
enemiesInSight = do
|
|
ents <- gets characterVisibleEntities
|
|
pure $ ents
|
|
^.. folded
|
|
. _SomeEntity @Creature
|
|
. filtered (view $ creatureType . hostile)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
autocommandIntervalμs :: Int
|
|
autocommandIntervalμs = 1000 * 50 -- 50 ms
|
|
|
|
runAutocommand :: Autocommand -> AppM ()
|
|
runAutocommand ac = do
|
|
env <- ask
|
|
tid <- liftIO . async $ runReaderT go env
|
|
autocommand .= ActiveAutocommand ac tid
|
|
where
|
|
go = everyμs autocommandIntervalμs $ sendEvent AutoContinue
|
|
|
|
-- | Perform 'act' every μs microseconds forever
|
|
everyμs :: MonadIO m => Int -> m () -> m ()
|
|
everyμs μs act = act >> liftIO (threadDelay μs) >> everyμs μs act
|