GHC 8.8 is better at detecting unused imports, it seems - all of these are new warnings that fail under -Werror Change-Id: I1357094d715483612deb0db4a75b3e4f8f27d2e3 Reviewed-on: https://cl.tvl.fyi/c/depot/+/889 Reviewed-by: glittershark <grfn@gws.fyi> Reviewed-by: BuildkiteCI Tested-by: BuildkiteCI
64 lines
2.4 KiB
Haskell
64 lines
2.4 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)
|
|
import Xanthous.Entities.Creature (Creature, creatureType)
|
|
import Xanthous.Entities.RawTypes (hostile)
|
|
import Xanthous.Game.State
|
|
--------------------------------------------------------------------------------
|
|
|
|
autoStep :: Autocommand -> AppM ()
|
|
autoStep (AutoMove dir) = do
|
|
newPos <- uses characterPosition $ move dir
|
|
collisionAt newPos >>= \case
|
|
Nothing -> do
|
|
characterPosition .= newPos
|
|
stepGameBy =<< uses (character . speed) (|*| 1)
|
|
describeEntitiesAt newPos
|
|
maybeVisibleEnemies <- nonEmpty <$> enemiesInSight
|
|
for_ maybeVisibleEnemies $ \visibleEnemies -> do
|
|
say ["autoMove", "enemyInSight"]
|
|
$ object [ "firstEntity" A..= NE.head visibleEnemies ]
|
|
cancelAutocommand
|
|
Just _ -> 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
|