From 61802fe1064f96b5d723650d06072a6347a0748e Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sat, 30 Oct 2021 12:12:47 -0400
Subject: feat(gs/xanthous): Allow throwing rocks

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
---
 users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs |  7 ++++-
 .../src/Xanthous/Data/EntityMap/Graphics.hs        | 36 +++++++++++++---------
 2 files changed, 28 insertions(+), 15 deletions(-)

(limited to 'users/grfn/xanthous/src/Xanthous/Data')

diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
index d24defa841ab..1d9c4d46cdc9 100644
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
+++ b/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
@@ -20,6 +20,7 @@ module Xanthous.Data.EntityMap
   , positions
   , lookup
   , lookupWithPosition
+  , positionOf
   -- , positionedEntities
   , neighbors
   , Deduplicate(..)
@@ -37,7 +38,7 @@ import Xanthous.Data
   , Positioned(..)
   , positioned
   , Neighbors(..)
-  , neighborPositions
+  , neighborPositions, position
   )
 import Xanthous.Data.VectorBag
 import Xanthous.Orphans ()
@@ -268,5 +269,9 @@ lookup eid = fmap (view positioned) . lookupWithPosition eid
 neighbors :: (Ord a, Show a) => Position -> EntityMap a -> Neighbors (VectorBag a)
 neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos
 
+-- | Traversal to the position of the entity with the given ID
+positionOf :: EntityID -> Traversal' (EntityMap a) Position
+positionOf eid = ix eid . position
+
 --------------------------------------------------------------------------------
 makeWrapped ''Deduplicate
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
-- 
cgit 1.4.1