about summary refs log blame commit diff
path: root/users/glittershark/xanthous/src/Xanthous/App/Autocommands.hs
blob: 35b92bba7289d901dcc4acab30938aa5c6ad12fe (plain) (tree)
1
2
3
4
5
6
7
8





                                                                                
                                 
                                                                                





                                                 
                                                                                








                                                                    









                                                                                




                                                                
                               







                                                     
















                                                                                
--------------------------------------------------------------------------------
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
import           Xanthous.Game.Lenses (characterVisibleEntities)
--------------------------------------------------------------------------------

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