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

Cleanup redundant modules

Browse Source
This commit is contained in:
justin
2021-07-25 02:21:55 +02:00
parent f5873db68d
commit 4f44b748bf
6 changed files with 44 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
-1
View File
@@ -15,7 +15,6 @@ import Dodge.Debug.Flag.Data
import Picture import Picture
import Render import Render
import Preload.Render import Preload.Render
import Picture.Tree
import Sound import Sound
import Preload import Preload
import Sound.Data import Sound.Data
src/Dodge/Render.hs
-1
View File
@@ -17,7 +17,6 @@ import Geometry.Data
import Render import Render
import Data.Preload.Render import Data.Preload.Render
import Picture.Data import Picture.Data
import Picture.Tree
import Shader import Shader
import Shader.Data import Shader.Data
import Shader.Poke import Shader.Poke
src/Picture.hs
+43 -1
View File
@@ -54,7 +54,6 @@ import Geometry
import Geometry.Vector3D import Geometry.Vector3D
import Geometry.Data import Geometry.Data
import Picture.Data import Picture.Data
import Picture.Tree
import Data.List import Data.List
import Data.Bifunctor import Data.Bifunctor
@@ -125,6 +124,7 @@ bezierQuad cola colc ra rc a b c
fa' = extrapolate aIn cIn bIn fa' = extrapolate aIn cIn bIn
fc' = extrapolate cIn aIn 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 bzhelp vs = zl $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
where where
(ps,cols,offps,rads) = unzip4 vs (ps,cols,offps,rads) = unzip4 vs
@@ -280,6 +280,7 @@ thickArc startA endA rad wdth
r = rad + 0.5 * wdth r = rad + 0.5 * wdth
w = 1 - wdth / r w = 1 - wdth / r
thickArcHelp :: Float -> Float -> Float -> Float -> [(Int, RenderType)]
thickArcHelp startA endA rad wdth = zl $ RenderArc thickArcHelp startA endA rad wdth = zl $ RenderArc
[( (0,0,0),black,(0,0,wdth)) [( (0,0,0),black,(0,0,wdth))
,((xa,ya,0),black,(1,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 :: Float -> Color
greyN x = (x,x,x,1) 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
src/Picture/ToPolyhedra.hs
-11
View File
@@ -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 _ = []
src/Picture/Tree.hs
-125
View File
@@ -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)
src/Polyhedra.hs
+1
View File
@@ -85,6 +85,7 @@ boxABC a b c =
polyToPics :: Polyhedra -> [Picture] polyToPics :: Polyhedra -> [Picture]
polyToPics = map helpPoly3D . _pyFaces polyToPics = map helpPoly3D . _pyFaces
helpPoly3D :: [(Point3, Point4)] -> [(Int, RenderType)]
helpPoly3D vs = zl $ RenderPoly $ polyToTris vs helpPoly3D vs = zl $ RenderPoly $ polyToTris vs
where where
zl :: RenderType -> [(Int,RenderType)] zl :: RenderType -> [(Int,RenderType)]