37 lines
1.3 KiB
Plaintext
37 lines
1.3 KiB
Plaintext
'Sphere for FreeBASIC May 2015
|
|
'spherefb4.bas
|
|
'Sphere using XPL0 code from rosetacode sphere page
|
|
'
|
|
screenres 640,480,32 '\set 640x480x32 graphics mode
|
|
windowtitle "32 bpp Blue Sphere FreeBASIC"
|
|
'
|
|
' wait until keypress
|
|
locate 50,2
|
|
color(rgb(255,255,255),rgb(0,0,0))
|
|
Print "Enter any key to start"
|
|
sleep
|
|
R=100 : R2=R*R '\radius, in pixels; radius squared
|
|
X0=640/2 : Y0=480/2 '\coordinates of center of screen
|
|
dim as integer X, Y, Z, C, D2 '\coords, color, distance from center squared
|
|
'
|
|
for Y= -R to +R '\for all the coordinates near the circle
|
|
for X = -R to +R '\ which is under the sphere
|
|
D2 = X*X + Y*Y '
|
|
C = 0 '\default color is black
|
|
if D2 <= R2 then '\coordinate is inside circle under sphere
|
|
Z = sqr(R2-D2) '\height of point on surface of sphere above X,Y
|
|
C = Z-(X+Y)/2+130 ' \color is proportional; offset X and Y, and
|
|
endif
|
|
color c ' \ shift color to upper limit of its range
|
|
'\green + blue = cyan orginal line don't understand
|
|
Pset(X+X0, Y+Y0)
|
|
next x
|
|
next y
|
|
'
|
|
' wait until keypress
|
|
locate 50,2
|
|
color(rgb(255,255,255),rgb(0,0,0))
|
|
Print "Enter any key to exit "
|
|
sleep
|
|
END
|