diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index 09c436187..045c2e95f 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/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) diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index b4003a89c..428f85bce 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/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 = diff --git a/src/Dodge/Item/Held.hs b/src/Dodge/Item/Held.hs index 634972b3e..623bf18b3 100644 --- a/src/Dodge/Item/Held.hs +++ b/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 diff --git a/src/Dodge/Item/Held/Rod.hs b/src/Dodge/Item/Held/Rod.hs index 44debd1d5..df8ec0ca7 100644 --- a/src/Dodge/Item/Held/Rod.hs +++ b/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 = diff --git a/src/Dodge/Item/Held/Utility.hs b/src/Dodge/Item/Held/Utility.hs index a4a15ca70..bba1cdd00 100644 --- a/src/Dodge/Item/Held/Utility.hs +++ b/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 diff --git a/src/Dodge/Item/Info.hs b/src/Dodge/Item/Info.hs index d3edd56ff..4ec27a264 100644 --- a/src/Dodge/Item/Info.hs +++ b/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++ "." diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index c47b69bca..9bf4f580f 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index ed1e0b4aa..4ff489a57 100644 --- a/src/Dodge/Update/Camera.hs +++ b/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) = - 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