Cleanup, prepare ground to allow for drawing attached items

ghcidOutput

@@ -1 +1,15 @@
-All good (607 modules, at 14:27:18)
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:9:1-39: warning: [-Wunused-imports]
+    The qualified import of ‘Linear.Quaternion’ is redundant
+  |
+9 | import qualified Linear.Quaternion as Q
+  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:10:1-20: warning: [-Wunused-imports]
+    The import of ‘Geometry.Data’ is redundant
+   |
+10 | import Geometry.Data
+   | ^^^^^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Data/ComposedItem.hs:13:1-43: warning: [-Wunused-imports]
+    The import of ‘Dodge.Data.Item.Use.Consumption.Ammo’ is redundant
+   |
+13 | import Dodge.Data.Item.Use.Consumption.Ammo
+   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

src/Dodge/Data/ComposedItem.hs

@@ -1,16 +1,18 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.ComposedItem
+module Dodge.Data.ComposedItem where
-  where
+
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.Item.Use.Consumption.Ammo
 -- it would be nice not to have to import the following...
 import Dodge.Data.Item
+import Dodge.Data.Item.Use.Consumption.Ammo
+import Geometry.Data
+import Linear.Quaternion (Quaternion (..))
 
 data ComposeLinkType
     = AmmoInLink Int AmmoType
@@ -22,7 +24,7 @@ data ComposeLinkType
     | WeaponTargetingLink
     | RemoteScreenLink
     | AugmentedHUDLink
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
 
 data ItemStructuralFunction
     = WeaponPlatformSF
@@ -36,21 +38,25 @@ data ItemStructuralFunction
     | AmmoTargetingSF AmmoType
     | AmmoPayloadSF AmmoType
     | AmmoEffectSF AmmoType
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
 
-type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest)
+type PartiallyComposedItem lt = (Item, ItemStructuralFunction, LinkTest lt)
 
-data LinkTest = LinkTest
+data ItemAttachment = IAttach
-    { _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
+    { _iatType :: ComposeLinkType
-    , _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
+    , _iatOrient :: Item -> Item -> Maybe (Point3, Quaternion Float)
     }
 
-data LinkUpdate = LinkUpdate
+data LinkTest lt = LTest
-    { _luLinkType :: ComposeLinkType
+    { _tryLeftLink :: PartiallyComposedItem lt -> Maybe (LinkUpdate lt)
-    , _luParentUpdate :: PartiallyComposedItem -> PartiallyComposedItem
+    , _tryRightLink :: PartiallyComposedItem lt -> Maybe (LinkUpdate lt)
-    , _luChildUpdate :: PartiallyComposedItem -> PartiallyComposedItem
     }
 
+data LinkUpdate lt = LUpdate
+    { _luLinkType :: lt
+    , _luParentUpdate :: PartiallyComposedItem lt -> PartiallyComposedItem lt
+    , _luChildUpdate :: PartiallyComposedItem lt -> PartiallyComposedItem lt
+    }
 
 makeLenses ''LinkTest
 makeLenses ''LinkUpdate

src/Dodge/Item/Draw.hs

@@ -16,7 +16,8 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture
 
-itemEquipPict :: Creature -> LabelDoubleTree ComposeLinkType PartiallyComposedItem -> SPic
+itemEquipPict :: Creature -> LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType)
+    -> SPic
 itemEquipPict cr itmtree = case itm ^. itUse of
     UseHeld{} | itm ^? itLocation . ilIsRoot == Just True 
         -> overPosSP (heldItemOffset itm cr) (itemSPic itmtree)

src/Dodge/Item/Draw/SPic.hs

@@ -26,7 +26,7 @@ import ShapePicture
 --    hit <- itm ^? itType . iyBase . ibtHeld
 --    return mempty
 
-itemSPic :: LabelDoubleTree ComposeLinkType PartiallyComposedItem -> SPic
+itemSPic :: LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType) -> SPic
 itemSPic itmtree = case it ^. itType of
     CRAFT _ -> defSPic
     HELD ht -> heldItemSPic ht it

src/Dodge/Item/Grammar.hs

@@ -6,6 +6,8 @@ module Dodge.Item.Grammar (
     invRootMap,
 ) where
 
+import qualified Linear.Quaternion as Q
+import Geometry.Data
 import Control.Applicative
 --import TreeHelp
 
@@ -18,21 +20,22 @@ import Dodge.Data.Item
 import Dodge.DoubleTree
 import ListHelp
 
-useBreakListsLinkTest :: [(ItemStructuralFunction,ComposeLinkType)]
+
-    -> [(ItemStructuralFunction,ComposeLinkType)]
+useBreakListsLinkTest :: [(ItemStructuralFunction,a)]
-    -> LinkTest
+    -> [(ItemStructuralFunction,a)]
-useBreakListsLinkTest llist rlist = LinkTest ltest rtest
+    -> LinkTest a
+useBreakListsLinkTest llist rlist = LTest ltest rtest
   where
     ltest (_,sf,_) = do
         let xs = dropWhile ((/= sf) . fst) llist
         (_,linktype) <- safeHead xs
-        return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
+        return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
     rtest (_,sf,_) = do
         let xs = dropWhile ((/= sf) . fst) rlist
         (_,linktype) <- safeHead xs
-        return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
+        return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
 
-basePartiallyComposedItem :: Item -> PartiallyComposedItem
+basePartiallyComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
 basePartiallyComposedItem itm = case itm ^. itType of
     HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest 
         (map (\(i,a) -> (AmmoMagSF a,AmmoInLink i a)) (IM.toList $ itm ^. itUse . heldAmmoTypes))
@@ -40,24 +43,24 @@ basePartiallyComposedItem itm = case itm ^. itType of
         )
     AMMOMAG _ -> ammoComposedItem itm
     TARGETING {} -> (itm,WeaponTargetingSF, useBreakListsLinkTest [(AugmentedHUDSF,AugmentedHUDLink)] [])
-    ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LinkTest (const Nothing) (const Nothing))
+    ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LTest (const Nothing) (const Nothing))
-    ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LinkTest (const Nothing) (const Nothing))
+    ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LTest (const Nothing) (const Nothing))
     ATTACH AUGMENTEDHUD -> nolinks AugmentedHUDSF
     BULLETMOD BulletModTrajectory {} -> nolinks $ AmmoTargetingSF BulletAmmo
     BULLETMOD BulletModPayload {} -> nolinks $ AmmoPayloadSF BulletAmmo
     BULLETMOD BulletModEffect {} -> nolinks $ AmmoEffectSF BulletAmmo
     ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
-    ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LinkTest (const Nothing) (const Nothing))
+    ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
     LEFT {} -> isolate
     EQUIP {} -> isolate
     CONSUMABLE {} -> isolate
     CRAFT {} -> isolate
 --    _ -> 
   where
-    nolinks x = (itm,x, LinkTest (const Nothing) (const Nothing))
+    nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
-    isolate = (itm,UncomposableIsolateSF, LinkTest (const Nothing) (const Nothing))
+    isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
 
-ammoComposedItem :: Item -> PartiallyComposedItem
+ammoComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
 ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
     atype <- itm ^? itUse . amagType
     return (itm
@@ -74,13 +77,13 @@ ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
 
 type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
 
-leftIsParentCombine :: LDTComb PartiallyComposedItem ComposeLinkType
+leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
 leftIsParentCombine ltree rtree = do
     lu <- (ltree ^. ldtValue . _3 . tryRightLink) (rtree ^. ldtValue)
     return $ ltree & ldtValue %~ (lu ^. luParentUpdate)
         & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
 
-rightIsParentCombine :: LDTComb PartiallyComposedItem ComposeLinkType
+rightIsParentCombine :: LDTComb (PartiallyComposedItem a) a
 rightIsParentCombine ltree rtree = do
     lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
     return $ rtree & ldtValue %~ (lu ^. luParentUpdate)
@@ -111,20 +114,11 @@ joinItemsInList f xs = snd $ h (xs, [])
         Nothing -> h (ys, y : z : zs)
         Just w -> h (w : ys, zs)
 
-invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType PartiallyComposedItem]
+invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType)]
 invLDT =
     joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
         . fmap (singleLDT . basePartiallyComposedItem)
 
--- this has provoked an error: hopefully it will crop up at some point and get
--- debugged with suitable info
---invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
---invAdj =  IM.unions . fmap (dtToLRAdj getid . ldtToDT) . invLDT
---  where
---    getid (itm, _,_,_) = fromMaybe
---        (error ("invAdj item " ++ show (_itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
---        $ itm ^? itLocation . ilInvID
-
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
 -- consider explicitly reseting the inventory ids (but this probably really

src/Dodge/Machine/Draw.hs

@@ -63,7 +63,7 @@ drawTurret :: Turret -> Machine -> SPic
 drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic ittree)
   where
     itm = _tuWeapon tu
-    ittree = singleLDT (itm,UncomposableIsolateSF,LinkTest (const Nothing) (const Nothing))
+    ittree = singleLDT (itm,UncomposableIsolateSF,LTest (const Nothing) (const Nothing))
 
 sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
 sensorSPic (pc, ds) mc =

src/Dodge/Render/HUD.hs

@@ -1,4 +1,3 @@
---{-# LANGUAGE TupleSections #-}
 module Dodge.Render.HUD (
     drawHUD,
 ) where

src/Dodge/Render/ShapePicture.hs

@@ -164,7 +164,7 @@ floorItemSPic :: FloorItem -> SPic
 floorItemSPic flit =
     uncurryV translateSPxy (_flItPos flit) $
         rotateSP (_flItRot flit) 
-            (itemSPic $ singleLDT ((_flIt flit),UncomposableIsolateSF,LinkTest (const Nothing) (const Nothing)))
+            (itemSPic $ singleLDT ((_flIt flit),UncomposableIsolateSF,LTest (const Nothing) (const Nothing)))
 
 btSPic :: Button -> SPic
 btSPic bt =

src/Dodge/Tweak.hs

@@ -1,25 +0,0 @@
-module Dodge.Tweak () where
-
-import Control.Lens
-import Dodge.Data.Item
-
---doTweak :: TweakType -> Int -> Item -> Item
---doTweak tt = case tt of
---    TweakPhaseV -> tweakPhaseV
---    TweakTractionPower -> tweakTractionPower
---    TweakSpinDrag -> \i -> itParams . shellSpinDrag .~ i
---    TweakSpinAmount -> \i -> itParams . shellSpinAmount .~ i
---    TweakThrustDelay -> \i -> itParams . shellThrustDelay .~ i
-
-tweakTractionPower :: Int -> Item -> Item
-tweakTractionPower 0 = itParams . attractionPower .~ 1
-tweakTractionPower 1 = itParams . attractionPower .~ -1
-tweakTractionPower 2 = itParams . attractionPower .~ -10
-tweakTractionPower 3 = itParams . attractionPower .~ 0
-tweakTractionPower _ = id
-
-tweakPhaseV :: Int -> Item -> Item
-tweakPhaseV 0 = itParams . phaseV .~ 0.2
-tweakPhaseV 1 = itParams . phaseV .~ 1
-tweakPhaseV 2 = itParams . phaseV .~ 5
-tweakPhaseV _ = id