Files
loop/src/Dodge/Luse.hs
T
2024-09-28 23:34:32 +01:00

140 lines
4.4 KiB
Haskell

module Dodge.Luse where
import Dodge.Base
import Dodge.Creature.Action
import Dodge.Data.World
--import MaybeHelp
import Dodge.Default.Creature
import Dodge.Item.Weapon.TriggerType
import Geometry
import qualified IntMapHelp as IM
import LensHelp
useL :: Luse -> Item -> Creature -> World -> World
useL lu = case lu of
LDoNothing -> const $ const id
LRewind -> useRewindGun
LTimePause -> hammerCheckL useStopWatch
LTimeScroll -> hammerCheckL useTimeScrollGun
LShrink -> hammerCheckL useShrinkGun
LBlink -> hammerCheckL (shootL $ const blinkActionMousePos)
LUnsafeBlink -> hammerCheckL (shootL $ const unsafeBlinkAction)
LBoost -> boostSelfL 10
useStopWatch :: Item -> Creature -> World -> World
useStopWatch itm _ w = w
& timeFlow .~ PausedTimeFlow
{ _timeFlowCharge = itm ^?! itUse . leftConsumption . wpCharge
, _scrollItemID = _itID itm
}
useTimeScrollGun :: Item -> Creature -> World -> World
useTimeScrollGun itm _ w = w & timeFlow .~ ItemScrollTimeFlow
{ _scrollSmoothing = 0
, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _futureWorlds = []
, _scrollItemID = _itID itm
}
useRewindGun :: Item -> Creature -> World -> World
useRewindGun itm _ w = w
& timeFlow .~ RewindLeftClick
{ _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _scrollItemID = _itID itm
}
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
-- (w' : ws) -> w
-- & cwTime . maybeWorld
-- .~ Just' w'
-- & cwTime . rewindWorlds .~ ws
-- _ -> w
-- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value
-- 22.05.23 this has been changed from using invids to items
useShrinkGun :: Item -> Creature -> World -> World
useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
--Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid
Just FullSize -> tryResize 0.5 $ f Shrunk UndroppableIdentified . dropExcept cr invid
Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr
Nothing -> error "useShrinkGun applied to item with incorrect ItParam"
where
invid = _ilInvID $ _itLocation it
tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid
%~ ((itParams . shrinkGunStatus .~ isInUse) . (itCurseStatus .~ cstatus))
boostSelfL ::
-- | boost amount
Float ->
Item ->
Creature ->
World ->
World
boostSelfL = undefined
--boostSelfL x itm cr w = case boostPoint x cr w of
-- Left p -> crEff p (itUse . leftConsumption . arLoaded .~ 0)
-- Right p -> crEff p (itUse . leftConsumption . arLoaded -~ 1)
-- where
-- invid = _ipInvID $ _itLocation itm
-- cid = _crID cr
-- cpos = _crPos cr
-- r = _crRad cr
-- pid =
-- fromMaybe
-- (IM.newKey $ _props (_cWorld w))
-- (cr ^? crInv . ix invid . itAttachment . atInt)
-- crEff p ammoEff =
-- addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
-- & cWorld . creatures . ix cid
-- %~ (crPos .~ p)
-- . ( crInv . ix invid
-- %~ ammoEff
-- . (itEffect . ieCounter .~ 1)
-- . (itAttachment .~ AttachInt pid)
-- )
-- | Move a creature towards the mouse position, with shockwave
boostPoint ::
-- | boost amount
Float ->
Creature ->
World ->
Either Point2 Point2
boostPoint x cr w = case mayp2 of
Nothing -> Right p1
Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
mayp2 = bouncePoint (const True) 1 cpos p1 w
addBoostShockwave ::
Int ->
Point2 ->
Point2 ->
World ->
World
addBoostShockwave pjid p v w =
w & cWorld . lWorld . linearShockwaves
%~ IM.insertWith f pjid thePJ
where
thePJ =
LinearShockwave
{ _lwPos = p
, _lwID = pjid
, _lwPoints = [(p, v)]
, _lwTimer = maxT
}
f newVal oldVal = newVal & lwPoints %~ (++ _lwPoints oldVal)
maxT :: Int
maxT = 20