Hlint pass

This commit is contained in:
2025-07-12 21:45:51 +01:00
parent cab125a1e9
commit 06cf55aa73
5 changed files with 14 additions and 28 deletions
-2
View File
@@ -1,7 +1,5 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.ComposedItem where
+2 -2
View File
@@ -24,8 +24,8 @@ import ShapePicture
itemTreeSPic :: DTree CItem -> SPic
itemTreeSPic (DT (itm,_) l r) = itemSPic itm <> foldMap (itemRotTreeSPic itm) (l <> r)
itemRotTreeSPic :: Item -> (DTree CItem) -> SPic
itemRotTreeSPic par ( 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 ^. dtValue
+11 -16
View File
@@ -52,10 +52,10 @@ tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
itemToBreakLists ::
Item ->
ItemStructuralFunction ->
([(ItemStructuralFunction)], [(ItemStructuralFunction)])
([ItemStructuralFunction], [ItemStructuralFunction])
itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
(HELD TORCH, _) -> (getAmmoLinks itm, [])
(ATTACH UNDERBARRELSLOT, _) -> ([(UnderBarrelPlatformSF)], [])
(ATTACH UNDERBARRELSLOT, _) -> ([UnderBarrelPlatformSF], [])
(_, HeldPlatformSF) ->
( getAmmoLinks itm
<> extraWeaponLinksBelow itm
@@ -181,41 +181,36 @@ type DTComb a = DTree a -> DTree a -> Maybe (DTree a)
leftIsParentCombine :: DTComb CItem
leftIsParentCombine ltree rtree = do
let l = rightChildList ltree
xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction rtree))) l
(sf) <- safeHead xs
xs = dropWhile (\s -> not $ S.member s (treeToPotentialFunction rtree)) l
sf <- safeHead xs
return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf)
rightIsParentCombine :: DTComb CItem
rightIsParentCombine ltree rtree = do
let l = leftChildList rtree
xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction ltree))) l
(sf) <- safeHead xs
xs = dropWhile (\s -> not $ S.member s (treeToPotentialFunction ltree)) l
sf <- safeHead xs
return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
leftChildList :: DTree CItem -> [ItemStructuralFunction]
leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2)
where
l = fst $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
f x y = tail $ dropWhile ((/=y) ) x
f x y = tail $ dropWhile (/=y) x
rightChildList :: DTree CItem -> [ItemStructuralFunction]
rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2)
where
l = snd $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
f x y = tail $ dropWhile ((/=y)) x
f x y = tail $ dropWhile (/=y) x
leftRightCombine ::
DTComb a ->
DTComb a ->
DTree a ->
DTree a ->
Maybe (DTree a)
leftRightCombine :: DTComb a -> DTComb a -> DTree a -> DTree a -> Maybe (DTree a)
leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
where
checkdepth t t'@(DT x ls rs) = fromMaybe (checktop t t') $ do
(t'') <- safeHead ls
t'' <- safeHead ls
tx <- checkdepth t t''
return $ Just $ DT x (( tx) : tail ls) rs
return $ Just $ DT x (tx : tail ls) rs
checktop t t' = f' t t'
joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
+1 -1
View File
@@ -56,7 +56,7 @@ handOrient cr = case cr ^. crStance . posture of
locOrient :: LocationDT OItem -> Creature -> Point3Q
locOrient loc cr =
handHandleOrient (fmap (\(x, y, _) -> (x, y)) $ locToTop' loc) cr
handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop' loc) cr
`Q.comp` (loc ^. locDT . dtValue . _3)
handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
-7
View File
@@ -1,6 +1,5 @@
module Dodge.Item.Orientation (
orientAttachment,
-- propagateOrientation,
propagateOrientation',
) where
@@ -40,12 +39,6 @@ orientAttachment par (ch,chsf) = case (_itType par, chsf) of
(t1, q1) = orientByParentChSF par chsf
(t2, q2) = orientChild ch
--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) _ (y,y1) = (y,y1,Q.comp pq $ orientAttachment x (y,y1))
propagateOrientation' :: DTree CItem -> DTree OItem
propagateOrientation' = dtStartPropagate g f
where