blob: f393a0e2ea9af4016d694a45c817da80b2deee24 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
--------------------------------------------------------------------------------
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
|
