Cleanup redundant modules
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+43
-1
@@ -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
|
||||
|
||||
@@ -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 _ = []
|
||||
@@ -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)
|
||||
@@ -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)]
|
||||
|
||||
Reference in New Issue
Block a user