Start implementing mapper item

data/dodge.config.json

@@ -1,7 +1,7 @@
 {
   "_debug_booleans": [
     "Show_ms_frame",
-    "Circ_collision_test"
+    "Mouse_position"
   ],
   "_debug_view_clip_bounds": "NoRoomClipBoundaries",
   "_gameplay_rotate_to_wall": true,

src/Dodge/Creature/Impulse/UseItem.hs

@@ -47,6 +47,9 @@ useItemLoc cr loc pt w
     | ITEMSCAN <- itm ^. itType
       , pt == InitialPress =
         return $ toggleExamineInv w
+    | MAPPER <- itm ^. itType
+      , pt == InitialPress =
+        return $ toggleMapperInv itm w
     | Just b <- itm ^? itUse . useToggle
       , pt == InitialPress =
         return $ w & pointerToItem itm . itUse . useToggle .~ not b
@@ -128,3 +131,8 @@ toggleExamineInv :: World -> World
 toggleExamineInv w = case w ^? hud . hudElement . subInventory of
     Just ExamineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
     _ -> w & hud . hudElement . subInventory .~ ExamineInventory
+
+toggleMapperInv :: Item -> World -> World
+toggleMapperInv itm w = case w ^? hud . hudElement . subInventory of
+    Just MapperInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
+    _ -> w & hud . hudElement . subInventory .~ MapperInventory 0 1 (_itID itm)

src/Dodge/Data/Item/Use.hs

@@ -12,18 +12,18 @@ module Dodge.Data.Item.Use (
     module Dodge.Data.Item.Targeting,
     module Dodge.Data.GenFloat,
     module Dodge.Data.Item.Scope,
-    module Dodge.Data.Item.BulletMod
+    module Dodge.Data.Item.BulletMod,
 ) where
 
-import qualified Data.Set as S
-import Dodge.Data.Item.BulletMod
-import Dodge.Data.Item.Scope
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
+import qualified Data.Set as S
 import Dodge.Data.GenFloat
+import Dodge.Data.Item.BulletMod
 import Dodge.Data.Item.HeldDelay
 import Dodge.Data.Item.HeldUse
+import Dodge.Data.Item.Scope
 import Dodge.Data.Item.Targeting
 import Dodge.Data.Item.Use.Consumption
 import Dodge.Data.Item.Use.Equipment
@@ -39,13 +39,14 @@ data ItemUse
         , _heldFrame :: Int
         , _heldUseEffect :: HeldUseEffect
         }
-    | UseEquip { _uequipEffect :: EquipEffect }
+    | UseEquip {_uequipEffect :: EquipEffect}
     | UseAttach {_uaParams :: AttachParams}
     | UseNothing
-    | UseScope { _uScope :: Scope }
+    | UseScope {_uScope :: Scope}
-    | UseBulletMod { _ubMod :: BulletMod }
+    | UseBulletMod {_ubMod :: BulletMod}
     | UseToggle {_useToggle :: Bool}
-    | UseMapper { _useMapperLines :: S.Set (Point2,Point2) 
+    | UseMapper
+        { _useMapperLines :: S.Set (Point2, Point2)
         , _useMapperPoints :: S.Set Point2
         }
     deriving (Eq, Show, Read)
@@ -74,7 +75,7 @@ data AttachParams
         {_apProjectiles :: [Int]}
     | APInt {_apInt :: Int}
     | APNothing
-    deriving (Eq, Show, Read) 
+    deriving (Eq, Show, Read)
 
 data HeldParams
     = DefaultHeldParams
@@ -111,7 +112,7 @@ data HeldParams
 
 data AmmoParams
     = BulletParams {_ampBullet :: Bullet}
-    | ProjectileParams { _ampPayload :: Payload }
+    | ProjectileParams {_ampPayload :: Payload}
     | GasParams {_ampCreateGas :: GasFuel}
     | NoAmmoParams
     deriving (Eq, Show, Read) --Generic, Flat)
@@ -159,7 +160,7 @@ data MuzzleEffect
     | MuzzleScroller
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data AmmoPerShot 
+data AmmoPerShot
     = UseExactly {_useExactly :: Int}
     | UseUpTo {_useUpTo :: Int}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -173,7 +174,7 @@ data Muzzle = Muzzle
     , _mzEffect :: MuzzleEffect
     , _mzAmmoPerShot :: AmmoPerShot
     , _mzFrame :: Int
---    , _mzChargeRequirement :: Maybe Int
+    --    , _mzChargeRequirement :: Maybe Int
     --    , _mzRecoil :: Float
     --    , _mzTorque :: Float
     --    , _mzSidePush :: Float

src/Dodge/Data/RadarSweep.hs

@@ -8,6 +8,8 @@ module Dodge.Data.RadarSweep (
     module Dodge.Data.ObjectType,
 ) where
 
+import Dodge.Data.Item.Location
+import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -19,6 +21,7 @@ data RadarSweep = RadarSweep
     , _rsRad :: Float
     , _rsObject :: ObjectType
     , _rsTimer :: Int
+    , _rsMapper :: Maybe (NewInt ItmInt)
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/HeldUse.hs

@@ -329,7 +329,7 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
                 w
         MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
         MuzzleShatter -> shootShatter itm cr w
-        MuzzleDetector -> itemDetectorEffect itm cr w
+        MuzzleDetector -> itemDetectorEffect itm (getAttachedMapper itmtree) cr w
         MuzzleBlink -> unsafeBlinkAction cr w
         MuzzleUnsafeBlink -> blinkActionMousePos cr w
         MuzzleRewind -> useRewindGun (itm ^. itID) w
@@ -339,13 +339,18 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
     mid = magtree ^? ldtValue . itLocation . ilInvID
     itm = itmtree ^. ldtValue
 
-itemDetectorEffect :: Item -> Creature -> World -> World
+
-itemDetectorEffect itm cr w = fromMaybe w $ do
+getAttachedMapper :: LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
+getAttachedMapper =
+    (^? ldtRight . folding (lookup (SFLink MapperSF)) . ldtValue . itID)
+
+itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) -> Creature -> World -> World
+itemDetectorEffect itm itid cr w = fromMaybe w $ do
     DETECTOR dt <- itm ^? itType
     return $ case dt of
-        ITEMDETECTOR -> aRadarPulse ObItem cr w
+        ITEMDETECTOR -> aRadarPulse itid ObItem cr w
-        CREATUREDETECTOR -> aRadarPulse ObCreature cr w
+        CREATUREDETECTOR -> aRadarPulse itid ObCreature cr w
-        WALLDETECTOR -> aRadarPulse ObWall cr w
+        WALLDETECTOR -> aRadarPulse itid ObWall cr w
 
 walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
 walkNozzle mzid mz itm cr w = fromMaybe w $ do

src/Dodge/Item/Grammar.hs

@@ -72,9 +72,8 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
         )
     (DETECTOR {}, _) -> 
         ( getAmmoLinks itm
-        , [(MapperSF,SFLink MapperSF),(TriggerSF, TriggerLink)]
+        , [(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
         )
-
     (_, GadgetPlatformSF) ->
         ( getAmmoLinks itm
         , [(TriggerSF, TriggerLink), (WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]

src/Dodge/Item/Scope.hs

@@ -20,7 +20,6 @@ module Dodge.Item.Scope (
     mapper,
 ) where
 
---import Dodge.Data.BlBl
 import Dodge.Item.Attach
 import Control.Lens
 import Dodge.Data.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 :: Maybe (NewInt ItmInt) -> ObjectType -> Creature -> World -> World
-aRadarPulse ob cr =
+aRadarPulse itid ob cr =
     cWorld . lWorld . radarSweeps
         .:~ RadarSweep
             { _rsTimer = 50
             , _rsRad = 0
             , _rsPos = _crPos cr
             , _rsObject = ob
+            , _rsMapper = itid
             }
 
-updateRadarSweep ::
+updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
-    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
+    putBlips = cWorld . lWorld . radarBlips .++~ map 
-    blips = map bf circPoints
+        (makeBlip ob) 
-    circPoints = blipsF p r w
+        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 :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
-crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
+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 :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
-itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
+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 :: Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
-wallBlips p r w =
+wallBlips p r = foldMap f . wlsNearCirc p r
-    mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine) $
-        map (over wlLine swp) (wlsNearCirc p r w)
-            <> wlsNearCirc p r w
   where
-    swp (a, b) = (b, a)
+    f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
+        [] -> mempty
+        xs -> (xs,S.singleton (wl ^. wlLine))

src/Dodge/Render/HUD.hs

@@ -171,8 +171,10 @@ drawMapperInventory p z itid _ w = fold $ do
     itm <- w ^? pointerToItemID itid
     ls <- itm ^? itUse . useMapperLines
     let r = w ^. wCam . camRot
-    return . scale z z . rotate r . uncurryV translate p 
+    return . color red
-        $ foldMap (\(x,y) -> line [x,y]) ls
+        $ foldMap (\(x,y) -> line [f x,f y]) ls
+  where
+    f = worldPosToScreen (w ^. wCam)
 
 drawCombineInventory ::
     Configuration ->

src/Geometry/Intersect.hs

@@ -309,7 +309,7 @@ intersectCircSeg c r a b
   where
     d = closestPointOnLine a b c
     x = dist d c
-    y = r ** 2 - x ** 2
+    y = r ^ (2::Int) - x ^ (2::Int)
     z = sqrt y
     v = z *.* normalizeV (b -.- a)