Fix aiming with scope

src/Dodge/Base/You.hs

@@ -1,5 +1,6 @@
 module Dodge.Base.You where
 
+import TreeHelp
 import Dodge.Data.World
 import Dodge.HeldScroll
 import qualified IntMapHelp as IM
@@ -25,8 +26,17 @@ yourScrollAttachment w = do
     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/Creature/YourControl.hs

@@ -133,13 +133,13 @@ wasdWithAiming w speed cr
     dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
     movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
     isAiming = _posture (_crStance cr) == Aiming
-    mouseDir = fromMaybe
+    mouseDir = argV $ mouseWorldPos (w ^. input) (w ^. wCam) - (cr ^. crPos)
-        (argV (_mousePos (_input w)) + (w ^. wCam . camRot))
+--    mouseDir = fromMaybe
-        $ do
+--        (argV (_mousePos (_input w)) + (w ^. wCam . camRot))
-            itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
+--        $ do
---            _ <- cr ^? crInv . ix itRef . itScope . scopePos
+--            itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
-            _ <- cr ^? crInv . ix itRef . itScope . remotePos
+--            _ <- cr ^? crInv . ix itRef . itScope . remotePos
-            return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr
+--            return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr
 
 aimTurn :: Float -> Creature -> Creature
 aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr

src/Dodge/Data/Item/Combine.hs

@@ -195,7 +195,6 @@ data HeldItemType
     | FORCEFIELDGUN
     | HELDDETECTOR Detector
     | TORCH
-    | BINOCULARS
     | FLATSHIELD
     | KEYCARD Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/Item/Scope.hs

@@ -17,13 +17,6 @@ data Scope
           _remotePos :: Point2
         , _remoteZoom :: Float
         }
---    | ZoomScope
---        { -- | a camera offset
---          _scopePos :: Point2
-----        , _scopeZoomChange :: Int
---        , _scopeZoom :: Float
---        , _scopeDefaultZoom :: Float
---        }
     deriving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''Scope

src/Dodge/Data/Item/Use.hs

@@ -66,7 +66,6 @@ data ScrollAttachParams
           _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/HeldScroll.hs

@@ -3,72 +3,74 @@ module Dodge.HeldScroll (
     canHeldScrollAttach,
 ) where
 
-import LensHelp hiding ((<|), (|>))
+--import LensHelp hiding ((<|), (|>))
-import Data.Maybe
+--import Data.Maybe
-import Control.Monad
+--import Control.Monad
-import Geometry
+--import Geometry
 --import Control.Lens hiding ((<|), (|>))
-import Data.Sequence
+--import Data.Sequence
 import Dodge.Data.World
-import SDL (MouseButton (..))
+--import SDL (MouseButton (..))
-import qualified Data.Map.Strict as M
+--import qualified Data.Map.Strict as M
 
+-- note that scope zooming is controlled by updateScopeZoom
 doHeldScroll :: Int -> ScrollAttachParams -> Float -> World -> World
-doHeldScroll invid hs x w  = case hs of
+doHeldScroll _ _ _ = id
-    ZoomScrollParams{}
+--doHeldScroll invid hs x w  =  case hs of
-        | SDL.ButtonRight `M.member` _mouseButtons (_input w) -> w &
+--    ZoomScrollParams{}
-            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
+--        | SDL.ButtonRight `M.member` _mouseButtons (_input w) -> w &
-                . itUse . attachParams . scrollAttachParams %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
+--            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
-    ZoomScrollParams{} -> w &
+--                . itUse . attachParams . scrollAttachParams %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
-            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
+--    ZoomScrollParams{} -> w &
-                . itUse . attachParams . scrollAttachParams %~ resetscope
+--            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
 
-    CharScrollParams{} -> w & cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itUse . attachParams . scrollAttachParams . scrollChar %~ cycleSignum x
+--doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
-  where
+--doScopeZoom scrollamount mp sc = case scrollamount of
-    mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
+--    x
-    resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
+--        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
-    resetscope otherAtt = otherAtt
+--        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
-
+--        | x > 0 -> zoomInLongGun mp sc
-doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
+--        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
-doScopeZoom scrollamount mp sc = case scrollamount of
+--        | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
-    x
+--        | x < 0 -> zoomOutLongGun sc
-        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
+--        | otherwise -> sc
-        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
+--
-        | x > 0 -> zoomInLongGun mp sc
+--zoomSpeed :: Float
-        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
+--zoomSpeed = 39 / 40
-        | 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
-    | 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
 
+--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/Item/Draw/SPic.hs

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

@@ -69,11 +69,6 @@ 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 
---            { _scopePos = (V2 0 0)
---            , _scopeZoom =  1
---            , _scopeDefaultZoom = 0.5 
---            }
 --        & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
 --        & itUse . useTargeting ?~ TargetLaser
 

src/Dodge/Item/Held/Utility.hs

@@ -23,22 +23,6 @@ keyCard n = defaultHeldItem & itType . iyBase .~ HELD (KEYCARD n)
 latchkey :: Int -> Item
 latchkey _ = defaultHeldItem 
 
-binoculars :: Item
-binoculars =
-    defaultHeldItem
---        & itScope .~ ZoomScope 
---            { _scopePos = (V2 0 0) 
---            , _scopeZoom = 1 
---            , _scopeDefaultZoom = 0.5 
---            }
-        & 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}
-
-
 torch :: Item
 torch =
     defaultHeldItem

src/Dodge/Item/Info.hs

@@ -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 ++ "."
 

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/Update/Camera.hs

@@ -5,7 +5,6 @@ module Dodge.Update.Camera (
     updateCamera,
 ) where
 
-import Dodge.HeldScroll
 import Bound
 import Control.Applicative
 import Control.Monad
@@ -127,12 +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
-    itm <- _crInv (you w) IM.!? i
-    atparams <- you w ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
-    guard (canHeldScrollAttach itm atparams)
     return $ updateScopeZoom' i w
 
 updateScopeZoom' :: Int -> World -> World
@@ -141,7 +139,7 @@ updateScopeZoom' i w
         w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
     | otherwise = w & wppointer %~ resetscope
   where
-    wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
+    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)

src/Dodge/Update/Scroll.hs

@@ -26,13 +26,9 @@ 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 -- closeObjScrollDir y w
+            (Nothing, _) -> w
             (Just (invid,hs), _) -> doHeldScroll invid hs y w
         | lbDown -> w & wCam . camZoom +~ y
         | invKeyDown -> changeSwapSel yi w