Wow. Saw the sample in the yabasic library - coded by Shockwave!!!
I changed some of it, made it so you can zoom in/out, make the cube transparent (has some glitches because of style = 1 - style... changes too quick some times), and the cube floats around the screen.
If I could have done that with VB... woooooooow!!!
But owell. I like this demo.
Shockwave: Wow! Nice 3D Cube demo.
open window 640,512
gosub initialise
repeat
setdrawbuf dw
dw = 1 - dw
setdispbuf dw
clear window
if style = 0 gosub stars
gosub rotate
gosub construct
if style = 1 gosub stars
rem Make Cube Move
if wip <= 0 wp = 0
if wip >= 5 wp = 1
if wp = 0 wip = wip + 0.05
if wp = 1 wip = wip - 0.05
rem Zoom In / Out
if (size < 24 and peek("port1") = 16) size = size + 0.5
if (size > 1.5 and peek("port1") = 64) size = size - 0.5
rem Change Style
if peek("port1") = 16384 style = 1 - style
until (peek("port1") = 8)
exit
label stars
for i = 1 to stars
star_y(i) = star_y(i) + speed(i)
if star_y(i) >= 512 then
star_x(i) = ran(640)
speed(i) = ran(3) + 1
star_y(i) = 0
fi
setrgb 1, 80 * speed(i), 80 * speed(i), 100 * speed(i)
dot star_x(i), star_y(i)
next
return
label construct
for a = 1 to faces
gosub draw
next a
return
label draw
rem Draw Faces
vx1 = tx(f1(a)) - tx(f2(a))
vy1 = ty(f1(a)) - ty(f2(a))
vx2 = tx(f3(a)) - tx(f2(a))
vy2 = ty(f3(a)) - ty(f2(a))
n = (vx1 * vy2 - vx2 * vy1) + 50
if n < 0 then
n = - (n / 1000)
setrgb 1, r(a) + n, g(a) + n, b(a) + n
fill triangle tx(f1(a)), ty(f1(a)) to tx(f2(a)), ty(f2(a)) to tx(f3(a)), ty(f3(a))
fill triangle tx(f1(a)), ty(f1(a)) to tx(f4(a)), ty(f4(a)) to tx(f3(a)), ty(f3(a))
if cls(a) = 1 then
setrgb 1, 150, 150, 150
line tx(f1(a)), ty(f1(a)), tx(f2(a)), ty(f2(a))
line tx(f2(a)), ty(f2(a)), tx(f3(a)), ty(f3(a))
line tx(f3(a)), ty(f3(a)), tx(f4(a)), ty(f4(a))
line tx(f4(a)), ty(f4(a)), tx(f1(a)), ty(f1(a))
fi
fi
return
label rotate
for a = 1 to points
x1 = x(a)
y1 = y(a)
z1 = z(a)
rem Rotation and Movement
xx = x1
yy = y1 * cs(xr) + z1 * sn(xr) + wip
zz = z1 * cs(xr) - y1 * sn(xr) + wip
y1 = yy
x1 = xx * cs(yr) - zz * sn(yr) + wip
z1 = xx * sn(yr) + zz * cs(yr) + wip
zz = z1
xx = x1 * cs(zr) - y1 * sn(zr) + wip
yy = x1 * sn(zr) + y1 * cs(zr) + wip
rem Perspective
dv = (zz / 40) + 1
xx = size * (xx / dv) + 320
yy = size * (yy / dv) + 256
tx(a) = xx
ty(a) = yy
tz(a) = zz
next a
xr = xr + 3
yr = yr + 2
zr = zr + 5
if xr > 720 xr = xr - 720
if yr > 720 yr = yr - 720
if zr > 720 zr = zr - 720
return
label initialise
rem Get Star Position and Speed
stars = 100
dim star_x(stars), star_y(stars), speed(stars)
for i = 1 to stars
setdrawbuf dw
dw = 1 - dw
setdispbuf dw
clear window
star_x(i) = ran(640):star_y(i) = ran(512)
speed(i) = ran(3) + 1
text 10, 20, "STARS: " + str$(i)
fill rect 100, 247, 100 + (i * 4), 263
rect 100, 247, 500, 263
next
rem Cube Initialise
size = 12
dw = 1
points = 8
faces = 6
dim x(points), y(points), z(points), tx(points), ty(points), tz(points)
dim f1(faces), f2(faces), f3(faces), f4(faces), r(faces), g(faces), b(faces), cls(faces)
dim cs(720), sn(720)
for ang = 0 to 720
cs(ang) = cos(ang * (pi / 360))
sn(ang) = sin(ang * (pi / 360))
next ang
rem Get Cube Points
for a = 1 to points
read x(a), y(a), z(a)
next a
rem Get Face Parameters and Connections
for a = 1 to faces
read f1(a)
read f2(a)
read f3(a)
read f4(a)
read r(a), g(a), b(a), cls(a)
next a
rem Objects X, Y, Z Points
data -10, 10, 10, 10, 10, 10, 10,-10, 10,-10,-10, 10
data -10, 10,-10, 10, 10,-10, 10,-10,-10,-10,-10,-10
rem Connections, Colour and Shaded
data 1, 2, 3, 4, 30, 0, 0, 1
data 5, 8, 7, 6, 30, 0, 0, 1
data 6, 2, 1, 5, 0, 30, 0, 1
data 8, 4, 3, 7, 0, 30, 0, 1
data 2, 6, 7, 3, 0, 0, 30, 1
data 8, 5, 1, 4, 0, 0, 30, 1
return
