Commit before attempting to remove ItemLinks, move LDT -> DT

This commit is contained in:
2025-07-10 11:20:27 +01:00
parent 8a8623d30b
commit e013bd57f7
2 changed files with 18 additions and 29 deletions
+16
View File
@@ -36,6 +36,22 @@ tryAttachItems :: LDTree ItemLink CItem -> LDTree ItemLink CItem ->
Maybe (LDTree ItemLink 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 ->
+2 -29
View File
@@ -1,8 +1,5 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.Orientation (
orientAttachment,
orientLocation,
propagateOrientation,
) where
@@ -21,7 +18,8 @@ orientChild itm = case _itType itm of
ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, r)
_ -> (0, Q.qID)
where
r = Q.axisAngle (V3 0 0 1) (-pi/4)
--r = Q.axisAngle (V3 0 0 1) (-pi/4)
r = Q.qID
orientByLink :: Item -> ItemLink -> Point3Q
orientByLink itm lt = case (_itType itm, lt) of
@@ -41,33 +39,8 @@ orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
(t1, q1) = orientByLink par lnk
(t2, q2) = orientChild ch
orientLocation' :: Point3Q -> LocationLDT ItemLink Item -> Point3Q
orientLocation' x = \case
(LocLDT TopLDT _) -> x
(LocLDT c t) -> orientLocation' x (LocLDT (_cldtUp c) (singleLDT (_cldtParent c)))
`Q.comp` orientAttachment (_cldtParent c) (_cldtLink c) (_ldtValue t)
-- (LocLDT c t) -> (p + Q.rotate q p1, q * q1)
-- where
-- (p, q) = orientLocation' x (LocLDT (_cldtUp c) (singleLDT (_cldtParent c)))
-- (p1, q1) = orientAttachment (_cldtParent c) (_cldtLink c) (_ldtValue t)
orientLocation :: Point3Q -> LocationLDT ItemLink Item -> Point3Q -> Point3Q
orientLocation x = Q.comp . orientLocation' x
--orientLocation x loc (p1, q1) = (p + Q.rotate q p1, q * q1)
-- where
-- (p, q) = orientLocation' x loc
propagateOrientation :: LDTree ItemLink CItem -> LDTree ItemLink OItem
propagateOrientation = ldtStartPropagate g f
where
g (x,y) = (x,y,(V3 0 0 0,Q.qID))
f (x,_,pq) i (y,y1) = (y,y1,Q.comp pq $ orientAttachment x i y)
--propagateOrientation' :: LDTree ItemLink Item
-- -> LDTree ItemLink (Item, (Point3, Q.Quaternion Float))
--propagateOrientation' = ldtStartPropagate g f
-- where
-- g x = (x,(V3 0 0 0,Q.qID))
-- f (x,(p,q)) i y = let (p1,q1) = orientAttachment x i y
-- in (y,(p + Q.rotate q p1, q * q1))