Broken commit

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/Data/Item/Combine.hs

@@ -87,7 +87,6 @@ data ItemBaseType
     = HELD {_ibtHeld :: HeldItemType}
     | LEFT {_ibtLeft :: LeftItemType}
     | EQUIP {_ibtEquip :: EquipItemType}
-    | AMMO {_ibtAmmo :: AmmoItemType}
     | CONSUMABLE {_ibtConsumable :: ConsumableItemType}
     | CRAFT CraftType
     | ATTACH AttachType
@@ -96,11 +95,21 @@ data ItemBaseType
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data AttachType
-    = ZOOMSCOPE
-    | TINMAG
-    | DRUMMAG
+    = 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
@@ -191,12 +200,6 @@ data HeldItemType
     | KEYCARD Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data AmmoItemType
-    = TINMAGAZINE
-    | DRUMMAGAZINE
-    | BULLETBELT
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
 data ItemModuleType
     = EMPTYMODULE
     | MAGNETMAG
@@ -240,12 +243,13 @@ 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
 deriveJSON defaultOptions ''HeldItemType
-deriveJSON defaultOptions ''AmmoItemType
 deriveJSON defaultOptions ''ItemModuleType
 deriveJSON defaultOptions ''ModuleSlot
 deriveJSON defaultOptions ''ItemBaseType

src/Dodge/Data/Item/Use.hs

@@ -63,7 +63,9 @@ data AttachParams
 data ScrollAttachParams
     = ZoomScrollParams
         { -- | a camera offset
-          _opticPos :: Point2
+          _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
 --        , _scopeZoomChange :: Int
         , _opticZoom :: Float
         , _opticDefaultZoom :: Float

src/Dodge/Debug/Terminal.hs

@@ -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/HeldScroll.hs

@@ -3,14 +3,61 @@ module Dodge.HeldScroll (
     canHeldScrollAttach,
 ) where
 
-import Control.Lens hiding ((<|), (|>))
+import LensHelp hiding ((<|), (|>))
+import Data.Maybe
+import Control.Monad
+import Geometry
+--import Control.Lens hiding ((<|), (|>))
 import Data.Sequence
 import Dodge.Data.World
+import SDL (MouseButton (..))
+import qualified Data.Map.Strict as M
 
 doHeldScroll :: Int -> ScrollAttachParams -> Float -> World -> World
 doHeldScroll invid hs x w  = case hs of
-    ZoomScrollParams{}-> w
+    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
+
+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
+
+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

src/Dodge/Item.hs

@@ -20,22 +20,17 @@ itemFromBase ibt = case ibt of
     HELD ht -> itemFromHeldType ht
     LEFT lt -> itemFromLeftType lt
     EQUIP et -> itemFromEquipType et
-    AMMO at -> itemFromAmmoType at
     CONSUMABLE et -> itemFromConsumableType et
     CRAFT cr -> makeTypeCraft cr
     ATTACH at -> itemFromAttachType at
 
 itemFromAttachType :: AttachType -> Item
 itemFromAttachType at = case at of
-    ZOOMSCOPE -> zoomScope
-    DRUMMAG -> drumMag
-    TINMAG -> tinMag
+    SCROLLATTACH ZOOMSCOPE -> zoomScope
+    AMMOATTACH DRUMMAG -> drumMag
+    AMMOATTACH TINMAG -> tinMag
+    AMMOATTACH BULLETBELT -> beltMag
 
-itemFromAmmoType :: AmmoItemType -> Item
-itemFromAmmoType at = case at of
-    TINMAGAZINE -> tinMag
-    DRUMMAGAZINE -> drumMag
-    BULLETBELT -> beltMag
 
 itemFromConsumableType :: ConsumableItemType -> Item
 itemFromConsumableType ct = case ct of

src/Dodge/Item/Ammo.hs

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

src/Dodge/Item/Display.hs

@@ -85,7 +85,6 @@ itemBaseName it = case _iyBase $ _itType it of
         Nothing -> show hit
     LEFT lit -> show lit
     EQUIP eit -> showEquipItem eit
-    AMMO ait -> show ait
     CONSUMABLE cit -> show cit
     ATTACH ait -> show ait
 

src/Dodge/Item/Draw/SPic.hs

@@ -22,7 +22,6 @@ itemSPic it =
         HELD ht -> heldItemSPic ht it
         LEFT lt -> leftItemSPic lt it
         EQUIP et -> equipItemSPic et it
-        AMMO {} -> defSPic
         CONSUMABLE{} -> defSPic
         ATTACH {} -> defSPic
 

src/Dodge/Item/Held/Rod.hs

@@ -74,7 +74,7 @@ sniperRifle =
 --            , _scopeZoom =  1
 --            , _scopeDefaultZoom = 0.5 
 --            }
-        & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
+--        & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
 --        & itUse . useTargeting ?~ TargetLaser
 
 machineGun :: Item

src/Dodge/Item/InventoryColor.hs

@@ -9,7 +9,6 @@ itemInvColor itm = case itm ^. itType . iyBase of
     HELD {} -> white
     LEFT {} -> cyan
     EQUIP {} -> yellow
-    AMMO {} -> orange
     CONSUMABLE {} -> blue
     CRAFT {} -> green
-    ATTACH {} -> chartreuse
+    ATTACH {} -> orange

src/Dodge/Item/Weapon/Remote.hs

@@ -7,7 +7,6 @@ import Dodge.Data.World
 import Dodge.Default
 import Geometry
 
-
 setRemoteScope :: Int -> Point2 -> World -> World
 setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of
     Just (InInv cid' invid) ->

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
@@ -75,7 +76,7 @@ updateInGameCamera cfig w =
         & updateBounds cfig
         & over wCam (setViewDistance cfig)
         & wCam %~ moveZoomCamera cfig (w ^. input) (you w)
-        & updateScopeZoom
+--        & updateScopeZoom
         & rotateCamera cfig
 
 moveZoomCamera :: Configuration -> Input -> Creature -> Camera -> Camera
@@ -97,14 +98,19 @@ moveZoomCamera cfig theinput cr campos =
         mitm ^? _Just . itScope . remotePos
     mscopeoffset = do
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
-        mitm ^? _Just . itScope . remotePos
+        i <- cr ^? crManipulation . manObject . inInventory . ispItem
+        (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticPos)
+            <|> (mitm ^? _Just . itScope . remotePos)
     newcen = cpos +.+ 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)
+--        case mitm ^? _Just . itScope of
+----        Just zs@ZoomScope{} -> _scopeZoom zs
+--        _ -> newDefaultZoom * newItemZoom
     idealDefaultZoom = clipZoom wallZoom
     newDefaultZoom = case mitm ^? _Just . itScope of
 --        Just zs@ZoomScope{} -> _scopeZoom zs