Start implementing mapper item

src/Dodge/RadarSweep.hs

@@ -1,10 +1,13 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.RadarSweep (
     aRadarPulse,
     updateRadarSweep,
 ) where
 
-import Color
 import Data.Maybe
+import Dodge.Item.Location
+import qualified Data.Set as S
+import Color
 import Dodge.Data.World
 import Dodge.Zoning.Wall
 import Geometry
@@ -12,36 +15,38 @@ import qualified IntMapHelp as IM
 import LensHelp
 import NewInt
 
-aRadarPulse :: ObjectType -> Creature -> World -> World
-aRadarPulse ob cr =
+aRadarPulse :: Maybe (NewInt ItmInt) -> ObjectType -> Creature -> World -> World
+aRadarPulse itid ob cr =
     cWorld . lWorld . radarSweeps
         .:~ RadarSweep
             { _rsTimer = 50
             , _rsRad = 0
             , _rsPos = _crPos cr
             , _rsObject = ob
+            , _rsMapper = itid
             }
 
-updateRadarSweep ::
-    World -> RadarSweep -> (World, Maybe RadarSweep)
+updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
 updateRadarSweep w pt
     | x < 1 = (w, Nothing)
     | otherwise =
-        ( putBlips w
+        ( putBlips w & updatemapper
         , Just $ pt & rsRad .~ r & rsTimer .~ (x -1)
         )
   where
+    updatemapper = fromMaybe id $ do
+        itid <- pt ^. rsMapper
+        return $ pointerToItemID itid . itUse . useMapperLines <>~ wps
     p = _rsPos pt
     ob = _rsObject pt
-    blipsF = findBlips ob
-    bf = makeBlip ob
     x = _rsTimer pt
-    putBlips = cWorld . lWorld . radarBlips .++~ blips
-    blips = map bf circPoints
-    circPoints = blipsF p r w
+    putBlips = cWorld . lWorld . radarBlips .++~ map 
+        (makeBlip ob) 
+        blips
+    (blips,wps) = findBlips ob p r w
     r = fromIntegral (400 - x * 8)
 
-findBlips :: ObjectType -> Point2 -> Float -> World -> [Point2]
+findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
 findBlips ob = case ob of
     ObCreature -> crBlips
     ObItem -> itemBlips
@@ -66,21 +71,20 @@ blipAt r col i p =
         , _rbPos = p
         }
 
-crBlips :: Point2 -> Float -> World -> [Point2]
-crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
+crBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
+crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
   where
     f q = dist p q <= r && dist p q > r - 100
     g cr = _crID cr /= 0
 
-itemBlips :: Point2 -> Float -> World -> [Point2]
-itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
+itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
+itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
   where
     f q = dist p q <= r && dist p q > r - 4
 
-wallBlips :: Point2 -> Float -> World -> [Point2]
-wallBlips p r w =
-    mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine) $
-        map (over wlLine swp) (wlsNearCirc p r w)
-            <> wlsNearCirc p r w
+wallBlips :: Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
+wallBlips p r = foldMap f . wlsNearCirc p r
   where
-    swp (a, b) = (b, a)
+    f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
+        [] -> mempty
+        xs -> (xs,S.singleton (wl ^. wlLine))