'=============================================================================='
'=============================================================================='
'                                                                              '
'                              "--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 "       (\)       to control lon,lat lines"
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 single PI = ATN(1)*4
dim as uinteger NumOfSegments = 12
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 double time1=timer,time2
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>=11 then longitude_latitude=0
    end if
    
    'time2=timer
    'if time2-time1>=1.5 then
    '    longitude_latitude+=1:if longitude_latitude>=11 then longitude_latitude=0
    '    time1=timer
    '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 Rad=atn(1)/45
    dim as single Deg1
    dim as single Deg2
    dim as single Deg1_Inc = 180/NumOfSegments
    dim as single Deg2_Inc = 360/NumOfSegments
    dim as single C1=0, S1=0, Z1=0
    dim as single C2=0, S2=0, Z2=0
    
    dim as GLuint listnum = 0
    dim as glfloat points((NumOfPoints*3)-1)
    
    dim as uinteger PC = 0
    For Deg1 = 0 to 181 step Deg1_Inc
        C1 = sin(Deg1*Rad)
        Z1 = cos(Deg1*Rad)
        S1 = sin(Deg1*Rad)
        For Deg2 = 0  to 361 step Deg2_Inc
            C2 = cos(deg2*rad)
            Z2 = Z1
            S2 = sin(deg2*rad)
            Points(PC*3+0)=C2*C1
            Points(PC*3+1)=Z2
            Points(PC*3+2)=S2*S1
            PC+=1
        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
            select case longitude_latitude
                case 0,1 ,5,6,7 
                    glcolor3ub(0,0,255)
                    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 select
            
            'LONGITUDE LINES
            select case longitude_latitude
                case 0,2 ,8,9,10
                    glcolor3ub(255,0,0)
                    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 select
            
            'DIAGONAL LINES
            select case longitude_latitude
                case 0,3 ,5,7 ,8,10
                    glcolor3ub(0,255,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))
                   
                    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 select
            
            'DIAGONAL LINES
            select case longitude_latitude
                case 0,4 ,6,7 ,9,10
                    glcolor3ub(255,0,255)
                    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(P2*3+0)
                    v(1)=Points(P2*3+1)
                    v(2)=Points(P2*3+2)
                    Normalize @v(0),@n(0)
                    glNormal3fv(@n(0))
                    glVertex3fv(@v(0))
            end select
        
        Next
    Next
    
    glEnd()
    glEndList()
    glCallList(listnum)
    
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)
    
end sub