Draw a sphere: Difference between revisions
added FreeBasic version, change existing version from FreeBASIC to Works with FreeBASIC
(added FreeBasic version, change existing version from FreeBASIC to Works with FreeBASIC) |
|||
Line 265:
==={{header|FreeBASIC}}===
<lang
' "/" = 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
'spherefb4.bas
'Sphere using XPL0 code from
'
screenres 640,480,32 '\set 640x480x32 graphics mode
| |||