justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix aiming with scope

Browse Source
This commit is contained in:
justin
2023-12-26 21:45:59 +00:00
parent 3b4bef944d
commit 26c55ee7f5
14 changed files with 85 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/You.hs
+10
View File
@@ -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
+7 -7
View File
@@ -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
(argV (_mousePos (_input w)) + (w ^. wCam . camRot))
$ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
-- _ <- cr ^? crInv . ix itRef . itScope . scopePos
_ <- cr ^? crInv . ix itRef . itScope . remotePos
return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr
mouseDir = argV $ mouseWorldPos (w ^. input) (w ^. wCam) - (cr ^. crPos)
-- mouseDir = fromMaybe
-- (argV (_mousePos (_input w)) + (w ^. wCam . camRot))
-- $ do
-- itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
-- _ <- cr ^? crInv . ix itRef . itScope . remotePos
-- 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
-1
View File
@@ -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
-7
View File
@@ -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
-1
View File
@@ -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
+63 -61
View File
@@ -3,72 +3,74 @@ module Dodge.HeldScroll (
canHeldScrollAttach,
) where
import LensHelp hiding ((<|), (|>))
import Data.Maybe
import Control.Monad
import Geometry
--import LensHelp hiding ((<|), (|>))
--import Data.Maybe
--import Control.Monad
--import Geometry
--import Control.Lens hiding ((<|), (|>))
import Data.Sequence
--import Data.Sequence
import Dodge.Data.World
import SDL (MouseButton (..))
import qualified Data.Map.Strict as M
--import SDL (MouseButton (..))
--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
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
doHeldScroll _ _ _ = id
--doHeldScroll invid hs x w = case hs of
-- 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
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
| 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
--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
-- | 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
-2
View File
@@ -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
-1
View File
@@ -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
-5
View File
@@ -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
-16
View File
@@ -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
-1
View File
@@ -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
-1
View File
@@ -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
+4 -6
View File
@@ -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
itm <- _crInv (you w) IM.!? i
atparams <- you w ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
guard (canHeldScrollAttach itm atparams)
i <- yourScopeInvID w
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
+1 -5
View File
@@ -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