|
Post by bplus on Nov 6, 2022 16:03:29 GMT
Option _Explicit _Title "Maple Leaf mod tsh73" ' b+ 2022-11-05 Screen _NewImage(500, 500, 32) Dim Shared As Double a, b, minX, maxX, minY, maxY, xxmin, xxmax, yymin, yymax Dim t0, tk, h, t, x, y, x0, y0, s, r, g, blu, m, lastX, lastY Dim As Long n, i, maxi 'parametric plot t0 = 0 tk = 1 * _Pi
'nPoints n = 301 'this small change just never steps on these problem points Dim dist(n), ang(n) 'save some data h = (tk - t0) / n
'get x, y bounds a = 0 b = 0 minY = 0 maxY = 0 For t = t0 To tk Step h x = px(t) If x < a Then a = x If x > b Then b = x y = py(t) If y < minY Then minY = y If y > maxY Then maxY = y Next minX = a: maxX = b
'axes xxmin = sx(a): xxmax = sx(b): y0 = sy(0) yymin = sy(minY): yymax = sy(maxY): x0 = sx(0)
Color , &HFFCCCCFF: Cls y = sy(py(t0)) PSet (x, y), &HFF000000 For t = t0 To tk Step h ' outline get data y = sy(py(t)) x = sx(px(t)) i = i + 1 dist(i) = Sqr((x - x0) ^ 2 + (y - y0) ^ 2) ang(i) = _Atan2(y - y0, x - x0) Line -(x, y), &HFF000000 Next maxi = i r = 95: g = 160: blu = 80 For s = 1 To 0 Step -.001 ' fill in with color m = m + .08 For i = 1 To maxi x = x0 + s * dist(i) * Cos(ang(i)) y = y0 + s * dist(i) * Sin(ang(i)) If i = 1 Then Circle (x, y), 1, _RGB32(r + m, g + 0 * m, blu - m) Else thic lastX, lastY, x, y, 1, _RGB32(r + 2 * m, g + .5 * m, blu - m) End If lastX = x: lastY = y Next Next Sleep
Function px (t) px = (1+cos(6*t)^2 +1/5*(cos(6*t)*cos(24*t))^10 + _ (1/4*cos(30*t)^2+1/9*cos(30*t)^12) *(1-sin(6*t)^10) _ ) *sin(2*t)*(1-cos(t)^4)* _ (1-cos(t)^10*cos(3*t)^2 ) +1/70*cos(t)^9 End Function
Function py (t) py = 0-21/20*cos(2*t)*(1-cos(t)^4+1/2*(cos(t)*cos(3*t))^10) * _ (1+cos(6*t)^2+1/5*(cos(6*t)*cos(18*t))^10 + _ (1/4*cos(30*t)^4 +1/10 * cos(30*t)^12 ) * _ (1-cos(t)^10*cos(3*t)^2 ) *(1-sin(6*t)^10)) End Function
'conversions (logical coords to screen) Function sx (x) 'screen X. Depends on width, minX, maxX sx = (x - minX) / (maxX - minX) * _Width End Function
Function sy (y) 'screen Y. Depends on height, minY, maxY. Upside down. sy = (1 - (y - minY) / (maxY - minY)) * _Height + 10 End Function
'update 2020-01-24 to include PD2 inside the sub Sub thic (x1, y1, x2, y2, thick, K As _Unsigned Long) Dim PD2 As Double, t2 As Single, a As Single, x3 As Single, y3 As Single, x4 As Single, y4 As Single Dim x5 As Single, y5 As Single, x6 As Single, y6 As Single PD2 = 1.570796326794897 t2 = thick / 2 If t2 < 1 Then t2 = 1 a = _Atan2(y2 - y1, x2 - x1) x3 = x1 + t2 * Cos(a + PD2) y3 = y1 + t2 * Sin(a + PD2) x4 = x1 + t2 * Cos(a - PD2) y4 = y1 + t2 * Sin(a - PD2) x5 = x2 + t2 * Cos(a + PD2) y5 = y2 + t2 * Sin(a + PD2) x6 = x2 + t2 * Cos(a - PD2) y6 = y2 + t2 * Sin(a - PD2) ftri x6, y6, x4, y4, x3, y3, K ftri x3, y3, x5, y5, x6, y6, K End Sub
'' BEST saves dest and optimized with Static a& and alpha colors work better '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long) Dim D As Long Static a& D = _Dest If a& = 0 Then a& = _NewImage(1, 1, 32) _Dest a& _DontBlend a& ' '<<<< new 2019-12-16 fix PSet (0, 0), K _Blend a& '<<<< new 2019-12-16 fix _Dest D _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3) End Sub
|
|
|
Post by mikesharpe on Nov 6, 2022 23:08:12 GMT
spectacular mod, B+. I'm not sure if leaves yellow from the inside out or outside in, this is why we need Steve.
you should also post the cannabis one from technotitlik over at JB
|
|