Add rotate to scope for (hopefully) all torque functions

src/Dodge/Base/You.hs

@@ -1,8 +1,11 @@
 module Dodge.Base.You where
 
+import TreeHelp
 import Dodge.Data.World
+import Dodge.HeldScroll
 import qualified IntMapHelp as IM
 import Control.Lens
+import Control.Monad
 
 you :: World -> Creature
 you w = w ^?! cWorld . lWorld . creatures . ix 0
@@ -15,8 +18,25 @@ yourItem w = do
     i <- you w ^? crManipulation . manObject . inInventory . ispItem
     _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
 
+attachmentTree :: Creature -> [Tree Int]
+attachmentTree cr = []
+
 --yourInvSel :: World -> Int
 --yourInvSel = crSel . you

src/Dodge/Combine.hs

@@ -8,6 +8,7 @@ import Dodge.Item.SlotsTaken
 import Dodge.Data.Universe
 import Dodge.Data.Combine
 import Dodge.Item.Display
+import Dodge.Item.InventoryColor
 import Color
 --import Dodge.Data.SelectionList
 import qualified Data.IntSet as IS
@@ -57,7 +58,7 @@ combineList' = map f . combineListInfo
         { _siPictures = basicItemDisplay itm 
         , _siHeight = itSlotsTaken itm
         , _siIsSelectable = True
-        , _siColor = _itInvColor itm
+        , _siColor = itemInvColor itm
         , _siOffX = 0
         , _siOffY = 0
         , _siPayload = CombinableItem is itm strs

src/Dodge/Combine/Combinations.hs

@@ -122,18 +122,6 @@ itemCombinations =
 moduleCombinations :: [(ModuleSlot, [Item], [([ItemBaseType], ItemModuleType)])]
 moduleCombinations =
     [
-        ( ModRifleMag
-        ,
-            [ repeater
-            , autoRifle
-            , burstRifle
-            ]
-        ,
-            [ amod [cr STEELDRUM, cr HARDWARE] DRUMMAG
-            , amod [cr MOTOR, cr HARDWARE] BELTMAG
-            ]
-        )
-    ,
         ( ModHeldAttach
         ,
             [ rifle

src/Dodge/Combine/Module.hs

@@ -10,8 +10,7 @@ import LensHelp
 moduleModification :: ItemModuleType -> Item -> Item
 moduleModification imt = case imt of
     EMPTYMODULE -> id
-    DRUMMAG -> itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 45
-    BELTMAG -> itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 150
+--    BELTMAG -> itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 150
     MAGNETMAG -> itUse . heldDelay . rateMax .~ 4
     BULPAY BulFlak -> (itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulFlak)
         . (itUse . heldConsumption . laAmmoType . amBullet . buTimer .~ 3)

src/Dodge/Creature/HandPos.hs

@@ -1,11 +1,27 @@
-module Dodge.Creature.HandPos where
+module Dodge.Creature.HandPos (
+    aimingWeaponZeroPos,
+    aimingMuzzlePos,
+    aimingMuzzleLength,
+    translatePointToLeftHand,
+    translatePointToRightHand,
+    translatePointToHead,
+    translateToLeftWrist,
+    translateToRightWrist,
+    translateToLeftLeg,
+    translateToRightLeg,
+    translateToHead,
+    translateToChest,
+    translateToBack,
+    translateToLeftHand,
+    translateToRightHand,
+) where
 
-import Linear
 import Control.Lens
 import Data.Maybe
 import Dodge.Creature.Test
 import Dodge.Data.Creature
 import Geometry
+import Linear
 import ShapePicture
 
 -- the position of a weapon handle
@@ -27,11 +43,6 @@ aimingMuzzlePos cr it = fmap ((+ zp) . _mzPos) (it ^.. itUse . heldAim . aimMuzz
   where
     zp = aimingWeaponZeroPos cr it
 
-aimingMuzzleOff :: Creature -> Item -> [Point2]
-aimingMuzzleOff cr it = fmap (rotateV (_crDir cr) . (+ zp) . _mzPos) (it ^.. itUse . heldAim . aimMuzzles . folded)
-  where
-    zp = aimingWeaponZeroPos cr it
-
 aimingMuzzleLength :: Creature -> Item -> Float
 aimingMuzzleLength cr it = head (aimingMuzzlePos cr it) ^. _x
 

src/Dodge/Creature/Impulse/UseItem.hs

@@ -42,6 +42,7 @@ itemEffect cr it w = case it ^. itUse of
     -- ConsumeUse will cause problems if the item is not selected
     (ConsumeUse eff _) -> useC eff it cr $ rmInvItem (_crID cr) itRef w
     CraftUse{} -> w
+    AttachUse{} -> w
   where
     itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
     hammerTest f = case _crHammerPosition cr of

src/Dodge/Creature/State.hs

@@ -271,6 +271,9 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
         | l < m -> it & itUse . leftConsumption . arProgress -~ 1
     _ -> it
 
+-- I feel like there should be a centralised function that supersumes this
+-- i.e. a function that deals with all states that depend upon item positioning
+-- in the inventory
 crGetTargeting :: Creature -> Maybe TargetType
 crGetTargeting cr = do
     i <- cr ^? crManipulation . manObject . inInventory . ispItem

src/Dodge/Creature/Test.hs

@@ -25,6 +25,7 @@ module Dodge.Creature.Test (
 ) where
 
 --import MaybeHelp
+--import Control.Applicative
 import Control.Lens
 import Data.List (find)
 import Data.Maybe
@@ -46,6 +47,15 @@ crWeaponReady cr = fromMaybe False $ do
         AboveSource -> do
             x <- cr ^? crInv . ix (i - 1) . itUse . equipEffect . eeUse . euseAmmoAmount
             return (x > 0)
+        BelowSource -> do
+            x <- cr ^? crInv . ix (i + 1) . itUse . equipEffect . eeUse . euseAmmoAmount
+            return (x > 0)
+        EitherSource -> return $
+             justIsPositive (cr ^? crInv . ix (i - 1) . itUse . equipEffect . eeUse . euseAmmoAmount)
+                || justIsPositive (cr ^? crInv . ix (i + 1) . itUse . equipEffect . eeUse . euseAmmoAmount)
+  where
+    justIsPositive Nothing = False
+    justIsPositive (Just x) = x > 0
 
 crCanSeeCr :: Creature -> (World, Creature) -> Bool
 crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w

src/Dodge/Creature/YourControl.hs

@@ -2,8 +2,6 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
-import Dodge.Creature.Impulse.UseItem
-import Dodge.Hotkey
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -11,8 +9,9 @@ import Data.Maybe
 import Dodge.Base.Coordinate
 import Dodge.Base.You
 import Dodge.Creature.Impulse.Movement
-import Dodge.Creature.Test
+import Dodge.Creature.Impulse.UseItem
 import Dodge.Data.World
+import Dodge.Hotkey
 import Dodge.InputFocus
 import Dodge.WASD
 import Geometry
@@ -92,21 +91,72 @@ tryAssignHotkey w sc = fromMaybe w $ do
     itid <- cr ^? crManipulation . manObject . inInventory . ispItem
     return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
 
--- | Turn key presses into creature movement.
--- | note the order of operation, setting the posture first--this prevents the twist fire bug
+{- | Turn key presses into creature movement.
+ | note the order of operation, setting the posture first--this prevents the twist fire bug
+-}
+--wasdWithAiming ::
+--    World ->
+--    -- | Base speed
+--    Float ->
+--    Creature ->
+--    Creature
+--wasdWithAiming w speed cr
+--    | isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
+--    | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
+--        aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
+--    | otherwise = theMovement $ theTurn $ removeTwist $ setMvAim cr
+--  where
+--    setMvAim = maybe id (crMvAim .~) dir
+--    twistamount = 1.6
+--    removeTwist cr' =
+--        cr'
+--            & crDir +~ _crTwist cr'
+--            & crTwist .~ 0
+--    addAnyTwist = fromMaybe id $ do
+--        itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
+--        astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
+--        case (astance, cr ^. crTwist) of
+--            (TwoHandUnder, 0) ->
+--                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
+--            (TwoHandOver, 0) ->
+--                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
+--            _ -> Nothing
+--    theMovement
+--        | movDir == V2 0 0 = id
+--        | otherwise = crMvAbsolute (speed *.* movAbs)
+--    theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
+--    movDir = wasdDir (w ^. input)
+--    dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
+--    movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
+--    isAiming = _posture (_crStance cr) == Aiming
+--    mouseDir = argV $ mouseWorldPos (w ^. input) (w ^. wCam) - (cr ^. crPos)
+
+-- | The order of these MAY be important, in particular the setting of crMvAim
+-- within wasdMovement should probably be done first
 wasdWithAiming ::
     World ->
     -- | Base speed
     Float ->
     Creature ->
     Creature
-wasdWithAiming w speed cr
-    | isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
-    | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
-        aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
-    | otherwise = noaimmove $ theTurn $ removeTwist $ setMvAim cr
+wasdWithAiming w speed = wasdAim inp cam . wasdTwist . wasdMovement inp cam speed
+  where
+    inp = w ^. input
+    cam = w ^. wCam
+
+wasdAim :: Input -> Camera -> Creature -> Creature
+wasdAim inp cam cr
+    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mouseDir cr
+    | otherwise = theTurn cr
+  where
+    theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
+    mouseDir = argV $ mouseWorldPos inp cam - (cr ^. crPos)
+
+wasdTwist :: Creature -> Creature
+wasdTwist cr
+    | _posture (_crStance cr) == Aiming = addAnyTwist cr
+    | otherwise = removeTwist cr
   where
-    setMvAim = maybe id (crMvAim .~) dir
     twistamount = 1.6
     removeTwist cr' =
         cr'
@@ -115,34 +165,25 @@ wasdWithAiming w speed cr
     addAnyTwist = fromMaybe id $ do
         itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
         astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
-        let currenttwistamount = cr ^. crTwist
-        case (astance, currenttwistamount) of
+        case (astance, cr ^. crTwist) of
             (TwoHandUnder, 0) ->
-                return $
-                    (crTwist .~ twistamount * pi)
-                        . (crDir -~ twistamount * pi)
+                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
             (TwoHandOver, 0) ->
-                return $
-                    (crTwist .~ twistamount * pi)
-                        . (crDir -~ twistamount * pi)
+                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
             _ -> Nothing
+  
+
+wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
+wasdMovement inp cam speed = theMovement . setMvAim
+  where
+    setMvAim = fromMaybe id $ do
+        dir <- safeArgV movDir
+        return $ crMvAim .~ (cam ^. camRot + dir)
+    movDir = wasdDir inp
+    movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
     theMovement
         | movDir == V2 0 0 = id
         | otherwise = crMvAbsolute (speed *.* movAbs)
-    noaimmove
-        | movDir == V2 0 0 = id
-        | otherwise = crMvForward speed
-    theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
-    movDir = wasdDir (w ^. input)
-    dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
-    movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
-    isAiming = _posture (_crStance cr) == Aiming
-    mouseDir = fromMaybe
-        (argV (_mousePos (_input w)) + (w ^. wCam . camRot))
-        $ do
-            itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
-            _ <- cr ^? crInv . ix itRef . itScope . scopePos
-            return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr
 
 aimTurn :: Float -> Creature -> Creature
 aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
@@ -154,11 +195,10 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
 -- | Set posture according to mouse presses.
 mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
 mouseActionsCr pkeys cr
-    | rbPressed && noaction =
+    | SDL.ButtonRight `M.member` pkeys && noaction =
         cr & crStance . posture .~ Aiming
     | otherwise = cr & crStance . posture .~ AtEase
   where
-    rbPressed = SDL.ButtonRight `M.member` pkeys
     noaction = fromMaybe True $ do
         theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
         return $ theaction == NoInvSelAction
@@ -167,8 +207,7 @@ pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
 pressedMBEffectsTopInventory pkeys w
     | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItemRightClick (you w) w
     | isDown SDL.ButtonLeft && inTopInv = useItemLeftClick (you w) w
-    | isDown SDL.ButtonMiddle =
-        w & wCam . camRot -~ rotation
+    | isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation
     | otherwise = w
   where
     inTopInv = case w ^. hud . hudElement of

src/Dodge/Data/Item.hs

@@ -16,7 +16,6 @@ module Dodge.Data.Item (
     module Dodge.Data.Item.Location,
 ) where
 
-import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -29,6 +28,7 @@ import Dodge.Data.Item.Params
 import Dodge.Data.Item.Tweak
 import Dodge.Data.Item.Use
 import Dodge.Data.Item.Location
+import Data.Set (Set)
 
 data Item = Item
     { _itUse :: ItemUse
@@ -38,17 +38,25 @@ data Item = Item
     , _itIsHeld :: Bool
     , _itEffect :: ItEffect
     , _itInvSize :: Float
-    , _itInvColor :: Color
     , _itDimension :: ItemDimension
     , _itCurseStatus :: CurseStatus
     , _itTweaks :: ItemTweaks
     , _itScope :: Scope
     , _itParams :: ItemParams
+    , _itAttachments :: Set ItemAttachment
     }
     --deriving (Eq, Show, Read) --Generic, Flat)
 
+data ItemAttachment = ScopeAttachment
+    | BulletClipAttachment
+    | BulletBeltAttachment
+    | StandAttachment
+    | PowerSourceAttachment
+    deriving (Eq,Ord)
+
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _heldAim . _itUse
 
 makeLenses ''Item
+deriveJSON defaultOptions ''ItemAttachment
 deriveJSON defaultOptions ''Item

src/Dodge/Data/Item/Combine.hs

@@ -1,38 +1,38 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.Item.Combine where
 
-import Dodge.Data.Item.Targeting
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.Map.Strict as M
 import Dodge.Data.Equipment.Misc
+import Dodge.Data.Item.Targeting
 import Dodge.Data.Item.Use.Consumption
 
 data ItemType = ItemType
     { _iyBase :: ItemBaseType
     , _iyModules :: M.Map ModuleSlot ItemModuleType
     }
-    deriving (Eq,Ord,Show,Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    deriving (Eq, Ord, Show, Read)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Stack = NoStack | Stack ItAmount
-    deriving (Eq,Ord,Show,Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    deriving (Eq, Ord, Show, Read)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CraftType
     = PIPE
     | TUBE
     | HARDWARE
     | SPRING
-
     | HOSE
     | TAPE
-
     | CAN
     | TIN
     | STEELDRUM
@@ -78,26 +78,44 @@ data CraftType
     | TIMEMODULE
     | SIZEMODULE
     | GRAVITYMODULE
-
     | TARGETMODULE TargetType
-    deriving (Eq,Ord,Show,Read)
-    --deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
+    deriving (Eq, Ord, Show, Read)
+
+--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
 
 data ItemBaseType
-    = NoItemType
-    | HELD {_ibtHeld :: HeldItemType}
+    = HELD {_ibtHeld :: HeldItemType}
     | LEFT {_ibtLeft :: LeftItemType}
     | EQUIP {_ibtEquip :: EquipItemType}
-    | Consumable {_ibtConsumable :: ConsumableItemType}
+    | CONSUMABLE {_ibtConsumable :: ConsumableItemType}
     | CRAFT CraftType
-    deriving (Eq,Ord,Show,Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    | ATTACH AttachType
+    deriving (Eq, Ord, Show, Read)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data AttachType
+    = SCROLLATTACH ScrollAttachType
+    | AMMOATTACH AmmoAttachType
+    deriving (Eq, Ord, Show, Read)
+
+data ScrollAttachType
+    = ZOOMSCOPE
+    deriving (Eq, Ord, Show, Read)
+
+data AmmoAttachType
+    = TINMAG
+    | DRUMMAG
+    | BULLETBELT
+    deriving (Eq, Ord, Show, Read)
+
 
 data ConsumableItemType
     = MEDKIT Int
     | EXPLOSIVES
-    deriving (Eq,Ord,Show,Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    deriving (Eq, Ord, Show, Read)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data EquipItemType
     = MAGSHIELD
@@ -112,16 +130,15 @@ data EquipItemType
     | POWERLEGS
     | SPEEDLEGS
     | JUMPLEGS
-
     | JETPACK
     | FUELPACK
     | BULLETBELTPACK
     | BULLETBELTBRACER
     | BATTERYPACK
-
     | AUTODETECTOR Detector
-    deriving (Eq,Ord,Show,Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    deriving (Eq, Ord, Show, Read)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data LeftItemType
     = BOOSTER
@@ -178,15 +195,12 @@ data HeldItemType
     | FORCEFIELDGUN
     | HELDDETECTOR Detector
     | TORCH
-    | BINOCULARS
     | FLATSHIELD
     | KEYCARD Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ItemModuleType
     = EMPTYMODULE
-    | DRUMMAG
-    | BELTMAG
     | MAGNETMAG
     | BULPAY BulletSpawn
     | BULBODY BulletEffect
@@ -228,6 +242,9 @@ makeLenses ''ItemModuleType
 deriveJSON defaultOptions ''Stack
 deriveJSON defaultOptions ''CraftType
 deriveJSON defaultOptions ''ConsumableItemType
+deriveJSON defaultOptions ''AmmoAttachType
+deriveJSON defaultOptions ''ScrollAttachType
+deriveJSON defaultOptions ''AttachType
 deriveJSON defaultOptions ''Detector
 deriveJSON defaultOptions ''EquipItemType
 deriveJSON defaultOptions ''LeftItemType
@@ -236,7 +253,7 @@ deriveJSON defaultOptions ''ItemModuleType
 deriveJSON defaultOptions ''ModuleSlot
 deriveJSON defaultOptions ''ItemBaseType
 deriveJSON defaultOptions ''ItemType
+
 instance ToJSONKey ModuleSlot
 
 instance FromJSONKey ModuleSlot
-

src/Dodge/Data/Item/HeldScroll.hs

@@ -1,21 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Dodge.Data.Item.HeldScroll where
-
-import Control.Lens
-import Data.Aeson
-import Data.Aeson.TH
-import qualified Data.Sequence as Seq
-
-data HeldScroll
-    = HeldScrollDoNothing
-    | HeldScrollZoom
-    | HeldScrollCharMode
-        {_hsCharMode :: Seq.Seq Char}
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-makeLenses ''HeldScroll
-deriveJSON defaultOptions ''HeldScroll

src/Dodge/Data/Item/Scope.hs

@@ -14,19 +14,8 @@ data Scope
     = NoScope
     | RemoteScope
         { -- | a camera offset
-          _scopePos :: Point2
-        , _scopeZoom :: Float
-        , -- | if the camera offset is also the center of vision
-          _scopeIsCamera :: Bool
-        }
-    | ZoomScope
-        { -- | a camera offset
-          _scopePos :: Point2
---        , _scopeZoomChange :: Int
-        , _scopeZoom :: Float
-        , _scopeDefaultZoom :: Float
-        , -- | if the camera offset is also the center of vision
-          _scopeIsCamera :: Bool
+          _remotePos :: Point2
+        , _remoteZoom :: Float
         }
     deriving (Eq, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Item/Use.hs

@@ -7,19 +7,18 @@ module Dodge.Data.Item.Use (
     module Dodge.Data.Item.Use,
     module Dodge.Data.Item.Use.Equipment,
     module Dodge.Data.Item.HeldUse,
-    module Dodge.Data.Item.HeldScroll,
     module Dodge.Data.Item.HeldDelay,
     module Dodge.Data.Item.Use.Consumption,
     module Dodge.Data.Hammer,
     module Dodge.Data.Item.Targeting,
 ) where
 
-import Linear
+import Geometry.Data
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
+import qualified Data.Sequence as Seq
 import Dodge.Data.Hammer
-import Dodge.Data.Item.HeldScroll
 import Dodge.Data.Item.HeldUse
 import Dodge.Data.Item.Use.Consumption
 import Dodge.Data.Item.Use.Equipment
@@ -33,7 +32,6 @@ data ItemUse
         , _heldMods :: HeldMod
         , _heldHammer :: HammerPosition
         , _heldAim :: AimParams
-        , _heldScroll :: HeldScroll
         , _heldConsumption :: HeldConsumption
 --        , _useTargeting :: Maybe TargetType
         }
@@ -54,8 +52,26 @@ data ItemUse
         }
     | CraftUse
         {_useAmount :: ItAmount}
+    | AttachUse
+        {_attachParams :: AttachParams}
     --deriving (Eq, Show, Read) --Generic, Flat)
 
+data AttachParams
+    = ScrollAttachParams {_scrollAttachParams :: ScrollAttachParams}
+    | AmmoAttachParams
+
+data ScrollAttachParams
+    = ZoomScrollParams
+        { -- | a camera offset
+          _opticPos :: Point2  -- this should be relative to the camera rotation
+                                -- then when the camera rotates when firing etc,
+                                -- this doesn't need to be changed
+        , _opticZoom :: Float
+        , _opticDefaultZoom :: Float
+        }
+    | CharScrollParams
+        { _scrollChar :: Seq.Seq Char}
+
 data ItemUse' 
     = ItemHeld HeldUse'
     | ItemEquip EquipUse'
@@ -104,8 +120,12 @@ makeLenses ''ItemUse
 makeLenses ''AimParams
 makeLenses ''ItZoom
 makeLenses ''Muzzle
+makeLenses ''AttachParams
+makeLenses ''ScrollAttachParams
 deriveJSON defaultOptions ''Muzzle
 deriveJSON defaultOptions ''AimStance
+deriveJSON defaultOptions ''ScrollAttachParams
+deriveJSON defaultOptions ''AttachParams
 deriveJSON defaultOptions ''ItZoom
 deriveJSON defaultOptions ''AimParams
 deriveJSON defaultOptions ''ItemUse

src/Dodge/Data/Item/Use/Consumption.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -29,15 +29,22 @@ data HeldConsumption
 data AmmoSource
     = InternalSource InternalAmmo
     | AboveSource
+    | BelowSource
+    | EitherSource
+    deriving (Eq, Show, Read) --Generic, Flat)
+
+data ExternalSourceType = BulletClip
+    | BulletBelt
+    | ElectricPower
     deriving (Eq, Show, Read) --Generic, Flat)
 
 data InternalAmmo = InternalAmmo
-        { _iaMax :: Int
-        , _iaLoaded :: Int
-        , _iaPrimed :: Bool
-        , _iaCycle :: [LoadAction]
-        , _iaProgress :: Maybe [LoadAction]
-        }
+    { _iaMax :: Int
+    , _iaLoaded :: Int
+    , _iaPrimed :: Bool
+    , _iaCycle :: [LoadAction]
+    , _iaProgress :: Maybe [LoadAction]
+    }
     deriving (Eq, Show, Read) --Generic, Flat)
 
 data LeftConsumption
@@ -54,8 +61,9 @@ data LeftConsumption
     deriving (Eq, Show, Read) --Generic, Flat)
 
 newtype ItAmount = ItAmount {_getItAmount :: Int}
---    deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
+    --    deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
     deriving newtype (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
+
 --    deriving stock (Generic)
 --    deriving anyclass (Flat)
 

src/Dodge/Debug/Terminal.hs

@@ -38,7 +38,7 @@ applyTerminalCommand s = case s of
 
 applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
 applyTerminalCommandArguments command args u = case command of
-    "ITEM" -> fromMaybe u $ do
+    "IT" -> fromMaybe u $ do
         (ibt, n) <- parseItem args
         return $ u & uvWorld %~ flip (foldr ($)) (replicate n (snd . createPutItem (itemFromBase ibt)))
     "DEX" -> fromMaybe u $ do
@@ -63,6 +63,9 @@ parseItem (x : xs) =
         <|> (readMaybe ("EQUIP {_ibtEquip=" ++ x ++ "}") <&> (,parseNum xs))
         <|> (readMaybe ("LEFT {_ibtLEFT=" ++ x ++ "}") <&> (,parseNum xs))
         <|> (readMaybe ("HELD (" ++ x ++ " {_xNum=" ++ show (parseNum xs) ++ "}") <&> (,1))
+        <|> (readMaybe ("ATTACH " ++ x) <&> (,parseNum xs))
+        <|> (readMaybe ("CONSUMABLE {_ibtConsumable=" ++ x ++ "}") <&> (,parseNum xs))
+        <|> (readMaybe ("AMMO {_ibtAmmo=" ++ x ++ "}") <&> (,parseNum xs))
         <|> parseItem (xs & ix 0 .++~ (x ++ " "))
 parseItem [] = Nothing
 

src/Dodge/Default.hs

@@ -25,10 +25,7 @@ import Geometry
 import Picture
 
 defaultEquipment :: Item
-defaultEquipment =
-    defaultItem
-        & itInvColor .~ yellow
-        & itUse .~ defaultEquipUse
+defaultEquipment = defaultHeldItem & itUse .~ defaultEquipUse
 
 defaultFlIt :: FloorItem
 defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}

src/Dodge/Default/Item.hs

@@ -4,7 +4,6 @@ module Dodge.Default.Item (
     module Dodge.Default.Item.Effect,
 ) where
 
-import Color
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Dodge.Data.Item
@@ -19,45 +18,28 @@ defaultItemDimension = ItemDimension
     , _dimAttachPos = V3 10 (-5) 3
     }
 
-defaultItem :: Item
-defaultItem =
-    Item
+defaultHeldItem :: Item
+defaultHeldItem = Item
         { _itCurseStatus = Uncursed
-        , _itType = defaultItemType
+        , _itType = ItemType (HELD PISTOL) mempty
         , _itEffect = defaultItEffect
         , _itID = 0
         , _itIsHeld = False
-        , _itInvColor = yellow
         , _itInvSize = 1
         , _itLocation = InVoid
         , _itDimension = defaultItemDimension
-        , _itUse = CraftUse (ItAmount 1)
+        , _itUse = defaultHeldUse
         , _itParams = NoParams
         , _itTweaks = NoTweaks
         , _itScope = NoScope
---        , _itValue = ItemValue 0 MundaneItem
+        , _itAttachments = mempty
         }
 
 defaultLeftItem :: Item
-defaultLeftItem =
-    defaultItem
-        & itUse .~ defaultLeftUse
-        & itInvColor .~ cyan
-
-defaultHeldItem :: Item
-defaultHeldItem =
-    defaultItem
-        & itInvColor .~ white
-        & itUse .~ defaultHeldUse
+defaultLeftItem = defaultHeldItem & itUse .~ defaultLeftUse
 
 defaultCraftItem :: Item
-defaultCraftItem =
-    defaultItem
-        & itUse .~ CraftUse 1
-        & itInvColor .~ green
-
-defaultItemType :: ItemType
-defaultItemType = ItemType NoItemType mempty
+defaultCraftItem = defaultHeldItem & itUse .~ CraftUse 1
 
 defaultBulletWeapon :: Item
 defaultBulletWeapon =
@@ -72,7 +54,6 @@ defaultWeapon :: Item
 defaultWeapon =
     defaultHeldItem
         & itUse .~ defaultHeldUse
-        & itInvColor .~ white
         & itType . iyModules
             .~ M.fromList
                 [ (ModTarget, EMPTYMODULE)
@@ -80,10 +61,5 @@ defaultWeapon =
                 ]
 
 defaultConsumable :: Item
-defaultConsumable =
-    defaultItem
-        & itUse .~ ConsumeUse CDoNothing 1
-        & itInvColor .~ blue
+defaultConsumable = defaultHeldItem & itUse .~ ConsumeUse CDoNothing 1
 
-defaultItZoom :: ItZoom
-defaultItZoom = ItZoom 20 0.2 1

src/Dodge/Default/Item/Use.hs

@@ -34,7 +34,5 @@ defaultHeldUse =
         , _heldMods = HeldModNothing
         , _heldHammer = HammerUp
         , _heldAim = defaultAimParams
-        , _heldScroll = HeldScrollDoNothing
         , _heldConsumption = defaultLoadable
---        , _useTargeting = Nothing
         }

src/Dodge/Default/Item/Use/AimParams.hs

@@ -9,10 +9,18 @@ defaultAimParams =
         { _aimWeight = 0
         , _aimTurnSpeed = 1
         , _aimRange = 0
-        , _aimZoom = ItZoom 20 0.2 1
+        , _aimZoom = defaultItZoom
         , _aimStance = OneHand
-        --, _aimHandlePos = 10
-        , _aimHandlePos = V2 3 0
+        , --, _aimHandlePos = 10
+          _aimHandlePos = V2 3 0
         , _aimMuzzles = [Muzzle (V2 20 0) 0 0]
---        , _aimMuzPos = 20
+        --        , _aimMuzPos = 20
+        }
+
+defaultItZoom :: ItZoom
+defaultItZoom =
+    ItZoom
+        { _izMax = 20
+        , _izMin = 0.2
+        , _izFac = 1
         }

src/Dodge/HeldScroll.hs

@@ -1,33 +1,76 @@
 module Dodge.HeldScroll (
     doHeldScroll,
+    canHeldScrollAttach,
 ) where
 
---import Dodge.Base.You
-import Control.Lens hiding ((<|), (|>))
-import Data.Sequence
-import Dodge.Data.Creature
+--import LensHelp hiding ((<|), (|>))
+--import Data.Maybe
+--import Control.Monad
+--import Geometry
+--import Control.Lens hiding ((<|), (|>))
+--import Data.Sequence
 import Dodge.Data.World
-import Data.Maybe
---import LensHelp hiding ((|>), (<|))
--- should be able to just import data.item
+--import SDL (MouseButton (..))
+--import qualified Data.Map.Strict as M
 
-doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World
-doHeldScroll hs = case hs of
-    HeldScrollDoNothing -> const . const id
-    HeldScrollZoom -> const . const id
-    HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
-  where
-    overYourItem f x cr w =  fromMaybe w $ do
-        i <- cr ^? crManipulation . manObject . inInventory . ispItem
-        return $ w & cWorld . lWorld . creatures . ix 0 . crInv . ix i %~ f x cr
+-- note that scope zooming is controlled by updateScopeZoom
+doHeldScroll :: Int -> ScrollAttachParams -> Float -> World -> World
+doHeldScroll _ _ _ = id
+--doHeldScroll invid hs x w  =  case hs of
+--    ZoomScrollParams{}
+--        | SDL.ButtonRight `M.member` _mouseButtons (_input w) -> w &
+--            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
+--                . itUse . attachParams . scrollAttachParams %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
+--    ZoomScrollParams{} -> w &
+--            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
+--                . itUse . attachParams . scrollAttachParams %~ resetscope
+--
+--    CharScrollParams{} -> w & cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itUse . attachParams . scrollAttachParams . scrollChar %~ cycleSignum x
+--  where
+--    mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
+--    resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
+--    resetscope otherAtt = otherAtt
 
-cycleSignum :: Float -> Seq a -> Seq a
-cycleSignum x
-    | x > 0 = cycleL
-    | otherwise = cycleR
+--doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
+--doScopeZoom scrollamount mp sc = case scrollamount of
+--    x
+--        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
+--        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
+--        | x > 0 -> zoomInLongGun mp sc
+--        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
+--        | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
+--        | x < 0 -> zoomOutLongGun sc
+--        | otherwise -> sc
+--
+--zoomSpeed :: Float
+--zoomSpeed = 39 / 40
 
-cycleL, cycleR :: Seq a -> Seq a
-cycleL (x :<| xs) = xs |> x
-cycleL xs = xs
-cycleR (xs :|> x) = x <| xs
-cycleR xs = xs
+--zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams
+--zoomInLongGun mousep sc = fromMaybe sc $ do
+--    curzoom <- sc ^? opticZoom
+--    guard $ curzoom < 8
+--    return $
+--        sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
+--            & opticZoom %~ (/ zoomSpeed)
+--
+--zoomOutLongGun :: ScrollAttachParams -> ScrollAttachParams
+--zoomOutLongGun sc = fromMaybe sc $ do
+--    curzoom <- sc ^? opticZoom
+--    guard $ curzoom > 0.5
+--    return $
+--        sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
+--            & opticZoom *~ zoomSpeed
+--
+--cycleSignum :: Float -> Seq a -> Seq a
+--cycleSignum x
+--    | x > 0 = cycleL
+--    | otherwise = cycleR
+--
+--cycleL, cycleR :: Seq a -> Seq a
+--cycleL (x :<| xs) = xs |> x
+--cycleL xs = xs
+--cycleR (xs :|> x) = x <| xs
+--cycleR xs = xs
+--
+canHeldScrollAttach :: Item -> ScrollAttachParams -> Bool
+canHeldScrollAttach _ _ = True

src/Dodge/HeldUse.hs

@@ -1,7 +1,5 @@
 module Dodge.HeldUse where
 
-import Dodge.Wall.Move
-import Dodge.Wall.ForceField
 import Color
 import Data.Maybe
 import Data.Traversable
@@ -18,6 +16,8 @@ import Dodge.Item.Weapon.TriggerType
 import Dodge.Projectile.Create
 import Dodge.SoundLogic
 import Dodge.Tesla.Arc
+import Dodge.Wall.ForceField
+import Dodge.Wall.Move
 import Dodge.WorldEvent.Flash
 import Geometry
 import qualified IntMapHelp as IM
@@ -52,8 +52,8 @@ useMod hm = case hm of
         ]
     FlameThrowerMod ->
         [ withSidePushAfterI 20
-         --, withTempLight 1 100 (V3 1 0 0)
-        , withSidePushI 5
+        , --, withTempLight 1 100 (V3 1 0 0)
+          withSidePushI 5
         , useAmmoAmount 1
         , ammoCheckI
         ]
@@ -81,9 +81,12 @@ useMod hm = case hm of
         ]
     LasWideMod n ->
         [ useAmmoAmount 1
-        , withItem $ \it -> duplicateNumBarrels (min 
-            (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
-            (it ^?! itParams . lasCycle `div` lasWideRate))
+        , withItem $ \it ->
+            duplicateNumBarrels
+                ( min
+                    (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
+                    (it ^?! itParams . lasCycle `div` lasWideRate)
+                )
         , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
         , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
         , withSoundForI tone440sawtoothquietS 2
@@ -114,13 +117,13 @@ useMod hm = case hm of
         ]
     ShatterMod ->
         [ useAmmoAmount 1
-         --        , withSoundStart tap3S
-        , useTimeCheck
+        , --        , withSoundStart tap3S
+          useTimeCheck
         , ammoCheckI
         , blCheck
         ]
     AmmoCheckMod -> [ammoCheckI]
-    AmmoUseCheckMod -> [useAmmoAmount 1,useTimeCheck, ammoCheckI]
+    AmmoUseCheckMod -> [useAmmoAmount 1, useTimeCheck, ammoCheckI]
     AmmoHammerTimeUseOneMod ->
         [ useAmmoAmount 1
         , useTimeCheck
@@ -128,7 +131,7 @@ useMod hm = case hm of
         , blCheck
         ]
     BangCaneMod ->
-        [ withMuzFlareI
+        [ withFlare
         , withSmoke 1 black 20 200 5
         , withRecoil
         , duplicateLoadedBarrels
@@ -141,7 +144,7 @@ useMod hm = case hm of
         ]
     VolleyGunMod ->
         [ withRecoil
-        , withMuzFlareI
+        , withFlare
         , duplicateLoadedBarrels
         , withTorqueAfter
         , useAllAmmo
@@ -152,7 +155,7 @@ useMod hm = case hm of
         ]
     AutoRifleMod ->
         -- note this is the same as BangCanemMod with the first changed
-        [ withMuzFlareI
+        [ withFlare
         , withSmoke 1 black 20 200 5
         , withRecoil
         , duplicateLoadedBarrels
@@ -164,7 +167,7 @@ useMod hm = case hm of
         ]
     BangRodMod ->
         [ withRecoil
-        , withMuzFlareI
+        , withFlare
         , withThickSmokeI
         , duplicateLoadedBarrels
         , withTorqueAfter
@@ -176,7 +179,7 @@ useMod hm = case hm of
         ]
     ElephantGunMod ->
         [ withRecoil
-        , withMuzFlareI
+        , withFlare
         , withThickSmokeI
         , duplicateLoadedBarrels
         , withTorqueAfter
@@ -188,7 +191,7 @@ useMod hm = case hm of
         ]
     AutoAmrMod ->
         [ withRecoil
-        , withMuzFlareI
+        , withFlare
         , withThickSmokeI
         , duplicateLoadedBarrels
         , withTorqueAfter
@@ -198,7 +201,7 @@ useMod hm = case hm of
         , ammoCheckI -- cf ElephantGun
         ]
     MachineGunMod ->
-        [ withMuzFlareI
+        [ withFlare
         , withThinSmokeI
         , withSoundStart bangEchoS
         , rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter
@@ -212,7 +215,7 @@ useMod hm = case hm of
         , withSoundItemChoiceStart bangStickSoundChoice
         , duplicateLoadedBarrels
         , withTorqueAfter
-        , withMuzFlareI
+        , withFlare
         , useTimeCheck
         , ammoCheckI
         , blCheck
@@ -220,7 +223,7 @@ useMod hm = case hm of
     PistolMod ->
         [ withSidePushI 50
         , withRecoil
-        , withMuzFlareI
+        , withFlare
         , withTorqueAfter
         , duplicateLoadedBarrels
         , withSoundStart tap3S
@@ -230,7 +233,7 @@ useMod hm = case hm of
         , blCheck
         ]
     AutoPistolMod ->
-        [ withMuzFlareI
+        [ withFlare
         , withSidePushI 50
         , withRecoil
         , withTorqueAfter
@@ -241,7 +244,7 @@ useMod hm = case hm of
         , ammoCheckI
         ]
     MachinePistolMod ->
-        [ withMuzFlareI
+        [ withFlare
         , withRecoil
         , withSidePushI 50
         , withTorqueAfter
@@ -253,7 +256,7 @@ useMod hm = case hm of
         ]
     BurstRifleMod ->
         [ withRecoil
-        , withMuzFlareI
+        , withFlare
         , duplicateLoadedBarrels
         , useAmmoAmount 1
         , withSoundStart tap3S
@@ -266,7 +269,7 @@ useMod hm = case hm of
         ]
     BurstRifleRepeatMod ->
         [ withRecoil
-        , withMuzFlareI
+        , withFlare
         , duplicateLoadedBarrels
         , useAmmoAmount 1
         , withSoundStart tap3S
@@ -274,23 +277,23 @@ useMod hm = case hm of
         , ammoCheckI
         ]
     MiniGunMod i ->
-         reverse  [ trigDoAlso' (moddelay x) (modcrpos x) useAmmoParams
-               | x <- map ((/ fromIntegral i) . fromIntegral) [1 .. i -1]
-               ]
-        <>
-        [ afterRecoil (fromIntegral i * 5)
+        [ duplicateNumBarrels 1
+        , repeatTransformed
+            [ (moddelay x, modcrpos x)
+            | x <- map ((/ (fromIntegral i - 1)) . fromIntegral) [0 .. i -1]
+            ]
+        , afterRecoil (fromIntegral i * 5)
         , torqueBefore (fromIntegral i * 0.05)
-        , withSidePushI (fromIntegral i * 50)
+        , withSidePushI (fromIntegral i * 25)
+        , withMuzFlare
+        , withSmoke 1 black 20 200 5
         , useAmmoAmount i
-        , withMuzFlareI
-        ,  withSmoke 1 black 20 200 5
-         --, withThinSmokeI
         , withSoundForI mini1S 2
         , withWarmUp crankSlowS
         , ammoCheckI
         ]
     SmgMod ->
-        [ withMuzFlareI
+        [ withFlare
         , withSidePushI 30
         , withRecoil
         , withTorqueAfter
@@ -303,26 +306,25 @@ useMod hm = case hm of
     RevolverXMod ->
         [ withRecoil
         , withTorqueAfter
-         --        , spreadLoaded
-        , withMuzFlareI
+        , withFlare
         , duplicateLoadedBarrels
         , useAmmoUpTo 1
         , withSoundStart tap3S
         , repeatOnFrames [2, 4, 6, 8, 10] RevolverXRepeatMod
-         , lockInvFor 10
-         -- rather than locking the inventory, a better solution may be to check
+        , lockInvFor 10
+        , -- rather than locking the inventory, a better solution may be to check
           -- that the weapon is still in your hands in the repeated frames
-        , useTimeCheck
+          useTimeCheck
         , ammoCheckI
         , blCheck
         ]
     RevolverXRepeatMod ->
         [ withRecoil
         , withTorqueAfter
-        , withMuzFlareI
+        , withFlare
         , duplicateLoadedBarrels
         , useAmmoUpTo 1
-        ,  withSoundStart tap3S
+        , withSoundStart tap3S
         , ammoCheckI
         ]
     BangConeMod ->
@@ -331,7 +333,7 @@ useMod hm = case hm of
         , withRandomOffset
         , duplicateLoadedBarrels
         , duplicateLoaded
-        , withMuzFlareI
+        , withMuzFlare
         , withRecoil
         , withTorqueAfter
         , useAllAmmo

src/Dodge/Inventory.hs

@@ -4,7 +4,7 @@ module Dodge.Inventory (
     rmSelectedInvItem,
     rmInvItem,
     updateCloseObjects,
-    closeObjScrollDir,
+    --closeObjScrollDir,
     changeSwapSel,
     scrollAugInvSel,
     crNumFreeSlots,
@@ -31,7 +31,7 @@ import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 import ListHelp
-import Padding
+--import Padding
 
 -- TODO check what happens to selection index when dropping non-selected items
 
@@ -134,11 +134,11 @@ updateCloseObjects w =
     updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
 
 
-closeObjScrollDir :: Float -> World -> World
-closeObjScrollDir x
-    | x > 0 = over (hud . closeObjects) rotU
-    | x < 0 = over (hud . closeObjects) rotD
-    | otherwise = id
+--closeObjScrollDir :: Float -> World -> World
+--closeObjScrollDir x
+--    | x > 0 = over (hud . closeObjects) rotU
+--    | x < 0 = over (hud . closeObjects) rotD
+--    | otherwise = id
 
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w

src/Dodge/Inventory/SelectionList.hs

@@ -9,6 +9,7 @@ import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Item.SlotsTaken
 import Dodge.Item.Display
+import Dodge.Item.InventoryColor
 import LensHelp
 import Picture.Base
 
@@ -26,7 +27,7 @@ invSelectionItem cr i it =
   where
     anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
     anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
-    col = _itInvColor it
+    col = itemInvColor it
     (yoff,pics) =  case _itCurseStatus it of
         UndroppableIdentified -> itemDisplayOffset cr it
         _ -> itemDisplayOffset cr it
@@ -64,5 +65,5 @@ closeObjectToSelectionItem e =
 --
 closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
 closeObjectToTextPictures e = case e of
-    Left flit -> let it = _flIt flit in (basicItemDisplay it, _itInvColor it)
+    Left flit -> let it = _flIt flit in (basicItemDisplay it, itemInvColor it)
     Right bt -> ([_btText bt], yellow)

src/Dodge/Item.hs

@@ -7,6 +7,7 @@ module Dodge.Item (
     itemFromBase,
 ) where
 
+import Dodge.Item.Ammo
 import Dodge.Data.Item
 import Dodge.Item.Consumable
 import Dodge.Item.Craftable
@@ -16,12 +17,20 @@ import Dodge.Item.Weapon
 
 itemFromBase :: ItemBaseType -> Item
 itemFromBase ibt = case ibt of
-    NoItemType -> undefined
     HELD ht -> itemFromHeldType ht
     LEFT lt -> itemFromLeftType lt
     EQUIP et -> itemFromEquipType et
-    Consumable et -> itemFromConsumableType et
+    CONSUMABLE et -> itemFromConsumableType et
     CRAFT cr -> makeTypeCraft cr
+    ATTACH at -> itemFromAttachType at
+
+itemFromAttachType :: AttachType -> Item
+itemFromAttachType at = case at of
+    SCROLLATTACH ZOOMSCOPE -> zoomScope
+    AMMOATTACH DRUMMAG -> drumMag
+    AMMOATTACH TINMAG -> tinMag
+    AMMOATTACH BULLETBELT -> beltMag
+
 
 itemFromConsumableType :: ConsumableItemType -> Item
 itemFromConsumableType ct = case ct of

src/Dodge/Item/Ammo.hs

@@ -0,0 +1,21 @@
+module Dodge.Item.Ammo where
+
+import Control.Lens
+import Dodge.Data.World
+import Dodge.Default.Item
+
+tinMag :: Item
+tinMag = defaultHeldItem & itType . iyBase .~ ATTACH (AMMOATTACH TINMAG)
+    & itUse .~ AttachUse AmmoAttachParams
+
+drumMag :: Item
+drumMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH DRUMMAG)
+
+beltMag :: Item
+beltMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH BULLETBELT)
+
+zoomScope :: Item
+zoomScope = tinMag
+    & itType . iyBase .~ ATTACH (SCROLLATTACH ZOOMSCOPE)
+    & itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams {_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
+    

src/Dodge/Item/Consumable.hs

@@ -9,7 +9,7 @@ medkit :: Int -> Item
 medkit i =
     defaultConsumable
         & itUse . cUse .~ CHeal i
-        & itType . iyBase .~ Consumable (MEDKIT i)
+        & itType . iyBase .~ CONSUMABLE (MEDKIT i)
 
 heal25 :: Int -> World -> Maybe World
 heal25 = heal 25

src/Dodge/Item/Craftable.hs

@@ -1,7 +1,6 @@
 module Dodge.Item.Craftable where
 
 import Dodge.Default.Item
-import Color
 import Control.Lens
 import Dodge.Data.Item
 
@@ -17,10 +16,7 @@ makeTypeCraft :: CraftType -> Item
 makeTypeCraft = makeTypeCraftNum 1
 
 energyBallCraft :: EnergyBallType -> Item
-energyBallCraft ebt = 
-    makeTypeCraft (ENERGYBALLCRAFT ebt)
-        & itInvSize .~ 1
-        & itInvColor .~ chartreuse
+energyBallCraft ebt = makeTypeCraft (ENERGYBALLCRAFT ebt) & itInvSize .~ 1
 
 incendiaryModule :: Item
 incendiaryModule = energyBallCraft IncBall
@@ -29,34 +25,21 @@ bulletBodyCraft :: BulletEffect -> Item
 bulletBodyCraft ebt = 
     makeTypeCraft (BULBODYCRAFT ebt)
         & itInvSize .~ 1
-        & itInvColor .~ chartreuse
 
 bounceModule :: Item
 bounceModule = bulletBodyCraft BounceBullet
 
 teleportModule :: Item
-teleportModule =
-    makeTypeCraft TELEPORTMODULE
-        & itInvSize .~ 1
-        & itInvColor .~ chartreuse
+teleportModule = makeTypeCraft TELEPORTMODULE & itInvSize .~ 1
 
 timeModule :: Item
-timeModule =
-    makeTypeCraft TIMEMODULE
-        & itInvSize .~ 1
-        & itInvColor .~ chartreuse
+timeModule = makeTypeCraft TIMEMODULE & itInvSize .~ 1
 
 sizeModule :: Item
-sizeModule =
-    makeTypeCraft SIZEMODULE
-        & itInvSize .~ 1
-        & itInvColor .~ chartreuse
+sizeModule = makeTypeCraft SIZEMODULE & itInvSize .~ 1
 
 gravityModule :: Item
-gravityModule =
-    makeTypeCraft GRAVITYMODULE
-        & itInvSize .~ 1
-        & itInvColor .~ chartreuse
+gravityModule = makeTypeCraft GRAVITYMODULE & itInvSize .~ 1
 
 pipe :: Item
 pipe = makeTypeCraft PIPE

src/Dodge/Item/Display.hs

@@ -2,7 +2,7 @@ module Dodge.Item.Display (
     --itemDisplay,
     itemDisplayOffset,
     canAttachTargetingBelow,
---    selectedItemDisplay,
+    --    selectedItemDisplay,
     itemString,
     itemBaseName,
     basicItemDisplay,
@@ -10,21 +10,24 @@ module Dodge.Item.Display (
 
 import Control.Applicative
 import Control.Monad
-import Dodge.Item.Info
 import Data.Maybe
 import Dodge.Data.Creature
+import Dodge.Item.Info
 import Dodge.Item.SlotsTaken
 import Dodge.Module
 import LensHelp
 import Padding
 
-itemDisplayOffset :: Creature -> Item -> (Int,[String])
+itemDisplayOffset :: Creature -> Item -> (Int, [String])
 itemDisplayOffset cr itm = case itm ^. itType . iyBase of
-    EQUIP (TARGETINGHAT tt) | targetItemCanAttachAbove cr itm 
-        -> (-1, leftPad 15 ' ' (targetingTypeString tt) : 
-            (itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^') )))
     EQUIP (TARGETINGHAT tt)
-        -> (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
+        | targetItemCanAttachAbove cr itm ->
+            ( -1
+            , leftPad 15 ' ' (targetingTypeString tt) :
+              (itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^')))
+            )
+    EQUIP (TARGETINGHAT tt) ->
+        (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
     _ -> (0, itemDisplay cr itm)
 
 targetItemCanAttachAbove :: Creature -> Item -> Bool
@@ -46,10 +49,9 @@ targetingTypeString tt = case tt of
     TargetRBCreature -> "LIFEFORM"
     TargetCursor -> "CURSOR"
 
-    
-
 itemDisplay :: Creature -> Item -> [String]
-itemDisplay cr itm = --itemDisplayWithNumber (showConsumption cr it) it
+itemDisplay cr itm =
+    --itemDisplayWithNumber (showConsumption cr it) it
     zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
 
 zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
@@ -57,18 +59,17 @@ zipWithDefaults f g h = go
   where
     go [] bs = map g bs
     go as [] = map f as
-    go (a:as) (b:bs) = h a b : go as bs
-
+    go (a : as) (b : bs) = h a b : go as bs
 
 itemDisplayPad :: [Char] -> String -> [Char]
 itemDisplayPad ls rs
     | rs == "" = ls
-    | otherwise = midPadL 15 ' ' ls (' ':rs)
+    | otherwise = midPadL 15 ' ' ls (' ' : rs)
 
 basicItemDisplay :: Item -> [String]
 basicItemDisplay itm =
     Prelude.take (itSlotsTaken itm) $
-        itemBaseName itm  :
+        itemBaseName itm :
         catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
             ++ moduleStrings itm
             ++ repeat "*"
@@ -78,14 +79,14 @@ itemString = head . basicItemDisplay
 
 itemBaseName :: Item -> String
 itemBaseName it = case _iyBase $ _itType it of
-    NoItemType -> show "NoItemType"
     CRAFT str -> show str
     HELD hit -> case hit ^? xNum of
         Just i -> takeWhile (/= ' ') (show hit) ++ show i
         Nothing -> show hit
     LEFT lit -> show lit
     EQUIP eit -> showEquipItem eit
-    Consumable cit -> show cit
+    CONSUMABLE cit -> show cit
+    ATTACH ait -> show ait
 
 showEquipItem :: EquipItemType -> String
 showEquipItem eit = case eit of
@@ -118,15 +119,18 @@ itemNumberDisplay cr itm = case iu of
     HeldUse{} -> [showReloadProgress cr itm]
     LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)]
     EquipUse{} -> showEquipmentNumber cr itm
-    _ -> [show $ iu ^?! useAmount . getItAmount]
+    CraftUse x -> [show $ x ^. getItAmount]
+    ConsumeUse {_useAmount = x} -> [show $ x ^. getItAmount]
+    AttachUse {} -> []
+    
   where
     iu = itm ^?! itUse
 
 showEquipmentNumber :: Creature -> Item -> [String]
 showEquipmentNumber cr itm = case _eeUse ee of
     EFuelSource x _ -> [show x]
-    EAmmoSource {} -> showAmmoSource cr itm
-    EBatterySource {_euseBatteryAmount = x} -> [show x]
+    EAmmoSource{} -> showAmmoSource cr itm
+    EBatterySource{_euseBatteryAmount = x} -> [show x]
     _ -> [""]
   where
     ee = itm ^?! itUse . equipEffect
@@ -137,18 +141,20 @@ showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
     atype <- eu ^? euseAmmoSourceType
     x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
     i <- itm ^? itLocation . ipInvID
-    (do 
-        at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
-        as <-  cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
-        guard (at' == atype && as == AboveSource)
-        return ["vvvv",x] ) <|> Just [x]
+    ( do
+            at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
+            as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
+            guard (at' == atype && as == AboveSource)
+            return ["vvvv", x]
+        )
+        <|> Just [x]
 
 showReloadProgress :: Creature -> Item -> String
 showReloadProgress cr itm = case ic ^? laSource of
     Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of
         Nothing -> maybe "" show $ ic ^? laSource . _InternalSource . iaLoaded
         Just la -> showLoadActionType la (_laSource ic)
-    Just AboveSource -> fromMaybe "||||" $ do
+    Just AboveSource -> fromMaybe "^^^^" $ do
         i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
         _ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
         return ""

src/Dodge/Item/Draw/SPic.hs

@@ -18,12 +18,12 @@ import ShapePicture
 itemSPic :: Item -> SPic
 itemSPic it =
     M.foldMapWithKey (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of
-        NoItemType -> over _1 (colorSH magenta) defSPic
         CRAFT _ -> defSPic
         HELD ht -> heldItemSPic ht it
         LEFT lt -> leftItemSPic lt it
         EQUIP et -> equipItemSPic et it
-        Consumable{} -> defSPic
+        CONSUMABLE{} -> defSPic
+        ATTACH {} -> defSPic
 
 equipItemSPic :: EquipItemType -> Item -> SPic
 equipItemSPic et _ = case et of
@@ -112,7 +112,6 @@ ammoPosition itm hit = case hit of
     SHATTERGUN -> NoAmmoPosition
     HELDDETECTOR _ -> NoAmmoPosition
     KEYCARD _ -> NoAmmoPosition
-    BINOCULARS -> NoAmmoPosition
   where
     lhs = Q.axisAngle (V3 1 0 0) pi
     rhs = Q.axisAngle (V3 1 0 0) 0
@@ -186,7 +185,6 @@ heldItemSPic ht it = case ht of
     SHATTERGUN -> shatterGunSPic
     HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
     KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic)
-    BINOCULARS -> mempty -- TODO
 
 torchShape :: Shape
 torchShape =

src/Dodge/Item/Equipment.hs

@@ -127,14 +127,10 @@ powerLegs =
         & itType . iyBase .~ EQUIP POWERLEGS
 
 speedLegs :: Item
-speedLegs =
-    powerLegs
-        & itType . iyBase .~ EQUIP SPEEDLEGS
+speedLegs = powerLegs & itType . iyBase .~ EQUIP SPEEDLEGS
 
 jumpLegs :: Item
-jumpLegs =
-    powerLegs
-        & itType . iyBase .~ EQUIP JUMPLEGS
+jumpLegs = powerLegs & itType . iyBase .~ EQUIP JUMPLEGS
 
 wristInvisibility :: Item
 wristInvisibility =

src/Dodge/Item/Held.hs

@@ -26,7 +26,6 @@ itemFromHeldType :: HeldItemType -> Item
 itemFromHeldType ht = case ht of
     KEYCARD i -> keyCard i
     TORCH -> torch
-    BINOCULARS -> binoculars
     SHATTERGUN -> shatterGun
     BANGSTICK i -> bangStick i
     PISTOL -> pistol

src/Dodge/Item/Held/Cane.hs

@@ -39,25 +39,14 @@ defaultBangCane =
 volleyGun :: Int -> Item
 volleyGun i =
     defaultBangCane
-        & itUse . heldDelay . rateMax .~ 6
         & itUse . heldMods .~ VolleyGunMod
         & itUse . heldAim . aimWeight .~ 6
         & itUse . heldAim . aimRange .~ 1
         & itUse . heldAim . aimStance .~ TwoHandFlat
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-        -- & itUse . heldAim . aimHandlePos .~ 5
         & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3]
         & itUse . heldConsumption . laSource . _InternalSource . iaMax .~ i
-        & itParams
-            .~ BulletShooter
-                { _muzVel = 0.8
-                , _rifling = 0.9
-                , _bore = 2
-                , _recoil = 50
-                , _torqueAfter = 0.1
-                , _randomOffset = 0
-                }
-        & itParams . torqueAfter .~ 0.48 + 0.2 * fromIntegral i
+        & itParams . torqueAfter .~ 0.15 + 0.05 * fromIntegral i
         & itType . iyBase .~ HELD (VOLLEYGUN i)
 
 rifle :: Item
@@ -66,7 +55,8 @@ rifle =
         & itUse . heldAim . aimStance .~ TwoHandUnder
         & itType . iyBase .~ HELD RIFLE
         & itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 1
-        & itUse . heldConsumption . laSource . _InternalSource . iaCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
+        & itUse . heldConsumption . laSource . _InternalSource . iaCycle 
+            .~ [loadEject 5, loadInsert 5, loadPrime 5]
         & itUse . heldAim . aimWeight .~ 6
         & itUse . heldAim . aimRange .~ 1
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
@@ -107,30 +97,20 @@ miniGunUse i =
         & heldAim . aimRange .~ 1
         & heldAim . aimStance .~ TwoHandUnder
         & heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-        -- & heldAim . aimHandlePos .~ 5
         & heldConsumption
             .~ (defaultBulletLoadable & laSource .~ AboveSource)
-                --(defaultBulletLoadable
-                --    & laSource . iaMax .~ 1500
-                --    & laSource . iaLoaded .~ 1500
-                --)
-        & heldConsumption . laSource . _InternalSource . iaCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
+--        & heldConsumption . laSource . _InternalSource . iaCycle
+--            .~ [loadEject 40, loadInsert 40, loadPrime 40]
 
 miniGunX :: Int -> Item
 miniGunX i =
     autoRifle
         & itUse .~ miniGunUse i
         & itUse . heldAim . aimTurnSpeed .~ 0.5
-        & itUse . heldAim . aimMuzzles .~ replicate i (Muzzle (V2 15 0) 0 0.05)
-        & itParams
-            .~ BulletShooter
-                { _muzVel = 1
-                , _rifling = 0.9
-                , _bore = 2
-                , _recoil = 10
-                , _torqueAfter = 0
-                , _randomOffset = 10
-                }
+        & itUse . heldAim . aimMuzzles .~ replicate i (Muzzle (V2 30 0) 0 0.05)
+        & itParams . recoil .~ 10
+        & itParams . torqueAfter .~ 0.01
+        & itParams . randomOffset .~ 10
         & itInvSize .~ fromIntegral i + 1
         & itDimension . dimRad .~ 20
         & itDimension . dimCenter .~ V3 5 0 0

src/Dodge/Item/Held/Launcher.hs

@@ -59,7 +59,7 @@ remoteLauncher =
     launcher
         & itType . iyBase .~ HELD REMOTELAUNCHER
         & itUse . heldUse .~ HeldFireRemoteShell --fireRemoteShell
-        & itScope .~ RemoteScope (V2 0 0) 1 True
+        & itScope .~ RemoteScope (V2 0 0) 1
         & itUse . heldConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
 
 basicAmPjMoves :: IM.IntMap TweakParam

src/Dodge/Item/Held/Rod.hs

@@ -49,7 +49,6 @@ elephantGun =
         & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0.05
         & itUse . heldMods .~ ElephantGunMod
         & itParams . recoil .~ 50
-        & itParams . torqueAfter .~ 0.1
 
 amr :: Item
 amr =
@@ -69,9 +68,8 @@ sniperRifle =
         & itType . iyBase .~ HELD SNIPERRIFLE
         & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5,_izFac = 1}
-        & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
-        & itScope .~ ZoomScope (V2 0 0) 1 0.5 False
-        & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
+--        & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
+--        & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
 --        & itUse . useTargeting ?~ TargetLaser
 
 machineGun :: Item

src/Dodge/Item/Held/Utility.hs

@@ -2,7 +2,6 @@ module Dodge.Item.Held.Utility where
 
 import Linear
 import Dodge.Default.Item
-import Color
 import Control.Lens
 import Dodge.Data.Item
 --import Geometry.Data
@@ -19,27 +18,10 @@ flatShield =
         & itType . iyBase .~ HELD FLATSHIELD
 
 keyCard :: Int -> Item
-keyCard n =
-    defaultHeldItem
-        & itInvColor .~ aquamarine
-        & itType . iyBase .~ HELD (KEYCARD n)
+keyCard n = defaultHeldItem & itType . iyBase .~ HELD (KEYCARD n)
 
 latchkey :: Int -> Item
-latchkey _ =
-    defaultHeldItem
-        & itInvColor .~ yellow
-
-binoculars :: Item
-binoculars =
-    defaultHeldItem
-        & itScope .~ ZoomScope (V2 0 0) 1 0.5 False
-        & itType . iyBase .~ HELD BINOCULARS
-        -- & itUse . heldAim . aimHandlePos .~ 5
---        & itUse . heldAim . aimMuzPos .~ 10
-        & itUse . heldAim . aimStance .~ TwoHandFlat
-        & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
-        & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5, _izFac = 1}
-
+latchkey _ = defaultHeldItem 
 
 torch :: Item
 torch =

src/Dodge/Item/HeldOffset.hs

@@ -1,4 +1,8 @@
-module Dodge.Item.HeldOffset where
+module Dodge.Item.HeldOffset (
+    turretItemOffset,
+    twoFlatHRot,
+    heldItemOffset,
+) where
 
 import Data.Maybe
 import Dodge.Creature.HandPos
@@ -66,4 +70,4 @@ strideRot cr = case cr ^? crStance . carriage of
     sLen = _strideLength $ _crStance cr
 
 twoFlatHRot :: Creature -> Float
-twoFlatHRot cr = 2 * strideRot cr
+twoFlatHRot = (2 *) . strideRot

src/Dodge/Item/Info.hs

@@ -23,7 +23,7 @@ itmBaseInfo itm = case itm ^. itType . iyBase of
     HELD hit -> heldInfo hit
     LEFT lit -> leftInfo lit
     EQUIP eit -> equipInfo eit
-    Consumable cit -> consumableInfo cit
+    CONSUMABLE cit -> consumableInfo cit
     CRAFT fit -> craftInfo fit
     _ -> "THIS SHOULD NOT BE DISPLAYED"
 
@@ -105,7 +105,6 @@ heldInfo hit = case hit of
     FORCEFIELDGUN -> "A device that produces a durable forcefield."
     HELDDETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."
     TORCH -> "A stick with a light on the end."
-    BINOCULARS -> "Two cylinders with lenses. Scroll to zoom."
     FLATSHIELD -> "A panel of metal that blocks unwanted objects from the front of the user."
     KEYCARD i -> "A keycard. It is labelled " ++ show i ++ "."
 
@@ -222,7 +221,7 @@ itmUsageInfo itm = case itm ^. itType . iyBase of
         "This item can be equipped" ++ itmEquipSiteInfo itm
             ++ ". When equipped, it can be activated."
     EQUIP _ -> "This item can be equipped " ++ itmEquipSiteInfo itm ++ "."
-    Consumable _ -> "This item can be consumed."
+    CONSUMABLE _ -> "This item can be consumed."
     CRAFT _ -> ""
     _ -> "THIS SHOULD NOT BE DISPLAYED"
 

src/Dodge/Item/InventoryColor.hs

@@ -0,0 +1,14 @@
+module Dodge.Item.InventoryColor where
+
+import Color
+import Dodge.Data.Item
+import Control.Lens
+
+itemInvColor :: Item -> Color
+itemInvColor itm = case itm ^. itType . iyBase of
+    HELD {} -> white
+    LEFT {} -> cyan
+    EQUIP {} -> yellow
+    CONSUMABLE {} -> blue
+    CRAFT {} -> green
+    ATTACH {} -> orange

src/Dodge/Item/Location.hs

@@ -2,9 +2,11 @@ module Dodge.Item.Location (
     pointerToItemLocation,
     getItem,
     pointerToItem,
+    pointerYourItem,
 ) where
 
 import Control.Lens
+import Data.Maybe
 import Dodge.Data.World
 
 getItem :: Int -> World -> Maybe Item
@@ -26,6 +28,11 @@ pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid .
 pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt
 pointerToItemLocation _ = const pure
 
+pointerYourItem :: Applicative a => (Item -> a Item) -> World -> a World
+pointerYourItem f w = fromMaybe (pure w) $ do
+    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
+    Just $ pointerToItemLocation (InInv 0 itinvid) f w
+
 pointerToItem ::
     Applicative f =>
     Item ->

src/Dodge/Item/Module.hs

@@ -70,7 +70,6 @@ heldBounds hit = case hit of
     FORCEFIELDGUN -> launchs
     HELDDETECTOR _ -> launchs
     TORCH -> launchs
-    BINOCULARS -> launchs
     FLATSHIELD -> launchs
     KEYCARD _ -> launchs
   where

src/Dodge/Item/Weapon/Remote.hs

@@ -1,29 +1,16 @@
 module Dodge.Item.Weapon.Remote (
     setRemoteScope,
-    setRemoteBombScope,
 ) where
 
 import Control.Lens
 import Dodge.Data.World
-import Dodge.Default
 import Geometry
 
-setRemoteBombScope :: Int -> Prop -> World -> World
-setRemoteBombScope itid pj w = case w ^?! cWorld . lWorld . itemLocations . ix itid of
-    InInv cid invid ->
-        w
-            & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itScope
-                . scopePos
-                .~ (_prPos pj -.- (w ^?! cWorld . lWorld . creatures . ix cid . crPos))
-            & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . heldAim . aimZoom
-                .~ (defaultItZoom{_izMax = 0.5, _izMin = 0.5})
-    _ -> w
-
 setRemoteScope :: Int -> Point2 -> World -> World
 setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of
     Just (InInv cid' invid) ->
         w
             & cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope
-                . scopePos
+                . remotePos
             .~ (pos -.- (w ^?! cWorld . lWorld . creatures . ix cid' . crPos))
     _ -> w

src/Dodge/Item/Weapon/TriggerType.hs

@@ -8,12 +8,12 @@ module Dodge.Item.Weapon.TriggerType (
     useAllAmmo,
     useAmmoUpTo,
     lockInvFor,
-    withMuzFlareI,
+    withFlare,
+    withMuzFlare,
     withCrPos,
     withCrPosShift,
     withOldDir,
     trigDoAlso,
-    trigDoAlso',
     withTempLight,
     withItem,
     withItemUpdate,
@@ -57,6 +57,7 @@ module Dodge.Item.Weapon.TriggerType (
     ammoCheckI,
     modClock,
     blCheck,
+    repeatTransformed,
 ) where
 
 import Dodge.Creature.HandPos
@@ -89,18 +90,25 @@ lockInvFor i f it cr =
     f it cr . (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
         . lockInv (_crID cr)
 
-trigDoAlso' ::
+repeatTransformed ::
+    [(Item -> Item,Creature -> Creature)] ->
+    ChainEffect
+repeatTransformed xs f itm cr w = foldr g w xs
+  where
+    g (fit,fcr) = f (fit itm) (fcr cr)
+
+trigDoAlso ::
     (Item -> Item) ->
     (Creature -> Creature) ->
     (Item -> Creature -> World -> World) ->
     ChainEffect
-trigDoAlso' fit fcr f g itm cr = g itm cr . f (fit itm) (fcr cr)
+trigDoAlso fit fcr f g itm cr = g itm cr . f (fit itm) (fcr cr)
 
 -- Note that this uses the "base" creature and item values
-trigDoAlso ::
-    (Item -> Creature -> World -> World) ->
-    ChainEffect
-trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr
+--trigDoAlso ::
+--    (Item -> Creature -> World -> World) ->
+--    ChainEffect
+--trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr
 
 withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect
 withSmoke num col rad t alt eff item cr w =
@@ -202,16 +210,16 @@ withWarmUp ::
 withWarmUp soundID f item cr w
     | curWarmUp < maxWarmUp && crWeaponReady cr =
         w
-            & pointerToItem . itUse . heldDelay . warmTime +~ 2
+            & pointertoitem . itUse . heldDelay . warmTime +~ 2
             & soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2)
     | otherwise =
         w
-            & pointerToItem . itUse . heldDelay . warmTime .~ maxWarmUp
+            & pointertoitem . itUse . heldDelay . warmTime .~ maxWarmUp
             & f item cr
   where
     cid = _crID cr
     itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-    pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
+    pointertoitem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
     curWarmUp = _warmTime . _heldDelay $ _itUse item
     maxWarmUp = _warmMax . _heldDelay $ _itUse item
 
@@ -352,7 +360,7 @@ useAmmoUpTo amAmount eff item cr =
 useAmmoAmount :: Int -> ChainEffect
 useAmmoAmount amAmount eff item cr =
     eff item cr
-        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ useAmmoAmount' itref amAmount) -- . _InternalSource . iaLoaded -~ amAmount)
+        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ useAmmoAmount' itref amAmount)
   where
     itref = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
 
@@ -362,6 +370,12 @@ useAmmoAmount' itref x inv = case inv ^? ix itref . itUse . heldConsumption . la
         inv & ix itref . itUse . heldConsumption . laSource . _InternalSource . iaLoaded -~ x
     Just AboveSource ->
         inv & ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
+    Just BelowSource ->
+        inv & ix (itref + 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
+    Just EitherSource -> case inv ^? ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount of
+        Just amamount | amamount > 0 -> 
+            inv & ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
+        _ -> inv & ix (itref + 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
     _ -> inv
 
 -- . crInv . ix itRef . itUse . heldConsumption . laSource
@@ -411,7 +425,7 @@ shootL ::
     World
 shootL f item cr w
     | fireCondition =
-        f item cr w & pointerToItem
+        f item cr w & cWorld . lWorld . creatures . ix cid . crInv . ix invid
             %~ ( itUseCharge 1
                     . (itUse . leftDelay . rateTime .~ _rateMax (_leftDelay (_itUse item)))
                )
@@ -420,7 +434,6 @@ shootL f item cr w
   where
     cid = _crID cr
     invid = _ipInvID $ _itLocation item
-    pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix invid
     fireCondition =
         _rateTime (_leftDelay (_itUse item)) == 0
             && _arLoaded (_leftConsumption (_itUse item)) > 0
@@ -453,8 +466,8 @@ modClock n chainEff eff it cr w
     | (w ^. cWorld . lWorld . lClock) `mod` n == 0 = chainEff eff it cr w
     | otherwise = eff it cr w
 
-withMuzFlareI :: ChainEffect
-withMuzFlareI f it cr =
+withFlare :: ChainEffect
+withFlare f it cr =
     makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (cpos `v2z` 20)
         -- . muzFlareAt (V4 5 5 0 2) (cpos `v2z` 20) cdir
         . muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
@@ -465,6 +478,19 @@ withMuzFlareI f it cr =
     cdir = _crDir cr
     cpos = _crPos cr
 
+withMuzFlare :: ChainEffect
+withMuzFlare f itm cr =
+    makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (cpos `v2z` 20)
+        -- . muzFlareAt (V4 5 5 0 2) (cpos `v2z` 20) cdir
+        . muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
+        . muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
+        . muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
+        . f itm cr
+  where
+    cdir = _crDir cr
+    cpos = _crPos cr + rotateV (_crDir cr) (_mzPos brl + aimingWeaponZeroPos cr itm)
+    brl = itm ^?! itUse . heldAim . aimMuzzles . ix 0
+
 --muzzleOffset :: Creature -> Item -> Point3
 --muzzleOffset cr it = V3 (holdOffset + 5 + _aimMuzPos dimPort - _aimHandlePos dimPort) 0 0
 --  where
@@ -554,10 +580,14 @@ torqueBefore torque feff item cr w
                 & randGen .~ g
                 & cWorld . lWorld . creatures . ix cid . crDir +~ rot
                 & wCam . camRot +~ rot
+                & rotateScope
     | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
   where
     cid = _crID cr
     (rot, g) = randomR (- torque, torque) $ _randGen w
+    rotateScope = fromMaybe id $ do
+        i <- yourScopeInvID w
+        return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
 
 {- | Rotates a creature with minimum rotation
  Rotates the player creature before applying the effect, other creatures after.
@@ -575,6 +605,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
                 & randGen .~ g
                 & cWorld . lWorld . creatures . ix cid . crDir +~ rot'
                 & wCam . camRot +~ rot'
+                & rotateScope
     | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w
   where
     cid = _crID cr
@@ -582,17 +613,31 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
     rot'
         | rot < 0 = rot - minTorque
         | otherwise = rot + minTorque
+    rotateScope = fromMaybe id $ do
+        i <- yourScopeInvID w
+        return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
 
 -- | Rotate a randomly creature after applying an effect.
 withTorqueAfter :: ChainEffect
 withTorqueAfter feff item cr w
-    --    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
-    | cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) $ feff item cr w
-    | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
+--    | cid == 0 = rotateScope . set randGen g $ over (wCam . camRot) (+ rot) $ feff item cr w
+--    | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
+    | cid == 0 = w
+        & feff item cr
+        & wCam . camRot +~ rot
+        & rotateScope
+        & randGen .~ g
+    | otherwise = w
+        & cWorld . lWorld . creatures . ix cid . crDir +~ rot
+        & randGen .~ g
   where
     cid = _crID cr
     (rot, g) = randomR (- torque, torque) $ _randGen w
     torque = fromMaybe 0 $ item ^? itParams . torqueAfter
+    rotateScope = fromMaybe id $ do
+        i <- yourScopeInvID w
+        return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
+--    rotateScope = pointerYourItem . itScope . scopePos %~ rotateV rot 
 
 sideEffectOnFrame ::
     Int ->
@@ -604,11 +649,14 @@ sideEffectOnFrame i sf f it cr w =
 
 torqueSideEffect :: Float -> Item -> Creature -> World -> World
 torqueSideEffect torque _ cr w
-    | cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) w
+    | cid == 0 = set randGen g . rotateScope $ over (wCam . camRot) (+ rot) w
     | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
   where
     cid = _crID cr
     (rot, g) = randomR (- torque, torque) $ _randGen w
+    rotateScope = fromMaybe id $ do
+        i <- yourScopeInvID w
+        return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
 
 -- pump the updated creature into the chain in later frames
 repeatOnFrames :: [Int] -> HeldMod -> ChainEffect

src/Dodge/Item/Weapon/Utility.hs

@@ -10,7 +10,6 @@ module Dodge.Item.Weapon.Utility
 import Control.Lens
 import Dodge.Data.Item
 import Dodge.Default
-import Picture
 
 stopWatch :: Item
 stopWatch =
@@ -20,7 +19,6 @@ stopWatch =
                     & leftUse .~ LTimePause
                     & equipEffect . eeSite .~ GoesOnWrist
                )
-        & itInvColor .~ cyan
         & itEffect . ieInv .~ ChargeIfEquipped
         & itEffect . ieOnDrop .~ SetCharge 0
         & itType . iyBase .~ LEFT STOPWATCH
@@ -53,8 +51,7 @@ shrinkGun =
 blinkGun :: Item
 blinkGun =
     defaultLeftItem
-        { _itInvColor = cyan
-        , _itUse =
+        { _itUse =
             defaultLeftUse
                 & leftUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
                 & equipEffect . eeSite .~ GoesOnWrist

src/Dodge/Module.hs

@@ -22,8 +22,7 @@ moduleStrings = M.elems . M.mapMaybe moduleName . _iyModules . _itType
 moduleName :: ItemModuleType -> Maybe String
 moduleName imt = case imt of
     EMPTYMODULE -> Nothing
-    DRUMMAG -> Just "+DRUM MAG"
-    BELTMAG -> Just "+BELT FEED"
+--    BELTMAG -> Just "+BELT FEED"
     MAGNETMAG -> Just "+MAGNET FEED"
     BULPAY thepayload -> Just $ "+" ++ displayBulletPayload thepayload
     BULBODY thebody -> Just $ "+" ++ displayBulletBody thebody

src/Dodge/Projectile/Update.hs

@@ -83,7 +83,7 @@ retireRemoteProj :: Int -> Int -> World -> World
 retireRemoteProj itid pjid w =
     w
         & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid)
-            %~ ( (itScope . scopePos .~ V2 0 0)
+            %~ ( (itScope . remotePos .~ V2 0 0)
                     . (itUse . heldUse .~ HeldFireRemoteShell)
                )
         & cWorld . lWorld . props %~ IM.delete pjid

src/Dodge/Render.hs

@@ -365,7 +365,9 @@ doDrawing' win pdata u = do
     -- draw the overlay
     --glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO)
     glDepthFunc GL_ALWAYS
+    --glDepthFunc GL_GEQUAL
     glDepthMask GL_FALSE
+    --glDepthMask GL_TRUE
     glEnable GL_BLEND
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     renderLayer DebugLayer shadV layerCounts

src/Dodge/Render/List.hs

@@ -50,6 +50,7 @@ makeSelectionListPictures :: SelectionList a -> [Picture]
 makeSelectionListPictures = concatMap f . getShownItems
   where
     f si = map (color (_siColor si) . text) $ _siPictures si
+    --f si = map ((flip inverseText) ((_siColor si))) $ _siPictures si
 
 drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
 drawCursorAt mi lis ldps = fromMaybe mempty $ do
@@ -159,6 +160,16 @@ drawListElement ygap s xint yint =
 renderListAt :: Float -> Float -> [(String, Color)] -> Picture
 renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
 
+--inverseText :: String -> Color -> Picture
+--inverseText str col = 
+--    translate3 (V3 0 0 (0.5))
+--    (color (V4 0 1 0 0.1) ( text str))
+--    <>
+--    translate3 (V3 0 0 (0.4))
+--    (color col (polygon [0,V2 l 0, V2 l 200, V2 0 200]))
+--  where
+--    l = 100 * fromIntegral (length str)
+
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
 drawList :: [Picture] -> Picture

src/Dodge/Update/Camera.hs

@@ -6,6 +6,7 @@ module Dodge.Update.Camera (
 ) where
 
 import Bound
+import Control.Applicative
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -57,9 +58,7 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
             & camViewFrom +~ thetran
 
 translateFloatingCameraKeys :: Input -> Camera -> Camera
-translateFloatingCameraKeys theinput =
-    (camCenter -~ thetran)
-        . (camViewFrom -~ thetran)
+translateFloatingCameraKeys theinput = (camCenter -~ thetran) . (camViewFrom -~ thetran)
   where
     thetran = 10 *.* wasdDir theinput
 
@@ -87,33 +86,31 @@ moveZoomCamera cfig theinput cr campos =
         & camDefaultZoom .~ newDefaultZoom
         & camItemZoom .~ newItemZoom
   where
-    cpos = _crPos cr
-    mitm = do
-        i <- cr ^? crManipulation . manObject . inInventory . ispItem
-        cr ^? crInv . ix i
-    newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
+    newvf = _crPos cr +.+ fromMaybe (V2 0 0) vfoffset
     vfoffset = do
-        iscam <- mitm ^? _Just . itScope . scopeIsCamera
-        guard iscam
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
-        mitm ^? _Just . itScope . scopePos
+        i <- cr ^? crManipulation . manObject . inInventory . ispItem
+        (cr ^? crInv . ix i . itScope . remotePos)
     mscopeoffset = do
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
-        mitm ^? _Just . itScope . scopePos
-    newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
+        i <- cr ^? crManipulation . manObject . inInventory . ispItem
+        (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticPos)
+            <|> (cr ^? crInv . ix i . itScope . remotePos)
+    newcen = _crPos cr +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
     offset =
         rotateV (campos ^. camRot) $
             ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
-    newzoom = case mitm ^? _Just . itScope of
-        Just zs@ZoomScope{} -> _scopeZoom zs
-        _ -> newDefaultZoom * newItemZoom
+    newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do  
+        i <- cr ^? crManipulation . manObject . inInventory . ispItem
+        (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticZoom)
     idealDefaultZoom = clipZoom wallZoom
-    newDefaultZoom = case mitm ^? _Just . itScope of
-        Just zs@ZoomScope{} -> _scopeZoom zs
-        _ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom
+    newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
+        i <- cr ^? crManipulation . manObject . inInventory . ispItem
+        (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticZoom)
     idealItemZoom = fromMaybe 1 $ do
         guard $ crIsAiming cr
-        zoomFromItem <$> (mitm ^? _Just . itUse . heldAim . aimZoom)
+        i <- cr ^? crManipulation . manObject . inInventory . ispItem
+        zoomFromItem <$> (cr ^? crInv . ix i . itUse . heldAim . aimZoom)
     newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
     changeZoom curZoom idealZoom
         | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
@@ -129,9 +126,11 @@ moveZoomCamera cfig theinput cr campos =
     zoomInSpeed = 25
     zoomOutSpeed = 15
 
+-- note that your _crInvLock does not apply to this TODO check that this is what
+-- is wanted
 updateScopeZoom :: World -> World
 updateScopeZoom w = fromMaybe w $ do
-    i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
+    i <- yourScopeInvID w
     return $ updateScopeZoom' i w
 
 updateScopeZoom' :: Int -> World -> World
@@ -140,12 +139,12 @@ updateScopeZoom' i w
         w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
     | otherwise = w & wppointer %~ resetscope
   where
-    wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
-    resetscope (ZoomScope _ _ defz bl) = ZoomScope (V2 0 0) defz defz bl
+    wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . attachParams . scrollAttachParams
+    resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
     resetscope otherAtt = otherAtt
     mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
 
-doScopeZoom :: Int -> Point2 -> Scope -> Scope
+doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
 doScopeZoom scrollamount mp sc = case scrollamount of
     x
         | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
@@ -159,21 +158,21 @@ doScopeZoom scrollamount mp sc = case scrollamount of
 zoomSpeed :: Float
 zoomSpeed = 39 / 40
 
-zoomInLongGun :: Point2 -> Scope -> Scope
+zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams
 zoomInLongGun mousep sc = fromMaybe sc $ do
-    curzoom <- sc ^? scopeZoom
+    curzoom <- sc ^? opticZoom
     guard $ curzoom < 8
     return $
-        sc & scopePos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
-            & scopeZoom %~ (/ zoomSpeed)
+        sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
+            & opticZoom %~ (/ zoomSpeed)
 
-zoomOutLongGun :: Scope -> Scope
+zoomOutLongGun :: ScrollAttachParams -> ScrollAttachParams
 zoomOutLongGun sc = fromMaybe sc $ do
-    curzoom <- sc ^? scopeZoom
+    curzoom <- sc ^? opticZoom
     guard $ curzoom > 0.5
     return $
-        sc & scopePos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
-            & scopeZoom *~ zoomSpeed
+        sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
+            & opticZoom *~ zoomSpeed
 
 ifConfigWallRotate :: Configuration -> World -> World
 ifConfigWallRotate cfig w
@@ -212,9 +211,11 @@ rotateCameraBy x w =
     rotateanyscope = fromMaybe id $ do
         i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
         return $
-            lWorld . creatures . ix 0 . crInv . ix i
-                . itScope
-                . scopePos
+            lWorld . creatures . ix 0 . crInv . ix (i - 1)
+                . itUse
+                . attachParams
+                . scrollAttachParams
+                . opticPos
                 %~ rotateV x
 
 rotateCamera :: Configuration -> World -> World

src/Dodge/Update/Scroll.hs

@@ -26,10 +26,10 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
         -- functions that modify the inventory should be centralised so that
         -- this lock can be sensibly applied, perhaps
         | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
-        | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
-            (_, EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
-            (Nothing, _) -> closeObjScrollDir y w
-            (Just f, _) -> doHeldScroll f y (you w) w
+        | rbDown -> case  (yourScrollAttachment w, _rbOptions w) of
+            (_,EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
+            (Nothing, _) -> w
+            (Just (invid,hs), _) -> doHeldScroll invid hs y w
         | lbDown -> w & wCam . camZoom +~ y
         | invKeyDown -> changeSwapSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w