LED tweak

src/Dodge/Creature/State.hs

@@ -238,11 +238,12 @@ shineTorch :: Creature -> LocationDT OItem -> World -> World
 shineTorch cr loc = fromMaybe id $ do
     mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
     i <- mag ^. dtValue . _1 . itConsumables
-    guard $ crIsAiming cr
+--    guard $ crIsAiming cr
     guard $ i >= x
     itid <- mag ^? dtValue . _1 . itID . unNInt
     return $
-        (cWorld . lWorld . lights .:~ LSParam pos 250 0.7)
+        (cWorld . lWorld . lights .:~ LSParam pos 150 0.3)
+           . (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3)
             . (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
   where
     itmtree = loc ^. locDT
@@ -250,7 +251,7 @@ shineTorch cr loc = fromMaybe id $ do
     x = 10
     isammolink AmmoMagSF{} = True
     isammolink _ = False
-    pos = _crPos cr `v2z` 0 + rotate3 cdir (p + Q.rotate q (V3 8 0 1.5))
+    pos = _crPos cr `v2z` 0 + rotate3 cdir (p + Q.rotate q (V3 5 0 1.5))
     cdir = _crDir cr
 
 -- this probably needs to be set to null when dropped as well?

src/Dodge/Item/Draw/SPic.hs

@@ -274,7 +274,7 @@ heldItemSPic ht it = case ht of
     KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic)
 
 torchShape :: Shape
-torchShape = colorSH blue $ upperPrismPolySE 3 $ rectWH 3 3
+torchShape = colorSH blue $ upperBox Small Essential 3 $ rectWH 3 3
 --    side = upperPrismPolySE 3 $ rectXH 10 0.5
 
 --    colorSH blue $

src/Dodge/Item/Orientation.hs

@@ -3,6 +3,7 @@ module Dodge.Item.Orientation (
     propagateOrientation,
 ) where
 
+import Dodge.Data.AmmoType
 import Shape.Data
 import Control.Lens
 import Linear
@@ -17,7 +18,9 @@ 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) (y-1) 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)
@@ -25,29 +28,42 @@ orientChild itm = case _itType itm of
   where
     --r = Q.axisAngle (V3 0 0 1) (-pi/4)
     r = Q.qID
-    y = itemShapeY itm
+--    y = itemShapeMin _y itm
-    x = itemShapeX 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{}) -> (V3 7 (-4) 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 5, Q.qID)
+    (HELD _, TorchSF) -> (V3 x y 0, Q.qID)
     _ -> (0, Q.qID)
   where
-    x = itemShapeX itm
+    x = itemShapeMaxX itm
-    y = itemShapeY itm
+    y = itemShapeMaxY itm
+    z = itemShapeMaxZ itm
 
-itemShapeX :: Item -> Float
+itemShapeMaxX :: Item -> Float
-itemShapeX = f . (^. _1) . itemSPic
+itemShapeMaxX = itemShapeMax _1
-  where
-    f = maximum . fmap (\sf -> maximum $ fmap (^. _1) (sf ^. sfVs))
 
-itemShapeY :: Item -> Float
+itemShapeMaxY :: Item -> Float
-itemShapeY = f . (^. _1) . itemSPic
+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 (^. _2) (sf ^. sfVs))
+    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