Cleanup

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.ScancodeLShift `M.member` _pressedKeys (_input w) 
+        || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) =
-        || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) 
+        foldl' tryAssignHotkey w allHotkeys
-        = foldl' tryAssignHotkey w allHotkeys
+    | otherwise = foldl' useHotkey w (M.intersection thehotkeys (w ^. input . pressedKeys))
-    | otherwise = foldl' useHotKey w (M.intersection thehotkeys (w ^. input . pressedKeys))
   where
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
 
-useHotKey :: World -> Int -> World
+useHotkey :: World -> Int -> World
-useHotKey w invid = fromMaybe w $ do
+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

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]}
+data DoubleTree a = DT {_dtValue :: a, _dtLeft :: [DoubleTree a], _dtRight :: [DoubleTree a]}
-    deriving (Eq,Ord,Show,Read)
+    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)]
+data LabelDoubleTree b a = LDT
-        ,_ldtRight :: [(b,LabelDoubleTree b a)]}
+    { _ldtValue :: a
-    deriving (Eq,Ord,Show,Read)
+    , _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  
+        { _cldtUp :: ContextLDT b a
-        , _cldtCloseLeft :: [(b,LabelDoubleTree b a)] 
+        , _cldtCloseLeft :: [(b, LabelDoubleTree b a)]
         , _cldtParent :: a
         , _cldtLink :: b
-        , _cldtCloseRight :: [(b,LabelDoubleTree b a)]
+        , _cldtCloseRight :: [(b, LabelDoubleTree b a)]
-        , _cldtFarRight :: [(b,LabelDoubleTree b a)]
+        , _cldtFarRight :: [(b, LabelDoubleTree b a)]
         }
-    | RightwardLDT 
+    | RightwardLDT
-        { _cldtUp :: ContextLDT b a  
+        { _cldtUp :: ContextLDT b a
-        , _cldtFarLeft :: [(b,LabelDoubleTree b a)]
+        , _cldtFarLeft :: [(b, LabelDoubleTree b a)]
-        , _cldtCloseLeft :: [(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)
+    first f (LDT x l r) =
-        (map (bimap f (first f)) r)
+        LDT
+            x
+            (map (bimap f (first f)) l)
+            (map (bimap f (first f)) r)
 
 makeLenses ''DoubleTree
 makeLenses ''LabelDoubleTree

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
+

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

src/Dodge/Luse.hs

@@ -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
-