feat(gs/xanthous): Allow throwing rocks r/2994

Implement a first pass at a "fire" command, which allows throwing rocks,
the max distance and the damage of which is based on the weight of the
item and the strength of the player.

Currently the actual numbers here likely need some tweaking, as the
rocks are easily throwable at good distances but don't really deal any
damage.

Change-Id: Ic6ad0599444af44d8438b834237a1997b67f220f
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3764
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

1 files changed, 22 insertions, 14 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
index 19e7b0cdf086..1398c611cf20 100644
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
+++ b/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
@@ -2,6 +2,7 @@
 module Xanthous.Data.EntityMap.Graphics
   ( visiblePositions
   , visibleEntities
+  , lineOfSight
   , linesOfSight
   , canSee
   ) where
@@ -27,27 +28,34 @@ visiblePositions
 visiblePositions pos radius
   = setFromList . positions . visibleEntities pos radius
 
+-- | Returns a list of entities on the *line of sight* from the first position
+-- to the second position
+lineOfSight
+  :: forall e. Entity e
+  => Position -- ^ Origin
+  -> Position -- ^ Destination
+  -> EntityMap e
+  -> [(Position, Vector (EntityID, e))]
+lineOfSight (view _Position -> origin) (view _Position -> destination) em =
+  takeWhileInclusive (none (view blocksVision . entityAttributes . snd) . snd)
+    $ getPositionedAt <$> line origin destination
+  where
+    getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
+    getPositionedAt (review _Position -> p) =
+      (p, over _2 (view positioned) <$> atPositionWithIDs p em)
+
 -- | 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
+  => Position    -- ^ Centerpoint
+  -> Word        -- ^ Radius
   -> EntityMap e
   -> [[(Position, Vector (EntityID, e))]]
-linesOfSight (view _Position -> pos) visionRadius em
-  = entitiesOnLines
-  <&> takeWhileInclusive
-      (none (view blocksVision . entityAttributes . snd) . snd)
+linesOfSight pos visionRadius em =
+  radius <&> \edge -> lineOfSight pos (_Position # edge) em
   where
-    radius = circle pos $ fromIntegral visionRadius
-    lines = line pos <$> radius
-    entitiesOnLines :: [[(Position, Vector (EntityID, e))]]
-    entitiesOnLines = lines <&> map getPositionedAt
-    getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
-    getPositionedAt p =
-      let ppos = _Position # p
-      in (ppos, over _2 (view positioned) <$> atPositionWithIDs ppos em)
+    radius = circle (pos ^. _Position) $ fromIntegral visionRadius
 
 -- | 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