You are here

sphere.bas

SmallBASIC syntax groups: 

' A small 3D globe rotation program
' Converted to SB(fltk) 23,may 2006, from an old basic code
' by Keijo koskinen
' You can download sphere.gif from:
' http://users.csolve.net/~keiko/smallbasic/sphere.gif
' When sphere.gif appears to screen, ..right clic it and shoose save as ..to your bas_home directory

img= env("Bas_Home")+"sphere.gif"
if
(!exist(img)) then
? "Sphere.gif does not exist "
? "then we are rolling this text"
? "with SmallBasic program"
else
open img for input as #1
w = imagew(#1,0)
h = imageh(#1,0)
x = 1
y = 1
image #1,0, x,y,0,0,w,h
close #1
fi
' Sphere numbers
r=80 ' radius 180
n=100 ' number of lattitudes
NumPoints=(n/1)*n*4+2 ' number of dots on sphere
NumVerts=(n/1)*(n*4-2)+2 ' number of triangles

DIM Points(NumPoints, 3)
DIM Vertices(NumVerts,4)
DIM Rotation(NumPoints,3)

DIM Sinus(628)
DIM CoSin(628)

' Precalc Sine and CoSinus tables
FOR j = 1 TO 360
trig=j*(2*pi)/360
Sinus(j) = sin(trig) 'shl 8 'sin x 256
CoSin(j) = cos(trig) 'shl 8 'cos x 256
NEXT j

'*** Create a Sphere ****

' pixel colors from bitmap image for maptexture
jjj=0
for yy=1 to n/2
apu0=n*2
for xx=1 to apu0
m_col = point(xx,yy) 'get pixelcolor at x, y
jjj=jjj+1
Vertices(jjj,4)=m_col
next
next

'Clear the screen
cls

xx=0
yy=0
IF r < 0 THEN r = -r
IF n < 3 THEN n = 3

iii=0
jjj=0
apu0=(n/2)-1
FOR thh= 0 TO apu0 '// lluulisi navalta navalle pituus
theta1 = thh * pi/(n/2)-pi/2 '2*pi / n - pi/2;
theta2 = (thh + 1) * pi/(n/2)-pi/2 '2*pi / n - pi/2;
jij=iii+1 ' seuraavan vertices eka piste
FOR thn= 0 TO n
iii=iii+1
theta3 = thn * 2*pi / n
Points(iii,1)= r*COS(theta2) * COS(theta3)
Points(iii,2)= r*SIN(theta2)
Points(iii,3)=r*COS(theta2) * SIN(theta3)
iii=iii+1
Points(iii,1)=r*COS(theta1) * COS(theta3)
Points(iii,2)= r*SIN(theta1)
Points(iii,3)=r*COS(theta1) * SIN(theta3)
NEXT
'jij=iii-(2*n+2)
apu1=jij
apu2=iii-2
for jep = apu1 to apu2 step 2
jjj=jjj+1
Vertices(jjj,1)=jep
Vertices(jjj,2)=jep+1
Vertices(jjj,3)=jep+2
jjj=jjj+1
Vertices(jjj,1)=jep+3
Vertices(jjj,2)=jep+2
Vertices(jjj,3)=jep+1
next
NEXt

NumPoints=iii
NumVerts=jjj

' END of Sphere
goto vector

END
'end of prog


label vector: ' main loop for rotation \

'-- Rotate angles
AngleX=1 'AngleX+0.2
IF AngleX > 360 THEN AngleX = 1
AngleY=AngleY+1
IF AngleY > 360 THEN AngleY = 1
AngleZ=1' AngleZ+0'.2
IF AngleZ > 360 THEN AngleZ = 1

' rotate the points according to angles
FOR i = 1 TO NumPoints
X = Points(i, 1): Y = Points(i, 2): Z = Points(i, 3)

Ty = Y * CoSin(AngleX) - Z * Sinus(AngleX) '
Tz = Y * Sinus(AngleX) + Z * CoSin(AngleX)

Tx = X * CoSin(AngleY) - Tz * Sinus(AngleY)
Tz = X * Sinus(AngleY) + Tz * CoSin(AngleY)
Ox = Tx
Tx = Tx * CoSin(AngleZ) - Ty * Sinus(AngleZ)
Ty = Ox * Sinus(AngleZ) + Ty * CoSin(AngleZ)
Nx=Tx
Ny=Ty

Rotation(i, 1) = Nx: Rotation(i, 2) = Ny: Rotation(i, 3) = Tz
NEXT i

' check if face N is visible.
FOR j = 1 TO NumVerts
k = Vertices(j, 1): l = Vertices(j, 2): m = Vertices(j, 3):m_col=Vertices(j,4)

X1 = Rotation(k, 1): X2 = Rotation(l, 1): X3 = Rotation(m, 1)
Y1 = Rotation(k, 2): Y2 = Rotation(l, 2): Y3 = Rotation(m, 2)
Z1 = Rotation(k, 3): Z2 = Rotation(l, 3): Z3 = Rotation(m, 3)

VIS= (X3 - X1) * (Y2 - Y1) - ((X2 - X1) * (Y3 - Y1)) 'VIS = value of visibility

' Render the Sphere
IF VIS <-3 then ' only clearly visible will be drawn

'triangle vertices color
XX1=X1+200
XX2=X2+200
XX3=X3+200
YY1=Y1+200
YY2=Y2+200
YY3=Y3+200

'** triangles, globe is so small, so filling not actually needed = faster
Line XX1, YY1, XX2, YY2, m_col
Line XX2, YY2, XX3, YY3, m_col
Line XX3, YY3, XX1, YY1, m_col

' triangle centers = filling or drawing points
l = (XX1 + XX2 + XX3) / 3
m = (YY1 + YY2 + YY3) / 3

'** if trianles used then they can be filled ****
' Paint l, m,m_col,m_col ' can't use ..this overflows

'** if triangles not used ...use one of following ***
' circle l,m,2,1,m_col filled
' rect l-2,m-2,l+2,m+2,m_col filled
' PSET l,m,m_col

END IF
NEXT j
goto
vector