85 lines
2.7 KiB
Haskell
85 lines
2.7 KiB
Haskell
module Dodge.Item.Orientation (
|
|
orientAttachment,
|
|
propagateOrientation,
|
|
) where
|
|
|
|
import Dodge.Data.AmmoType
|
|
import Shape.Data
|
|
import Control.Lens
|
|
import Linear
|
|
import Dodge.Item.Draw.SPic
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.Item
|
|
import Dodge.DoubleTree
|
|
import Geometry.Data
|
|
import qualified Quaternion as Q
|
|
|
|
orientChild :: Item -> Point3Q
|
|
orientChild itm = case _itType itm of
|
|
--HELD LED -> (V3 0 5 0, Q.qID)
|
|
HELD LED -> (V3 (-x) 0 0, Q.qID)
|
|
AMMOMAG BATTERY -> (V3 0 0 1, Q.qID)
|
|
AMMOMAG {} -> (V3 0 (2-itemShapeMax _y itm) 0, Q.qID)
|
|
--HELD LASER -> (V3 15 (-5) 0, Q.qID)
|
|
LASER -> (V3 15 (-5) 0, Q.qID)
|
|
ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, r)
|
|
_ -> (0, Q.qID)
|
|
where
|
|
--r = Q.axisAngle (V3 0 0 1) (-pi/4)
|
|
r = Q.qID
|
|
-- y = itemShapeMin _y itm
|
|
x = itemShapeMaxX itm
|
|
|
|
orientByParentChSF :: Item -> ItemSF -> Point3Q
|
|
orientByParentChSF itm lt = case (_itType itm, lt) of
|
|
(HELD FLAMETHROWER, AmmoMagSF{}) -> (V3 4 (-6) 0, Q.qID)
|
|
(HELD _, AmmoMagSF{_amsfType = ElectricalAmmo}) -> (V3 0 0 z, Q.qID)
|
|
(HELD _, AmmoMagSF{}) -> (V3 7 (itemShapeMin _y itm) 0, Q.qID)
|
|
(HELD _, WeaponScopeSF) -> (V3 5 0 5, Q.qID)
|
|
(HELD _, TorchSF) -> (V3 x y 0, Q.qID)
|
|
_ -> (0, Q.qID)
|
|
where
|
|
x = itemShapeMaxX itm
|
|
y = itemShapeMaxY itm
|
|
z = itemShapeMaxZ itm
|
|
|
|
itemShapeMaxX :: Item -> Float
|
|
itemShapeMaxX = itemShapeMax _1
|
|
|
|
itemShapeMaxY :: Item -> Float
|
|
itemShapeMaxY = itemShapeMax _2
|
|
|
|
itemShapeMaxZ :: Item -> Float
|
|
itemShapeMaxZ = itemShapeMax _3
|
|
|
|
itemShapeMax
|
|
:: ((Float -> Const Float Float) -> Point3 -> Const Float Point3) -> Item -> Float
|
|
itemShapeMax g = f . (^. _1) . itemSPic
|
|
where
|
|
f = maximum . fmap (\sf -> maximum $ fmap (^. g) (sf ^. sfVs))
|
|
|
|
itemShapeMin
|
|
:: ((Float -> Const Float Float) -> Point3 -> Const Float Point3) -> Item -> Float
|
|
itemShapeMin g = f . (^. _1) . itemSPic
|
|
where
|
|
f = minimum . fmap (\sf -> minimum $ fmap (^. g) (sf ^. sfVs))
|
|
|
|
orientAttachment :: Item -> CItem -> Point3Q
|
|
orientAttachment par (ch,chsf) = case (_itType par, chsf) of
|
|
(ATTACH UNDERBARRELSLOT, _) -> (V3 (-5) (-8) 0, Q.qID)
|
|
(_,LaserWeaponSF) -> (V3 2 8 0, Q.qID)
|
|
-- (_,TorchSF) -> (V3 2 8 0, Q.qID)
|
|
-- (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
|
|
-- (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4))
|
|
_ -> (t1 + Q.rotate q1 t2, q1 * q2)
|
|
where
|
|
(t1, q1) = orientByParentChSF par chsf
|
|
(t2, q2) = orientChild ch
|
|
|
|
propagateOrientation :: DTree CItem -> DTree OItem
|
|
propagateOrientation = dtStartPropagate g f
|
|
where
|
|
g (x,y) = (x,y,(V3 0 0 0,Q.qID))
|
|
f (x,_,pq) (y,y1) = (y,y1,Q.comp pq $ orientAttachment x (y,y1))
|