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

Unify matrix uniform assignment, move towards uniform block

Browse Source
This commit is contained in:
justin
2021-06-24 14:38:17 +02:00
parent 2625927f14
commit d534f08064
19 changed files with 70 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Tree.hs
+9 -26
View File
@@ -30,7 +30,6 @@ picToLTree mx (BezierQuad i vs) = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map ze
where
(ps,cols,offps,rads) = unzip4 vs
rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse
[( (-r, r,0), colC)
,( (-r,-r,0), colE)
@@ -53,24 +52,21 @@ picToLTree mx (Line i ps)
picToLTree mx (LineCol i vs)
= filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
where (ps,cs) = unzip vs
picToLTree mx (Text i s)
= filtB mx i $ LLeaf $ RenderText $ stringToList s
picToLTree mx (Text i s) = filtB mx i $ LLeaf $ RenderText $ stringToList s
picToLTree _ Blank = LBranches []
picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
picToLTree j (OverPic f r f'' (OverPic g s g'' pic))
= picToLTree j $ OverPic (f . g) (r + s) (f'' . g'') pic
picToLTree j (OverPic f r f'' (Pictures ps))
= LBranches (map (picToLTree j . OverPic f r f'') ps)
picToLTree j (OverPic f r f'' pic)
= overPos f . overRot r . overCol f'' <$> picToLTree j pic
picToLTree j (OverPic f f' (OverPic g g' pic)) = picToLTree j $ OverPic (f . g) (f' . g') pic
picToLTree j (OverPic f f' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f') ps)
picToLTree j (OverPic f f' pic) = overPos f . 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
filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
{-# INLINE filtB #-}
filtB mx i t | Just i == mx || isNothing mx = t
| otherwise = LBranches []
filtB mx i t
| Just i == mx || isNothing mx = t
| otherwise = LBranches []
doubleLine :: [a] -> [a]
{-# INLINE doubleLine #-}
@@ -91,10 +87,6 @@ overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
overPos f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs
overPos _ _ = undefined
overRot :: Float -> RenderType -> RenderType
{-# INLINE overRot #-}
overRot _ ren = ren
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
{-# INLINE overCol #-}
overCol f (RenderPoly vs) = RenderPoly $ map (second f) vs
@@ -102,12 +94,12 @@ 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 vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs
overCol _ _ = undefined
stringToList :: String -> [(Point3,Point4,Point2)]
{-# INLINE stringToList #-}
stringToList s = concat $ zipWith (\x -> map (f x))
stringToList s = concat $ zipWith (map . f)
[0,0.9*dimText..]
$ map charToTuple s
where
@@ -133,12 +125,3 @@ charToTuple c =
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)
-- where (x',y') = rotateV a (x,y)