PDA

View Full Version : OpenGL Sphere

albert_redditt
03-21-2012, 10:39 PM
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 '
' Install in the same directory you installed FreeBasic '
' '
' Modified From D.J.Peters Sphere code '
' http://www.freebasic.net/forum/viewtopic.php?f=3&amp;t=16207&amp;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
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(&amp;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
gluPerspective perspective, xres/yres, .1, 100.0
glMatrixMode GL_MODELVIEW

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
'================================================= ==============================
'================================================= ==============================
'================================================= ==============================
'================================================= ==============================
'================================================= ==============================
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

BionicBytes
03-22-2012, 10:11 AM
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.

Congratulations you can cut and paste.

Now, what's the question or did you just want to share that with the rest of the world?