Cleanup pictures

This commit is contained in:
2023-01-11 11:26:26 +00:00
parent 68338d223b
commit af24c5bc9c
2 changed files with 17 additions and 68 deletions
+4 -1
View File
@@ -1,4 +1,6 @@
module Picture.Arc where
module Picture.Arc
( arcFull
) where
import Color
import Geometry
@@ -7,6 +9,7 @@ import Picture.Data
-- this should work regardless of which angle is larger, though swapping the
-- angles will affect the winding of the drawn triangles
arcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
{-# INLINE arcFull #-}
arcFull startA swidth scol endA ewidth ecol r centercol
| abs (difference startA endA) > pi / 2 =
arcFull startA swidth scol midA mw mc r centercol
+13 -67
View File
@@ -51,8 +51,8 @@ module Picture.Base (
import Color
import Data.Foldable
import Geometry
import Picture.Data
import Picture.Arc
import Picture.Data
blank :: Picture
{-# INLINE blank #-}
@@ -62,9 +62,6 @@ polygonWire :: [Point2] -> Picture
{-# INLINE polygonWire #-}
polygonWire ps = line (ps ++ [head ps])
picFormat :: [Verx] -> Picture
picFormat = id
picMap :: (Verx -> Verx) -> Picture -> Picture
{-# INLINE picMap #-}
picMap = map
@@ -72,19 +69,19 @@ picMap = map
-- | Expects clockwise input.
polygon :: [Point2] -> Picture
{-# INLINE polygon #-}
polygon = picFormat . map f . polyToTris
polygon = map f . polyToTris
where
f (V2 x y) = Verx (V3 x y 0) black [] BottomLayer polyNum
polygonZ :: [Point2] -> Float -> Picture
{-# INLINE polygonZ #-}
polygonZ ps z = picFormat . map (f . zeroZ) $ polyToTris ps
polygonZ ps z = map (f . zeroZ) $ polyToTris ps
where
f pos = Verx pos black [z] BottomLayer polyzNum
polygonCol :: [(Point2, RGBA)] -> Picture
{-# INLINE polygonCol #-}
polygonCol = picFormat . polyToTris . map f
polygonCol = polyToTris . map f
where
f (V2 x y, col) = Verx (V3 x y 0) col [] BottomLayer polyNum
@@ -94,7 +91,7 @@ poly3 = poly3Col . map (,black)
poly3Col :: [(Point3, RGBA)] -> Picture
{-# INLINE poly3Col #-}
poly3Col = picFormat . map f . polyToTris
poly3Col = map f . polyToTris
where
f (pos, col) = Verx pos col [] BottomLayer polyNum
@@ -136,7 +133,7 @@ bezierQuad cola colc ra rc a b c
fc' = extrapolate cIn aIn bIn
bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
bzhelp = picFormat . map f
bzhelp = map f
where
f (V2 x y, col, V2 a b, V2 c d) = Verx (V3 x y 0) col [a, b, c, d] BottomLayer bezNum
@@ -229,13 +226,12 @@ circleSolid = circleSolidCol white white
circleSolidCol :: Color -> Color -> Float -> Picture
{-# INLINE circleSolidCol #-}
circleSolidCol colC colE r =
picFormat $
map
f
[ (V3 (- r) r 0, colC)
, (V3 (- r) (- r) 0, colE)
, (V3 r (- r) 0, black)
]
map
f
[ (V3 (- r) r 0, colC)
, (V3 (- r) (- r) 0, colE)
, (V3 r (- r) 0, black)
]
where
f (pos, col) = Verx pos col [] BottomLayer ellNum
@@ -253,7 +249,7 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
text :: String -> Picture
{-# INLINE text #-}
text = picFormat . map f . stringToList
text = map f . stringToList
where
f (pos, col, V2 a b) = Verx pos col [a, b] BottomLayer textNum
@@ -329,59 +325,9 @@ arc ::
arc startA endA rad = thickArc startA endA rad 1
{-# INLINE arc #-}
--thickArcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Picture
--{-# INLINE thickArcFull #-}
--thickArcFull sa sw sc ea ew ec rad
-- | difference sa ea > pi / 2 = thickArcFull sa sw sc ma mw mc rad <> thickArcFull ma mw mc ea ew ec rad
-- | otherwise = map f
-- [ (V3 0 0 0, mc, V3 0 0 mw)
-- , (V3 xa ya 0, sc, V3 1 0 sw)
-- , (V3 xb yb 0, mc, V3 1 1 mw)
-- , (V3 0 0 0, sc, V3 0 0 sw)
-- , (V3 xb yb 0, mc, V3 1 1 mw)
-- , (V3 xc yc 0, ec, V3 0 1 ew)
-- ]
-- where
-- (V2 xa ya) = rotateV sa (V2 rad 0)
-- (V2 xb yb) = rotateV (0.5 * (sa + ea)) (V2 (rad * sqrt 2) 0)
-- (V2 xc yc) = rotateV ea (V2 rad 0)
-- f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
-- ma = 0.5 * (sa + ea)
-- mw = 0.5 * (sw + ew)
-- mc = mixColors 0.5 0.5 sc ec
thickArc :: Float -> Float -> Float -> Float -> Picture
{-# INLINE thickArc #-}
thickArc startA endA rad wdth = arcFull startA wdth white endA wdth white rad white
--thickArc startA endA rad wdth
-- | endA - startA > (pi / 2) =
-- pictures
-- [ thickArc (startA + pi / 2) endA rad wdth
-- , thickArcHelp startA (startA + pi / 2) r w
-- ]
-- | otherwise = thickArcHelp startA endA r w
-- where
-- r = rad + 0.5 * wdth
-- w = 1 - wdth / r
--thickArcHelp :: Float -> Float -> Float -> Float -> Picture
--{-# INLINE thickArcHelp #-}
--thickArcHelp startA endA rad wdth =
-- picFormat $
-- map
-- f
-- [ (V3 0 0 0, black, V3 0 0 wdth)
-- , (V3 xa ya 0, black, V3 1 0 wdth)
-- , (V3 xb yb 0, black, V3 1 1 wdth)
-- , (V3 0 0 0, black, V3 0 0 wdth)
-- , (V3 xb yb 0, black, V3 1 1 wdth)
-- , (V3 xc yc 0, black, V3 0 1 wdth)
-- ]
-- where
-- (V2 xa ya) = rotateV startA (V2 rad 0)
-- (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
-- (V2 xc yc) = rotateV endA (V2 rad 0)
-- f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
-- Currently the lens version is much slower
overPos :: (Point3 -> Point3) -> Verx -> Verx