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
2025-07-12 21:52:12 +01:00
parent 026dbf9d15
commit a054d433b3
7 changed files with 28 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/ComposedItem.hs
+3 -3
View File
@@ -7,7 +7,7 @@ import Dodge.Data.Item
import Linear
import qualified Linear.Quaternion as Q
data ItemStructuralFunction
data ItemSF -- Structural Function
= UnloadedWeaponSF
| HeldPlatformSF
| UnderBarrelSlotSF
@@ -38,6 +38,6 @@ data ItemStructuralFunction
| LaserWeaponSF
deriving (Eq, Ord, Show, Read)
type CItem = (Item, ItemStructuralFunction)
type CItem = (Item, ItemSF)
type OItem = (Item, ItemStructuralFunction, (V3 Float,Q.Quaternion Float))
type OItem = (Item, ItemSF, (V3 Float,Q.Quaternion Float))
src/Dodge/DoubleTree.hs
+4 -4
View File
@@ -281,8 +281,8 @@ locUp (LocLDT c@RightwardLDT{} t) =
(_cldtUp c)
(LDT (_cldtParent c) (_cldtFarLeft c) (_cldtCloseLeft c ++ ((_cldtLink c, t) : _cldtCloseRight c)))
locToTop :: LocationLDT b a -> LocationLDT b a
locToTop loc = maybe loc locToTop $ locUp loc
--locToTop :: LocationLDT b a -> LocationLDT b a
--locToTop loc = maybe loc locToTop $ locUp loc
locUp' :: LocationDT a -> Maybe (LocationDT a)
locUp' (LocDT TopDT _) = Nothing
@@ -297,8 +297,8 @@ locUp' (LocDT c@RightwardDT{} t) =
(_cdtUp c)
(DT (_cdtParent c) (_cdtFarLeft c) (_cdtCloseLeft c ++ ( t : _cdtCloseRight c)))
locToTop' :: LocationDT a -> LocationDT a
locToTop' loc = maybe loc locToTop' $ locUp' loc
locToTop :: LocationDT a -> LocationDT a
locToTop loc = maybe loc locToTop $ locUp' loc
--locToTop = fix $ \x -> fromMaybe x $ locUp x
src/Dodge/HeldUse.hs
+2 -5
View File
@@ -750,7 +750,7 @@ basicMuzFlare pos dir =
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
isAmmoIntLink :: Int -> ItemStructuralFunction -> Bool
isAmmoIntLink :: Int -> ItemSF -> Bool
isAmmoIntLink i (AmmoMagSF j _) = i == j
isAmmoIntLink _ _ = False
@@ -796,10 +796,7 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
mid = magtree ^? dtValue . _1 . itLocation . ilInvID
itm = itmtree ^. dtValue . _1
getAttachedSFLink ::
ItemStructuralFunction ->
DTree OItem ->
Maybe (NewInt ItmInt)
getAttachedSFLink :: ItemSF -> DTree OItem -> Maybe (NewInt ItmInt)
getAttachedSFLink sf = (^? dtRight . folding (find f) . dtValue . _1 . itID)
where
f :: DTree OItem -> Bool
src/Dodge/Item/Grammar.hs
+9 -28
View File
@@ -33,26 +33,7 @@ import ListHelp
tryAttachItems :: DTree CItem -> DTree CItem -> Maybe (DTree CItem)
tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
--breakListAbove :: Item -> ItemStructuralFunction -> [(ItemStructuralFunction, ItemLink)]
--breakListAbove itm itmf = case (itm ^. itType, itmf) of
-- (_, HeldPlatformSF) ->
-- [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
-- <> getAutoSpringLinks itm
-- <> extraWeaponLinks itm
-- (DETECTOR {}, _) ->
-- [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
-- (CRAFT TRANSFORMER, _) -> [(LaserWeaponSF,SFLink LaserWeaponSF)]
-- (MAPPER, _) -> [(ARHUDSF,SFLink ARHUDSF)]
-- (_, GadgetPlatformSF) ->
-- [(TriggerSF, TriggerLink), (WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
-- (_, RemoteScreenSF) ->
-- [(JoystickSF, JoystickLink)]
-- _ -> []
itemToBreakLists ::
Item ->
ItemStructuralFunction ->
([ItemStructuralFunction], [ItemStructuralFunction])
itemToBreakLists :: Item -> ItemSF -> ([ItemSF], [ItemSF])
itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
(HELD TORCH, _) -> (getAmmoLinks itm, [])
(ATTACH UNDERBARRELSLOT, _) -> ([UnderBarrelPlatformSF], [])
@@ -105,12 +86,12 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
([AmmoMagSF 0 ElectricalAmmo], [])
_ -> ([], [])
getAutoSpringLinks :: Item -> [ItemStructuralFunction]
getAutoSpringLinks :: Item -> [ItemSF]
getAutoSpringLinks itm = case baseItemTriggerType itm of
HammerTrigger _ -> [MakeAutoSF]
_ -> []
extraWeaponLinks :: Item -> [ItemStructuralFunction]
extraWeaponLinks :: Item -> [ItemSF]
extraWeaponLinks itm = case itm ^. itType of
HELD GLAUNCHER -> launcherlinks <> [GrenadeHitEffectSF]
HELD RLAUNCHER -> launcherlinks
@@ -119,15 +100,15 @@ extraWeaponLinks itm = case itm ^. itType of
where
launcherlinks = [ProjectileStabiliserSF]
extraWeaponLinksBelow :: Item -> [ItemStructuralFunction]
extraWeaponLinksBelow :: Item -> [ItemSF]
extraWeaponLinksBelow itm
| TwoHandUnder <- itemBaseStance itm = [UnderBarrelSlotSF]
| otherwise = []
getAmmoLinks :: Item -> [ItemStructuralFunction]
getAmmoLinks :: Item -> [ItemSF]
getAmmoLinks itm = map (uncurry AmmoMagSF) (IM.toList $ itemAmmoSlots itm)
itemToFunction :: Item -> ItemStructuralFunction
itemToFunction :: Item -> ItemSF
itemToFunction itm = case itm ^. itType of
DETECTOR {} -> GadgetPlatformSF
MAPPER -> MapperSF
@@ -161,7 +142,7 @@ itemToFunction itm = case itm ^. itType of
CLICKER{} -> GadgetPlatformSF
_ -> NoSF
treeToPotentialFunction :: DTree CItem -> S.Set ItemStructuralFunction
treeToPotentialFunction :: DTree CItem -> S.Set ItemSF
treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
STICKYMOD -> S.singleton GrenadeHitEffectSF
ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
@@ -192,13 +173,13 @@ rightIsParentCombine ltree rtree = do
sf <- safeHead xs
return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
leftChildList :: DTree CItem -> [ItemStructuralFunction]
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)
f x y = tail $ dropWhile (/=y) x
rightChildList :: DTree CItem -> [ItemStructuralFunction]
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)
src/Dodge/Item/HeldOffset.hs
+2 -2
View File
@@ -55,7 +55,7 @@ handOrient cr = case cr ^. crStance . posture of
locOrient :: LocationDT OItem -> Creature -> Point3Q
locOrient loc cr =
handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop' loc) cr
handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr
`Q.comp` (loc ^. locDT . dtValue . _3)
handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
@@ -63,7 +63,7 @@ handHandleOrient loc cr =
handOrient cr (aimStance (loc' ^. locDT))
`Q.comp` handleOrient loc'
where
loc' = locToTop' loc
loc' = locToTop loc
shoulderHeight :: Float
shoulderHeight = 18
src/Dodge/Item/Orientation.hs
+1 -1
View File
@@ -21,7 +21,7 @@ orientChild itm = case _itType itm of
--r = Q.axisAngle (V3 0 0 1) (-pi/4)
r = Q.qID
orientByParentChSF :: Item -> ItemStructuralFunction -> Point3Q
orientByParentChSF :: Item -> ItemSF -> Point3Q
orientByParentChSF itm lt = case (_itType itm, lt) of
(HELD FLAMETHROWER, AmmoMagSF{}) -> (V3 4 (-6) 0, Q.qID)
(HELD _, AmmoMagSF{}) -> (V3 7 (-2) 0, Q.qID)
src/Dodge/Render/HUD.hs
+7 -8
View File
@@ -4,8 +4,6 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Data.EquipType
import Dodge.Item.Location
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -22,6 +20,7 @@ import Dodge.Data.CardinalPoint
import Dodge.Data.Combine
import Dodge.Data.Config
import Dodge.Data.DoubleTree
import Dodge.Data.EquipType
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.DoubleTree
@@ -31,6 +30,7 @@ import Dodge.Item.Display
import Dodge.Item.Grammar
import Dodge.Item.Info
import Dodge.Item.InvSize
import Dodge.Item.Location
import Dodge.ListDisplayParams
import Dodge.Render.Connectors
--import Dodge.Render.HUD.Carte
@@ -48,7 +48,7 @@ import SDL (MouseButton (..))
drawHUD :: Configuration -> World -> Picture
drawHUD cfig w = case w ^. hud . hudElement of
-- DisplayCarte -> drawCarte cfig w
-- DisplayCarte -> drawCarte cfig w
DisplayInventory{_diSections = sections, _subInventory = subinv} ->
drawInventory sections w cfig
<> drawSubInventory subinv cfig w
@@ -96,7 +96,7 @@ getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
getRootItemBounds i inv = do
let ia = invIndents inv -- why indents? why OItem?
itm <- ia ^? ix i . _2
let root = locToTop' itm
let root = locToTop itm
x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
return (x, y)
@@ -160,7 +160,7 @@ drawDragSelecting cfig w = do
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory{} -> drawRBOptions cfig w
ExamineInventory -> drawExamineInventory cfig w
DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
@@ -172,8 +172,7 @@ drawMapperInventory itid w = fold $ do
itm <- w ^? pointerToItemID itid
ls <- itm ^? itUse . useMapperLines
let _ = w ^. wCam . camRot
return . color red
$ foldMap (\(x,y) -> line [f x,f y]) ls
return . color red $ foldMap (\(x, y) -> line [f x, f y]) ls
where
f = worldPosToScreen (w ^. wCam)
@@ -253,7 +252,7 @@ drawRBOptions cfig w = fold $ do
invid <- you w ^? crManipulation . manObject . imSelectedItem
eslist <-
fmap eqSiteToPositions $
you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
you w ^? crInv . ix invid >>= equipType -- . itUse . uequipEffect . eeType
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation invid w
sss <- w ^? hud . hudElement . diSections