-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Online operations for structure recognizer.
--
-- See "Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute" for
-- details of the structure recognition process.
module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking (
  entityModified,
) where

import Control.Carrier.State.Lazy
import Control.Effect.Lens
import Control.Lens ((^.))
import Control.Monad (forM, forM_, guard)
import Data.HashMap.Strict qualified as HM
import Data.HashSet (HashSet)
import Data.HashSet qualified as HS
import Data.Hashable (Hashable)
import Data.Int (Int32)
import Data.List (sortOn)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (listToMaybe)
import Data.Ord (Down (..))
import Data.Semigroup (Max (..), Min (..))
import Linear (V2 (..))
import Swarm.Game.Entity (Entity)
import Swarm.Game.Location (Location)
import Swarm.Game.Scenario (StructureCells)
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.State
import Swarm.Game.State.Substate
import Swarm.Game.Universe
import Swarm.Game.World.Modify
import Text.AhoCorasick

-- | A hook called from the centralized entity update function,
-- 'Swarm.Game.Step.Util.updateEntityAt'.
--
-- This handles structure detection upon addition of an entity,
-- and structure de-registration upon removal of an entity.
-- Also handles atomic entity swaps.
entityModified ::
  (Has (State GameState) sig m) =>
  CellModification Entity ->
  Cosmic Location ->
  m ()
entityModified :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
CellModification Entity -> Cosmic Location -> m ()
entityModified CellModification Entity
modification Cosmic Location
cLoc = do
  case CellModification Entity
modification of
    Add Entity
newEntity -> Entity -> m ()
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Member (State GameState) sig, Algebra sig m) =>
Entity -> m ()
doAddition Entity
newEntity
    Remove Entity
_ -> m ()
doRemoval
    Swap Entity
_ Entity
newEntity -> m ()
doRemoval m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Entity -> m ()
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Member (State GameState) sig, Algebra sig m) =>
Entity -> m ()
doAddition Entity
newEntity
 where
  doAddition :: Entity -> m ()
doAddition Entity
newEntity = do
    HashMap
  Entity
  (AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity))
entLookup <- Getting
  (HashMap
     Entity
     (AutomatonInfo
        Entity
        (AtomicKeySymbol Entity)
        (StructureSearcher StructureCells Entity)))
  GameState
  (HashMap
     Entity
     (AutomatonInfo
        Entity
        (AtomicKeySymbol Entity)
        (StructureSearcher StructureCells Entity)))
-> m (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (HashMap
      Entity
      (AutomatonInfo
         Entity
         (AtomicKeySymbol Entity)
         (StructureSearcher StructureCells Entity)))
   GameState
   (HashMap
      Entity
      (AutomatonInfo
         Entity
         (AtomicKeySymbol Entity)
         (StructureSearcher StructureCells Entity)))
 -> m (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity))))
-> Getting
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     GameState
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
-> m (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
forall a b. (a -> b) -> a -> b
$ (Discovery
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      Discovery)
-> GameState
-> Const
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const
       (HashMap
          Entity
          (AutomatonInfo
             Entity
             (AtomicKeySymbol Entity)
             (StructureSearcher StructureCells Entity)))
       Discovery)
 -> GameState
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      GameState)
-> ((HashMap
       Entity
       (AutomatonInfo
          Entity
          (AtomicKeySymbol Entity)
          (StructureSearcher StructureCells Entity))
     -> Const
          (HashMap
             Entity
             (AutomatonInfo
                Entity
                (AtomicKeySymbol Entity)
                (StructureSearcher StructureCells Entity)))
          (HashMap
             Entity
             (AutomatonInfo
                Entity
                (AtomicKeySymbol Entity)
                (StructureSearcher StructureCells Entity))))
    -> Discovery
    -> Const
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity)))
         Discovery)
-> Getting
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     GameState
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (HashMap
          Entity
          (AutomatonInfo
             Entity
             (AtomicKeySymbol Entity)
             (StructureSearcher StructureCells Entity)))
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      Discovery)
-> ((HashMap
       Entity
       (AutomatonInfo
          Entity
          (AtomicKeySymbol Entity)
          (StructureSearcher StructureCells Entity))
     -> Const
          (HashMap
             Entity
             (AutomatonInfo
                Entity
                (AtomicKeySymbol Entity)
                (StructureSearcher StructureCells Entity)))
          (HashMap
             Entity
             (AutomatonInfo
                Entity
                (AtomicKeySymbol Entity)
                (StructureSearcher StructureCells Entity))))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity)))
         (StructureRecognizer StructureCells Entity))
-> (HashMap
      Entity
      (AutomatonInfo
         Entity
         (AtomicKeySymbol Entity)
         (StructureSearcher StructureCells Entity))
    -> Const
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity)))
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity))))
-> Discovery
-> Const
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons StructureCells Entity
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      (RecognizerAutomatons StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(RecognizerAutomatons b a -> f (RecognizerAutomatons b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
automatons ((RecognizerAutomatons StructureCells Entity
  -> Const
       (HashMap
          Entity
          (AutomatonInfo
             Entity
             (AtomicKeySymbol Entity)
             (StructureSearcher StructureCells Entity)))
       (RecognizerAutomatons StructureCells Entity))
 -> StructureRecognizer StructureCells Entity
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      (StructureRecognizer StructureCells Entity))
-> ((HashMap
       Entity
       (AutomatonInfo
          Entity
          (AtomicKeySymbol Entity)
          (StructureSearcher StructureCells Entity))
     -> Const
          (HashMap
             Entity
             (AutomatonInfo
                Entity
                (AtomicKeySymbol Entity)
                (StructureSearcher StructureCells Entity)))
          (HashMap
             Entity
             (AutomatonInfo
                Entity
                (AtomicKeySymbol Entity)
                (StructureSearcher StructureCells Entity))))
    -> RecognizerAutomatons StructureCells Entity
    -> Const
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity)))
         (RecognizerAutomatons StructureCells Entity))
-> (HashMap
      Entity
      (AutomatonInfo
         Entity
         (AtomicKeySymbol Entity)
         (StructureSearcher StructureCells Entity))
    -> Const
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity)))
         (HashMap
            Entity
            (AutomatonInfo
               Entity
               (AtomicKeySymbol Entity)
               (StructureSearcher StructureCells Entity))))
-> StructureRecognizer StructureCells Entity
-> Const
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     (StructureRecognizer StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap
   Entity
   (AutomatonInfo
      Entity
      (AtomicKeySymbol Entity)
      (StructureSearcher StructureCells Entity))
 -> Const
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity)))
      (HashMap
         Entity
         (AutomatonInfo
            Entity
            (AtomicKeySymbol Entity)
            (StructureSearcher StructureCells Entity))))
-> RecognizerAutomatons StructureCells Entity
-> Const
     (HashMap
        Entity
        (AutomatonInfo
           Entity
           (AtomicKeySymbol Entity)
           (StructureSearcher StructureCells Entity)))
     (RecognizerAutomatons StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(HashMap
   a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
 -> f (HashMap
         a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
automatonsByEntity
    Maybe
  (AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity))
-> (AutomatonInfo
      Entity
      (AtomicKeySymbol Entity)
      (StructureSearcher StructureCells Entity)
    -> m ())
-> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Entity
-> HashMap
     Entity
     (AutomatonInfo
        Entity
        (AtomicKeySymbol Entity)
        (StructureSearcher StructureCells Entity))
-> Maybe
     (AutomatonInfo
        Entity
        (AtomicKeySymbol Entity)
        (StructureSearcher StructureCells Entity))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Entity
newEntity HashMap
  Entity
  (AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity))
entLookup) ((AutomatonInfo
    Entity
    (AtomicKeySymbol Entity)
    (StructureSearcher StructureCells Entity)
  -> m ())
 -> m ())
-> (AutomatonInfo
      Entity
      (AtomicKeySymbol Entity)
      (StructureSearcher StructureCells Entity)
    -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \AutomatonInfo
  Entity
  (AtomicKeySymbol Entity)
  (StructureSearcher StructureCells Entity)
finder -> do
      let msg :: SearchLog Entity
msg = ParticipatingEntity Entity -> SearchLog Entity
forall e. ParticipatingEntity e -> SearchLog e
FoundParticipatingEntity (ParticipatingEntity Entity -> SearchLog Entity)
-> ParticipatingEntity Entity -> SearchLog Entity
forall a b. (a -> b) -> a -> b
$ Entity -> InspectionOffsets -> ParticipatingEntity Entity
forall e. e -> InspectionOffsets -> ParticipatingEntity e
ParticipatingEntity Entity
newEntity (AutomatonInfo
  Entity
  (AtomicKeySymbol Entity)
  (StructureSearcher StructureCells Entity)
finder AutomatonInfo
  Entity
  (AtomicKeySymbol Entity)
  (StructureSearcher StructureCells Entity)
-> Getting
     InspectionOffsets
     (AutomatonInfo
        Entity
        (AtomicKeySymbol Entity)
        (StructureSearcher StructureCells Entity))
     InspectionOffsets
-> InspectionOffsets
forall s a. s -> Getting a s a -> a
^. Getting
  InspectionOffsets
  (AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity))
  InspectionOffsets
forall en k v (f :: * -> *).
Functor f =>
(InspectionOffsets -> f InspectionOffsets)
-> AutomatonInfo en k v -> f (AutomatonInfo en k v)
inspectionOffsets)
      (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> Discovery -> Identity Discovery)
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> Discovery -> Identity Discovery)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SearchLog Entity] -> Identity [SearchLog Entity])
-> StructureRecognizer StructureCells Entity
-> Identity (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
([SearchLog a] -> f [SearchLog a])
-> StructureRecognizer b a -> f (StructureRecognizer b a)
recognitionLog (([SearchLog Entity] -> Identity [SearchLog Entity])
 -> GameState -> Identity GameState)
-> ([SearchLog Entity] -> [SearchLog Entity]) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (SearchLog Entity
msg SearchLog Entity -> [SearchLog Entity] -> [SearchLog Entity]
forall a. a -> [a] -> [a]
:)
      Cosmic Location
-> AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity)
-> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location
-> AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity)
-> m ()
registerRowMatches Cosmic Location
cLoc AutomatonInfo
  Entity
  (AtomicKeySymbol Entity)
  (StructureSearcher StructureCells Entity)
finder

  doRemoval :: m ()
doRemoval = do
    -- Entity was removed; may need to remove registered structure.
    FoundRegistry StructureCells Entity
structureRegistry <- Getting
  (FoundRegistry StructureCells Entity)
  GameState
  (FoundRegistry StructureCells Entity)
-> m (FoundRegistry StructureCells Entity)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (FoundRegistry StructureCells Entity)
   GameState
   (FoundRegistry StructureCells Entity)
 -> m (FoundRegistry StructureCells Entity))
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
-> m (FoundRegistry StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ (Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> GameState
-> Const (FoundRegistry StructureCells Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const (FoundRegistry StructureCells Entity) Discovery)
 -> GameState
 -> Const (FoundRegistry StructureCells Entity) GameState)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> Discovery
    -> Const (FoundRegistry StructureCells Entity) Discovery)
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (FoundRegistry StructureCells Entity)
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (FoundRegistry StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (FoundRegistry StructureCells Entity)
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures
    Maybe (FoundStructure StructureCells Entity)
-> (FoundStructure StructureCells Entity -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Cosmic Location
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
-> Maybe (FoundStructure StructureCells Entity)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Cosmic Location
cLoc (Map (Cosmic Location) (FoundStructure StructureCells Entity)
 -> Maybe (FoundStructure StructureCells Entity))
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
-> Maybe (FoundStructure StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ FoundRegistry StructureCells Entity
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
forall b a.
FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
foundByLocation FoundRegistry StructureCells Entity
structureRegistry) ((FoundStructure StructureCells Entity -> m ()) -> m ())
-> (FoundStructure StructureCells Entity -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FoundStructure StructureCells Entity
fs -> do
      let structureName :: OriginalName
structureName = NamedOriginal StructureCells -> OriginalName
forall a. NamedOriginal a -> OriginalName
getName (NamedOriginal StructureCells -> OriginalName)
-> NamedOriginal StructureCells -> OriginalName
forall a b. (a -> b) -> a -> b
$ StructureWithGrid StructureCells Entity
-> NamedOriginal StructureCells
forall b a. StructureWithGrid b a -> NamedOriginal b
originalDefinition (StructureWithGrid StructureCells Entity
 -> NamedOriginal StructureCells)
-> StructureWithGrid StructureCells Entity
-> NamedOriginal StructureCells
forall a b. (a -> b) -> a -> b
$ FoundStructure StructureCells Entity
-> StructureWithGrid StructureCells Entity
forall b a. FoundStructure b a -> StructureWithGrid b a
structureWithGrid FoundStructure StructureCells Entity
fs
       in do
            (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> Discovery -> Identity Discovery)
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> Discovery -> Identity Discovery)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SearchLog Entity] -> Identity [SearchLog Entity])
-> StructureRecognizer StructureCells Entity
-> Identity (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
([SearchLog a] -> f [SearchLog a])
-> StructureRecognizer b a -> f (StructureRecognizer b a)
recognitionLog (([SearchLog Entity] -> Identity [SearchLog Entity])
 -> GameState -> Identity GameState)
-> ([SearchLog Entity] -> [SearchLog Entity]) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (OriginalName -> SearchLog Entity
forall e. OriginalName -> SearchLog e
StructureRemoved OriginalName
structureName SearchLog Entity -> [SearchLog Entity] -> [SearchLog Entity]
forall a. a -> [a] -> [a]
:)
            (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((FoundRegistry StructureCells Entity
     -> Identity (FoundRegistry StructureCells Entity))
    -> Discovery -> Identity Discovery)
-> (FoundRegistry StructureCells Entity
    -> Identity (FoundRegistry StructureCells Entity))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> Discovery -> Identity Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Identity (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Identity (FoundRegistry StructureCells Entity))
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Identity (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Identity (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures ((FoundRegistry StructureCells Entity
  -> Identity (FoundRegistry StructureCells Entity))
 -> GameState -> Identity GameState)
-> (FoundRegistry StructureCells Entity
    -> FoundRegistry StructureCells Entity)
-> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= FoundStructure StructureCells Entity
-> FoundRegistry StructureCells Entity
-> FoundRegistry StructureCells Entity
forall b a.
FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a
removeStructure FoundStructure StructureCells Entity
fs

-- | In case this cell would match a candidate structure,
-- ensures that the entity in this cell is not already
-- participating in a registered structure.
--
-- Furthermore, treating cells in registered structures
-- as 'Nothing' has the effect of "masking" them out,
-- so that they can overlap empty cells within the bounding
-- box of the candidate structure.
--
-- Finally, entities that are not members of any candidate
-- structure are also masked out, so that it is OK for them
-- to intrude into the candidate structure's bounding box
-- where the candidate structure has empty cells.
candidateEntityAt ::
  (Has (State GameState) sig m) =>
  -- | participating entities
  HashSet Entity ->
  Cosmic Location ->
  m (Maybe Entity)
candidateEntityAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
HashSet Entity -> Cosmic Location -> m (AtomicKeySymbol Entity)
candidateEntityAt HashSet Entity
participating Cosmic Location
cLoc = do
  FoundRegistry StructureCells Entity
registry <- Getting
  (FoundRegistry StructureCells Entity)
  GameState
  (FoundRegistry StructureCells Entity)
-> m (FoundRegistry StructureCells Entity)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (FoundRegistry StructureCells Entity)
   GameState
   (FoundRegistry StructureCells Entity)
 -> m (FoundRegistry StructureCells Entity))
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
-> m (FoundRegistry StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ (Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> GameState
-> Const (FoundRegistry StructureCells Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const (FoundRegistry StructureCells Entity) Discovery)
 -> GameState
 -> Const (FoundRegistry StructureCells Entity) GameState)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> Discovery
    -> Const (FoundRegistry StructureCells Entity) Discovery)
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (FoundRegistry StructureCells Entity)
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (FoundRegistry StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (FoundRegistry StructureCells Entity)
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures
  if Cosmic Location
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Cosmic Location
cLoc (Map (Cosmic Location) (FoundStructure StructureCells Entity)
 -> Bool)
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
-> Bool
forall a b. (a -> b) -> a -> b
$ FoundRegistry StructureCells Entity
-> Map (Cosmic Location) (FoundStructure StructureCells Entity)
forall b a.
FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
foundByLocation FoundRegistry StructureCells Entity
registry
    then AtomicKeySymbol Entity -> m (AtomicKeySymbol Entity)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return AtomicKeySymbol Entity
forall a. Maybe a
Nothing
    else do
      AtomicKeySymbol Entity
maybeEnt <- Cosmic Location -> m (AtomicKeySymbol Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (AtomicKeySymbol Entity)
entityAt Cosmic Location
cLoc
      AtomicKeySymbol Entity -> m (AtomicKeySymbol Entity)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicKeySymbol Entity -> m (AtomicKeySymbol Entity))
-> AtomicKeySymbol Entity -> m (AtomicKeySymbol Entity)
forall a b. (a -> b) -> a -> b
$ do
        Entity
ent <- AtomicKeySymbol Entity
maybeEnt
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Entity -> HashSet Entity -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Entity
ent HashSet Entity
participating
        Entity -> AtomicKeySymbol Entity
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
ent

-- | Excludes entities that are already part of a
-- registered found structure.
getWorldRow ::
  (Has (State GameState) sig m) =>
  -- | participating entities
  HashSet Entity ->
  Cosmic Location ->
  InspectionOffsets ->
  Int32 ->
  m [Maybe Entity]
getWorldRow :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
HashSet Entity
-> Cosmic Location
-> InspectionOffsets
-> Int32
-> m [AtomicKeySymbol Entity]
getWorldRow HashSet Entity
participatingEnts Cosmic Location
cLoc (InspectionOffsets (Min Int32
offsetLeft) (Max Int32
offsetRight)) Int32
yOffset =
  (Cosmic Location -> m (AtomicKeySymbol Entity))
-> [Cosmic Location] -> m [AtomicKeySymbol Entity]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HashSet Entity -> Cosmic Location -> m (AtomicKeySymbol Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
HashSet Entity -> Cosmic Location -> m (AtomicKeySymbol Entity)
candidateEntityAt HashSet Entity
participatingEnts) [Cosmic Location]
horizontalOffsets
 where
  horizontalOffsets :: [Cosmic Location]
horizontalOffsets = (Int32 -> Cosmic Location) -> [Int32] -> [Cosmic Location]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Cosmic Location
mkLoc [Int32
offsetLeft .. Int32
offsetRight]

  -- NOTE: We negate the yOffset because structure rows are numbered increasing from top
  -- to bottom, but swarm world coordinates increase from bottom to top.
  mkLoc :: Int32 -> Cosmic Location
mkLoc Int32
x = Cosmic Location
cLoc Cosmic Location -> V2 Int32 -> Cosmic Location
`offsetBy` Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
x (Int32 -> Int32
forall a. Num a => a -> a
negate Int32
yOffset)

-- | This is the first (one-dimensional) stage
-- in a two-stage (two-dimensional) search.
registerRowMatches ::
  (Has (State GameState) sig m) =>
  Cosmic Location ->
  AutomatonInfo Entity (AtomicKeySymbol Entity) (StructureSearcher StructureCells Entity) ->
  m ()
registerRowMatches :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location
-> AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity)
-> m ()
registerRowMatches Cosmic Location
cLoc (AutomatonInfo HashSet Entity
participatingEnts InspectionOffsets
horizontalOffsets StateMachine
  (AtomicKeySymbol Entity) (StructureSearcher StructureCells Entity)
sm) = do
  [AtomicKeySymbol Entity]
entitiesRow <- HashSet Entity
-> Cosmic Location
-> InspectionOffsets
-> Int32
-> m [AtomicKeySymbol Entity]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
HashSet Entity
-> Cosmic Location
-> InspectionOffsets
-> Int32
-> m [AtomicKeySymbol Entity]
getWorldRow HashSet Entity
participatingEnts Cosmic Location
cLoc InspectionOffsets
horizontalOffsets Int32
0
  let candidates :: [Position (StructureSearcher StructureCells Entity)]
candidates = StateMachine
  (AtomicKeySymbol Entity) (StructureSearcher StructureCells Entity)
-> [AtomicKeySymbol Entity]
-> [Position (StructureSearcher StructureCells Entity)]
forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> [keySymb] -> [Position val]
findAll StateMachine
  (AtomicKeySymbol Entity) (StructureSearcher StructureCells Entity)
sm [AtomicKeySymbol Entity]
entitiesRow
      mkCandidateLogEntry :: Position (StructureSearcher b Entity) -> FoundRowCandidate Entity
mkCandidateLogEntry Position (StructureSearcher b Entity)
c =
        HaystackContext Entity
-> [AtomicKeySymbol Entity]
-> [MatchingRowFrom]
-> FoundRowCandidate Entity
forall e.
HaystackContext e
-> StructureRowContent e
-> [MatchingRowFrom]
-> FoundRowCandidate e
FoundRowCandidate
          ([AtomicKeySymbol Entity]
-> HaystackPosition -> HaystackContext Entity
forall e.
WorldRowContent e -> HaystackPosition -> HaystackContext e
HaystackContext [AtomicKeySymbol Entity]
entitiesRow (Int -> HaystackPosition
HaystackPosition (Int -> HaystackPosition) -> Int -> HaystackPosition
forall a b. (a -> b) -> a -> b
$ Position (StructureSearcher b Entity) -> Int
forall val. Position val -> Int
pIndex Position (StructureSearcher b Entity)
c))
          (StructureSearcher b Entity -> [AtomicKeySymbol Entity]
forall b a. StructureSearcher b a -> SymbolSequence a
needleContent (StructureSearcher b Entity -> [AtomicKeySymbol Entity])
-> StructureSearcher b Entity -> [AtomicKeySymbol Entity]
forall a b. (a -> b) -> a -> b
$ Position (StructureSearcher b Entity) -> StructureSearcher b Entity
forall val. Position val -> val
pVal Position (StructureSearcher b Entity)
c)
          [MatchingRowFrom]
rowMatchInfo
       where
        rowMatchInfo :: [MatchingRowFrom]
rowMatchInfo = NonEmpty MatchingRowFrom -> [MatchingRowFrom]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty MatchingRowFrom -> [MatchingRowFrom])
-> (StructureSearcher b Entity -> NonEmpty MatchingRowFrom)
-> StructureSearcher b Entity
-> [MatchingRowFrom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SingleRowEntityOccurrences b Entity -> MatchingRowFrom)
-> NonEmpty (SingleRowEntityOccurrences b Entity)
-> NonEmpty MatchingRowFrom
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (StructureRow b Entity -> MatchingRowFrom
forall {a} {a}. StructureRow a a -> MatchingRowFrom
f (StructureRow b Entity -> MatchingRowFrom)
-> (SingleRowEntityOccurrences b Entity -> StructureRow b Entity)
-> SingleRowEntityOccurrences b Entity
-> MatchingRowFrom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRowEntityOccurrences b Entity -> StructureRow b Entity
forall b a. SingleRowEntityOccurrences b a -> StructureRow b a
myRow) (NonEmpty (SingleRowEntityOccurrences b Entity)
 -> NonEmpty MatchingRowFrom)
-> (StructureSearcher b Entity
    -> NonEmpty (SingleRowEntityOccurrences b Entity))
-> StructureSearcher b Entity
-> NonEmpty MatchingRowFrom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureSearcher b Entity
-> NonEmpty (SingleRowEntityOccurrences b Entity)
forall b a.
StructureSearcher b a -> NonEmpty (SingleRowEntityOccurrences b a)
singleRowItems (StructureSearcher b Entity -> [MatchingRowFrom])
-> StructureSearcher b Entity -> [MatchingRowFrom]
forall a b. (a -> b) -> a -> b
$ Position (StructureSearcher b Entity) -> StructureSearcher b Entity
forall val. Position val -> val
pVal Position (StructureSearcher b Entity)
c
         where
          f :: StructureRow a a -> MatchingRowFrom
f StructureRow a a
x = Int32 -> OriginalName -> MatchingRowFrom
MatchingRowFrom (StructureRow a a -> Int32
forall b a. StructureRow b a -> Int32
rowIndex StructureRow a a
x) (OriginalName -> MatchingRowFrom)
-> OriginalName -> MatchingRowFrom
forall a b. (a -> b) -> a -> b
$ NamedOriginal a -> OriginalName
forall a. NamedOriginal a -> OriginalName
getName (NamedOriginal a -> OriginalName)
-> (StructureRow a a -> NamedOriginal a)
-> StructureRow a a
-> OriginalName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureWithGrid a a -> NamedOriginal a
forall b a. StructureWithGrid b a -> NamedOriginal b
originalDefinition (StructureWithGrid a a -> NamedOriginal a)
-> (StructureRow a a -> StructureWithGrid a a)
-> StructureRow a a
-> NamedOriginal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureRow a a -> StructureWithGrid a a
forall b a. StructureRow b a -> StructureWithGrid b a
wholeStructure (StructureRow a a -> OriginalName)
-> StructureRow a a -> OriginalName
forall a b. (a -> b) -> a -> b
$ StructureRow a a
x

      logEntry :: SearchLog Entity
logEntry = [FoundRowCandidate Entity] -> SearchLog Entity
forall e. [FoundRowCandidate e] -> SearchLog e
FoundRowCandidates ([FoundRowCandidate Entity] -> SearchLog Entity)
-> [FoundRowCandidate Entity] -> SearchLog Entity
forall a b. (a -> b) -> a -> b
$ (Position (StructureSearcher StructureCells Entity)
 -> FoundRowCandidate Entity)
-> [Position (StructureSearcher StructureCells Entity)]
-> [FoundRowCandidate Entity]
forall a b. (a -> b) -> [a] -> [b]
map Position (StructureSearcher StructureCells Entity)
-> FoundRowCandidate Entity
forall {b}.
Position (StructureSearcher b Entity) -> FoundRowCandidate Entity
mkCandidateLogEntry [Position (StructureSearcher StructureCells Entity)]
candidates

  (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> Discovery -> Identity Discovery)
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> Discovery -> Identity Discovery)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SearchLog Entity] -> Identity [SearchLog Entity])
-> StructureRecognizer StructureCells Entity
-> Identity (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
([SearchLog a] -> f [SearchLog a])
-> StructureRecognizer b a -> f (StructureRecognizer b a)
recognitionLog (([SearchLog Entity] -> Identity [SearchLog Entity])
 -> GameState -> Identity GameState)
-> ([SearchLog Entity] -> [SearchLog Entity]) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (SearchLog Entity
logEntry SearchLog Entity -> [SearchLog Entity] -> [SearchLog Entity]
forall a. a -> [a] -> [a]
:)
  [[FoundStructure StructureCells Entity]]
candidates2D <- [Position (StructureSearcher StructureCells Entity)]
-> (Position (StructureSearcher StructureCells Entity)
    -> m [FoundStructure StructureCells Entity])
-> m [[FoundStructure StructureCells Entity]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Position (StructureSearcher StructureCells Entity)]
candidates ((Position (StructureSearcher StructureCells Entity)
  -> m [FoundStructure StructureCells Entity])
 -> m [[FoundStructure StructureCells Entity]])
-> (Position (StructureSearcher StructureCells Entity)
    -> m [FoundStructure StructureCells Entity])
-> m [[FoundStructure StructureCells Entity]]
forall a b. (a -> b) -> a -> b
$ Cosmic Location
-> InspectionOffsets
-> Position (StructureSearcher StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location
-> InspectionOffsets
-> Position (StructureSearcher StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
checkVerticalMatch Cosmic Location
cLoc InspectionOffsets
horizontalOffsets
  [FoundStructure StructureCells Entity] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
[FoundStructure StructureCells Entity] -> m ()
registerStructureMatches ([FoundStructure StructureCells Entity] -> m ())
-> [FoundStructure StructureCells Entity] -> m ()
forall a b. (a -> b) -> a -> b
$ [[FoundStructure StructureCells Entity]]
-> [FoundStructure StructureCells Entity]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FoundStructure StructureCells Entity]]
candidates2D

checkVerticalMatch ::
  (Has (State GameState) sig m) =>
  Cosmic Location ->
  -- | Horizontal search offsets
  InspectionOffsets ->
  Position (StructureSearcher StructureCells Entity) ->
  m [FoundStructure StructureCells Entity]
checkVerticalMatch :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location
-> InspectionOffsets
-> Position (StructureSearcher StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
checkVerticalMatch Cosmic Location
cLoc (InspectionOffsets (Min Int32
searchOffsetLeft) Max Int32
_) Position (StructureSearcher StructureCells Entity)
foundRow =
  Cosmic Location
-> InspectionOffsets
-> AutomatonInfo
     Entity
     [AtomicKeySymbol Entity]
     (StructureWithGrid StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location
-> InspectionOffsets
-> AutomatonInfo
     Entity
     [AtomicKeySymbol Entity]
     (StructureWithGrid StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
getMatches2D Cosmic Location
cLoc InspectionOffsets
horizontalFoundOffsets (AutomatonInfo
   Entity
   [AtomicKeySymbol Entity]
   (StructureWithGrid StructureCells Entity)
 -> m [FoundStructure StructureCells Entity])
-> AutomatonInfo
     Entity
     [AtomicKeySymbol Entity]
     (StructureWithGrid StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
forall a b. (a -> b) -> a -> b
$ StructureSearcher StructureCells Entity
-> AutomatonInfo
     Entity
     [AtomicKeySymbol Entity]
     (StructureWithGrid StructureCells Entity)
forall b a.
StructureSearcher b a
-> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
automaton2D (StructureSearcher StructureCells Entity
 -> AutomatonInfo
      Entity
      [AtomicKeySymbol Entity]
      (StructureWithGrid StructureCells Entity))
-> StructureSearcher StructureCells Entity
-> AutomatonInfo
     Entity
     [AtomicKeySymbol Entity]
     (StructureWithGrid StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ Position (StructureSearcher StructureCells Entity)
-> StructureSearcher StructureCells Entity
forall val. Position val -> val
pVal Position (StructureSearcher StructureCells Entity)
foundRow
 where
  foundLeftOffset :: Int32
foundLeftOffset = Int32
searchOffsetLeft Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position (StructureSearcher StructureCells Entity) -> Int
forall val. Position val -> Int
pIndex Position (StructureSearcher StructureCells Entity)
foundRow)
  foundRightInclusiveIndex :: Int32
foundRightInclusiveIndex = Int32
foundLeftOffset Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position (StructureSearcher StructureCells Entity) -> Int
forall val. Position val -> Int
pLength Position (StructureSearcher StructureCells Entity)
foundRow) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1
  horizontalFoundOffsets :: InspectionOffsets
horizontalFoundOffsets = Min Int32 -> Max Int32 -> InspectionOffsets
InspectionOffsets (Int32 -> Min Int32
forall a. a -> Min a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
foundLeftOffset) (Int32 -> Max Int32
forall a. a -> Max a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
foundRightInclusiveIndex)

getFoundStructures ::
  Hashable keySymb =>
  (Int32, Int32) ->
  Cosmic Location ->
  StateMachine keySymb (StructureWithGrid StructureCells Entity) ->
  [keySymb] ->
  [FoundStructure StructureCells Entity]
getFoundStructures :: forall keySymb.
Hashable keySymb =>
(Int32, Int32)
-> Cosmic Location
-> StateMachine keySymb (StructureWithGrid StructureCells Entity)
-> [keySymb]
-> [FoundStructure StructureCells Entity]
getFoundStructures (Int32
offsetTop, Int32
offsetLeft) Cosmic Location
cLoc StateMachine keySymb (StructureWithGrid StructureCells Entity)
sm [keySymb]
entityRows =
  (Position (StructureWithGrid StructureCells Entity)
 -> FoundStructure StructureCells Entity)
-> [Position (StructureWithGrid StructureCells Entity)]
-> [FoundStructure StructureCells Entity]
forall a b. (a -> b) -> [a] -> [b]
map Position (StructureWithGrid StructureCells Entity)
-> FoundStructure StructureCells Entity
forall {b} {a}.
Position (StructureWithGrid b a) -> FoundStructure b a
mkFound [Position (StructureWithGrid StructureCells Entity)]
candidates
 where
  candidates :: [Position (StructureWithGrid StructureCells Entity)]
candidates = StateMachine keySymb (StructureWithGrid StructureCells Entity)
-> [keySymb]
-> [Position (StructureWithGrid StructureCells Entity)]
forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> [keySymb] -> [Position val]
findAll StateMachine keySymb (StructureWithGrid StructureCells Entity)
sm [keySymb]
entityRows
  mkFound :: Position (StructureWithGrid b a) -> FoundStructure b a
mkFound Position (StructureWithGrid b a)
candidate = StructureWithGrid b a -> Cosmic Location -> FoundStructure b a
forall b a.
StructureWithGrid b a -> Cosmic Location -> FoundStructure b a
FoundStructure (Position (StructureWithGrid b a) -> StructureWithGrid b a
forall val. Position val -> val
pVal Position (StructureWithGrid b a)
candidate) (Cosmic Location -> FoundStructure b a)
-> Cosmic Location -> FoundStructure b a
forall a b. (a -> b) -> a -> b
$ Cosmic Location
cLoc Cosmic Location -> V2 Int32 -> Cosmic Location
`offsetBy` V2 Int32
loc
   where
    -- NOTE: We negate the yOffset because structure rows are numbered increasing from top
    -- to bottom, but swarm world coordinates increase from bottom to top.
    loc :: V2 Int32
loc = Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
offsetLeft (Int32 -> V2 Int32) -> Int32 -> V2 Int32
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32
forall a. Num a => a -> a
negate (Int32 -> Int32) -> Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ Int32
offsetTop Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position (StructureWithGrid b a) -> Int
forall val. Position val -> Int
pIndex Position (StructureWithGrid b a)
candidate)

getMatches2D ::
  (Has (State GameState) sig m) =>
  Cosmic Location ->
  -- | Horizontal found offsets (inclusive indices)
  InspectionOffsets ->
  AutomatonInfo Entity (SymbolSequence Entity) (StructureWithGrid StructureCells Entity) ->
  m [FoundStructure StructureCells Entity]
getMatches2D :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location
-> InspectionOffsets
-> AutomatonInfo
     Entity
     [AtomicKeySymbol Entity]
     (StructureWithGrid StructureCells Entity)
-> m [FoundStructure StructureCells Entity]
getMatches2D
  Cosmic Location
cLoc
  horizontalFoundOffsets :: InspectionOffsets
horizontalFoundOffsets@(InspectionOffsets (Min Int32
offsetLeft) Max Int32
_)
  (AutomatonInfo HashSet Entity
participatingEnts (InspectionOffsets (Min Int32
offsetTop) (Max Int32
offsetBottom)) StateMachine
  [AtomicKeySymbol Entity] (StructureWithGrid StructureCells Entity)
sm) = do
    [[AtomicKeySymbol Entity]]
entityRows <- (Int32 -> m [AtomicKeySymbol Entity])
-> [Int32] -> m [[AtomicKeySymbol Entity]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int32 -> m [AtomicKeySymbol Entity]
getRow [Int32]
verticalOffsets
    [FoundStructure StructureCells Entity]
-> m [FoundStructure StructureCells Entity]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FoundStructure StructureCells Entity]
 -> m [FoundStructure StructureCells Entity])
-> [FoundStructure StructureCells Entity]
-> m [FoundStructure StructureCells Entity]
forall a b. (a -> b) -> a -> b
$ (Int32, Int32)
-> Cosmic Location
-> StateMachine
     [AtomicKeySymbol Entity] (StructureWithGrid StructureCells Entity)
-> [[AtomicKeySymbol Entity]]
-> [FoundStructure StructureCells Entity]
forall keySymb.
Hashable keySymb =>
(Int32, Int32)
-> Cosmic Location
-> StateMachine keySymb (StructureWithGrid StructureCells Entity)
-> [keySymb]
-> [FoundStructure StructureCells Entity]
getFoundStructures (Int32
offsetTop, Int32
offsetLeft) Cosmic Location
cLoc StateMachine
  [AtomicKeySymbol Entity] (StructureWithGrid StructureCells Entity)
sm [[AtomicKeySymbol Entity]]
entityRows
   where
    getRow :: Int32 -> m [AtomicKeySymbol Entity]
getRow = HashSet Entity
-> Cosmic Location
-> InspectionOffsets
-> Int32
-> m [AtomicKeySymbol Entity]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
HashSet Entity
-> Cosmic Location
-> InspectionOffsets
-> Int32
-> m [AtomicKeySymbol Entity]
getWorldRow HashSet Entity
participatingEnts Cosmic Location
cLoc InspectionOffsets
horizontalFoundOffsets
    verticalOffsets :: [Int32]
verticalOffsets = [Int32
offsetTop .. Int32
offsetBottom]

-- |
-- We only allow an entity to participate in one structure at a time,
-- so multiple matches require a tie-breaker.
-- The largest structure (by area) shall win.
registerStructureMatches ::
  (Has (State GameState) sig m) =>
  [FoundStructure StructureCells Entity] ->
  m ()
registerStructureMatches :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
[FoundStructure StructureCells Entity] -> m ()
registerStructureMatches [FoundStructure StructureCells Entity]
unrankedCandidates = do
  (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> Discovery -> Identity Discovery)
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> Discovery -> Identity Discovery)
-> (([SearchLog Entity] -> Identity [SearchLog Entity])
    -> StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> ([SearchLog Entity] -> Identity [SearchLog Entity])
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SearchLog Entity] -> Identity [SearchLog Entity])
-> StructureRecognizer StructureCells Entity
-> Identity (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
([SearchLog a] -> f [SearchLog a])
-> StructureRecognizer b a -> f (StructureRecognizer b a)
recognitionLog (([SearchLog Entity] -> Identity [SearchLog Entity])
 -> GameState -> Identity GameState)
-> ([SearchLog Entity] -> [SearchLog Entity]) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (SearchLog Entity
forall {e}. SearchLog e
newMsg SearchLog Entity -> [SearchLog Entity] -> [SearchLog Entity]
forall a. a -> [a] -> [a]
:)

  Maybe (FoundStructure StructureCells Entity)
-> (FoundStructure StructureCells Entity -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FoundStructure StructureCells Entity]
-> Maybe (FoundStructure StructureCells Entity)
forall a. [a] -> Maybe a
listToMaybe [FoundStructure StructureCells Entity]
rankedCandidates) ((FoundStructure StructureCells Entity -> m ()) -> m ())
-> (FoundStructure StructureCells Entity -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FoundStructure StructureCells Entity
fs ->
    (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((FoundRegistry StructureCells Entity
     -> Identity (FoundRegistry StructureCells Entity))
    -> Discovery -> Identity Discovery)
-> (FoundRegistry StructureCells Entity
    -> Identity (FoundRegistry StructureCells Entity))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> Discovery -> Identity Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Identity (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Identity (FoundRegistry StructureCells Entity))
-> Discovery
-> Identity Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Identity (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Identity (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures ((FoundRegistry StructureCells Entity
  -> Identity (FoundRegistry StructureCells Entity))
 -> GameState -> Identity GameState)
-> (FoundRegistry StructureCells Entity
    -> FoundRegistry StructureCells Entity)
-> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= FoundStructure StructureCells Entity
-> FoundRegistry StructureCells Entity
-> FoundRegistry StructureCells Entity
forall b a.
FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a
addFound FoundStructure StructureCells Entity
fs
 where
  -- Sorted by decreasing order of preference.
  rankedCandidates :: [FoundStructure StructureCells Entity]
rankedCandidates = (FoundStructure StructureCells Entity
 -> Down (FoundStructure StructureCells Entity))
-> [FoundStructure StructureCells Entity]
-> [FoundStructure StructureCells Entity]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn FoundStructure StructureCells Entity
-> Down (FoundStructure StructureCells Entity)
forall a. a -> Down a
Down [FoundStructure StructureCells Entity]
unrankedCandidates

  getStructName :: FoundStructure a a -> OriginalName
getStructName (FoundStructure StructureWithGrid a a
swg Cosmic Location
_) = NamedOriginal a -> OriginalName
forall a. NamedOriginal a -> OriginalName
getName (NamedOriginal a -> OriginalName)
-> NamedOriginal a -> OriginalName
forall a b. (a -> b) -> a -> b
$ StructureWithGrid a a -> NamedOriginal a
forall b a. StructureWithGrid b a -> NamedOriginal b
originalDefinition StructureWithGrid a a
swg
  newMsg :: SearchLog e
newMsg = [OriginalName] -> SearchLog e
forall e. [OriginalName] -> SearchLog e
FoundCompleteStructureCandidates ([OriginalName] -> SearchLog e) -> [OriginalName] -> SearchLog e
forall a b. (a -> b) -> a -> b
$ (FoundStructure StructureCells Entity -> OriginalName)
-> [FoundStructure StructureCells Entity] -> [OriginalName]
forall a b. (a -> b) -> [a] -> [b]
map FoundStructure StructureCells Entity -> OriginalName
forall {a} {a}. FoundStructure a a -> OriginalName
getStructName [FoundStructure StructureCells Entity]
rankedCandidates