diff --git a/src/Dodge/DoubleTree.hs b/src/Dodge/DoubleTree.hs index 72c06d94f..0fd407164 100644 --- a/src/Dodge/DoubleTree.hs +++ b/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) diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 5bf171706..282aba039 100644 --- a/src/Dodge/Item/Draw.hs +++ b/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 diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index d7d81b232..2d6f01e1a 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/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 diff --git a/src/Dodge/Item/Orientation.hs b/src/Dodge/Item/Orientation.hs index b251d3106..d6a7f6d50 100644 --- a/src/Dodge/Item/Orientation.hs +++ b/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))