49 lines
1.8 KiB
Plaintext
49 lines
1.8 KiB
Plaintext
' "\" = 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
|
|
' version 17-06-2015
|
|
' compile with: fbc -s console or fbc -s gui
|
|
#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
|
|
' empty keyboard buffer
|
|
While InKey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|