Cleanup scope zooming

src/Dodge/Data/Item/Combine.hs

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

src/Dodge/Item/Draw/SPic.hs

@@ -115,6 +115,7 @@ heldItemSPic ht it = case ht of
     SHATTERGUN -> shatterGunSPic
     HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPoly 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,6 +26,7 @@ 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,10 @@ sniperRifle =
     elephantGun
         & itType . iyBase .~ HELD SNIPERRIFLE
         & itParams . gunBarrels .~ SingleBarrel 0
-        & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5}
+        & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5,_izFac = 1}
         & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
         & itScope .~ ZoomScope (V2 0 0) 0 1 0.5 False
         & itUse . useTargeting ?~ TargetLaser
-        & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1}
 
 machineGun :: Item
 machineGun =

src/Dodge/Item/Held/Utility.hs

@@ -4,6 +4,7 @@ import Dodge.Default.Item
 import Color
 import Control.Lens
 import Dodge.Data.Item
+import Geometry.Data
 
 flatShield :: Item
 flatShield =
@@ -32,6 +33,18 @@ latchkey _ =
     defaultHeldItem
         & itInvColor .~ yellow
 
+binoculars :: Item
+binoculars =
+    defaultHeldItem
+        & itScope .~ ZoomScope (V2 0 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}
+
+
 torch :: Item
 torch =
     defaultHeldItem

src/Dodge/Item/Info.hs

@@ -80,6 +80,7 @@ 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/Render/ShapePicture.hs

@@ -396,7 +396,8 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
 
 drawMousePosition :: Configuration -> World -> Picture
 drawMousePosition cfig w =
-    setLayer FixedCoordLayer . winScale cfig
+    setLayer FixedCoordLayer 
+        . winScale cfig
         . uncurryV translate p
         . scale 0.1 0.1
         . text
@@ -496,32 +497,3 @@ viewClipBounds cfig w
                 <> g x ys
         | otherwise = g x ys
     g _ [] = mempty
-
---wallFloorsToDraw :: World -> [Wall]
---wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
---  where
---    onScreen wall = uncurry (lineOnScreen w) $ _wlLine wall
---    isVisible wl
---        | wl ^? wlUnshadowed == Just False = False
---        | otherwise = onScreen wl
---
---lineOnScreen :: World -> Point2 -> Point2 -> Bool
---lineOnScreen w p1 p2 = pointInPolygon p1 sp
---    || pointInPolygon p2 sp
---    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
---  where
---    sp = screenPolygon w
---    sps = zip sp (tail sp ++ [head sp])
---
---drawWallFloor :: Wall -> Picture
---drawWallFloor wl = if _wlOpacity wl == SeeThrough
---    then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
---    else blank
---  where
---    (x,y) = _wlLine wl
---    c = _wlColor wl
---    n2 = 15 *.* (vNormal . errorNormalizeVDR $ y -.- x)
---
---errorNormalizeVDR :: Point2 -> Point2
---errorNormalizeVDR (V2 0 0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
---errorNormalizeVDR p = normalizeV p

src/Dodge/Update/Camera.hs

@@ -54,7 +54,8 @@ moveZoomCamera cfig theinput cr campos =
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
         mitm ^? _Just . itScope . scopePos
     newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
-    offset = rotateV (campos ^. camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
+    offset = rotateV (campos ^. camRot) 
+        $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
     newzoom = case mitm ^? _Just . itScope of
         Just zs@ZoomScope{} -> _scopeZoom zs
         _ -> newDefaultZoom * newItemZoom
@@ -83,65 +84,56 @@ moveZoomCamera cfig theinput cr campos =
 
 updateScopeZoom :: World -> World
 updateScopeZoom w
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) = over wppointer (doScopeZoom mp) w
-        case w
-            ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0))
-                . itScope
-                . scopeZoomChange of
-            Just x
-                | x > 10 -> zoomInLongGun $ zoomInLongGun $ zoomInLongGun w
-                | x > 5 -> zoomInLongGun $ zoomInLongGun w
-                | x > 0 -> zoomInLongGun w
-                | x < -10 -> zoomOutLongGun $ zoomOutLongGun $ zoomOutLongGun w
-                | x < -5 -> zoomOutLongGun $ zoomOutLongGun w
-                | x < 0 -> zoomOutLongGun w
-                | otherwise -> w
-            _ -> w
     | otherwise =
         w
             & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0))
                 . itScope
             %~ updateScope
   where
+    wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope
     updateScope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
     updateScope otherAtt = otherAtt
+    mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
+
+doScopeZoom :: Point2 -> Scope -> Scope
+doScopeZoom mp sc = case sc ^? scopeZoomChange of
+    Just 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
+    _ -> sc
 
 zoomSpeed :: Float
 zoomSpeed = 39 / 40
 
-zoomInLongGun :: World -> World
+zoomInLongGun :: Point2 -> Scope -> Scope
-zoomInLongGun w
+zoomInLongGun mousep sc
     | currentZoom < 8 =
-        w
+        sc
-            & wpPointer . itScope . scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
+            & scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
-            & wpPointer . itScope . scopeZoom %~ (/ zoomSpeed)
+            & scopeZoom %~ (/ zoomSpeed)
             & decreaseScopeZoomChange
-    | otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
+    | otherwise = sc & scopeZoomChange .~ 0
   where
-    decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
+    decreaseScopeZoomChange = scopeZoomChange -~ 1
-    wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0))
+    Just currentZoom = sc ^? scopeZoom
-    wp = ycr ^?! crInv . ix (crSel ycr)
+    newzoom = (sc ^?! scopeZoom) / zoomSpeed
-    ycr = you w
-    Just currentZoom = wp ^? itScope . scopeZoom
-    newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
-    mousep = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
 
-zoomOutLongGun :: World -> World
+zoomOutLongGun :: Scope -> Scope
-zoomOutLongGun w
+zoomOutLongGun sc
     | currentZoom > 0.5 =
-        w
+        sc
-            --        & wpPointer . itScope . scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
+            --        & scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
-            & wpPointer . itScope . scopeZoom *~ zoomSpeed
+            & scopeZoom *~ zoomSpeed
-            & increaseScopeZoomChange
+            & scopeZoomChange +~ 1
-    --    | otherwise = increaseScopeZoomChange w
+    | otherwise = sc & scopeZoomChange .~ 0
-    | otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
   where
-    --mousep = rotateV (_cameraRot w) $ _mousePos w
+    Just currentZoom = sc ^? scopeZoom
-    increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1
-    wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0))
-    wp = ycr ^?! crInv . ix (crSel ycr)
-    ycr = you w
-    Just currentZoom = wp ^? itScope . scopeZoom
 
 ifConfigWallRotate :: Configuration -> World -> World
 ifConfigWallRotate cfig w