Implement the start of creature AI

Add a Brain class, which determines for an entity the set of moves it
makes every step of the game, and begin to implement that for gormlaks.
The idea here is that every step of the game, a gormlak will move
towards the furthest-away wall it can see.

2 files changed, 42 insertions, 14 deletions

diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs
index 7885839d51b0..5b5e8a063f2c 100644
--- a/src/Xanthous/Data/EntityMap.hs
+++ b/src/Xanthous/Data/EntityMap.hs
@@ -14,6 +14,7 @@ module Xanthous.Data.EntityMap
   , insertAt
   , insertAtReturningID
   , fromEIDsAndPositioned
+  , toEIDsAndPositioned
   , atPosition
   , atPositionWithIDs
   , positions
@@ -101,6 +102,14 @@ instance Semigroup (EntityMap a) where
 instance Monoid (EntityMap a) where
   mempty = emptyEntityMap
 
+instance FunctorWithIndex EntityID EntityMap
+
+instance FoldableWithIndex EntityID EntityMap
+
+instance TraversableWithIndex EntityID EntityMap where
+  itraversed = byID . itraversed . rmap sequenceA . distrib
+  itraverse = itraverseOf itraversed
+
 emptyEntityMap :: EntityMap a
 emptyEntityMap = EntityMap mempty mempty 0
 
@@ -183,6 +192,9 @@ fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty
       .~ fromMaybe 1
          (maximumOf (ifolded . asIndex) (em ^. byID))
 
+toEIDsAndPositioned :: EntityMap a -> [(EntityID, Positioned a)]
+toEIDsAndPositioned = itoListOf $ byID . ifolded
+
 positions :: EntityMap a -> [Position]
 positions = toListOf $ byPosition . to keys . folded
 
diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs
index 9dcc02b8e88f..3124c6a334cc 100644
--- a/src/Xanthous/Data/EntityMap/Graphics.hs
+++ b/src/Xanthous/Data/EntityMap/Graphics.hs
@@ -3,9 +3,10 @@
 module Xanthous.Data.EntityMap.Graphics
   ( visiblePositions
   , visibleEntities
+  , linesOfSight
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude
+import Xanthous.Prelude hiding (lines)
 --------------------------------------------------------------------------------
 import Xanthous.Util (takeWhileInclusive)
 import Xanthous.Data
@@ -14,22 +15,37 @@ import Xanthous.Entities
 import Xanthous.Util.Graphics (circle, line)
 --------------------------------------------------------------------------------
 
-visiblePositions :: Position -> Word -> EntityMap SomeEntity -> Set Position
+visiblePositions :: Entity e => Position -> Word -> EntityMap e -> Set Position
 visiblePositions pos radius = setFromList . positions . visibleEntities pos radius
 
-
--- | Given a point and a radius of vision, returns a list of all entities that
--- are *visible* (eg, not blocked by an entity that obscures vision) from that
--- point
-visibleEntities :: Position -> Word -> EntityMap SomeEntity -> EntityMap SomeEntity
-visibleEntities (view _Position -> pos) visionRadius em
-  = fromEIDsAndPositioned . fold . fold $ sightAdjustedLines
+-- | Returns a list of individual lines of sight, each of which is a list of
+-- entities at positions on that line of sight
+linesOfSight
+  :: forall e. Entity e
+  => Position
+  -> Word
+  -> EntityMap e
+  -> [[(Position, Vector (EntityID, e))]]
+linesOfSight (view _Position -> pos) visionRadius em
+  = entitiesOnLines
+  <&> takeWhileInclusive (none (blocksVision . snd) . snd)
   where
-    -- I love laziness!
     radius = circle pos $ fromIntegral visionRadius
-    linesOfSight = radius <&> line pos
-    entitiesOnLines = linesOfSight <&> map getPositionedAt
-    sightAdjustedLines = entitiesOnLines <&> takeWhileInclusive (none $ blocksVision . snd)
+    lines = line pos <$> radius
+    entitiesOnLines :: [[(Position, Vector (EntityID, e))]]
+    entitiesOnLines = lines <&> map getPositionedAt
+    getPositionedAt :: (Int, Int) -> (Position, Vector (EntityID, e))
     getPositionedAt p =
       let ppos = _Position # p
-      in atPositionWithIDs ppos em
+      in (ppos, over _2 (view positioned) <$> atPositionWithIDs ppos em)
+
+-- | Given a point and a radius of vision, returns a list of all entities that
+-- are *visible* (eg, not blocked by an entity that obscures vision) from that
+-- point
+visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e
+visibleEntities pos visionRadius
+  = fromEIDsAndPositioned
+  . fold
+  . map (\(p, es) -> over _2 (Positioned p) <$> es)
+  . fold
+  . linesOfSight pos visionRadius