justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Linting

Browse Source
This commit is contained in:
justin
2021-04-23 11:10:45 +02:00
parent c740ca0844
commit ffe4a8083b
14 changed files with 329 additions and 286 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Tree.hs
+24 -14
View File
@@ -1,3 +1,4 @@
{- Transform a picture into renderable objects. -}
module Picture.Tree
( picToLTree
)
@@ -10,7 +11,11 @@ import Data.List
-- todo: refactor out the layer check somehow
-- consider generalising to alternative rather than using LTree
picToLTree :: Maybe Int -> Picture -> LTree RenderType
-- | Transform a picture into a tree of renderable objects
picToLTree
:: Maybe Int -- ^ Layer filter. Draw if 'Nothing' or when value is the same as at the leaf.
-> Picture
-> LTree RenderType
{-# INLINE picToLTree #-}
picToLTree mx (Polygon i ps)
= filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
@@ -28,20 +33,22 @@ picToLTree mx (Circle i colC colE r)
,( ( r,-r,0), black)
]
picToLTree mx (ThickArc i startA endA rad wdth)
= filtB mx i $ LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
= filtB mx i $ LLeaf $ RenderArc ((0,0,0),black,(startA,endA,rad,wdth))
picToLTree mx (Line i ps)
= filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
picToLTree mx (LineCol i vs)
= filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
where (ps,cs) = unzip vs
where (ps,cs) = unzip vs
picToLTree mx (Text i s)
= filtB mx i $ LLeaf $ RenderText $ stringToList s
picToLTree j Blank = LBranches []
picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic))
= picToLTree j $ OverPic (f . g) (f' . g') (r + s) (f'' . g'') pic
picToLTree j (OverPic f f' r f'' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f' r f'') ps)
picToLTree j (OverPic f f' r f'' pic) = fmap (overPos f . overSca f' . overRot r . overCol f'') $ picToLTree j pic
picToLTree j (OverPic f f' r f'' (Pictures ps))
= LBranches (map (picToLTree j . OverPic f f' r f'') ps)
picToLTree j (OverPic f f' r f'' pic)
= (overPos f . overSca f' . overRot r . overCol f'') <$> picToLTree j pic
picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
| otherwise = LBranches []
picToLTree Nothing (OnLayer _ pic) = picToLTree Nothing pic
@@ -53,7 +60,7 @@ filtB mx i t | Just i == mx || Nothing == mx = t
doubleLine :: [a] -> [a]
{-# INLINE doubleLine #-}
doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (: []) (y:xs)
doubleLine _ = []
white = (1,1,1,1)
@@ -70,8 +77,8 @@ scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))
overPos :: (Point3 -> Point3) -> RenderType -> RenderType
{-# INLINE overPos #-}
overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
overPos f (RenderPoly vs) = RenderPoly $ map (first f) vs
overPos f (RenderLine vs) = RenderLine $ map (first f) vs
overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
@@ -84,12 +91,12 @@ overRot _ ren = ren
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
{-# INLINE overCol #-}
overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
overCol f (RenderEllipse vs) = RenderEllipse $ map (second $ f) vs
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
overCol f (RenderPoly vs) = RenderPoly $ map (second f) vs
overCol f (RenderLine vs) = RenderLine $ map (second f) vs
overCol f (RenderEllipse vs) = RenderEllipse $ map (second f) vs
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
overSca :: (Point2 -> Point2) -> RenderType -> RenderType
{-# INLINE overSca #-}
@@ -110,12 +117,15 @@ charToTuple :: Char -> (Point3,Point4,Point3)
charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
where offset = fromIntegral (fromEnum c) - 32
{- Translate a 3D vector in the x and y directions. -}
translate3 :: Float -> Float -> Point3 -> Point3
{-# INLINE translate3 #-}
translate3 a b (x,y,z) = (x+a,y+b,z)
{- Scale a 3D vector in the x and y directions. -}
scale3 :: Float -> Float -> Point3 -> Point3
{-# INLINE scale3 #-}
scale3 a b (x,y,z) = (x*a,y*b,z)
{- Rotate a 3D vector in the x-y plane. -}
rotate3 :: Float -> Point3 -> Point3
{-# INLINE rotate3 #-}
rotate3 a (x,y,z) = (x',y',z)