This commit is contained in:
2024-09-27 21:55:17 +01:00
parent dd6cbc0bfb
commit 6c3d0d5def
21 changed files with 232 additions and 333 deletions
+1
View File
@@ -43,6 +43,7 @@ itemEffect cr it w = case it ^. ldtValue . itUse of
CraftUse{} -> w
AttachUse{} -> selectUse it cr w
AmmoMagUse{} -> w
ScopeUse{} -> w
where
itm = it ^. ldtValue
doequipmentchange = fromMaybe w $ do
+1 -1
View File
@@ -43,7 +43,7 @@ data Item = Item
, _itDimension :: ItemDimension
, _itCurseStatus :: CurseStatus
, _itTweaks :: ItemTweaks
, _itScope :: Scope
-- , _itScope :: Scope
, _itParams :: ItemParams
, _itAttachments :: Set ItemAttachment
}
-5
View File
@@ -20,11 +20,6 @@ data Scope
, _opticZoom :: Float
, _opticDefaultZoom :: Float
}
| RemoteScope
{ -- | a camera offset, note unlike the optic pos this is absolute
_remotePos :: Point2
, _remoteZoom :: Float
}
deriving (Eq, Show, Read) --Generic, Flat)
makeLenses ''Scope
+7 -2
View File
@@ -12,8 +12,10 @@ module Dodge.Data.Item.Use (
module Dodge.Data.Hammer,
module Dodge.Data.Item.Targeting,
module Dodge.Data.GenFloat,
module Dodge.Data.Item.Scope
) where
import Dodge.Data.Item.Scope
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -67,6 +69,10 @@ data ItemUse
, _amagParams :: AmmoParams
, _amagType :: AmmoType
}
| ScopeUse
{ -- | a camera offset
_scopeScope :: Scope
}
deriving (Eq, Show, Read) --Generic, Flat)
data TriggerType
@@ -111,8 +117,7 @@ data AmmoParams
= BulletParams {_ampBullet :: Bullet}
| ProjectileParams
{ _ampPayload :: Payload
, _ampPjDraw :: ProjectileDraw
-- , _ampPjCreation :: ProjectileCreate
-- , _ampPjDraw :: ProjectileDraw
}
| GasParams {_ampCreateGas :: GasFuel}
deriving (Eq, Show, Read) --Generic, Flat)
+1 -1
View File
@@ -102,7 +102,7 @@ data LWorld = LWorld
, _clouds :: [Cloud]
, _gusts :: IM.IntMap Gust
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _projectiles :: IM.IntMap Projectile
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _radarSweeps :: [RadarSweep]
+3 -3
View File
@@ -11,7 +11,7 @@ import Data.Aeson.TH
import Dodge.Data.Item.Use.Consumption.Ammo
import Geometry.Data
data Proj
data Projectile
= Shell
{ _prjPos :: Point2
, _prjStartPos :: Point2
@@ -29,5 +29,5 @@ data Proj
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Proj
deriveJSON defaultOptions ''Proj
makeLenses ''Projectile
deriveJSON defaultOptions ''Projectile
+1 -1
View File
@@ -31,7 +31,7 @@ defaultHeldItem = Item
, _itUse = defaultHeldUse
, _itParams = NoParams
, _itTweaks = NoTweaks
, _itScope = NoScope
-- , _itScope = NoScope
, _itAttachments = mempty
}
-23
View File
@@ -1,23 +0,0 @@
module Dodge.Default.Shell where
import Dodge.Data.Item.Use.Consumption.Ammo
import Dodge.Data.Projectile
import Geometry.Data
defaultShell :: Proj
defaultShell =
Shell
{ _prjPos = V2 0 0
, _prjZ = 20
, _prjStartPos = V2 0 0
, _prjVel = V2 0 0
, _prjAcc = V2 0 0
, _prjDir = 0
, _prjSpin = 0
, _prjDraw = DrawShell
, _prjID = 0
, _prjTimer = 0
, _prjPayload = ExplosionPayload
, _prjUpdates = []
-- , _prjMITID = Nothing
}
+2 -1
View File
@@ -505,7 +505,8 @@ createProjectile magtree muz itm cr = fromMaybe failsound $ do
ammoitem <- cr ^? crInv . ix magid
let mscreen = lookup RemoteScreenLink (magtree ^. ldtLeft)
j <- ammoitem ^? itLocation . ilInvID
return $ fireTrackingShell (mscreen ^? _Just . ldtValue) ammoitem muz itm cr
aparams <- ammoitem ^? itUse . amagParams
return $ fireTrackingShell (mscreen ^? _Just . ldtValue) aparams muz itm cr
. startthesound
. useammo j
where
+1 -1
View File
@@ -58,7 +58,7 @@ shellMag =
.~ AmmoMagUse
{ _amagParams = ProjectileParams
{ _ampPayload = ExplosionPayload
, _ampPjDraw = DrawShell
-- , _ampPjDraw = DrawShell
}
, _amagLoadStatus =
ReloadStatus
+2
View File
@@ -117,6 +117,8 @@ itemNumberDisplay cr itm = case iu of
ConsumeUse {} -> []
AttachUse {} -> [] --[showReloadProgress cr itm]
AmmoMagUse {} -> [showLoadedAmount itm]
ScopeUse OpticScope {_opticZoom = x} -> [show x]
ScopeUse {} -> []
-- this could be cleaner here...
where
iu = itm ^?! itUse
+1 -1
View File
@@ -13,7 +13,7 @@ zoomScope =
defaultHeldItem
& itType . iyBase .~ ATTACH ZOOMSCOPE
-- & itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
& itScope .~ OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}
& itUse .~ ScopeUse OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}
targetingScope :: TargetType -> Item
targetingScope tt =
-16
View File
@@ -1,16 +0,0 @@
module Dodge.Item.Weapon.Remote (
-- setRemoteScope,
) where
--import Control.Lens
--import Dodge.Data.World
--import Geometry
--setRemoteScope :: Int -> Point2 -> World -> World
--setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of
-- Just (InInv cid' invid _ _ _) ->
-- w
-- & cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope
-- . remotePos
-- .~ (pos -.- (w ^?! cWorld . lWorld . creatures . ix cid' . crPos))
-- _ -> w
-19
View File
@@ -1,19 +0,0 @@
module Dodge.Item.Weapon.Shell (
decTimMvVel,
) where
import Control.Lens
import Dodge.Data.World
import Geometry.Vector
decTimMvVel :: Proj -> World -> World
decTimMvVel pj =
cWorld . lWorld . projectiles . ix pjid
%~ ( (prjTimer -~ 1)
. (prjPos %~ (+.+ vel))
. (prjAcc %~ rotateV rot)
)
where
rot = _prjSpin pj
vel = _prjVel pj
pjid = _prjID pj
+33 -80
View File
@@ -1,6 +1,6 @@
module Dodge.Projectile.Create
( fireTrackingShell
) where
module Dodge.Projectile.Create (
fireTrackingShell,
) where
import Data.Maybe
import Dodge.Data.World
@@ -9,88 +9,41 @@ import qualified IntMapHelp as IM
import LensHelp
-- assumes the mscreen is in your inventory
fireTrackingShell :: Maybe Item -> Item -> Muzzle -> Item -> Creature -> World -> World
fireTrackingShell mscreen ammoitem muz it cr w = fromMaybe w $ do
aparams <- ammoitem ^? itUse . amagParams
return $ w & cWorld . lWorld . projectiles . at i
?~ Shell
{ _prjPos = pos
, _prjZ = 20
, _prjStartPos = pos
, _prjVel = rotateV dir (V2 1 0)
, _prjDraw = DrawShell
, _prjID = i
, _prjAcc = rotateV dir (V2 3 0)
, _prjDir = dir
, _prjSpin = 0
, _prjPayload = _ampPayload aparams
, _prjTimer = 350
, _prjUpdates =
[ PJRemoteShellCollisionCheck (mscreen ^? _Just . itID) --Just screenid)
, PJDecTimMvVel
, PJSpin 335 (_crID cr) spinamount
, PJRemoteSetDirection (350 - thrustdelay) 0 (mscreen ^? _Just . itID)
, PJThrust (350 - thrustdelay) 0
, PJReduceSpin (1 - fromIntegral spindrag * 2 / 200)
]
-- , _prjMITID = Just $ _itID it
}
& updatescreen
-- makeShell
-- (mscreen ^? _Just . itLocation . ilInvID) -- Just screeninvid)
-- ammoitem
-- muz
-- cr
-- [ PJRemoteShellCollisionCheck (mscreen ^? _Just . itID) --Just screenid)
-- , PJDecTimMvVel
-- , PJSpin 335 (_crID cr) spinamount
-- , PJRemoteSetDirection (350 - thrustdelay) 0 (mscreen ^? _Just . itID)
-- , PJThrust (350 - thrustdelay) 0
-- , PJReduceSpin (1 - fromIntegral spindrag * 2 / 200)
-- ]
fireTrackingShell :: Maybe Item -> AmmoParams -> Muzzle -> Item -> Creature -> World -> World
fireTrackingShell mscreen aparams muz it cr w = w
& updatescreen
& cWorld . lWorld . projectiles . at i
?~ Shell
{ _prjPos = pos
, _prjZ = 20
, _prjStartPos = pos
, _prjVel = rotateV dir (V2 1 0)
, _prjDraw = maybe DrawShell (const DrawRemoteShell) mscreen
, _prjID = i
, _prjAcc = rotateV dir (V2 3 0)
, _prjDir = dir
, _prjSpin = 0
, _prjPayload = _ampPayload aparams
, _prjTimer = 350
, _prjUpdates =
[ PJRemoteShellCollisionCheck (mscreen ^? _Just . itID) --Just screenid)
, PJDecTimMvVel
, PJSpin 335 (_crID cr) (_shellSpinAmount params)
, PJRemoteSetDirection (350 - thrustdelay) 0 (mscreen ^? _Just . itID)
, PJThrust (350 - thrustdelay) 0
, PJReduceSpin (1 - fromIntegral (_shellSpinDrag params) * 2 / 200)
]
}
where
spinamount = _shellSpinAmount params
thrustdelay = _shellThrustDelay params
spindrag = _shellSpinDrag params
params = _itParams it
updatescreen = fromMaybe id $ do
screeninvid <- mscreen ^? _Just . itLocation . ilInvID
return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix screeninvid
. itUse . atLinkedProjectile ?~ i
return $
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix screeninvid
. itUse
. atLinkedProjectile
?~ i
i = IM.newKey $ w ^. cWorld . lWorld . projectiles -- _props (_cWorld w)
dir = _crDir cr + _mzRot muz
pos = _crPos cr +.+ rotateV dir (_mzPos muz)
---- rather than screen invid why not use an item location?
--makeShell :: Maybe Int -> Item -> Muzzle -> Creature -> [ProjectileUpdate] -> World -> World
--makeShell mscreeninvid ammoitem muz cr theupdate w = fromMaybe w $ do
-- aparams <- ammoitem ^? itUse . amagParams
-- return $
-- w & cWorld . lWorld . projectiles . at i
-- ?~ Shell
-- { _prjPos = pos
-- , _prjZ = 20
-- , _prjStartPos = pos
-- , _prjVel = rotateV dir (V2 1 0)
-- , _prjDraw = DrawShell
-- , _prjID = i
-- , _prjAcc = rotateV dir (V2 3 0)
-- , _prjDir = dir
-- , _prjSpin = 0
-- , _prjPayload = _ampPayload aparams
-- , _prjTimer = 350
-- , _prjUpdates = theupdate
---- , _prjMITID = Just $ _itID it
-- }
-- & updatescreen
-- where
-- updatescreen = fromMaybe id $ do
-- screeninvid <- mscreeninvid
-- return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix screeninvid
-- . itUse . atLinkedProjectile ?~ i
-- i = IM.newKey $ w ^. cWorld . lWorld . projectiles -- _props (_cWorld w)
-- dir = _crDir cr + _mzRot muz
-- pos = _crPos cr +.+ rotateV dir (_mzPos muz)
+6 -4
View File
@@ -1,4 +1,6 @@
module Dodge.Projectile.Draw where
module Dodge.Projectile.Draw
( drawProjectile
) where
import Dodge.Data.Item.Use.Consumption.Ammo
import Dodge.Data.Projectile
@@ -7,14 +9,14 @@ import Picture
import Shape
import ShapePicture
drawProjectile :: Proj -> SPic
drawProjectile :: Projectile -> SPic
drawProjectile prj = case _prjDraw prj of
DrawShell -> drawShell prj
DrawRemoteShell -> drawRemoteShell prj
DrawDrone -> drawShell prj
DrawBlankProjectile -> mempty
drawShell :: Proj -> SPic
drawShell :: Projectile -> SPic
drawShell pj =
noPic
. translateSHz 18
@@ -24,7 +26,7 @@ drawShell pj =
shellShape :: Shape
shellShape = colorSH black $ upperPrismPoly Small Typical 4 $ map toV2 [(-6, 4), (-6, -4), (6, -4), (8, 0), (6, 4)]
drawRemoteShell :: Proj -> SPic
drawRemoteShell :: Projectile -> SPic
drawRemoteShell pj
| rem (t + 200) 20 < 9 =
doposition $ noPic shellShape
+31 -23
View File
@@ -1,33 +1,30 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Projectile.Update where
--{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Projectile.Update
( updateProjectile
) where
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.Item.Location
import Dodge.Item.Weapon.Launcher
import Dodge.Item.Weapon.Remote
import Dodge.Item.Weapon.Shell
import Dodge.Item.Weapon.TriggerType
import Dodge.Movement.Turn
import Dodge.Payload
import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound
import Dodge.WorldEvent.Cloud
import Geometry
import qualified IntMapHelp as IM
import RandomHelp
import qualified SDL
updateProjectile :: Proj -> World -> World
updateProjectile pj = case pj of
Shell{} -> upsProjectile pj
updateProjectile :: Projectile -> World -> World
updateProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
--updateProjectile pj = case pj of
-- Shell{} -> upsProjectile pj
--
--upsProjectile :: Projectile -> World -> World
--upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
shellCollisionCheck :: (Proj -> World -> World) -> Proj -> World -> World
shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
shellCollisionCheck doExplode pj w
| time > 330 && circOnSomeWall oldPos 4 w = doExplode pj w
| time <= 330 && anythingHitCirc 2 oldPos newPos w = doExplode pj w
@@ -39,7 +36,7 @@ shellCollisionCheck doExplode pj w
vel = _prjVel pj
newPos = oldPos +.+ vel
remoteShellCollisionCheck :: Maybe Int -> Proj -> World -> World
remoteShellCollisionCheck :: Maybe Int -> Projectile -> World -> World
remoteShellCollisionCheck mscreenid = shellCollisionCheck
$ \pj -> explodeRemoteRocket mscreenid (_prjID pj)
@@ -49,10 +46,8 @@ remoteShellCollisionCheck mscreenid = shellCollisionCheck
-- . stopSoundFrom (ShellSound (_prjID pj))
-- . (cWorld . lWorld . projectiles %~ IM.delete (_prjID pj))
upsProjectile :: Proj -> World -> World
upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
upProjectile :: ProjectileUpdate -> Proj -> World -> World
upProjectile :: ProjectileUpdate -> Projectile -> World -> World
upProjectile pu pj = case pu of
PJRemoteShellCollisionCheck mscreenid -> remoteShellCollisionCheck mscreenid pj
-- PJShellCollisionCheck -> plainShellCollisionCheck pj
@@ -91,7 +86,7 @@ retireRemoteProj mitid pjid w = w & cWorld . lWorld . projectiles %~ IM.delete p
guard $ itm == pjid
return $ pointerToItemLocation loc . itUse . atLinkedProjectile .~ Nothing
doThrust :: Proj -> World -> World
doThrust :: Projectile -> World -> World
doThrust pj w =
w
& randGen .~ g
@@ -117,7 +112,7 @@ trySpinByCID ::
Int ->
-- | Spin amount
Int ->
Proj ->
Projectile ->
World ->
World
trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin .~ newSpin
@@ -144,7 +139,7 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin
-- --itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid
-- note this only allows YOU to remotely track projectiles
pjRemoteSetDirection :: Maybe Int -> Proj -> World -> World
pjRemoteSetDirection :: Maybe Int -> Projectile -> World -> World
pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
screenid <- mscreenid
let newdir
@@ -169,5 +164,18 @@ pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
-- (argV $ _prjAcc pj)
-- --itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid
reduceSpinBy :: Float -> Proj -> World -> World
reduceSpinBy :: Float -> Projectile -> World -> World
reduceSpinBy x pj = cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
decTimMvVel :: Projectile -> World -> World
decTimMvVel pj =
cWorld . lWorld . projectiles . ix pjid
%~ ( (prjTimer -~ 1)
. (prjPos %~ (+.+ vel))
. (prjAcc %~ rotateV rot)
)
where
rot = _prjSpin pj
vel = _prjVel pj
pjid = _prjID pj
+6 -11
View File
@@ -6,7 +6,7 @@ module Dodge.Update.Camera (
) where
import Bound
import Control.Applicative
--import Control.Applicative
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
@@ -81,15 +81,11 @@ moveZoomCamera :: Configuration -> Input -> Creature -> World -> Camera -> Camer
moveZoomCamera cfig theinput cr w campos =
campos
& camCenter .~ fromMaybe (_crPos cr +.+ offset ) mremotepos
& camViewFrom .~ fromMaybe (_crPos cr +.+ vfoffset) mremotepos
& camViewFrom .~ fromMaybe (_crPos cr) mremotepos
& camZoom .~ newzoom
& camDefaultZoom .~ newDefaultZoom
& camItemZoom .~ newItemZoom
where
vfoffset = fromMaybe 0 $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . imSelectedItem
cr ^? crInv . ix i . itScope . remotePos
mremotepos = do
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- cr ^? crInv . ix i . itUse . atLinkedProjectile . _Just
@@ -98,17 +94,16 @@ moveZoomCamera cfig theinput cr w campos =
offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . imSelectedItem
fmap docamrot (cr ^? crInv . ix i . itScope . opticPos)
<|> (cr ^? crInv . ix i . itScope . remotePos)
fmap docamrot (cr ^? crInv . ix i . itUse . scopeScope . opticPos)
noscopeoffset = docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
cr ^? crInv . ix i . itScope . opticZoom
cr ^? crInv . ix i . itUse . scopeScope . opticZoom
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
cr ^? crInv . ix i . itScope . opticZoom
cr ^? crInv . ix i . itUse . scopeScope . opticZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr
i <- cr ^? crManipulation . manObject . imSelectedItem
@@ -141,7 +136,7 @@ updateScopeZoom' i w
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
| otherwise = w & wppointer %~ resetscope
where
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . scopeScope
resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz
resetscope otherAtt = otherAtt