Start adding DT versions of LDT functions

src/Dodge/DoubleTree.hs

@@ -15,6 +15,21 @@ singleLDT x = LDT x [] []
 ldtToDT :: LDTree b a -> DTree a
 ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
 
+dtStartPropagate :: (a -> c) -> (c -> a -> c) -> DTree a -> DTree c
+dtStartPropagate g f (DT x l r) = DT z 
+    (fmap (\(t) -> (dtPropagate' z f t)) l)
+    (fmap (\(t) -> (dtPropagate' z f t)) r)
+  where
+    z = g x
+ 
+
+dtPropagate' :: c -> (c -> a -> c) -> DTree a -> DTree c
+dtPropagate' x f (DT y l r) = DT z 
+    (fmap (\(t) -> (dtPropagate' z f t)) l)
+    (fmap (\(t) -> (dtPropagate' z f t)) r)
+  where
+    z = f x y
+
 ldtStartPropagate :: (a -> c) -> (c -> b -> a -> c) -> LDTree b a -> LDTree b c
 ldtStartPropagate g f (LDT x l r) = LDT z 
     (fmap (\(j,t) -> (j,ldtPropagate' z j f t)) l)

src/Dodge/Item/Draw.hs

@@ -4,6 +4,7 @@ module Dodge.Item.Draw (
     itemEquipPict,
 ) where
 
+import Dodge.DoubleTree
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
@@ -22,7 +23,7 @@ itemEquipPict cr itmtree
     , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
         = equipPosition esite cr attachpos (itemSPic itm)
     | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
-        = overPosSP (heldItemOffset loc cr) (itemTreeSPic itmtree)
+        = overPosSP (heldItemOffset loc cr) (itemTreeSPic $ ldtToDT itmtree)
     | otherwise = mempty
   where
     itm = itmtree ^. ldtValue . _1

src/Dodge/Item/Draw/SPic.hs

@@ -21,14 +21,14 @@ import Picture
 import Shape
 import ShapePicture
 
-itemTreeSPic :: LDTree ItemLink CItem -> SPic
-itemTreeSPic (LDT (itm,_) l r) = itemSPic itm <> foldMap (itemRotTreeSPic itm) (l <> r)
+itemTreeSPic :: DTree CItem -> SPic
+itemTreeSPic (DT (itm,_) l r) = itemSPic itm <> foldMap (itemRotTreeSPic itm) (l <> r)
 
-itemRotTreeSPic :: Item -> (ItemLink, LDTree ItemLink CItem) -> SPic
-itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
+itemRotTreeSPic :: Item -> (DTree CItem) -> SPic
+itemRotTreeSPic par ( t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
   where
     (p, q) = orientAttachment par itm
-    itm = t ^. ldtValue
+    itm = t ^. dtValue
 
 itemSPic :: Item -> SPic
 itemSPic it = case it ^. itType of

src/Dodge/Item/Orientation.hs

@@ -43,4 +43,10 @@ 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 (y,y1))
+    f (x,_,pq) _ (y,y1) = (y,y1,Q.comp pq $ orientAttachment x (y,y1))
+
+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))