From 2b5a81fd110b63ce596364faf0e6c9b79d65c8a7 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 19 Dec 2024 22:10:18 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Creature/YourControl.hs | 26 +++++++------- src/Dodge/Data/DoubleTree.hs | 52 ++++++++++++++++------------ src/Dodge/HeldUse.hs | 38 +++++++++++++++++++++ src/Dodge/ItEffect.hs | 3 -- src/Dodge/Luse.hs | 56 ------------------------------- 5 files changed, 81 insertions(+), 94 deletions(-) delete mode 100644 src/Dodge/Luse.hs diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index e702f2884..c322fe034 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -2,10 +2,6 @@ module Dodge.Creature.YourControl ( yourControl, ) where -import Dodge.Data.ComposedItem -import Dodge.HeldUse -import Dodge.Data.DoubleTree -import Dodge.Item.Grammar import Control.Monad import Data.Foldable import qualified Data.Map.Strict as M @@ -13,9 +9,13 @@ import Data.Maybe import Dodge.Base.Coordinate import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.UseItem +import Dodge.Data.ComposedItem +import Dodge.Data.DoubleTree import Dodge.Data.World +import Dodge.HeldUse import Dodge.Hotkey import Dodge.InputFocus +import Dodge.Item.Grammar import Dodge.WASD import Geometry import LensHelp @@ -43,16 +43,15 @@ yourControl _ w handleHotkeys :: World -> World handleHotkeys w --- | SDL.ButtonRight `M.member` _mouseButtons (_input w) - | SDL.ScancodeLShift `M.member` _pressedKeys (_input w) - || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) - = foldl' tryAssignHotkey w allHotkeys - | otherwise = foldl' useHotKey w (M.intersection thehotkeys (w ^. input . pressedKeys)) + | SDL.ScancodeLShift `M.member` _pressedKeys (_input w) + || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) = + foldl' tryAssignHotkey w allHotkeys + | otherwise = foldl' useHotkey w (M.intersection thehotkeys (w ^. input . pressedKeys)) where thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys -useHotKey :: World -> Int -> World -useHotKey w invid = fromMaybe w $ do +useHotkey :: World -> Int -> World +useHotkey w invid = fromMaybe w $ do cr <- w ^? cWorld . lWorld . creatures . ix 0 itmloc <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT return $ heldEffectNoHammerCheck (bimap (^. iatType) (^. _1) itmloc) cr w @@ -132,7 +131,8 @@ wasdTwist cr (TwoHandOver, 0) -> return $ cr & crTwist .~ twistamount * pi & crDir -~ twistamount * pi _ -> Nothing - | otherwise = cr + | otherwise = + cr & crDir +~ _crTwist cr & crTwist .~ 0 --remove twistk where @@ -173,7 +173,7 @@ mouseActionsCr pkeys pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World pressedMBEffectsTopInventory pkeys w | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = youhammerdown $ useRootItem 0 w --- | isDown SDL.ButtonLeft && inTopInv = youhammerdown $ useItemLeftClick (you w) w + -- | isDown SDL.ButtonLeft && inTopInv = youhammerdown $ useItemLeftClick (you w) w | isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation | otherwise = w where diff --git a/src/Dodge/Data/DoubleTree.hs b/src/Dodge/Data/DoubleTree.hs index b61f3fdbc..ff364efbd 100644 --- a/src/Dodge/Data/DoubleTree.hs +++ b/src/Dodge/Data/DoubleTree.hs @@ -1,14 +1,15 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} --{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} -module Dodge.Data.DoubleTree - where + +module Dodge.Data.DoubleTree where import Control.Lens import Data.Aeson import Data.Aeson.TH import Data.Bifunctor + --import qualified Data.Map.Strict as M data DoubleTreeNodeType @@ -26,37 +27,41 @@ data LabelDoubleTreeNodeType a | LDTMidBelowNode a | LDTBottomNode a -data DoubleTree a = DT {_dtValue :: a,_dtLeft :: [DoubleTree a],_dtRight :: [DoubleTree a]} - deriving (Eq,Ord,Show,Read) +data DoubleTree a = DT {_dtValue :: a, _dtLeft :: [DoubleTree a], _dtRight :: [DoubleTree a]} + deriving (Eq, Ord, Show, Read) --data FLatLabelDoubleTreeNode b a = FLDT -- {_fldtValue :: a --- ,_fldtType :: +-- ,_fldtType :: -- ,_fldtIndentation :: Int -- ,_fldtID :: Int --- ,_fldtChildren = +-- ,_fldtChildren = -data LabelDoubleTree b a = LDT {_ldtValue :: a, _ldtLeft :: [(b,LabelDoubleTree b a)] - ,_ldtRight :: [(b,LabelDoubleTree b a)]} - deriving (Eq,Ord,Show,Read) +data LabelDoubleTree b a = LDT + { _ldtValue :: a + , _ldtLeft :: [(b, LabelDoubleTree b a)] + , _ldtRight :: [(b, LabelDoubleTree b a)] + } + deriving (Eq, Ord, Show, Read) -- I am not sure about the double use of records here -data ContextLDT b a = TopLDT +data ContextLDT b a + = TopLDT | LeftwardLDT - { _cldtUp :: ContextLDT b a - , _cldtCloseLeft :: [(b,LabelDoubleTree b a)] + { _cldtUp :: ContextLDT b a + , _cldtCloseLeft :: [(b, LabelDoubleTree b a)] , _cldtParent :: a , _cldtLink :: b - , _cldtCloseRight :: [(b,LabelDoubleTree b a)] - , _cldtFarRight :: [(b,LabelDoubleTree b a)] + , _cldtCloseRight :: [(b, LabelDoubleTree b a)] + , _cldtFarRight :: [(b, LabelDoubleTree b a)] } - | RightwardLDT - { _cldtUp :: ContextLDT b a - , _cldtFarLeft :: [(b,LabelDoubleTree b a)] - , _cldtCloseLeft :: [(b,LabelDoubleTree b a)] + | RightwardLDT + { _cldtUp :: ContextLDT b a + , _cldtFarLeft :: [(b, LabelDoubleTree b a)] + , _cldtCloseLeft :: [(b, LabelDoubleTree b a)] , _cldtParent :: a , _cldtLink :: b - , _cldtCloseRight :: [(b,LabelDoubleTree b a)] + , _cldtCloseRight :: [(b, LabelDoubleTree b a)] } data LocationLDT b a = LocLDT @@ -75,8 +80,11 @@ instance Functor (LabelDoubleTree b) where instance Bifunctor LabelDoubleTree where second = fmap - first f (LDT x l r) = LDT x (map (bimap f (first f)) l) - (map (bimap f (first f)) r) + first f (LDT x l r) = + LDT + x + (map (bimap f (first f)) l) + (map (bimap f (first f)) r) makeLenses ''DoubleTree makeLenses ''LabelDoubleTree diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 32c2ada19..4e163f16f 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -7,6 +7,7 @@ module Dodge.HeldUse ( mcUseHeld, ) where +import NewInt import Dodge.Luse import Dodge.Creature.Action.Blink import Dodge.RadarSweep @@ -565,3 +566,40 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do -- ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w -- pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm) ---- , withSmoke 1 black 20 200 5 + +useStopWatch :: Item -> Creature -> World -> World +useStopWatch itm _ = + timeFlow + .~ PausedTimeFlow + { _timeFlowCharge = 100 + , _scrollItemID = _itID itm + } + +useTimeScrollGun :: Item -> Creature -> World -> World +useTimeScrollGun itm _ = + timeFlow + .~ ItemScrollTimeFlow + { _scrollSmoothing = 0 + --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge + , _reverseAmount = 100 + , _futureWorlds = [] + , _scrollItemID = _itID itm + } + +useRewindGun :: NewInt ItmInt -> World -> World +useRewindGun i = + timeFlow + .~ RewindLeftClick +-- { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge + { _reverseAmount = 100 + , _scrollItemID = i + } + +--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of +-- [w'] -> w & cwTime . maybeWorld .~ Just' w' +-- (w' : ws) -> w +-- & cwTime . maybeWorld +-- .~ Just' w' +-- & cwTime . rewindWorlds .~ ws +-- _ -> w + diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index a4cf7bdea..045bb9c7e 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -9,9 +9,6 @@ import Dodge.Euse doInvEffect :: ItInvEffect -> Item -> Creature -> World -> World doInvEffect iie = case iie of NoInvEffect -> const $ const id - -- ChargeIfEquipped -> chargeIfEquipped - -- ChargeIfInInventory -> chargeIfInInventory - -- SetCharge i -> setItemCharge i EffectRootNotroot f g -> rootNotrootEff f g CreateShieldWall -> createShieldWall RemoveShieldWall -> removeShieldWall diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs deleted file mode 100644 index c799f58e8..000000000 --- a/src/Dodge/Luse.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -module Dodge.Luse ( --- useL, - useRewindGun, - useStopWatch, - useTimeScrollGun -) where - -import NewInt -import Dodge.Data.World ---import Dodge.Item.Weapon.TriggerType -import LensHelp - ---useL :: Luse -> Item -> Creature -> World -> World ---useL = \case --- LDoNothing -> const $ const id --- LRewind -> useRewindGun --- LTimePause -> hammerCheckL useStopWatch --- LTimeScroll -> hammerCheckL useTimeScrollGun - -useStopWatch :: Item -> Creature -> World -> World -useStopWatch itm _ = - timeFlow - .~ PausedTimeFlow - { _timeFlowCharge = 100 - , _scrollItemID = _itID itm - } - -useTimeScrollGun :: Item -> Creature -> World -> World -useTimeScrollGun itm _ = - timeFlow - .~ ItemScrollTimeFlow - { _scrollSmoothing = 0 - --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge - , _reverseAmount = 100 - , _futureWorlds = [] - , _scrollItemID = _itID itm - } - -useRewindGun :: NewInt ItmInt -> World -> World -useRewindGun i = - timeFlow - .~ RewindLeftClick --- { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge - { _reverseAmount = 100 - , _scrollItemID = i - } - ---useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of --- [w'] -> w & cwTime . maybeWorld .~ Just' w' --- (w' : ws) -> w --- & cwTime . maybeWorld --- .~ Just' w' --- & cwTime . rewindWorlds .~ ws --- _ -> w -