Mapper, ARHUD, radar sweeps update. Add dropper items

data/dodge.config.json

@@ -9,7 +9,7 @@
   "_graphics_cloud_shadows": true,
   "_graphics_distortion_resolution": "FullRes",
   "_graphics_distortions": true,
-  "_graphics_downsize_resolution": "EighthRes",
+  "_graphics_downsize_resolution": "SixteenthRes",
   "_graphics_num_shadow_casters": "NumShadowCasters20",
   "_graphics_shadow_rendering": "GeoObjShads",
   "_graphics_shadow_size": "Typical",

src/Dodge/Base/You.hs

@@ -1,19 +1,13 @@
 module Dodge.Base.You 
     (you
---    , yourScopeInvID
     , yourInv
---    , yourScrollAttachment
     , yourSelectedItem
     , yourRootItem
     )where
 
 import Dodge.Data.World
---import Dodge.HeldScroll
 import qualified IntMapHelp as IM
---import qualified Data.Map.Strict as M
 import Control.Lens
---import Control.Monad
---import Data.Maybe
 
 you :: World -> Creature
 you w = w ^?! cWorld . lWorld . creatures . ix 0
@@ -28,23 +22,6 @@ yourRootItem w = do
     i <- you w ^? crManipulation . manObject . imRootSelectedItem
     _crInv (you w) IM.!? i
 
---yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)
---yourScrollAttachment w = do
---    i <- you w ^? crManipulation . manObject . inInventory . ispItem
---    itm <- _crInv (you w) IM.!? i
---    atparams <- you w ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
---    guard (canHeldScrollAttach itm atparams)
---    return (i - 1, atparams)
-
---yourScopeInvID :: World -> Maybe Int
---yourScopeInvID w = do
---    (i, params) <- yourScrollAttachment w
---    _ <- params ^? opticPos
---    return i
-
 yourInv :: World -> IM.IntMap Item
 yourInv = _crInv . you
 
-
---yourInvSel :: World -> Int
---yourInvSel = crSel . you

src/Dodge/Creature.hs

@@ -245,7 +245,7 @@ inventoryX c = case c of
         , gimbal
         , battery
         , laser
-        , augmentedHUD
+        , arHUD
         , rLauncher
         , megaShellMag
         , homingModule
@@ -269,7 +269,7 @@ inventoryX c = case c of
         <>
         [ battery
         , zoomScope
-        , augmentedHUD
+        , arHUD
         , makeTypeCraft SPRING
         , makeTypeCraft HARDWARE
         , autoRifle
@@ -307,7 +307,7 @@ stackedInventory =
     , magShield
     , bangCone
     , megaTinMag 100
-    , augmentedHUD
+    , arHUD
     , smallBattery
     , makeTypeCraft TRANSFORMER
     , remoteScreen

src/Dodge/Creature/Impulse/UseItem.hs

@@ -36,7 +36,7 @@ useItemLoc cr loc pt w
       , cr ^. crStance . posture == Aiming =
         return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
     | GadgetPlatformSF <- sf =
-        return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
+        return $ gadgetEffect pt loc cr w
     | UnderBarrelPlatformSF <- sf
       , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
       , cr ^. crStance . posture == Aiming =
@@ -79,6 +79,8 @@ structureUseAtLoc :: ItemStructuralFunction -> Bool
 structureUseAtLoc = \case
     HeldPlatformSF -> True
     UnderBarrelPlatformSF -> True
+    GadgetPlatformSF -> True
+    MapperSF -> True
     _ -> False
 
 activateDetonator ::

src/Dodge/Creature/State.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
+import Control.Applicative
 import Dodge.HeldUse
 import Control.Monad
 import qualified Data.Map.Strict as M
@@ -291,16 +292,17 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) =
         (HELD TORCH, _) -> shineTorch cr itmtree m
         (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
         (TARGETING tt, _) -> updateItemTargeting tt cr itm
-        (ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc
+        (ARHUD, _) -> drawARHUD loc
         _ -> id
   where
     ci = itmtree ^. ldtValue
     itm = ci ^. _1
 
-drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
+drawARHUD :: LocationLDT ItemLink ComposedItem -> World -> World
-drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
+drawARHUD (LocLDT con _) w = fromMaybe w $ do
     itm <- con ^? cldtParent . _1
-    return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w
+    return $ w & cWorld . lWorld . flares <>~ fold 
+        (drawTargetingAR itm w <|> drawMapperAR itm w)
 
 shineTargetLaser ::
     Creature ->

src/Dodge/Data/ComposedItem.hs

@@ -26,7 +26,7 @@ data ComposeLinkType
     | RemoteScreenLink
     | RemoteDetonatorLink
     | SmokeReducerLink
-    | AugmentedHUDLink
+--    | AugmentedHUDLink
     | FunctionChangeLink
     | MakeAutoLink
     | ProjectileStabiliserLink
@@ -47,7 +47,7 @@ data ItemStructuralFunction
     | WeaponTargetingSF
     | IntroScanSF
     | TriggerSF
-    | AugmentedHUDSF
+    | ARHUDSF
     | AmmoMagSF AmmoType
     | RemoteScreenSF
     | JoystickSF

src/Dodge/Data/Item/Combine.hs

@@ -23,8 +23,16 @@ data ItemType
     | STICKYMOD
     | ITEMSCAN
     | MAPPER
+    | DROPPER InventoryPathing
     | INTROSCAN {_ibtIntroScanType :: IntroScanType}
     | DETECTOR {_ibtDetector :: Detector}
+    | ARHUD
+    deriving (Eq, Ord, Show, Read)
+
+data InventoryPathing
+    = ABSOLUTE
+    | RELCURS
+    | RELITEM
     deriving (Eq, Ord, Show, Read)
 
 data IntroScanType
@@ -85,7 +93,6 @@ data AttachType
     | REMOTEDETONATOR
     | SMOKEREDUCER
     | HOMINGMODULE
-    | AUGMENTEDHUD
     | SHELLPAYLOAD {_shellPayload :: Payload}
     deriving (Eq, Ord, Show, Read)
 
@@ -175,6 +182,7 @@ data Detector
 makeLenses ''ItemType
 makeLenses ''HeldItemType
 makeLenses ''AttachType
+deriveJSON defaultOptions ''InventoryPathing
 deriveJSON defaultOptions ''IntroScanType
 deriveJSON defaultOptions ''CraftType
 deriveJSON defaultOptions ''ConsumableItemType

src/Dodge/Data/Item/Use.hs

@@ -41,6 +41,7 @@ data ItemUse
         }
     | UseEquip {_uequipEffect :: EquipEffect}
     | UseAttach {_uaParams :: AttachParams}
+    | UseInt {_uInt :: Int}
     | UseNothing
     | UseScope {_uScope :: Scope}
     | UseBulletMod {_ubMod :: BulletMod}
@@ -223,8 +224,6 @@ deriveJSON defaultOptions ''HeldParams
 deriveJSON defaultOptions ''AmmoPerShot
 deriveJSON defaultOptions ''Muzzle
 deriveJSON defaultOptions ''AimStance
-
---deriveJSON defaultOptions ''ScrollAttachParams
 deriveJSON defaultOptions ''AttachParams
 deriveJSON defaultOptions ''ItZoom
 deriveJSON defaultOptions ''AimParams

src/Dodge/Data/RadarSweep.hs

@@ -22,6 +22,8 @@ data RadarSweep = RadarSweep
     , _rsObject :: ObjectType
     , _rsTimer :: Int
     , _rsMapper :: Maybe (NewInt ItmInt)
+    , _rsAR :: Maybe (NewInt ItmInt)
+    , _rsSource :: NewInt ItmInt
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/HeldUse.hs

@@ -3,17 +3,18 @@
 
 module Dodge.HeldUse (
     heldEffect,
+    gadgetEffect,
     heldEffectNoHammerCheck,
     mcUseHeld,
 ) where
 
+import qualified Data.IntMap.Strict as IM
+import Dodge.Creature.Action
 import Color
 import Control.Applicative
 import Control.Monad
 import Data.Maybe
 import Dodge.Base.Collide
---import Dodge.Base.Coordinate
-import Dodge.Creature.Action.Blink
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.MuzzleEffect
@@ -35,6 +36,20 @@ import Picture.Base
 import RandomHelp
 import qualified SDL
 
+gadgetEffect ::
+    PressType ->
+    LocationLDT ItemLink ComposedItem ->
+    Creature ->
+    World ->
+    World
+gadgetEffect pt loc
+    | UseHeld {} <- loc ^. locLDT . ldtValue . _1 . itUse = heldEffect pt 
+        (bimap _iatType (^. _1) (loc ^. locLDT))
+    | DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
+    , Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
+    , pt == InitialPress = dropInventoryPath i x loc
+    | otherwise = const id
+
 heldEffect ::
     PressType ->
     LabelDoubleTree ComposeLinkType Item ->
@@ -329,7 +344,8 @@ 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 (getAttachedMapper itmtree) cr w
+        MuzzleDetector -> itemDetectorEffect itm (getAttachedSFLink MapperSF itmtree) 
+            (getAttachedSFLink ARHUDSF itmtree) cr w
         MuzzleBlink -> unsafeBlinkAction cr w
         MuzzleUnsafeBlink -> blinkActionMousePos cr w
         MuzzleRewind -> useRewindGun (itm ^. itID) w
@@ -339,18 +355,20 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
     mid = magtree ^? ldtValue . itLocation . ilInvID
     itm = itmtree ^. ldtValue
 
+getAttachedSFLink :: ItemStructuralFunction 
+    -> LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
+getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
 
-getAttachedMapper :: LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
+itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) 
-getAttachedMapper =
+    -> Maybe (NewInt ItmInt) -> Creature -> World -> World
-    (^? ldtRight . folding (lookup (SFLink MapperSF)) . ldtValue . itID)
+itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
-
-itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) -> Creature -> World -> World
-itemDetectorEffect itm itid cr w = fromMaybe w $ do
     DETECTOR dt <- itm ^? itType
-    return $ case dt of
+    return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w
-        ITEMDETECTOR -> aRadarPulse itid ObItem cr w
+  where
-        CREATUREDETECTOR -> aRadarPulse itid ObCreature cr w
+    f ITEMDETECTOR = ObItem
-        WALLDETECTOR -> aRadarPulse itid ObWall cr w
+    f CREATUREDETECTOR = ObCreature
+    f WALLDETECTOR = ObWall
+
 
 walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
 walkNozzle mzid mz itm cr w = fromMaybe w $ do
@@ -759,6 +777,22 @@ useRewindGun i =
             , _scrollItemID = i
             }
 
+dropInventoryPath :: Int -> InventoryPathing -> LocationLDT ItemLink ComposedItem 
+    -> Creature
+    -> World -> World
+dropInventoryPath i ip loc cr w = case ip of
+    ABSOLUTE -> fromMaybe w $ do
+        guard $ i `IM.member` (cr ^. crInv)
+        return $ dropItem cr i w
+    RELCURS -> fromMaybe w $ do
+        j <- cr ^? crManipulation . manObject . imSelectedItem
+        guard $ (i + j) `IM.member` (cr ^. crInv)
+        return $ dropItem cr (i + j) w
+    RELITEM -> fromMaybe w $ do
+        j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID
+        guard $ (i + j) `IM.member` (cr ^. crInv)
+        return $ dropItem cr (i + j) w
+
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
 --    [w'] -> w & cwTime . maybeWorld .~ Just' w'
 --    (w' : ws) -> w

src/Dodge/Item.hs

@@ -29,6 +29,8 @@ itemFromBase = \case
     INTROSCAN t -> introScan t
     MAPPER -> mapper
     DETECTOR d -> detector d
+    ARHUD -> arHUD
+    DROPPER x -> dropper x
 
 itemFromAmmoMag :: AmmoMagType -> Item
 itemFromAmmoMag at = case at of
@@ -52,7 +54,6 @@ itemFromAttachType at = case at of
     SMOKEREDUCER -> smokeReducer
     --    ROCKETHOMER -> rocketHomer
     HOMINGMODULE -> homingModule
-    AUGMENTEDHUD -> augmentedHUD
     SHELLPAYLOAD p -> shellModule p
 
 itemFromEquipType :: EquipItemType -> Item

src/Dodge/Item/Display.hs

@@ -70,6 +70,14 @@ itemBaseName = \case
     INTROSCAN t -> show t
     MAPPER -> "MAPPER"
     DETECTOR t -> show t
+    ARHUD -> "AR-HUD"
+    DROPPER x -> "DROPPER-" ++ showInventoryPathing x
+
+showInventoryPathing :: InventoryPathing -> String
+showInventoryPathing = \case
+    ABSOLUTE -> "ABS"
+    RELCURS -> "CURS"
+    RELITEM -> "HERE"
 
 showAttachItem :: AttachType -> String
 showAttachItem t = case t of
@@ -81,7 +89,6 @@ showAttachItem t = case t of
     REMOTEDETONATOR -> "REM.DETONATR"
     SMOKEREDUCER -> "SMOKE.REDUCR"
     HOMINGMODULE -> "HOMING MOD"
-    AUGMENTEDHUD -> "AUGMENTED HUD"
     SHELLPAYLOAD x -> show x
     GIMBAL -> "GIMBAL"
     GYROSCOPE -> "GYROSCOPE"
@@ -96,6 +103,7 @@ showEquipItem eit = case eit of
 -- that is to say, it should not change based on functional positioning
 itemNumberDisplay :: World -> Creature -> ComposedItem -> [String]
 itemNumberDisplay w cr ci
+    | Just x <- ci ^? _1 . itUse . uInt = [show x]
     | Just x <- ci ^? _1 . itUse . useToggle = [show x]
     | ITEMSCAN <- ci ^. _1 . itType
     , Just ExamineInventory <- w ^? hud . hudElement . subInventory

src/Dodge/Item/Draw/SPic.hs

@@ -43,8 +43,10 @@ itemSPic it = case it ^. itType of
     STICKYMOD -> defSPic
     ITEMSCAN -> defSPic
     MAPPER -> defSPic
+    ARHUD -> defSPic
     INTROSCAN {} -> defSPic
     DETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
+    DROPPER{} -> defSPic
 
 craftItemSPic :: CraftType -> Shape
 craftItemSPic = \case

src/Dodge/Item/Grammar.hs

@@ -72,7 +72,11 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
         )
     (DETECTOR {}, _) -> 
         ( getAmmoLinks itm
-        , [(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
+        , [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
+        )
+    (MAPPER, _) -> 
+        ( []
+        , [(ARHUDSF,SFLink ARHUDSF)]
         )
     (_, GadgetPlatformSF) ->
         ( getAmmoLinks itm
@@ -100,7 +104,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
         ( [(JoystickSF, JoystickLink)]
         , []
         )
-    (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
+    (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(ARHUDSF, SFLink ARHUDSF)], [])
     (ATTACH BULLETSYNTH, _) ->
         ([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
     _ -> ([], [])
@@ -154,7 +158,7 @@ itemToFunction itm = case itm ^. itType of
     ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
     ATTACH ZOOMSCOPE -> WeaponScopeSF
     ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
-    ATTACH AUGMENTEDHUD -> AugmentedHUDSF
+    ARHUD -> ARHUDSF
     ATTACH UNDERBARRELSLOT -> UnderBarrelSlotSF
     BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
     BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
@@ -162,6 +166,7 @@ itemToFunction itm = case itm ^. itType of
     EQUIP WRIST_ECG -> TriggerSF
     EQUIP{} -> EquipmentPlatformSF
     ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
+    DROPPER{} -> GadgetPlatformSF
     _ -> NoSF
 
 structureToPotentialFunction ::

src/Dodge/Item/Info.hs

@@ -28,8 +28,26 @@ itmBaseInfo itm = case itm ^. itType of
     CRAFT fit -> craftInfo fit
     DETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."
     ATTACH t -> attachInfo t
+    AMMOMAG t -> ammoMagInfo t
+--    TARGETING {_ibtTargeting :: TargetingType}
+--    BULLETMOD {_ibtBulletMod :: BulletMod}
+--    STICKYMOD
+--    ITEMSCAN
+--    MAPPER
+--    INTROSCAN {_ibtIntroScanType :: IntroScanType}
+--    DETECTOR {_ibtDetector :: Detector}
+--    ARHUD
     _ -> "THIS SHOULD NOT BE DISPLAYED"
 
+ammoMagInfo :: AmmoMagType -> String
+ammoMagInfo = \case
+    TINMAG -> "A small tin magazine for containing bullets. "
+    DRUMMAG -> "A mid-sized magazine for containing bullets. "
+    BELTMAG -> "A belt with attachable bullets. "
+    SHELLMAG -> "A container for a projectile. "
+    BATTERY -> "A store of electrical potential energy. "
+    CHEMFUELPOUCH -> "A small tank for containing flammable liquids. "
+
 attachInfo :: AttachType -> String
 attachInfo = \case
     ZOOMSCOPE -> "An optical zoom. "

src/Dodge/Item/InventoryColor.hs

@@ -20,7 +20,7 @@ itemInvColor ci = case ci ^. _2 of
     TriggerSF -> yellow
     WeaponScopeSF -> chartreuse
     WeaponTargetingSF -> green
-    AugmentedHUDSF -> rose
+    ARHUDSF -> rose
     AmmoMagSF{} -> red
     RemoteScreenSF -> azure
     JoystickSF -> azure

src/Dodge/Item/Scope.hs

@@ -10,14 +10,14 @@ module Dodge.Item.Scope (
     joystick,
     remoteDetonator,
     homingModule,
---    bulletTargetingModule,
+    arHUD,
-    augmentedHUD,
     bulletModule,
     bulletPayloadModule,
     smokeReducer,
     itemScan,
     introScan,
     mapper,
+    dropper,
 ) where
 
 import Dodge.Item.Attach
@@ -68,6 +68,12 @@ mapper =
         & itType .~ MAPPER
         & itUse .~ UseMapper mempty mempty
 
+dropper :: InventoryPathing -> Item
+dropper x =
+    defaultHeldItem
+        & itType .~ DROPPER x
+        & itUse .~ UseInt 0
+
 bulletModule :: BulletMod -> Item
 bulletModule bm =
     defaultHeldItem
@@ -85,8 +91,10 @@ shellModule p = defaultHeldItem
 bulletPayloadModule :: BulletPayload -> Item
 bulletPayloadModule = bulletModule . BulletModPayload
 
-augmentedHUD :: Item
+arHUD :: Item
-augmentedHUD = makeAttach AUGMENTEDHUD
+arHUD = defaultHeldItem
+    & itType .~ ARHUD
+    & itUse .~ UseNothing
 
 remoteScreen :: Item
 remoteScreen = makeAttach REMOTESCREEN

src/Dodge/RadarBlip.hs

@@ -1,4 +1,7 @@
-module Dodge.RadarBlip where
+module Dodge.RadarBlip (
+    updateRadarBlip,
+    drawBlip,
+) where
 
 import Dodge.Data.RadarBlip
 import Geometry.Data

src/Dodge/RadarSweep.hs

@@ -1,29 +1,39 @@
 {-# LANGUAGE TupleSections #-}
+
 module Dodge.RadarSweep (
     aRadarPulse,
     updateRadarSweep,
 ) where
 
-import Data.Maybe
-import Dodge.Item.Location
-import qualified Data.Set as S
 import Color
+import Data.Maybe
+import qualified Data.Set as S
 import Dodge.Data.World
+import Dodge.Item.Location
 import Dodge.Zoning.Wall
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 import NewInt
 
-aRadarPulse :: Maybe (NewInt ItmInt) -> ObjectType -> Creature -> World -> World
+aRadarPulse ::
-aRadarPulse itid ob cr =
+    NewInt ItmInt ->
+    Maybe (NewInt ItmInt) ->
+    Maybe (NewInt ItmInt) ->
+    ObjectType ->
+    Creature ->
+    World ->
+    World
+aRadarPulse itid mitid armitid ob cr =
     cWorld . lWorld . radarSweeps
         .:~ RadarSweep
             { _rsTimer = 50
             , _rsRad = 0
             , _rsPos = _crPos cr
             , _rsObject = ob
-            , _rsMapper = itid
+            , _rsMapper = mitid
+            , _rsAR = armitid
+            , _rsSource = itid
             }
 
 updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
@@ -40,13 +50,16 @@ updateRadarSweep w pt
     p = _rsPos pt
     ob = _rsObject pt
     x = _rsTimer pt
-    putBlips = cWorld . lWorld . radarBlips .++~ map 
+    putBlips 
-        (makeBlip ob) 
+        | isJust (pt ^. rsAR) = cWorld . lWorld . radarBlips
-        blips
+            .++~ map
-    (blips,wps) = findBlips ob p r w
+                (makeBlip ob)
+                blips
+        | otherwise = id
+    (blips, wps) = findBlips ob p r w
     r = fromIntegral (400 - x * 8)
 
-findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
+findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
 findBlips ob = case ob of
     ObCreature -> crBlips
     ObItem -> itemBlips
@@ -71,20 +84,20 @@ blipAt r col i p =
         , _rbPos = p
         }
 
-crBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
+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], S.Set (Point2,Point2))
+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],S.Set (Point2,Point2))
+wallBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
 wallBlips p r = foldMap f . wlsNearCirc p r
   where
     f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
         [] -> mempty
-        xs -> (xs,S.singleton (wl ^. wlLine))
+        xs -> (xs, S.singleton (wl ^. wlLine))

src/Dodge/RadarSweep/Draw.hs

@@ -1,15 +1,26 @@
-module Dodge.RadarSweep.Draw where
+module Dodge.RadarSweep.Draw (
+    drawRadarSweep,
+) where
 
+import Control.Lens
+import Data.Maybe
 import Dodge.Data.RadarSweep
 import Geometry
 import Picture
 
+-- I have taken shortcuts in determining whether this is drawn or not wrt to the
+-- linked ARHUD: it needs to have existed at the sweeps original creation, then
+-- the sweep is drawn
 drawRadarSweep :: RadarSweep -> Picture
-drawRadarSweep pt = setLayer DebugLayer $ fold 
+drawRadarSweep pt
-        [ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
+    | isJust (pt ^. rsAR) =
-        , colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
+        setLayer DebugLayer $
-        , colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
+            fold
-        ]
+                [ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
+                , colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
+                , colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
+                ]
+    | otherwise = mempty
   where
     col = rsObjectColor $ _rsObject pt
     p = _rsPos pt

src/Dodge/Render/HUD.hs

@@ -164,13 +164,13 @@ drawSubInventory subinv cfig w = case subinv of
     ExamineInventory -> drawExamineInventory cfig w
     DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
-    MapperInventory p z itid -> drawMapperInventory p z itid cfig w
+    MapperInventory _ _ itid -> drawMapperInventory itid w
 
-drawMapperInventory :: Point2 -> Float -> NewInt ItmInt -> Configuration -> World -> Picture
+drawMapperInventory :: NewInt ItmInt -> World -> Picture
-drawMapperInventory p z itid _ w = fold $ do
+drawMapperInventory itid w = fold $ do
     itm <- w ^? pointerToItemID itid
     ls <- itm ^? itUse . useMapperLines
-    let r = w ^. wCam . camRot
+    let _ = w ^. wCam . camRot
     return . color red
         $ foldMap (\(x,y) -> line [f x,f y]) ls
   where

src/Dodge/ScrollValue.hs

@@ -1,11 +1,12 @@
-module Dodge.ScrollValue where
+module Dodge.ScrollValue (updateScrollTestValue) where
 
 import Dodge.Data.Input
 import LensHelp
 
 updateScrollTestValue :: Input -> Input
-updateScrollTestValue theinput = theinput & scrollTestFloat +~ theamount
+updateScrollTestValue theinput =
-    & scrollTestInt +~ i
+    theinput & scrollTestFloat +~ theamount
+        & scrollTestInt +~ i
   where
     i = theinput ^. scrollAmount
     theamount = fromIntegral i / 100

src/Dodge/SmoothScroll.hs

@@ -1,4 +1,8 @@
-module Dodge.SmoothScroll where
+module Dodge.SmoothScroll (
+    getSmoothScrollValue,
+    calcSmoothScroll,
+    advanceSmoothScroll,
+) where
 
 import Control.Lens
 import Dodge.Data.Input
@@ -33,5 +37,5 @@ advanceSmoothScroll y
     | y > 0 = y - 1
     | y == 0 = 0
     | y > (-10) = y + 1
-    | y > (-20) = y+2
+    | y > (-20) = y + 2
-    | otherwise = y+3
+    | otherwise = y + 3

src/Dodge/Targeting/Draw.hs

@@ -1,17 +1,24 @@
 module Dodge.Targeting.Draw (
-    drawTargeting,
+    drawTargetingAR,
+    drawMapperAR,
 ) where
 
 import Control.Lens
-import Data.Maybe
 import Dodge.Base.Coordinate
 import Dodge.Data.Universe
 import Geometry.Data
 import Picture
 
--- it would be nice to get rid of some redundant checks here
+drawMapperAR :: Item -> World -> Maybe Picture
-drawTargeting :: Item -> World -> Picture
+drawMapperAR itm w = do
-drawTargeting itm w = fromMaybe mempty $ do
+    ls <- itm ^? itUse . useMapperLines
+    let _ = w ^. wCam . camRot
+    return . setLayer FixedCoordLayer . color red $ foldMap (\(x,y) -> line [f x,f y]) ls
+  where
+    f = worldPosToScreen (w ^. wCam)
+
+drawTargetingAR :: Item -> World -> Maybe Picture
+drawTargetingAR itm w = do
     p <- itm ^? itTargeting . itTgPos . _Just
     let thepic = case itm ^? itTargeting . itTgActive of
             Just True -> activeTargetCursorPic

src/Dodge/TestString.hs

@@ -96,32 +96,6 @@ showManObj (SelCloseButton x) = "CloseButton " ++ show x
 --    ]
 
 
---    getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
---    <> ["---"]
---    <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
-    
---    [show $ u ^. uvWorld . input . smoothScrollAmount
---    , show $ getSmoothScrollValue (u ^. uvWorld . input)
---    , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
---    ]
---    [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam) 
---        (u ^. uvWorld . cWorld . lWorld)
---        , show a
---        , show $ u ^. uvWorld . input . mousePos
---        , show $ u ^. uvConfig . windowX
---        , show $ u ^. uvConfig . windowY
---        , show $ u ^. uvWorld . input . scrollTestInt
---        ]
---  where
---    w = u ^. uvWorld
---    a = fromMaybe 0 $ do 
---        cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
---        return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
---            - w ^. wCam . camRot
-
-    --[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
---    [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
-
 showTimeFlow :: TimeFlowStatus -> String
 showTimeFlow tfs = case tfs of
     DeathTime i -> "DeathTime"++show i

src/Dodge/Update/Scroll.hs

@@ -18,7 +18,7 @@ updateWheelEvent :: Int -> World -> World
 updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
     NoSubInventory -> updateBaseWheelEvent yi w
     ExamineInventory -> updateBaseWheelEvent yi w
-    MapperInventory {} -> updateBaseWheelEvent yi w
+    MapperInventory{} -> updateBaseWheelEvent yi w
     CombineInventory{} -> moveCombineSel yi w
     DisplayTerminal tmid -> terminalWheelEvent yi tmid w
 
@@ -27,7 +27,7 @@ updateBaseWheelEvent yi w
     | Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
     | bdown ButtonRight = case _rbOptions w of
         EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
-        NoRightButtonOptions -> selectedItemScroll yi w
+        NoRightButtonOptions -> fromMaybe w (selectedItemScroll yi w)
     | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
     | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
     | otherwise = scrollAugInvSel yi w
@@ -38,37 +38,41 @@ updateBaseWheelEvent yi w
         esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeType
         return . length $ eqSiteToPositions esite
 
-selectedItemScroll :: Int -> World -> World
+selectedItemScroll :: Int -> World -> Maybe World
-selectedItemScroll scrollamount w = fromMaybe w $ do
+selectedItemScroll yi w = do
     i <- you w ^? crManipulation . manObject . imSelectedItem
     itm <- you w ^? crInv . ix i
-    return $ itemScroll scrollamount i itm w
+    return $ itemScroll yi i itm w
 
 itemScroll :: Int -> Int -> Item -> World -> World
-itemScroll yi invid itm w = case itm ^. itType of
+itemScroll yi invid itm w
-    ATTACH ZOOMSCOPE -> updateScopeZoom w
+    | isJust $ itm ^? itUse . uInt =
-    HELD ALTERIFLE
+        w
-        | yi /= 0 ->
+            & cWorld . lWorld . creatures . ix 0 . crInv . ix invid
-            w
+                . itUse
-                & cWorld . lWorld . creatures . ix 0 . crInv . ix invid
+                . uInt
-                    . itUse
+                +~ yi
-                    . heldAim
+    | ATTACH ZOOMSCOPE <- itm ^. itType = updateScopeZoom invid w
-                    . aimMuzzles
+    | HELD ALTERIFLE <- itm ^. itType
-                    . ix 0
+      , yi /= 0 =
-                    . mzAmmoSlot
+        w
-                    %~ ((`mod` 2) . (+ 1))
+            & cWorld . lWorld . creatures . ix 0 . crInv . ix invid
-    _ -> w
+                . itUse
+                . heldAim
+                . aimMuzzles
+                . ix 0
+                . mzAmmoSlot
+                %~ ((`mod` 2) . (+ 1))
+    | otherwise = w
 
 -- note that your _crInvLock does not apply to this TODO check that this is what
 -- is wanted
-updateScopeZoom :: World -> World
+updateScopeZoom :: Int -> World -> World
-updateScopeZoom w = fromMaybe w $ do
+updateScopeZoom i w
-    i <- you w ^? crManipulation . manObject . imSelectedItem
+    | Just 0 <- w ^. input . mouseButtons . at SDL.ButtonRight =
-    return $ updateScopeZoom' i w
+        w
-
+            & wppointer %~ resetscope
-updateScopeZoom' :: Int -> World -> World
+    | Just _ <- w ^. input . mouseButtons . at SDL.ButtonRight =
-updateScopeZoom' i w
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
         w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
     | otherwise = w & wppointer %~ resetscope
   where
@@ -118,10 +122,10 @@ moveCombineSel yi =
 terminalWheelEvent :: Int -> Int -> World -> World
 terminalWheelEvent yi tmid w
     | w & has (input . mouseButtons . ix ButtonRight)
-    , Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
+      , Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
-            w & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
+        w & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
     | Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
-            w & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
+        w & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
     | otherwise = w
   where
     updatetermsel tm = case tm ^? tmInput . tiSel of