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

Implement arcs with variable width and color

Browse Source
This commit is contained in:
justin
2023-01-11 00:00:02 +00:00
parent 44f767841a
commit 471c6fec7e
11 changed files with 116 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Base.hs
+23 -2
View File
@@ -15,6 +15,7 @@ module Picture.Base (
arc,
arcSolid,
thickArc,
thickArcFull,
thickCircle,
thickLine,
lineThick,
@@ -153,7 +154,7 @@ extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
color :: RGBA -> Picture -> Picture
{-# INLINE color #-}
color c = picMap $ overCol (const c)
color = picMap . overCol . const
translateH :: Float -> Float -> Point3 -> Point3
{-# INLINE translateH #-}
@@ -326,6 +327,27 @@ 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
@@ -355,7 +377,6 @@ thickArcHelp startA endA rad wdth =
where
(V2 xa ya) = rotateV startA (V2 rad 0)
(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
--(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * 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
src/Picture/Test.hs
+41
View File
@@ -0,0 +1,41 @@
module Picture.Test where
import Picture.Data
import Geometry
import Color
arcTest :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
arcTest startA sw sc endA ew ec r centercol
| abs (difference startA endA) > pi / 2 = arcTest startA sw sc midA mw mc r centercol
<> arcTest midA mw mc endA ew ec r centercol
| otherwise = arcTest' startA sw sc endA ew ec r centercol
where
midA = 0.5 * (startA + endA)
mw = 0.5 * (sw + ew)
mc = mixColors 0.5 0.5 sc ec
arcTest' :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
arcTest' startA sw sc endA ew ec r centercol =
map
f
[ (V3 0 0 0, centercol, V3 0 0 mwdth)
, (V3 xa ya 0, sc, V3 ad op wdth)
, (V3 xb yb 0, mc, V3 1 1 mwdth)
, (V3 0 0 0, centercol, V3 0 0 mwdth)
, (V3 xb yb 0, mc, V3 1 1 mwdth)
, (V3 xc yc 0, ec, V3 ad op ewdth)
]
where
mc = mixColors 0.5 0.5 sc ec
ang = endA - startA
op = sin ((pi/2 - ang)/2)
ad = cos ((pi/2 - ang)/2)
wdth = (wdth' + (wdth' - 1) * mwdth)/wdth'
wdth' = 1 - sw / r
mwdth = 1 - (0.5 * (sw + ew)) / r
ewdth' = 1 - ew / r
ewdth = (ewdth' + (ewdth' - 1) * mwdth)/ewdth'
(V2 xa ya) = rotateV startA (V2 r 0)
(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (r * sqrt 2) 0)
(V2 xc yc) = rotateV endA (V2 r 0)
f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum