Draw a sphere: Difference between revisions

<lang FreeBASIC>' "\" = a integer division (CPU)

' "/" = a floating point division (FPU)

' the compiler takes care of the conversion between floating point and integer

' compile with: FBC -s console "filename.bas" or FBC -s GUI "filename.bas"

' filename is whatever name you give it, .bas is mandatory

' Sphere using XPL0 code from rosetacode sphere page

' Altered freebasic version to compile in default mode

#Define W 640

#Define H 480

ScreenRes W, H, 32 ' set 640x480x32 graphics mode, 32 bits color mode

WindowTitle "32 bpp Cyan Sphere FreeBASIC"

' wait until keypress

' Color(RGB(255,255,255),RGB(0,0,0)) ' default white foreground, black background

Locate 50,2

Print "Enter any key to start"

Sleep

Dim As UInteger R = 100, R2 = R * R ' radius, in pixels; radius squared

Dim As UInteger X0 = W \ 2, Y0 = H \ 2 ' coordinates of center of screen

Dim As Integer X, Y, 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

If D2 <= R2 Then ' coordinate is inside circle under sphere

' height of point on surface of sphere above X,Y

C = Sqr(R2 - D2) - ( X + Y) / 2 + 130 ' color is proportional; offset X and Y, and

Color C Shl 8 + C ' = color RGB(0, C, C)

' green + blue = cyan

PSet(X + X0, Y + Y0)

End If

Next

Next

' wait until keypress

Locate 50,2

Color(RGB(255,255,255),RGB(0,0,0)) ' foreground color is changed

Print "Enter any key to exit "

Sleep

End</lang>

{{works with|FreeBASIC}}

needs #Lang "fblite", #Lang "qb" or #Lang "deprecated" to compile.

<lang FreeBASIC>'Sphere for FreeBASIC May 2015

'Sphere using XPL0 code from rosetacode sphere page