From 27ce087e330285958231e764d3bca305b342582f Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 13 Jul 2025 22:24:54 +0100 Subject: [PATCH] Cleanup, split itemToBreakLists --- src/Dodge/Item/Draw/SPic.hs | 28 +-------- src/Dodge/Item/Grammar.hs | 118 ++++++++++++++++++++++++------------ 2 files changed, 81 insertions(+), 65 deletions(-) diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 159b898bc..3b8447c5a 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -141,12 +141,6 @@ craftItemSPic = \case . upperCylinder Small Typical 1 $ polyCirc 3 4 --- FRAGMODULE --- FLASHMODULE --- GASINJECTOR --- FLAKCRAFT --- FRAGCRAFT - ammoMagSPic :: Item -> AmmoMagType -> SPic ammoMagSPic it = \case TINMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- (am * 5)) (-1) 1) @@ -385,10 +379,7 @@ volleyGunShape i = -- to get this rotating should probably add extra state to the minigun miniGunXPictItem :: Int -> Item -> SPic -miniGunXPictItem i it = miniGunXPict i spin - where - --spin = (-10) + _warmTime (_heldDelay $ _itUse it) - spin = (-10) + _wTime (_itParams it) +miniGunXPictItem i it = miniGunXPict i (_wTime (_itParams it) - 10) miniGunXPict :: Int -> Int -> SPic miniGunXPict i spin = @@ -421,14 +412,6 @@ rlauncherPic _ = noPic . colorSH cyan $ xCylinderST 5 20 glauncherPic :: Item -> SPic glauncherPic _ = noPic . colorSH green $ xCylinderST 5 20 ---launcherPic _ = noPic . colorSH cyan $ xCylinder 4 5 20 --- ( colorSH cyan $ --- prismPoly --- (map (+.+.+ V3 20 0 5) $ polyCircx 4 5) --- (map (+.+.+ V3 0 0 5) $ polyCircx 4 5) --- , mempty --- ) - baseRodShape :: Shape baseRodShape = colorSH orange $ xCylinderST 3 20 @@ -494,14 +477,5 @@ keyPic = , thickLine 2 $ map toV2 [(4, 0), (4, -4)] ] ---latchkeyPic :: Picture ---latchkeyPic = --- color yellow $ --- pictures --- [ translate (-4) 0 $ thickCircle 4 2 --- , thickLine 2 $ map toV2 [(0, 0), (8, 0), (8, -4)] --- , thickLine 2 $ map toV2 [(4, 0), (4, -4)] --- ] - legsSPic :: Color -> SPic legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPolyST 3 $ rectWH 2 2 diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 7883e0949..a9cd8d1a8 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -33,33 +33,27 @@ import ListHelp tryAttachItems :: DTree CItem -> DTree CItem -> Maybe (DTree CItem) tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine -itemToBreakLists :: Item -> ItemSF -> ([ItemSF], [ItemSF]) -itemToBreakLists itm itmf = case (itm ^. itType, itmf) of - (HELD TORCH, _) -> (getAmmoLinks itm, []) - (ATTACH UNDERBARRELSLOT, _) -> ([UnderBarrelPlatformSF], []) +itemAboveAttachables :: CItem -> [ItemSF] +itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of (_, HeldPlatformSF) -> - ( getAmmoLinks itm - <> extraWeaponLinksBelow itm - , [WeaponTargetingSF, WeaponScopeSF] + [WeaponTargetingSF, WeaponScopeSF] <> getAutoSpringLinks itm <> extraWeaponLinks itm - ) - (_, UnderBarrelPlatformSF) -> - ( getAmmoLinks itm,[]) - (DETECTOR {}, _) -> - ( getAmmoLinks itm - , [ARHUDSF,TriggerSF,MapperSF] - ) - (CRAFT TRANSFORMER, _) -> ([],[LaserWeaponSF]) - (MAPPER, _) -> - ( [] - , [ARHUDSF] - ) - (_, GadgetPlatformSF) -> - ( getAmmoLinks itm - , [TriggerSF, WeaponTargetingSF, WeaponScopeSF] - ) - (_, AmmoMagSF{}) -> fromMaybe ([], []) $ do + (DETECTOR {}, _) -> [ARHUDSF,TriggerSF,MapperSF] + (CRAFT TRANSFORMER, _) -> [LaserWeaponSF] + (MAPPER, _) -> [ARHUDSF] + (_, GadgetPlatformSF) -> [TriggerSF, WeaponTargetingSF, WeaponScopeSF] + _ -> [] + +itemBelowAttachables :: CItem -> [ItemSF] +itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of + (HELD TORCH, _) -> getAmmoLinks itm + (ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF] + (_, HeldPlatformSF) -> getAmmoLinks itm <> extraWeaponLinksBelow itm + (_, UnderBarrelPlatformSF) -> getAmmoLinks itm + (DETECTOR {}, _) -> getAmmoLinks itm + (_, GadgetPlatformSF) -> getAmmoLinks itm + (_, AmmoMagSF{}) -> fromMaybe [] $ do atype <- magAmmoType itm let screenanddet = case atype of LauncherAmmo -> @@ -67,24 +61,72 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of , RemoteDetonatorSF ] _ -> [] - return - ( [ AmmoModifierSF atype + return $ + [ AmmoModifierSF atype , AmmoTargetingSF atype , AmmoPayloadSF atype , AmmoEffectSF atype , SmokeReducerSF ] <> screenanddet - , [] - ) - (_, RemoteScreenSF) -> - ( [JoystickSF] - , [] - ) - (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [ARHUDSF], []) - (ATTACH BULLETSYNTH, _) -> - ([AmmoMagSF 0 ElectricalAmmo], []) - _ -> ([], []) + + (_, RemoteScreenSF) -> [JoystickSF] + (_, WeaponTargetingSF) -> getAmmoLinks itm ++ [ARHUDSF] + (ATTACH BULLETSYNTH, _) -> [AmmoMagSF 0 ElectricalAmmo] + _ -> [] + +--itemToBreakLists :: Item -> ItemSF -> ([ItemSF], [ItemSF]) +--itemToBreakLists itm itmf = case (itm ^. itType, itmf) of +-- (HELD TORCH, _) -> (getAmmoLinks itm, []) +-- (ATTACH UNDERBARRELSLOT, _) -> ([UnderBarrelPlatformSF], []) +-- (_, HeldPlatformSF) -> +-- ( getAmmoLinks itm +-- <> extraWeaponLinksBelow itm +-- , [WeaponTargetingSF, WeaponScopeSF] +-- <> getAutoSpringLinks itm +-- <> extraWeaponLinks itm +-- ) +-- (_, UnderBarrelPlatformSF) -> +-- ( getAmmoLinks itm,[]) +-- (DETECTOR {}, _) -> +-- ( getAmmoLinks itm +-- , [ARHUDSF,TriggerSF,MapperSF] +-- ) +-- (CRAFT TRANSFORMER, _) -> ([],[LaserWeaponSF]) +-- (MAPPER, _) -> +-- ( [] +-- , [ARHUDSF] +-- ) +-- (_, GadgetPlatformSF) -> +-- ( getAmmoLinks itm +-- , [TriggerSF, WeaponTargetingSF, WeaponScopeSF] +-- ) +-- (_, AmmoMagSF{}) -> fromMaybe ([], []) $ do +-- atype <- magAmmoType itm +-- let screenanddet = case atype of +-- LauncherAmmo -> +-- [ RemoteScreenSF +-- , RemoteDetonatorSF +-- ] +-- _ -> [] +-- return +-- ( [ AmmoModifierSF atype +-- , AmmoTargetingSF atype +-- , AmmoPayloadSF atype +-- , AmmoEffectSF atype +-- , SmokeReducerSF +-- ] +-- <> screenanddet +-- , [] +-- ) +-- (_, RemoteScreenSF) -> +-- ( [JoystickSF] +-- , [] +-- ) +-- (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [ARHUDSF], []) +-- (ATTACH BULLETSYNTH, _) -> +-- ([AmmoMagSF 0 ElectricalAmmo], []) +-- _ -> ([], []) getAutoSpringLinks :: Item -> [ItemSF] getAutoSpringLinks itm = case baseItemTriggerType itm of @@ -171,13 +213,13 @@ rightIsParentCombine ltree rtree = do leftChildList :: DTree CItem -> [ItemSF] leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2) where - l = fst $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2) + l = itemBelowAttachables (t ^. dtValue) f x y = tail $ dropWhile (/=y) x rightChildList :: DTree CItem -> [ItemSF] rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2) where - l = snd $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2) + l = itemAboveAttachables (t ^. dtValue) f x y = tail $ dropWhile (/=y) x leftRightCombine :: DTComb a -> DTComb a -> DTree a -> DTree a -> Maybe (DTree a)