Tweak use location
This commit is contained in:
@@ -13,7 +13,7 @@ import Dodge.DoubleTree
|
||||
import Geometry.Data
|
||||
import qualified Quaternion as Q
|
||||
|
||||
orientChild :: Item -> (Point3, Q.Quaternion Float)
|
||||
orientChild :: Item -> Point3Q
|
||||
orientChild itm = case _itType itm of
|
||||
HELD TORCH -> (V3 0 5 0, Q.qID)
|
||||
--HELD LASER -> (V3 15 (-5) 0, Q.qID)
|
||||
@@ -23,14 +23,14 @@ orientChild itm = case _itType itm of
|
||||
where
|
||||
r = Q.axisAngle (V3 0 0 1) (-pi/4)
|
||||
|
||||
orientByLink :: Item -> ItemLink -> (Point3, Q.Quaternion Float)
|
||||
orientByLink :: Item -> ItemLink -> Point3Q
|
||||
orientByLink itm lt = case (_itType itm, lt) of
|
||||
(HELD FLAMETHROWER, AmmoInLink{}) -> (V3 4 (-6) 0, Q.qID)
|
||||
(HELD _, AmmoInLink{}) -> (V3 7 (-2) 0, Q.qID)
|
||||
(HELD _, WeaponScopeLink) -> (V3 5 0 5, Q.qID)
|
||||
_ -> (0, Q.qID)
|
||||
|
||||
orientAttachment :: Item -> ItemLink -> Item -> (Point3, Q.Quaternion Float)
|
||||
orientAttachment :: Item -> ItemLink -> Item -> Point3Q
|
||||
orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
|
||||
(ATTACH UNDERBARRELSLOT, _, _) -> (V3 (-5) (-8) 0, Q.qID)
|
||||
-- (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
|
||||
@@ -40,32 +40,28 @@ orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
|
||||
(t1, q1) = orientByLink par lnk
|
||||
(t2, q2) = orientChild ch
|
||||
|
||||
orientLocation' ::
|
||||
(Point3, Q.Quaternion Float) ->
|
||||
LocationLDT ItemLink Item ->
|
||||
(Point3, Q.Quaternion Float)
|
||||
orientLocation' :: Point3Q -> LocationLDT ItemLink Item -> Point3Q
|
||||
orientLocation' x = \case
|
||||
(LocLDT TopLDT _) -> x
|
||||
(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)
|
||||
(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 ::
|
||||
(Point3, Q.Quaternion Float) ->
|
||||
LocationLDT ItemLink Item ->
|
||||
(Point3, Q.Quaternion Float) ->
|
||||
(Point3, Q.Quaternion Float)
|
||||
orientLocation x loc (p1, q1) = (p + Q.rotate q p1, q * q1)
|
||||
where
|
||||
(p, q) = orientLocation' x loc
|
||||
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,_,(p,q)) i (y,y1) = let (p1,q1) = orientAttachment x i y
|
||||
in (y,y1,(p + Q.rotate q p1, q * q1))
|
||||
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))
|
||||
|
||||
Reference in New Issue
Block a user