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

Cleanup

Browse Source
This commit is contained in:
justin
2024-12-19 22:10:18 +00:00
parent 3da9490dd4
commit 2b5a81fd11
5 changed files with 81 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/YourControl.hs
+13 -13
View File
@@ -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
src/Dodge/Data/DoubleTree.hs
+30 -22
View File
@@ -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
src/Dodge/HeldUse.hs
+38
View File
@@ -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
-3
View File
@@ -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
-56
View File
@@ -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