Cleanup scope zooming

2023-01-07 10:43:53 +00:00
parent 87ea7da1d4
commit 6b259fa200
8 changed files with 54 additions and 74 deletions
@@ -177,6 +177,7 @@ data HeldItemType
    | FORCEFIELDGUN
    | HELDDETECTOR Detector
    | TORCH
+    | BINOCULARS
    | FLATSHIELD
    | KEYCARD Int
    deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -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 =
@@ -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
@@ -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 =
@@ -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
@@ -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++ "."

@@ -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
@@ -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) =
-        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
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) = over wppointer (doScopeZoom mp) 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 w
+zoomInLongGun :: Point2 -> Scope -> Scope
+zoomInLongGun mousep sc
    | currentZoom < 8 =
-        w
-            & wpPointer . itScope . scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
-            & wpPointer . itScope . scopeZoom %~ (/ zoomSpeed)
+        sc
+            & scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
+            & scopeZoom %~ (/ zoomSpeed)
            & decreaseScopeZoomChange
-    | otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
+    | otherwise = sc & scopeZoomChange .~ 0
  where
-    decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
-    wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0))
-    wp = ycr ^?! crInv . ix (crSel ycr)
-    ycr = you w
-    Just currentZoom = wp ^? itScope . scopeZoom
-    newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
-    mousep = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
+    decreaseScopeZoomChange = scopeZoomChange -~ 1
+    Just currentZoom = sc ^? scopeZoom
+    newzoom = (sc ^?! scopeZoom) / zoomSpeed

-zoomOutLongGun :: World -> World
-zoomOutLongGun w
+zoomOutLongGun :: Scope -> Scope
+zoomOutLongGun sc
    | currentZoom > 0.5 =
-        w
-            --        & wpPointer . itScope . scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
-            & wpPointer . itScope . scopeZoom *~ zoomSpeed
-            & increaseScopeZoomChange
-    --    | otherwise = increaseScopeZoomChange w
-    | otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
+        sc
+            --        & scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
+            & scopeZoom *~ zoomSpeed
+            & scopeZoomChange +~ 1
+    | otherwise = sc & scopeZoomChange .~ 0
  where
-    --mousep = rotateV (_cameraRot w) $ _mousePos w
-    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
+    Just currentZoom = sc ^? scopeZoom

 ifConfigWallRotate :: Configuration -> World -> World
 ifConfigWallRotate cfig w