Post by johnno56 on Nov 5, 2021 2:49:50 GMT -6
This is a variation on a theme. The old 3D Surface Plot has been around a LONG time. This version is different. It's animated.
Animation is controlled by lines #98 and #101. Decreasing the values will produce more detail at the cost of speed and flicker.
Not mine. Only guilty of conversion... I think it's cool...
'===========================================================================
'3D Surface Plot
'From "Microcomputer Graphics Techniques and Applications" by Donald Hearn
'Ported To PB by Dave Navarro (dave@powerbasic.com)
'===========================================================================
'Converted to sdlBAS, and colorized by Andres Amaya Jr
' 2016-09-07 [B+=MGA] mod per Andy's instructions to animate drawing
' and check speed of transitions
'===========================================================================
' Converted to RCBasic by Johnno56. 5-Nov-2021
'===========================================================================
xmax = 960
ymax = 720
title$ = "3D Surface Plot"
center_x = windowpos_centered
center_y = windowpos_centered
WindowOpen(1,title$,center_x,center_y,xmax,ymax,WindowMode(1,0,0,0,0),1)
SetWindowAutoClose(1, 0)
CanvasOpen(1,xmax,ymax,0,0,xmax,ymax,0)
ClearCanvas
randomize(timer)
sw = xmax : sh = ymax
cx = int(sw / 2) : cy = int(sh / 2)
fx = cx - 30 : fy = cy - 114
Dim pal[48]
' Define colour palette
'
pal[0] = rgb(0,0,255) '0x0000FF
pal[1] = rgb(32,0,255) '0x2000FF
pal[2] = rgb(64,0,255) '0x4000FF
pal[3] = rgb(96,0,255) '0x6000FF
pal[4] = rgb(128,0,255) '0x8000FF
pal[5] = rgb(160,0,255) '0xA000FF
pal[6] = rgb(192,0,255) '0xC000FF
pal[7] = rgb(224,0,255) '0xE000FF
pal[8] = rgb(255,0,255) '0xFF00FF
pal[9] = rgb(255,0,224) '0xFF00E0
pal[10] = rgb(255,0,192) '0xFF00C0
pal[11] = rgb(255,0,160) '0xFF00A0
pal[12] = rgb(255,0,128) '0xFF0080
pal[13] = rgb(255,0,96) '0xFF0060
pal[14] = rgb(255,0,64) '0xFF0040
pal[15] = rgb(255,0,32) '0xFF0020
pal[16] = rgb(255,0,0) '0xFF0000
pal[17] = rgb(255,32,0) '0xFF2000
pal[18] = rgb(255,64,0) '0xFF4000
pal[19] = rgb(255,96,0) '0xFF6000
pal[20] = rgb(255,128,0) '0xFF8000
pal[21] = rgb(255,160,0) '0xFFA000
pal[22] = rgb(255,192,0) '0xFFC000
pal[23] = rgb(255,224,0) '0xFFE000
pal[24] = rgb(255,255,0) '0xFFFF00
pal[25] = rgb(224,255,0) '0xE0FF00
pal[26] = rgb(192,255,0) '0xC0FF00
pal[27] = rgb(160,255,0) '0xA0FF00
pal[28] = rgb(128,255,0) '0x80FF00
pal[29] = rgb(96,255,0) '0x60FF00
pal[30] = rgb(64,255,0) '0x40FF00
pal[31] = rgb(32,255,0) '0x20FF00
pal[32] = rgb(0,255,0) '0x00FF00
pal[33] = rgb(0,255,32) '0x00FF20
pal[34] = rgb(0,255,64) '0x00FF40
pal[35] = rgb(0,255,96) '0x00FF60
pal[36] = rgb(0,255,128) '0x00FF80
pal[37] = rgb(0,255,160) '0x00FFA0
pal[38] = rgb(0,255,192) '0x00FFC0
pal[39] = rgb(0,255,224) '0x00FFE0
pal[40] = rgb(0,255,255) '0x00FFFF
pal[41] = rgb(0,224,255) '0x00E0FF
pal[42] = rgb(0,192,255) '0x00C0FF
pal[43] = rgb(0,160,255) '0x00A0FF
pal[44] = rgb(0,128,255) '0x0080FF
pal[45] = rgb(0,96,255) '0x0060FF
pal[46] = rgb(0,64,255) '0x0040FF
pal[47] = rgb(0,32,255) '0x0020FF
Rho = 45 ' viewing angle
Scale = 1020 ' scaling factor
Theta = 1
snt = sin(Theta) : cst = cos(Theta)
Phi = 1
snp = sin(Phi) : csp = cos(Phi)
tx = 450 : ty = 485 ' x & y translates
incremented = 3.1
dr = -1
increment = 0.2
Dim oldx
Dim oldy
while key(27) = 0
ClearCanvas
For x= -15 To 15 Step 0.2 ' 0.125 <===== increase faster. Lower res.
flag = 0
x2 = x * x
For y = -15 To 15 Step 0.2 ' 0.125 <===== increase faster. Lower res.
xy2 = (x2 + y*y) / 20
z = incremented * Cos(xy2)
xe = -x * snt + y * cst
ye = -x * cst * csp - y * snt * csp + z * snp
ze = -x * snp * cst - y * snt * snp - z * csp + Rho
sx = Scale * xe / ze
sy = Scale * ye / ze
ix = Int(sx + tx)
iy = sh - Int(sy + ty)
colr = (Int(Sqrt((fx - ix) * (fx - ix) + 4.3 * (fy - iy) * (fy - iy)) / 15) + 7) Mod 48
If flag = 0 Then
setColor(pal[colr])
Pset(ix, iy)
flag = 1 : oldx = ix : oldy = iy
Else
setColor(pal[colr])
Line (oldx, oldy, ix, iy)
oldx = ix : oldy = iy
End If
Next
Next
incremented = incremented + increment * dr
if incremented > 5 then
incremented = 5
dr = dr * -1
end if
if incremented < -5 then
incremented = -5
dr = dr * -1
end if
if Not WindowExists(1) Or WindowEvent_Close(1) Then
end
end if
update()
wend