Пасхальные поверхности

Скоро, возможно, напишу статью, так как набрался материальчик, а пока картинки с алгоритмами:

  Dim x1(), y1(), a1(), L1() Private Sub Комманда1_Click() Cls DrawWidth = 2 pi = 4 * Atn(1) x0 = 350 y0 = 180 bb = 160 ss = 6 n = 0 ReDim x1(num), y1(num), a1(num), L1(num) xx1 = 0: yy1 = 0: k = 1: j = 1 '*********************************shadow****** For a = 180 To 0 Step -6 For x = -a To a Step 0.5 If KeyAscii = 32 Then End If k = -1 And j = 1 Then j = -j an = a / 1.2: xn = x / 1.2 tn = (an ^ 2 - xn ^ 2) If tn > 0 Then yn = k * tn ^ 0.5 / 4 qrrn = Abs(255 - (-a + 180) / 1) qggn = Abs(255 - (-a + 180) / 1) qbbn = Abs(255 - (-a + 180)) col = RGB(qrrn, qggn, qbbn) xx = xn yy = 110 + yn If ss > 1 Then Line (xx + 350 + (a - 180) / 2, yy + 300)-Step(ss, ss), col, BF If ss = 1 Then PSet (xx + 350, yy + 300), col Else zzzz = 0 End If k = -k: j = -j Next x n = n + 1 Next a '**********************************egg******** For a = 180 To 0 Step -3 'For b = 1# To 1.007 Step 0.001 For x = -a To a Step 0.05 If KeyAscii = 32 Then End If k = -1 And j = 1 Then j = -j t = (a ^ 2 - x ^ 2) If t > 0 Then y = (a - 180) / 2 + k * t ^ 0.5 / (1.6 * 1.0014 ^ x) qrr = Abs(255 - a / 2.5) qgg = Abs(255 - a / 1.5) qbb = Abs(255 - a) col = RGB(qrr, qgg, qbb) xx = x yy = y If ss > 1 Then Line (xx + 350 + (a - 180) / 2, yy + 300)-Step(ss, ss), col, BF If ss = 1 Then PSet (xx + 350, yy + 300), col Else zzzz = 0 End If k = -k: j = -j Next x n = n + 1 Next a End Sub

У следующей картинки код тот же, но расцветка привязана к Y

А следующие картинки созданы в 3D-Grapher

 

В программе 3D-Grapher эта поверхность задается формулой (в сферических координатах):
r(u,v)=3*(1*cos(0.5*v))^6*1*cos(1*v)^3+1*cos(0.5*u)^1*cos(0.5*v)^1
Предыдущие картинки - вариации этой же формулы.