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

Remove data Hammers

Browse Source
This commit is contained in:
justin
2024-12-31 12:42:03 +00:00
parent 9e2dc995e9
commit 17da9e00f8
15 changed files with 146 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Creature/Impulse/UseItem.hs
+37 -46
View File
@@ -15,14 +15,14 @@ import Dodge.HeldUse
--import Dodge.Hotkey --import Dodge.Hotkey
import Dodge.Inventory import Dodge.Inventory
import Dodge.Item.Grammar import Dodge.Item.Grammar
import Dodge.Item.Location --import Dodge.Item.Location
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
useItem :: Int -> PressType -> World -> World useItem :: Int -> PressType -> World -> World
useItem invid pt w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do useItem invid pt w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0 cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2 itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
usedloc <- useLocation' itmloc usedloc <- useLocation itmloc
useItemLoc cr usedloc pt w useItemLoc cr usedloc pt w
useItemLoc :: Creature -> LocationLDT ItemLink ComposedItem -> PressType useItemLoc :: Creature -> LocationLDT ItemLink ComposedItem -> PressType
@@ -30,15 +30,15 @@ useItemLoc :: Creature -> LocationLDT ItemLink ComposedItem -> PressType
useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
HeldPlatformSF -> HeldPlatformSF ->
return $ return $
heldEffect (bimap _iatType (^. _1) ldt) cr w heldEffect pt (bimap _iatType (^. _1) ldt) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown -- & pointerToItem itm . itUse . heldHammer .~ HammerDown
GadgetPlatformSF -> GadgetPlatformSF ->
return $ return $
heldEffect (bimap _iatType (^. _1) ldt) cr w heldEffect pt (bimap _iatType (^. _1) ldt) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown -- & pointerToItem itm . itUse . heldHammer .~ HammerDown
RemoteDetonatorSF -> do RemoteDetonatorSF -> do
return $ activateDetonator ldt w return $ activateDetonator ldt w
& pointerToItem itm . itUse . heldHammer .~ HammerDown -- & pointerToItem itm . itUse . heldHammer .~ HammerDown
_ | isJust $ itm ^? itUse . uequipEffect -> do _ | isJust $ itm ^? itUse . uequipEffect -> do
invid' <- itm ^? itLocation . ilInvID invid' <- itm ^? itLocation . ilInvID
return $ toggleEquipmentAt invid' cr w return $ toggleEquipmentAt invid' cr w
@@ -47,9 +47,9 @@ useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
ldt = loc ^. locLDT ldt = loc ^. locLDT
itm = ldt ^. ldtValue . _1 itm = ldt ^. ldtValue . _1
useLocation' :: LocationLDT ItemLink ComposedItem useLocation :: LocationLDT ItemLink ComposedItem
-> Maybe (LocationLDT ItemLink ComposedItem) -> Maybe (LocationLDT ItemLink ComposedItem)
useLocation' loc useLocation loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = return loc | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = return loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just
= return loc = return loc
@@ -57,34 +57,34 @@ useLocation' loc
= return loc = return loc
| otherwise = return $ locToTop loc | otherwise = return $ locToTop loc
useSelectedItem :: Int -> World -> World --useSelectedItem :: Int -> World -> World
useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do --useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid -- cr <- w ^? cWorld . lWorld . creatures . ix crid
invid <- cr ^? crManipulation . manObject . imSelectedItem -- invid <- cr ^? crManipulation . manObject . imSelectedItem
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2 -- itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
let usedloc = case useLocation itmloc of -- let usedloc = case useLocation itmloc of
UseFromLocation -> itmloc ^. locLDT -- UseFromLocation -> itmloc ^. locLDT
UseFromRoot -> locToTop itmloc ^. locLDT -- UseFromRoot -> locToTop itmloc ^. locLDT
let itm = usedloc ^. ldtValue . _1 -- let itm = usedloc ^. ldtValue . _1
case usedloc ^. ldtValue . _2 of -- case usedloc ^. ldtValue . _2 of
HeldPlatformSF -> -- HeldPlatformSF ->
return $ -- return $
heldEffect (bimap _iatType fst3 usedloc) cr w -- heldEffect (bimap _iatType fst3 usedloc) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown -- & pointerToItem itm . itUse . heldHammer .~ HammerDown
GadgetPlatformSF -> -- GadgetPlatformSF ->
return $ -- return $
heldEffect (bimap _iatType fst3 usedloc) cr w -- heldEffect (bimap _iatType fst3 usedloc) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown -- & pointerToItem itm . itUse . heldHammer .~ HammerDown
RemoteDetonatorSF -> do -- RemoteDetonatorSF -> do
return $ activateDetonator usedloc w -- return $ activateDetonator usedloc w
& pointerToItem itm . itUse . heldHammer .~ HammerDown -- & pointerToItem itm . itUse . heldHammer .~ HammerDown
_ | isJust $ itm ^? itUse . uequipEffect -> do -- _ | isJust $ itm ^? itUse . uequipEffect -> do
-- guard (_crHammerPosition cr == HammerUp) ---- guard (_crHammerPosition cr == HammerUp)
invid' <- itm ^? itLocation . ilInvID -- invid' <- itm ^? itLocation . ilInvID
return $ toggleEquipmentAt invid' cr w -- return $ toggleEquipmentAt invid' cr w
_ -> Nothing -- _ -> Nothing
where -- where
fst3 (x, _, _) = x -- fst3 (x, _, _) = x
activateDetonator :: activateDetonator ::
LabelDoubleTree ItemLink ComposedItem -> LabelDoubleTree ItemLink ComposedItem ->
@@ -94,15 +94,6 @@ activateDetonator det = fromMaybe id $ do
pjid <- det ^? ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 pjid <- det ^? ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0 return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
useLocation :: LocationLDT ItemLink ComposedItem -> UseFocus
useLocation loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = UseFromLocation
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just =
UseFromLocation
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
UseFromLocation
| otherwise = UseFromRoot
toggleEquipmentAt :: Int -> Creature -> World -> World toggleEquipmentAt :: Int -> Creature -> World -> World
toggleEquipmentAt invid cr w = case getEquipmentAllocation w of toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
DoNotMoveEquipment -> w DoNotMoveEquipment -> w
src/Dodge/Creature/State.hs
+3 -6
View File
@@ -21,7 +21,6 @@ import Dodge.Data.DoubleTree
import Dodge.Data.World import Dodge.Data.World
import Dodge.DoubleTree import Dodge.DoubleTree
import Dodge.Euse import Dodge.Euse
import Dodge.Hammer
import Dodge.ItEffect import Dodge.ItEffect
import Dodge.Item.Grammar import Dodge.Item.Grammar
import Dodge.Item.HeldOffset import Dodge.Item.HeldOffset
@@ -123,9 +122,7 @@ poisonSPic = over _1 $ overColSH (mixColors 0.5 0.5 green . normalizeColor)
internalCreatureUpdate :: Creature -> World -> World internalCreatureUpdate :: Creature -> World -> World
internalCreatureUpdate cr = internalCreatureUpdate cr =
cWorld . lWorld . creatures . ix (_crID cr) cWorld . lWorld . creatures . ix (_crID cr)
%~ ( --(crHammerPosition %~ moveHammerUp). %~ updateMovement
updateMovement
)
{- | Drop items according to the creature state. {- | Drop items according to the creature state.
TODO make sure this doesn't mess up any ItemPosition TODO make sure this doesn't mess up any ItemPosition
@@ -432,10 +429,10 @@ itemUpdate = itUse %~ useUpdate
useUpdate :: ItemUse -> ItemUse useUpdate :: ItemUse -> ItemUse
useUpdate = useUpdate =
(heldHammer %~ moveHammerUp) -- (heldHammer %~ moveHammerUp)
-- . (leftHammer %~ moveHammerUp) -- . (leftHammer %~ moveHammerUp)
-- . (leftDelay . rateTime %~ decreaseToZero) -- . (leftDelay . rateTime %~ decreaseToZero)
. (heldDelay . warmTime %~ decreaseToZero) (heldDelay . warmTime %~ decreaseToZero)
. (heldDelay . rateTime %~ decreaseToZero) . (heldDelay . rateTime %~ decreaseToZero)
--updateAutoRecharge :: Item -> Item --updateAutoRecharge :: Item -> Item
src/Dodge/Creature/YourControl.hs
+8 -9
View File
@@ -43,19 +43,20 @@ handleHotkeys w
|| SDL.ScancodeRShift `M.member` _pressedKeys (_input w) = || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) =
foldl' tryAssignHotkey w allHotkeys foldl' tryAssignHotkey w allHotkeys
| otherwise = | otherwise =
foldl' M.foldl'
useHotkey useHotkey
w w
(M.intersection thehotkeys (M.filter (== InitialPress) (w ^. input . pressedKeys))) (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
where where
thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
useHotkey :: World -> NewInt ItmInt -> World useHotkey :: World -> (NewInt ItmInt,PressType) -> World
useHotkey w (NInt itid) = fromMaybe w $ do useHotkey w (NInt itid,pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
cr <- w ^? cWorld . lWorld . creatures . ix 0 return $ useItem invid pt w
itmloc <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT -- cr <- w ^? cWorld . lWorld . creatures . ix 0
return $ heldEffectNoHammerCheck (bimap (^. iatType) (^. _1) itmloc) cr w -- itmloc <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
-- return $ heldEffectNoHammerCheck (bimap (^. iatType) (^. _1) itmloc) cr w
allHotkeys :: [SDL.Scancode] allHotkeys :: [SDL.Scancode]
allHotkeys = map hotkeyToScancode [minBound .. maxBound] allHotkeys = map hotkeyToScancode [minBound .. maxBound]
@@ -176,8 +177,6 @@ pressedMBEffectsTopInventory pkeys w
| Just ltime <- pkeys ^? ix SDL.ButtonLeft | Just ltime <- pkeys ^? ix SDL.ButtonLeft
, Just rtime <- pkeys ^? ix SDL.ButtonRight , Just rtime <- pkeys ^? ix SDL.ButtonRight
, ltime <= rtime && inTopInv = , ltime <= rtime && inTopInv =
--youhammerdown $
--useSelectedItem 0 w
fromMaybe w $ do fromMaybe w $ do
invid <- w ^? cWorld . lWorld . creatures . ix 0 invid <- w ^? cWorld . lWorld . creatures . ix 0
. crManipulation . manObject . imSelectedItem . crManipulation . manObject . imSelectedItem
src/Dodge/Data.hs
-2
View File
@@ -11,7 +11,6 @@ module Dodge.Data (
module Dodge.Data.Material, module Dodge.Data.Material,
module Dodge.Data.GenWorld, module Dodge.Data.GenWorld,
module Dodge.Data.Universe, module Dodge.Data.Universe,
module Dodge.Data.Hammer,
module MaybeHelp, module MaybeHelp,
module Dodge.Data.RoomCluster, module Dodge.Data.RoomCluster,
module Dodge.Data.Room, module Dodge.Data.Room,
@@ -32,7 +31,6 @@ import Dodge.Data.CrWlID
import Dodge.Data.CreatureEffect import Dodge.Data.CreatureEffect
import Dodge.Data.Distortion import Dodge.Data.Distortion
import Dodge.Data.GenWorld import Dodge.Data.GenWorld
import Dodge.Data.Hammer
import Dodge.Data.Material import Dodge.Data.Material
import Dodge.Data.MountedObject import Dodge.Data.MountedObject
import Dodge.Data.ObjectType import Dodge.Data.ObjectType
src/Dodge/Data/Creature.hs
-3
View File
@@ -14,7 +14,6 @@ module Dodge.Data.Creature (
module Dodge.Data.ActionPlan, module Dodge.Data.ActionPlan,
module Dodge.Data.Item, module Dodge.Data.Item,
module Dodge.Data.Material, module Dodge.Data.Material,
module Dodge.Data.Hammer,
) where ) where
import Control.Lens import Control.Lens
@@ -27,7 +26,6 @@ import Dodge.Data.Creature.Misc
import Dodge.Data.Creature.Perception import Dodge.Data.Creature.Perception
import Dodge.Data.Creature.Stance import Dodge.Data.Creature.Stance
import Dodge.Data.Creature.State import Dodge.Data.Creature.State
import Dodge.Data.Hammer
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Data.Material import Dodge.Data.Material
import Geometry.Data import Geometry.Data
@@ -66,7 +64,6 @@ data Creature = Creature
, _crGroup :: CrGroup , _crGroup :: CrGroup
, _crIntention :: Intention , _crIntention :: Intention
, _crMvType :: CrMvType , _crMvType :: CrMvType
-- , _crHammerPosition :: HammerPosition
, _crName :: String , _crName :: String
, _crStatistics :: CreatureStatistics , _crStatistics :: CreatureStatistics
, _crDeathTimer :: Int , _crDeathTimer :: Int
src/Dodge/Data/Hammer.hs
-25
View File
@@ -1,25 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Hammer where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
data HammerType
= NoHammer
| HasHammer {_hammerPosition :: HammerPosition}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data HammerPosition
= HammerDown
| HammerReleased
| HammerUp
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''HammerType
deriveJSON defaultOptions ''HammerPosition
deriveJSON defaultOptions ''HammerType
src/Dodge/Data/Item/Use.hs
-4
View File
@@ -9,7 +9,6 @@ module Dodge.Data.Item.Use (
module Dodge.Data.Item.HeldUse, module Dodge.Data.Item.HeldUse,
module Dodge.Data.Item.HeldDelay, module Dodge.Data.Item.HeldDelay,
module Dodge.Data.Item.Use.Consumption, module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Hammer,
module Dodge.Data.Item.Targeting, module Dodge.Data.Item.Targeting,
module Dodge.Data.GenFloat, module Dodge.Data.GenFloat,
module Dodge.Data.Item.Scope, module Dodge.Data.Item.Scope,
@@ -22,7 +21,6 @@ import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import Dodge.Data.GenFloat import Dodge.Data.GenFloat
import Dodge.Data.Hammer
import Dodge.Data.Item.HeldDelay import Dodge.Data.Item.HeldDelay
import Dodge.Data.Item.HeldUse import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.Targeting import Dodge.Data.Item.Targeting
@@ -34,7 +32,6 @@ import Sound.Data
data ItemUse data ItemUse
= UseHeld = UseHeld
{ _heldDelay :: UseDelay { _heldDelay :: UseDelay
, _heldHammer :: HammerPosition
, _heldAim :: AimParams , _heldAim :: AimParams
, _heldParams :: HeldParams , _heldParams :: HeldParams
, _heldTriggerType :: TriggerType , _heldTriggerType :: TriggerType
@@ -43,7 +40,6 @@ data ItemUse
} }
| UseEquip { _uequipEffect :: EquipEffect } | UseEquip { _uequipEffect :: EquipEffect }
| UseAttach {_uaParams :: AttachParams} | UseAttach {_uaParams :: AttachParams}
| UseHammer {_heldHammer :: HammerPosition}
| UseNothing | UseNothing
| UseScope { _uScope :: Scope } | UseScope { _uScope :: Scope }
| UseBulletMod { _ubMod :: BulletMod } | UseBulletMod { _ubMod :: BulletMod }
src/Dodge/Data/World.hs
-2
View File
@@ -9,7 +9,6 @@ module Dodge.Data.World (
module Dodge.Data.CWorld, module Dodge.Data.CWorld,
module Dodge.Data.RightButtonOptions, module Dodge.Data.RightButtonOptions,
module Dodge.Data.SoundOrigin, module Dodge.Data.SoundOrigin,
module Dodge.Data.Hammer,
module Dodge.Data.Input, module Dodge.Data.Input,
) where ) where
@@ -20,7 +19,6 @@ import Data.IntSet (IntSet)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Set (Set) import Data.Set (Set)
import Dodge.Data.CWorld import Dodge.Data.CWorld
import Dodge.Data.Hammer
import Dodge.Data.Input import Dodge.Data.Input
import Dodge.Data.RightButtonOptions import Dodge.Data.RightButtonOptions
import Dodge.Data.SaveSlot import Dodge.Data.SaveSlot
src/Dodge/Default.hs
+2 -2
View File
@@ -73,8 +73,8 @@ defaultPP =
, _ppText = "Pressure plate" , _ppText = "Pressure plate"
} }
upHammer :: HammerType --upHammer :: HammerType
upHammer = HasHammer HammerUp --upHammer = HasHammer HammerUp
defaultProximitySensor :: Sensor defaultProximitySensor :: Sensor
defaultProximitySensor = defaultProximitySensor =
src/Dodge/Default/Item/Use.hs
+1 -1
View File
@@ -26,7 +26,7 @@ defaultEquipUse = UseEquip
defaultHeldUse :: ItemUse defaultHeldUse :: ItemUse
defaultHeldUse = UseHeld defaultHeldUse = UseHeld
{ _heldDelay = FixedRate{_rateMax = 8, _rateTime = 0} { _heldDelay = FixedRate{_rateMax = 8, _rateTime = 0}
, _heldHammer = HammerUp -- , _heldHammer = HammerUp
, _heldAim = defaultAimParams , _heldAim = defaultAimParams
, _heldParams = BulletShooterParams , _heldParams = BulletShooterParams
{ _muzVel = ConstFloat 0.8 { _muzVel = ConstFloat 0.8
src/Dodge/Hammer.hs
-8
View File
@@ -1,8 +0,0 @@
module Dodge.Hammer where
import Dodge.Data.Hammer
moveHammerUp :: HammerPosition -> HammerPosition
{-# INLINE moveHammerUp #-}
moveHammerUp HammerDown = HammerReleased
moveHammerUp _ = HammerUp
src/Dodge/HeldUse.hs
+91 -55
View File
@@ -7,9 +7,8 @@ module Dodge.HeldUse (
mcUseHeld, mcUseHeld,
) where ) where
import Control.Applicative
import Dodge.Item.Weapon.Bullet
import Color import Color
import Control.Applicative
import Control.Monad import Control.Monad
import Data.Maybe import Data.Maybe
import Dodge.Base.Collide import Dodge.Base.Collide
@@ -22,6 +21,7 @@ import Dodge.Data.World
import Dodge.Gas import Dodge.Gas
import Dodge.Inventory.Lock import Dodge.Inventory.Lock
import Dodge.Item.HeldOffset import Dodge.Item.HeldOffset
import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.Shatter import Dodge.Item.Weapon.Shatter
import Dodge.Projectile.Create import Dodge.Projectile.Create
import Dodge.RadarSweep import Dodge.RadarSweep
@@ -35,8 +35,13 @@ import Picture.Base
import RandomHelp import RandomHelp
import qualified SDL import qualified SDL
heldEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World heldEffect ::
heldEffect = hammerCheck heldEffectNoHammerCheck PressType ->
LabelDoubleTree ComposeLinkType Item ->
Creature ->
World ->
World
heldEffect pt = hammerCheck pt heldEffectNoHammerCheck
heldEffectNoHammerCheck :: heldEffectNoHammerCheck ::
LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
@@ -49,12 +54,18 @@ type ChainEffect =
World -> World ->
World World
hammerCheck :: ChainEffect hammerCheck ::
hammerCheck f it cr w = case it ^? ldtValue . itUse . heldTriggerType of PressType ->
Just HammerTrigger | nomakeauto (LabelDoubleTree ComposeLinkType Item -> t1 -> t2 -> t2) ->
-> case w ^? input . mouseButtons . ix SDL.ButtonLeft of LabelDoubleTree ComposeLinkType Item ->
Just 0 -> f it cr w t1 ->
_ -> w t2 ->
t2
hammerCheck pt f it cr w = case it ^? ldtValue . itUse . heldTriggerType of
Just HammerTrigger | nomakeauto ->
case pt of
InitialPress -> f it cr w
_ -> w
_ -> f it cr w _ -> f it cr w
where where
nomakeauto = isNothing $ lookup MakeAutoLink (it ^. ldtRight) nomakeauto = isNothing $ lookup MakeAutoLink (it ^. ldtRight)
@@ -88,26 +99,34 @@ useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
heldEffectMuzzles t cr w = heldEffectMuzzles t cr w =
doHeldUseEffect t cr $ doHeldUseEffect t cr $
uncurry (applyCME (_ldtValue t) cr) cmew uncurry (applyCME (_ldtValue t) cr) cmew
-- & cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles -- & cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles
& doWeaponRepetitions upitm cr & doWeaponRepetitions upitm cr
where where
muzzles = t ^. ldtValue . itUse . heldAim . aimMuzzles muzzles = t ^. ldtValue . itUse . heldAim . aimMuzzles
(upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles (upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles
cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False, w) $ zip [0 ..] loadedmuzzles cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False, w) $ zip [0 ..] loadedmuzzles
doHeldUseEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World doHeldUseEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^? ldtValue . itUse . heldUseEffect of doHeldUseEffect t cr w = case t ^? ldtValue . itUse . heldUseEffect of
Just (RandomiseMuzzleFrames x) -> fromMaybe w $ do Just (RandomiseMuzzleFrames x) -> fromMaybe w $ do
i <- t ^? ldtValue . itLocation . ilInvID i <- t ^? ldtValue . itLocation . ilInvID
let g = w ^. randGen let g = w ^. randGen
(is,g') = runState (shuffle [0..x-1]) g (is, g') = runState (shuffle [0 .. x -1]) g
return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i . itUse . heldAim . aimMuzzles %~ zipWith (\j mz -> mz & mzFrame .~ j) is return $
& randGen .~ g' w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i . itUse . heldAim . aimMuzzles %~ zipWith (\j mz -> mz & mzFrame .~ j) is
& randGen .~ g'
Just SwitchAlteRifle -> fromMaybe w $ do Just SwitchAlteRifle -> fromMaybe w $ do
i <- t ^? ldtValue . itLocation . ilInvID i <- t ^? ldtValue . itLocation . ilInvID
return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i return $
. itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot %~ ((`mod` 2) . (+1)) w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
. itUse
. heldAim
. aimMuzzles
. ix 0
. mzAmmoSlot
%~ ((`mod` 2) . (+ 1))
Just NoHeldUseEffect -> w Just NoHeldUseEffect -> w
Nothing -> w Nothing -> w
@@ -117,7 +136,7 @@ doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponR
Just xs -> cWorld . lWorld . delayedEvents .++~ map f xs Just xs -> cWorld . lWorld . delayedEvents .++~ map f xs
_ -> id _ -> id
where where
f x = (x,WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffect) f x = (x, WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffect)
upitm x = upitm x =
itm & ldtValue . itUse . heldParams . weaponRepeat .~ [] itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
& ldtValue . itUse . heldTriggerType .~ AutoTrigger & ldtValue . itUse . heldTriggerType .~ AutoTrigger
@@ -300,8 +319,14 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
MuzzleTesla -> shootTeslaArc itm cr mz w MuzzleTesla -> shootTeslaArc itm cr mz w
MuzzleTractor -> shootTractorBeam cr w MuzzleTractor -> shootTractorBeam cr w
MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w
MuzzleGLauncher -> createProjectile (Grenade (GBounce 2)) magtree MuzzleGLauncher ->
(getPJStabiliser itmtree) mz cr w createProjectile
(Grenade (GBounce 2))
magtree
(getPJStabiliser itmtree)
mz
cr
w
MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
MuzzleShatter -> shootShatter itm cr w MuzzleShatter -> shootShatter itm cr w
MuzzleDetector -> itemDetectorEffect itm cr w MuzzleDetector -> itemDetectorEffect itm cr w
@@ -409,25 +434,25 @@ removeAmmoFromMag x mid cr = fromMaybe id $ do
-~ x -~ x
getBulletType :: getBulletType ::
-- LabelDoubleTree ComposeLinkType Item -> -- LabelDoubleTree ComposeLinkType Item ->
LabelDoubleTree ComposeLinkType Item -> LabelDoubleTree ComposeLinkType Item ->
-- Muzzle -> -- Muzzle ->
-- Creature -> -- Creature ->
-- World -> -- World ->
Maybe Bullet Maybe Bullet
--getBulletType itmtree magtree mz cr w = --getBulletType itmtree magtree mz cr w =
getBulletType magtree = getBulletType magtree =
magtree ^? ldtValue . itConsumables . magParams . ampBullet magtree ^? ldtValue . itConsumables . magParams . ampBullet
-- <&> buTrajectory .~ btraj -- <&> buTrajectory .~ btraj
<&> buPayload .~ bpayload <&> buPayload .~ bpayload
<&> buEffect .~ beffect <&> buEffect .~ beffect
where where
-- btraj = fromMaybe BasicBulletTrajectory $ do -- btraj = fromMaybe BasicBulletTrajectory $ do
-- targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these? -- targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these?
-- tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just -- tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just
-- attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
-- bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory -- bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory
-- return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w -- return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
bpayload = fromMaybe BulSpark $ do bpayload = fromMaybe BulSpark $ do
attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft) attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft)
attree ^? ldtValue . itUse . ubMod . bmPayload attree ^? ldtValue . itUse . ubMod . bmPayload
@@ -462,7 +487,7 @@ shootBullet ::
World -> World ->
World World
shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
-- thebullet <- getBulletType itmtree magtree mz cr w -- thebullet <- getBulletType itmtree magtree mz cr w
thebullet <- getBulletType magtree thebullet <- getBulletType magtree
return $ foldl' (&) w (replicate x (makeBullet' thebullet (itmtree ^. ldtValue) cr mz)) return $ foldl' (&) w (replicate x (makeBullet' thebullet (itmtree ^. ldtValue) cr mz))
@@ -566,17 +591,24 @@ mcShootLaser _ mc = cWorld . lWorld . lasers .:~ lasRayAt yellow dam phasev pos
mcShootAuto :: Item -> Machine -> World -> World mcShootAuto :: Item -> Machine -> World -> World
mcShootAuto itm mc w mcShootAuto itm mc w
| Just (FixedRate x 0) <- mc ^? mcType . mctTurret . tuWeapon . itUse . heldDelay | Just (FixedRate x 0) <- mc ^? mcType . mctTurret . tuWeapon . itUse . heldDelay =
= w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon w
. itUse . heldDelay . rateTime .~ x & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
. itUse
. heldDelay
. rateTime
.~ x
& makeBullet defaultBullet itm pos dir & makeBullet defaultBullet itm pos dir
| otherwise | otherwise =
= w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon w
. itUse . heldDelay . rateTime -~ 1 & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
. itUse
. heldDelay
. rateTime
-~ 1
where where
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
dir = mc ^?! mcType . _McTurret . tuDir dir = mc ^?! mcType . _McTurret . tuDir
-- | assumes that the item is held -- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World
@@ -595,8 +627,9 @@ determineProjectileTracking ::
LabelDoubleTree ComposeLinkType Item -> LabelDoubleTree ComposeLinkType Item ->
LabelDoubleTree ComposeLinkType Item -> LabelDoubleTree ComposeLinkType Item ->
RocketHoming RocketHoming
determineProjectileTracking magtree itmtree = fromMaybe NoHoming $ determineProjectileTracking magtree itmtree =
finddronecontrols <|> findexternaltracking fromMaybe NoHoming $
finddronecontrols <|> findexternaltracking
where where
finddronecontrols = do finddronecontrols = do
screen <- lookup RemoteScreenLink (magtree ^. ldtLeft) screen <- lookup RemoteScreenLink (magtree ^. ldtLeft)
@@ -615,23 +648,23 @@ createProjectileR ::
World -> World ->
World World
createProjectileR itmtree magtree = createProjectileR itmtree magtree =
createProjectile createProjectile
(Rocket ( Rocket
(determineProjectileTracking magtree itmtree) (determineProjectileTracking magtree itmtree)
smoke smoke
) magtree )
magtree
(getPJStabiliser itmtree) (getPJStabiliser itmtree)
where where
smoke smoke
| isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke | isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke
| otherwise = Nothing | otherwise = Nothing
getPJStabiliser :: LabelDoubleTree ComposeLinkType Item -> Maybe PJStabiliser getPJStabiliser :: LabelDoubleTree ComposeLinkType Item -> Maybe PJStabiliser
getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of
Just GIMBAL -> Just StabOrthReduce Just GIMBAL -> Just StabOrthReduce
Just GYROSCOPE -> Just StabSpinIncrease Just GYROSCOPE -> Just StabSpinIncrease
_ -> Nothing _ -> Nothing
_ -> Nothing _ -> Nothing
@@ -646,12 +679,15 @@ createProjectile ::
createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do
magid <- magtree ^? ldtValue . itLocation . ilInvID magid <- magtree ^? ldtValue . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid ammoitem <- cr ^? crInv . ix magid
let rdetonate = (^. ldtValue . itID) <$> let rdetonate =
lookup RemoteDetonatorLink (magtree ^. ldtLeft) (^. ldtValue . itID)
rscreen = (^. ldtValue . itID) <$> <$> lookup RemoteDetonatorLink (magtree ^. ldtLeft)
lookup RemoteScreenLink (magtree ^. ldtLeft) rscreen =
aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload)) (^. ldtValue . itID)
<|> ammoitem ^? itConsumables . magParams . ampPayload <$> lookup RemoteScreenLink (magtree ^. ldtLeft)
aparams <-
((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
<|> ammoitem ^? itConsumables . magParams . ampPayload
return $ return $
createShell rdetonate rscreen stab pjtype aparams muz cr createShell rdetonate rscreen stab pjtype aparams muz cr
. startthesound . startthesound
src/Dodge/Item/Scope.hs
+1 -1
View File
@@ -73,7 +73,7 @@ remoteScreen = makeAttach REMOTESCREEN
remoteDetonator :: Item remoteDetonator :: Item
remoteDetonator = makeAttach REMOTEDETONATOR remoteDetonator = makeAttach REMOTEDETONATOR
& itUse .~ UseHammer HammerUp -- & itUse .~ UseHammer HammerUp
& itUse . uaParams .~ APProjectiles [] & itUse . uaParams .~ APProjectiles []
joystick :: Item joystick :: Item
src/Dodge/WorldEffect.hs
+2 -1
View File
@@ -5,6 +5,7 @@ module Dodge.WorldEffect (
lineOutputTerminal, lineOutputTerminal,
) where ) where
import Dodge.Data.Input
import Dodge.HeldUse import Dodge.HeldUse
import Dodge.Data.ComposedItem import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree import Dodge.Data.DoubleTree
@@ -43,7 +44,7 @@ doWdWd we = case we of
doItCrWdWd :: ItCrWdWd -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World doItCrWdWd :: ItCrWdWd -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
doItCrWdWd icww = case icww of doItCrWdWd icww = case icww of
ItCrWdItemHeldEffect -> heldEffect ItCrWdItemHeldEffect -> heldEffect InitialPress
accessTerminal :: Maybe Int -> World -> World accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = fromMaybe w $ do accessTerminal mtmid w = fromMaybe w $ do