{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Some entities are "combustible". A command, 'Swarm.Language.Syntax.Ignite', will
-- initiate combustion on such an entity.
-- Furthermore, combustion can spread to (4-)adjacent entities, depending
-- on the 'ignition' property of that entity.
--
-- Short-lived robots are used to illustrate the combusting entity as
-- well as to initiate the delayed combustion of its neighbors.
module Swarm.Game.Step.Combustion where

import Control.Applicative (Applicative (..))
import Control.Carrier.State.Lazy
import Control.Effect.Lens
import Control.Effect.Lift
import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
import Control.Monad (forM_, void, when)
import Data.Text qualified as T
import Linear (zero)
import Swarm.Game.CESK (emptyStore, initMachine)
import Swarm.Game.Display
import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
import Swarm.Game.Entity qualified as E
import Swarm.Game.Location
import Swarm.Game.Robot
import Swarm.Game.State
import Swarm.Game.Step.Util
import Swarm.Game.Universe
import Swarm.Language.Context (empty)
import Swarm.Language.Pipeline (ProcessedTerm)
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Syntax
import Swarm.Language.Text.Markdown qualified as Markdown
import Swarm.Util hiding (both)
import System.Clock (TimeSpec)
import Prelude hiding (Applicative (..), lookup)

igniteCommand :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Const -> Direction -> m ()
igniteCommand :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const -> Direction -> m ()
igniteCommand Const
c Direction
d = do
  (Cosmic Location
loc, Maybe Entity
me) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
  -- Ensure there is an entity here.
  Entity
e <-
    Maybe Entity
me forall {a}. Maybe a -> [Var] -> m a
`isJustOrFail` [Var
"There is nothing here to", Var
verb forall a. Semigroup a => a -> a -> a
<> Var
"."]

  -- Ensure it can be ignited.
  (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Combustible)
    Bool -> [Var] -> m ()
`holdsOrFail` [Var
"The", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Var
entityName, Var
"here can't be", Var
verbed forall a. Semigroup a => a -> a -> a
<> Var
"."]

  -- Remove the entity from the world.
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw

  -- Start burning process
  let selfCombustibility :: Combustibility
selfCombustibility = (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Combustibility)
entityCombustion) forall a. Maybe a -> a -> a
? Combustibility
defaultCombustibility
  TimeSpec
createdAt <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow
  Integer
combustionDurationRand <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity
-> Combustibility -> TimeSpec -> Cosmic Location -> m Integer
addCombustionBot Entity
e Combustibility
selfCombustibility TimeSpec
createdAt Cosmic Location
loc
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Cosmic Location -> [Cosmic Location]
getNeighborLocs Cosmic Location
loc) forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TimeSpec -> Integer -> Cosmic Location -> m ()
igniteNeighbor TimeSpec
createdAt Integer
combustionDurationRand
 where
  verb :: Var
verb = Var
"ignite"
  verbed :: Var
verbed = Var
"ignited"

  holdsOrFail :: Bool -> [Var] -> m ()
holdsOrFail = forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Bool -> [Var] -> m ()
holdsOrFail' Const
c
  isJustOrFail :: Maybe a -> [Var] -> m a
isJustOrFail = forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> Maybe a -> [Var] -> m a
isJustOrFail' Const
c

-- | Construct a "combustion robot" from entity and position
--   and add it to the world.
--   It has low priority and will be covered
--   by placed entities.
--   The "combustion bot" represents the burning of a single
--   entity; propagating the fire to neighbors is handled upstream,
--   within the 'Swarm.Language.Syntax.Ignite' command.
addCombustionBot ::
  Has (State GameState) sig m =>
  Entity ->
  Combustibility ->
  TimeSpec ->
  Cosmic Location ->
  m Integer
addCombustionBot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity
-> Combustibility -> TimeSpec -> Cosmic Location -> m Integer
addCombustionBot Entity
inputEntity Combustibility
combustibility TimeSpec
ts Cosmic Location
loc = do
  [(Count, Entity)]
botInventory <- case Maybe Var
maybeCombustionProduct of
    Maybe Var
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Var
n -> do
      Maybe Entity
maybeE <- forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses (Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap) (Var -> EntityMap -> Maybe Entity
lookupEntityName Var
n)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Count
1,)) Maybe Entity
maybeE
  Integer
combustionDurationRand <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Integer, Integer)
durationRange
  let combustionProg :: ProcessedTerm
combustionProg = Integer -> Combustibility -> ProcessedTerm
combustionProgram Integer
combustionDurationRand Combustibility
combustibility
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TRobot -> m Robot
addTRobot forall a b. (a -> b) -> a -> b
$
      forall (phase :: RobotPhase).
RobotID phase
-> Maybe Count
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Count, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot
        ()
        forall a. Maybe a
Nothing
        Var
"fire"
        (Var -> Document Syntax
Markdown.fromText forall a b. (a -> b) -> a -> b
$ [Var] -> Var
T.unwords [Var
"A burning", (Entity
inputEntity forall s a. s -> Getting a s a -> a
^. Lens' Entity Var
entityName) forall a. Semigroup a => a -> a -> a
<> Var
"."])
        (forall a. a -> Maybe a
Just Cosmic Location
loc)
        forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
        ( Char -> Display
defaultEntityDisplay Char
'*'
            forall a b. a -> (a -> b) -> b
& Lens' Display Attribute
displayAttr forall s t a b. ASetter s t a b -> b -> s -> t
.~ Var -> Attribute
AWorld Var
"fire"
            forall a b. a -> (a -> b) -> b
& Lens' Display Count
displayPriority forall s t a b. ASetter s t a b -> b -> s -> t
.~ Count
0
        )
        (ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
combustionProg forall t. Ctx t
empty Store
emptyStore)
        []
        [(Count, Entity)]
botInventory
        Bool
True
        Bool
False
        forall a. Monoid a => a
mempty
        TimeSpec
ts
  forall (m :: * -> *) a. Monad m => a -> m a
return Integer
combustionDurationRand
 where
  Combustibility Double
_ (Integer, Integer)
durationRange Maybe Var
maybeCombustionProduct = Combustibility
combustibility

-- Triggers the ignition of the entity underfoot with some delay.
ignitionProgram :: Integer -> ProcessedTerm
ignitionProgram :: Integer -> ProcessedTerm
ignitionProgram Integer
waitTime =
  [tmQ|
    wait $int:waitTime;
    try {
      ignite down;
      noop;
    } {};
    selfdestruct
  |]

-- | A system program for a "combustion robot", to burn an entity
--   after it is ignited.
--
-- For efficiency, we determine a priori (i.e. the instant
-- the combustion robot is spawned) whether any neighbors will eventually
-- be burned, based on probabilities.
--
-- Note that it is possible that new neighbors may be introduced while
-- combustion is in progress. Although it may be more realistic to subject
-- these to possible combustion as well, we do not bother.
--
-- Though if we did actually want to do that, some options are:
--
-- 1. Create sub-partitions (of say, 10-tick duration) of the combustion duration
--    to re-evaluate opportunities to light adjacent entities on fire.
-- 2. Use the 'Swarm.Language.Syntax.Watch' command to observe for changes to adjacent entities.
--    Note that if we "wake" from our 'Swarm.Language.Syntax.Wait' due to the 'Swarm.Language.Syntax.Watch' being triggered,
--    we would need to maintain bookkeeping of how much time is left.
-- 3. Spawn more robots whose sole purpose is to observe for changes to neighbor
--    cells. This would avoid polluting the logic of the currently burning cell
--    with logic to manage probabilities of combustion propagation.
combustionProgram :: Integer -> Combustibility -> ProcessedTerm
combustionProgram :: Integer -> Combustibility -> ProcessedTerm
combustionProgram Integer
combustionDuration (Combustibility Double
_ (Integer, Integer)
_ Maybe Var
maybeCombustionProduct) =
  [tmQ|
    wait $int:combustionDuration;
    if ($int:invQuantity > 0) {
      try {
        place $str:combustionProduct;
      } {};
    } {};
    selfdestruct
  |]
 where
  (Integer
invQuantity, Var
combustionProduct) = case Maybe Var
maybeCombustionProduct of
    Maybe Var
Nothing -> (Integer
0, Var
"")
    Just Var
p -> (Integer
1, Var
p)

-- | We treat the 'ignition' field in the 'Combustibility' record
-- as a /rate/ in a Poisson distribution.
-- Ignition of neighbors depends on that particular neighbor entity's
-- combustion /rate/, but also on the duration
-- that the current entity will burn.
igniteNeighbor ::
  Has (State GameState) sig m =>
  TimeSpec ->
  Integer ->
  Cosmic Location ->
  m ()
igniteNeighbor :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TimeSpec -> Integer -> Cosmic Location -> m ()
igniteNeighbor TimeSpec
creationTime Integer
sourceDuration Cosmic Location
loc = do
  Maybe Entity
maybeEnt <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Entity
maybeEnt forall {sig :: (* -> *) -> * -> *} {f :: * -> *}.
(Algebra sig f, Member (State GameState) sig) =>
Entity -> f ()
igniteEntity
 where
  igniteEntity :: Entity -> f ()
igniteEntity Entity
e =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Combustible) forall a b. (a -> b) -> a -> b
$ do
      Double
threshold <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Double
0, Double
1)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
probabilityOfIgnition forall a. Ord a => a -> a -> Bool
>= Double
threshold) forall a b. (a -> b) -> a -> b
$ do
        Double
ignitionDelayRand <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Double
0, Double
1)
        let ignitionDelay :: Integer
ignitionDelay =
              forall a b. (RealFrac a, Integral b) => a -> b
floor
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sourceDuration)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate
                forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a
log Double
ignitionDelayRand forall a. Fractional a => a -> a -> a
/ Double
rate
        forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Integer -> Entity -> TimeSpec -> Cosmic Location -> m ()
addIgnitionBot Integer
ignitionDelay Entity
e TimeSpec
creationTime Cosmic Location
loc
   where
    neighborCombustibility :: Combustibility
neighborCombustibility = (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Combustibility)
entityCombustion) forall a. Maybe a -> a -> a
? Combustibility
defaultCombustibility
    rate :: Double
rate = Combustibility -> Double
E.ignition Combustibility
neighborCombustibility
    probabilityOfIgnition :: Double
probabilityOfIgnition = Double
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Double
rate forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sourceDuration)

-- | Construct an invisible "ignition robot" and add it to the world.
--   Its sole purpose is to delay the 'Swarm.Language.Syntax.Ignite' command for a neighbor
--   that has been a priori determined that it shall be ignited.
addIgnitionBot ::
  Has (State GameState) sig m =>
  Integer ->
  Entity ->
  TimeSpec ->
  Cosmic Location ->
  m ()
addIgnitionBot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Integer -> Entity -> TimeSpec -> Cosmic Location -> m ()
addIgnitionBot Integer
ignitionDelay Entity
inputEntity TimeSpec
ts Cosmic Location
loc =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TRobot -> m Robot
addTRobot forall a b. (a -> b) -> a -> b
$
      forall (phase :: RobotPhase).
RobotID phase
-> Maybe Count
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Count, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot
        ()
        forall a. Maybe a
Nothing
        Var
"firestarter"
        (Var -> Document Syntax
Markdown.fromText forall a b. (a -> b) -> a -> b
$ [Var] -> Var
T.unwords [Var
"Delayed ignition of", (Entity
inputEntity forall s a. s -> Getting a s a -> a
^. Lens' Entity Var
entityName) forall a. Semigroup a => a -> a -> a
<> Var
"."])
        (forall a. a -> Maybe a
Just Cosmic Location
loc)
        forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
        ( Char -> Display
defaultEntityDisplay Char
'*'
            forall a b. a -> (a -> b) -> b
& Lens' Display Bool
invisible forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
        )
        (ProcessedTerm -> Env -> Store -> CESK
initMachine (Integer -> ProcessedTerm
ignitionProgram Integer
ignitionDelay) forall t. Ctx t
empty Store
emptyStore)
        []
        []
        Bool
True
        Bool
False
        forall a. Monoid a => a
mempty
        TimeSpec
ts