I’ve been playing around trying to learn how to make a sphere.
Someone on the FreeBasic forum did one and i modified it somewhat with all sorts of keyboard inputs.
'=============================================================================='
'=============================================================================='
' '
' "--SPHERE--" '
' By Albert Redditt '
' written with: '
' Free Basic for Windows Version 0.23 Also available for Linux and DOS '
' '
' compiler available at: '
' http://sourceforge.net/projects/fbc/files/ '
' '
' FBIDE , A simple to use IDE : '
' Just load the code and hit F5 to run program '
' http://fbide.freebasic.net/index.php?menuID=56 '
' click on: FBIde - zipped. Download '
' Install in the same directory you installed FreeBasic '
' '
' Modified From D.J.Peters Sphere code '
' http://www.freebasic.net/forum/viewtopic.php?f=3&t=16207&start=1530 '
' post number, 3 and 5 '
'=============================================================================='
'includes
'=============================================================================='
#include "fbgfx.bi"
#include "GL/gl.bi"
#include "GL/glu.bi"
'===============================================================================
'declare subs
'===============================================================================
declare sub SetUpGl(byval perspective as single)
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub DrawSphere(byval NumOfSegments as uinteger)
'===============================================================================
'console printed instructoins.
'===============================================================================
screen 0
cls
print "Press Esc to EXIT"
print "-----------------------------------------"
print "Press Space-bar to stop all motion "
print "-----------------------------------------"
print "Left , Right Arrows to rotate on X - Axis"
print " Up , Down Arrows to rotate on Y - Axis"
print " R_Shft to reset U/D , L/R rotate values "
print "-----------------------------------------"
print " (+) , (-) , (Enter) to control spin "
print
print " (Q) , (W) , (E) to control zoom level "
print " (1) , (2) , (3) to control Perspective "
print
print " (A) , (S) , (D) to control U/D shift "
print " (Z) , (X) , (C) to control L/R shift "
print
print " ([) , (]) to control segments "
print
print " (R) , (T) to control RED LEVEL "
print " (F) , (G) to control GREEN LEVEL "
print " (V) , (B) to control BLUE LEVEL "
print "-----------------------------------------";
'===============================================================================
'Call SetUpGl to setup the screen
'===============================================================================
dim shared as integer xres,yres
screen 19 ' comment this out to get full screen after you know what keys to press
screeninfo xres,yres
screenres xres,yres,32,,10
dim as single perspective=10:SetUpGl(perspective)
'===============================================================================
'for OpenGl transition,rotation
'===============================================================================
dim as double xt =0, yt =0, zt=-15 'transition variables
dim as double xr =0, yr =0, zr= 0 'rotation variables
dim as double xrs=1, yrs=1, zrs=1 'transitions of camera
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI = ATN(1)*4
dim as uinteger NumOfSegments = 3
dim shared as ubyte longitude_latitude : longitude_latitude=0
dim as ubyte color_red =125
dim as ubyte color_green=175
dim as ubyte color_blue =125
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as ubyte status = 1
dim as string ink
'===============================================================================
'start main loop
'===============================================================================
do while status=1
xr = xr - xrs 'for x spin
yr = yr - yrs 'for y spin
zr = zr - zrs 'for z spin
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glLoadIdentity
gltranslatef xt, yt, zt
glrotatef xr, 1, 0, 0
glrotatef yr, 0, 1, 0
glrotatef zr, 0, 0, 1
glColor3ub( color_red, color_green , color_blue )
DrawSphere(NumOfSegments) 'call the Draw-Sphere sub routine
flip
glflush
'check for keys being pressed
if multikey(&h36) then 'Right_SHIFT ,STOP X/Y SPINS AND RESET to 0
xrs=0:yrs=0:zrs=0
xr =0:yr =0:zr =0
end if
ink = inkey
if ink<>"" then
if ink=chr(27) then status = 0 ' esc key to quit
if ink=chr(255)+"H" then xrs+=.1 'SPIN LEFT
if ink=chr(255)+"P" then xrs-=.1 'SPIN RIGHT
if ink=chr(255)+"K" then yrs+=.1 'SPIN UP
if ink=chr(255)+"M" then yrs-=.1 'SPIN DOWN
if ink="-" then zrs-=.1 'SPIN Z UP/LEFT
if ink="+" then zrs+=.1 'SPIN Z DOWN/RIGHT
if ink=" " then 'Space key ,STOP ALL ROTATION
xrs=0
yrs=0
zrs=0
end if
if ink=chr(13) then zrs=0 'Enter_Key ,Stop Z SPIN
if ink="q" then zt-=.1 'ZOOM IN
if ink="w" then zt+=.1 'ZOOM OUT
if ink="e" then zt=-15 'RESET ZOOM
if ink="a" then xt-=.1 'MOVE LEFT
if ink="s" then xt+=.1 'MOVE RIGHT
if ink="d" then xt =0 'RESET TO CENTER
if ink="z" then yt+=.1 'MOVE UP
if ink="x" then yt-=.1 'MOVE DOWN
if ink="c" then yt= 0 'RESET TO CENTER
if ink="r" then color_red -= 1 : if Color_red < 0 then color_red =255
if ink="t" then color_red += 1 : if Color_red > 255 then color_red = 0
if ink="f" then color_green -= 1 : if color_green < 0 then color_green =255
if ink="g" then color_green += 1 : if color_green > 255 then color_green = 0
if ink="v" then color_blue -= 1 : if Color_blue < 0 then color_blue =255
if ink="b" then color_blue += 1 : if Color_blue > 255 then color_blue = 0
if ink="[" then NumOfSegments-=1:if NumOfSegments<= 3 then NumOfSegments= 3
if ink="]" then NumOfSegments+=1:if NumOfSegments>=64 then NumOfSegments=64
if ink="1" then perspective-=2:if perspective<= 1 then perspective= 1
if ink="2" then perspective+=2:if perspective>=135 then perspective=135
if ink="3" then perspective=10
if ink="1" or ink="2" or ink="3" then SetUpGL(perspective)
if ink="\" then longitude_latitude+=1:if longitude_latitude>=3 then longitude_latitude=0
end if
loop
'===============================================================================
'EXIT main loop
'===============================================================================
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'set up GL screen
'===============================================================================
sub SetUpGl(byval perspective as single)
glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective perspective, xres/yres, .1, 100.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
glShadeModel GL_SMOOTH
glClearColor 0.0, 0.0, 0.0, 0.0
glClearDepth 1.0
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
glEnable(GL_LIGHTING)
glEnable(GL_LIGHT0)
glEnable(GL_COLOR_MATERIAL)
end sub
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'control lighting/shading
'===============================================================================
private sub Normalize(v as glfloat ptr,n as glfloat ptr)
dim as glfloat l = v[0]*v[0] + v[1]*v[1] + v[2]*v[2]
if l then
l=1.0/sqr(l)
n[0]=v[0]*l
n[1]=v[1]*l
n[2]=v[2]*l
end if
end sub
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'draw sphere
'===============================================================================
private sub DrawSphere(byval NumOfSegments as Uinteger)
dim as integer NumOfPoints = (NumOfSegments+1)*(NumOfSegments+1)
dim as single UR=0, YP=0, VR=0, UW=0, VW=0, l=0
dim as single US = (PI * 2 ) / NumOfSegments
dim as single VS = (PI ) / NumOfSegments
dim as integer PC = 0
dim as GLuint listnum = 0
dim as glfloat points(NumOfPoints*3-1)
For yc as integer = 0 To NumOfSegments
UR = sin(VW)
YP = cos(VW)
VR = sin(VW)
VW+=VS
UW = 0
For xc as integer = 0 To NumOfSegments
Points(PC*3+0)=sin(PI + UW ) * UR
Points(PC*3+1)= YP
Points(PC*3+2)=cos(PI + UW ) * VR
PC+=1
UW+=US
Next
Next
listnum = glGenLists(1)
glNewList (listnum,GL_COMPILE)
glBegin GL_LINES
For yc as integer = 0 To NumOfSegments - 1
For xc as integer = 0 To NumOfSegments - 1
dim as integer P0 = (yc + 1) * (NumOfSegments + 1) + (xc + 0)
dim as integer P1 = (yc + 1) * (NumOfSegments + 1) + (xc + 1)
dim as integer P2 = (yc + 0) * (NumOfSegments + 1) + (xc + 1)
dim as integer P3 = (yc + 0) * (NumOfSegments + 1) + (xc + 0)
dim as glfloat v(2),n(2)
'LATITUDE LINES
if longitude_latitude=0 or longitude_latitude=2 then
v(0)=Points(p0*3+0)
v(1)=Points(p0*3+1)
v(2)=Points(p0*3+2)
Normalize @v(0),@n(0)
glNormal3fv(@n(0))
glVertex3fv(@v(0))
v(0)=Points(p1*3+0)
v(1)=Points(p1*3+1)
v(2)=Points(p1*3+2)
Normalize @v(0),@n(0)
glNormal3fv(@n(0))
glVertex3fv(@v(0))
end if
'LONGITUDE LINES
if longitude_latitude=0 or longitude_latitude=1 then
v(0)=Points(p0*3+0)
v(1)=Points(p0*3+1)
v(2)=Points(p0*3+2)
Normalize @v(0),@n(0)
glNormal3fv(@n(0))
glVertex3fv(@v(0))
v(0)=Points(p3*3+0)
v(1)=Points(p3*3+1)
v(2)=Points(p3*3+2)
Normalize @v(0),@n(0)
glNormal3fv(@n(0))
glVertex3fv(@v(0))
end if
Next
Next
glEnd()
glEndList()
glCallList(listnum)
glDeleteLists(listnum , NumOfPoints*3)
glDeleteLists(points(0), NumOfPoints*3)
end sub