From 4f44b748bf3b0b9b5644646fee48613f78f0a466 Mon Sep 17 00:00:00 2001 From: jgk Date: Sun, 25 Jul 2021 02:21:55 +0200 Subject: [PATCH] Cleanup redundant modules --- app/Main.hs | 1 - src/Dodge/Render.hs | 1 - src/Picture.hs | 44 ++++++++++++- src/Picture/ToPolyhedra.hs | 11 ---- src/Picture/Tree.hs | 125 ------------------------------------- src/Polyhedra.hs | 1 + 6 files changed, 44 insertions(+), 139 deletions(-) delete mode 100644 src/Picture/ToPolyhedra.hs delete mode 100644 src/Picture/Tree.hs diff --git a/app/Main.hs b/app/Main.hs index ad63552fc..28ee05729 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -15,7 +15,6 @@ import Dodge.Debug.Flag.Data import Picture import Render import Preload.Render -import Picture.Tree import Sound import Preload import Sound.Data diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 8052e17cc..d94ed48f2 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -17,7 +17,6 @@ import Geometry.Data import Render import Data.Preload.Render import Picture.Data -import Picture.Tree import Shader import Shader.Data import Shader.Poke diff --git a/src/Picture.hs b/src/Picture.hs index bb40d16da..91ee59335 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -54,7 +54,6 @@ import Geometry import Geometry.Vector3D import Geometry.Data import Picture.Data -import Picture.Tree import Data.List import Data.Bifunctor @@ -125,6 +124,7 @@ bezierQuad cola colc ra rc a b c fa' = extrapolate aIn cIn bIn fc' = extrapolate cIn aIn bIn +bzhelp :: [(Point2, Point4, (Float, Float), (Float, Float))] -> [(Int, RenderType)] bzhelp vs = zl $ RenderBezQ $ zip3 (map zeroZ ps) cols rs where (ps,cols,offps,rads) = unzip4 vs @@ -280,6 +280,7 @@ thickArc startA endA rad wdth r = rad + 0.5 * wdth w = 1 - wdth / r +thickArcHelp :: Float -> Float -> Float -> Float -> [(Int, RenderType)] thickArcHelp startA endA rad wdth = zl $ RenderArc [( (0,0,0),black,(0,0,wdth)) ,((xa,ya,0),black,(1,0,wdth)) @@ -334,3 +335,44 @@ bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a) greyN :: Float -> Color greyN x = (x,x,x,1) + +overPos :: (Point3 -> Point3) -> RenderType -> RenderType +--{-# INLINE overPos #-} +overPos f (RenderPoly vs) = RenderPoly $ 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 +overPos f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs +overPos f (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (f a,b,c)) vs +overPos _ _ = undefined + +overCol :: (Point4 -> Point4) -> RenderType -> RenderType +--{-# INLINE overCol #-} +overCol f (RenderPoly vs) = RenderPoly $ 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 (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (a,f b,c)) vs +overCol _ _ = undefined + +-- no premature optimisation, consider changing to use texture arrays +stringToList :: String -> [(Point3,Point4,Point2)] +{-# INLINE stringToList #-} +--stringToList s = concat $ zipWith charToTuple [0,0.9*dimText ..] s +stringToList s = concatMap (uncurry charToTuple) $ zip [0,0.9*dimText ..] s + where + dimText = 100 + +charToTuple :: Float -> Char -> [(Point3,Point4,Point2)] +{-# INLINE charToTuple #-} +charToTuple x c = + [((x-50,-100,0), white,(offset,1)) + ,((x-50,100,0), white,(offset,0)) + ,((x+50,100,0), white,(offset+1,0)) + ,((x-50,-100,0), white,(offset,1)) + ,((x+50,-100,0), white,(offset+1,1)) + ,((x+50,100,0), white,(offset+1,0)) + ] + where + offset = fromIntegral (fromEnum c) - 32 diff --git a/src/Picture/ToPolyhedra.hs b/src/Picture/ToPolyhedra.hs deleted file mode 100644 index 0e7fcc9a0..000000000 --- a/src/Picture/ToPolyhedra.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Picture.ToPolyhedra - where -import Picture.Data -import Geometry.Data - ---toPolyhedra :: Picture -> [[Point3]] ---toPolyhedra (OnLayer _ pic) = toPolyhedra pic ---toPolyhedra (Pictures pics) = concatMap toPolyhedra pics ---toPolyhedra (OverPic f _ pic) = map (map f) $ toPolyhedra pic ---toPolyhedra (Poly3D vs) = [map fst vs] ---toPolyhedra _ = [] diff --git a/src/Picture/Tree.hs b/src/Picture/Tree.hs deleted file mode 100644 index 8deb3ac1c..000000000 --- a/src/Picture/Tree.hs +++ /dev/null @@ -1,125 +0,0 @@ -{- Transform a picture into renderable objects. -} -module Picture.Tree - ( overPos - , overCol - , stringToList - ) - where -import Picture.Data -import Geometry -import Geometry.Data ---import StrictHelp -import Control.DeepSeq - -import Data.Bifunctor -import Data.List -import qualified Data.DList as DL -import Control.Applicative ---import Data.Maybe (isNothing) - ---picToLTree' --- :: Maybe Int -- ^ Layer filter. Draw 'Nothing' when value is the same as at the leaf. --- -> Picture --- -> LTree RenderType ---picToLTree' x p = rnf (picToLTree x p) `seq` picToLTree x p --- ----- todo: refactor out the layer check somehow ----- consider generalising to alternative rather than using LTree ----- | Transform a picture into a tree of renderable objects ---picToLTree --- :: Maybe Int -- ^ Layer filter. Draw 'Nothing' when value is the same as at the leaf. --- -> Picture --- -> LTree RenderType -----{-# INLINE picToLTree #-} ---picToLTree _ (Polygon ps) --- = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black ---picToLTree _ (PolygonZ ps z) --- = LLeaf $ RenderPolyZ $ zip3 (map zeroZ $ polyToTris ps) (repeat black) (repeat z) ---picToLTree _ (PolygonCol vs) --- = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs --- where --- (ps,cs) = unzip vs ---picToLTree _ (Poly3D vs) = LLeaf $ RenderPoly $ polyToTris vs ---picToLTree _ (BezierQuad vs) = LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs --- where --- (ps,cols,offps,rads) = unzip4 vs --- rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads ---picToLTree _ (Circle colC colE r) = LLeaf $ RenderEllipse --- [( (-r, r,0), colC) --- ,( (-r,-r,0), colE) --- ,( ( r,-r,0), black) --- ] ---picToLTree _ (ThickArc startA endA rad wdth) = LLeaf $ RenderArc --- [( (0,0,0),black,(0,0,wdth)) --- ,((xa,ya,0),black,(1,0,wdth)) --- ,((xb,yb,0),black,(1,1,wdth)) --- ,( (0,0,0),black,(0,0,wdth)) --- ,((xb,yb,0),black,(1,1,wdth)) --- ,((xc,yc,0),black,(0,1,wdth)) --- ] --- where --- (xa,ya) = rotateV startA (rad,0) --- (xb,yb) = rotateV (0.5 * (startA + endA)) (rad * sqrt 2,0) --- (xc,yc) = rotateV endA (rad,0) ---picToLTree _ (Text s) = LLeaf $ RenderText $ stringToList s ---picToLTree _ Blank = LBranches [] ---picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics -----picToLTree j (Pictures pics) = LBranches . forceFoldable $ map (picToLTree j) pics ---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 - - -white, black :: Color -white = (1,1,1,1) -black = (0,0,0,1) - -overPos :: (Point3 -> Point3) -> RenderType -> RenderType ---{-# INLINE overPos #-} -overPos f (RenderPoly vs) = RenderPoly $ 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 -overPos f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs -overPos f (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (f a,b,c)) vs -overPos _ _ = undefined - -overCol :: (Point4 -> Point4) -> RenderType -> RenderType ---{-# INLINE overCol #-} -overCol f (RenderPoly vs) = RenderPoly $ 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 (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (a,f b,c)) vs -overCol _ _ = undefined - --- no premature optimisation, consider changing to use texture arrays -stringToList :: String -> [(Point3,Point4,Point2)] -{-# INLINE stringToList #-} ---stringToList s = concat $ zipWith charToTuple [0,0.9*dimText ..] s -stringToList s = concatMap (uncurry charToTuple) $ zip [0,0.9*dimText ..] s - where - dimText = 100 - -charToTuple :: Float -> Char -> [(Point3,Point4,Point2)] -{-# INLINE charToTuple #-} -charToTuple x c = - [((x-50,-100,0), white,(offset,1)) - ,((x-50,100,0), white,(offset,0)) - ,((x+50,100,0), white,(offset+1,0)) - ,((x-50,-100,0), white,(offset,1)) - ,((x+50,-100,0), white,(offset+1,1)) - ,((x+50,100,0), white,(offset+1,0)) - ] - 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) diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index e47c998da..dd2d3707c 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -85,6 +85,7 @@ boxABC a b c = polyToPics :: Polyhedra -> [Picture] polyToPics = map helpPoly3D . _pyFaces +helpPoly3D :: [(Point3, Point4)] -> [(Int, RenderType)] helpPoly3D vs = zl $ RenderPoly $ polyToTris vs where zl :: RenderType -> [(Int,RenderType)]