Morphius Screen-Savers

[albert]

Just use CMD.EXE ( ie..DOS PROMPT ) and COPY filename.EXE to filename.SCR

And then stick in your .\Windows\System32 directory, or your .\Windows\WOW64 directory.

Morphius_Solid

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius-Solid                                        '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub DrawSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    DrawSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle =8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    sleep 1,1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
private sub DrawSphere()
   
    dim as GLuint listnum = 0
    dim as glfloat points(NumOfPoints*3-1)
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
   
    dim as single  US = ( PI * multiplier1*2) / NumOfSegments
    dim as single  VS = ( PI * multiplier2/8) / NumOfSegments
    dim as integer PC = 0
   
    For yc as integer = 0 To NumOfSegments
        UR = sin(VW)
        YP = cos(VW)
        VR = sin(VW)
        VW+=VS  + ( (US*2) * (atn(UR+YP+VR)^2) )
       
        UW = 0
        For xc as integer = 0 To NumOfSegments
            Points(PC*3+0)=cos(PI + UW) * UR
            Points(PC*3+1)=               YP
            Points(PC*3+2)=sin(PI + UW) * VR
            PC+=1
            UW+=US
        Next
    Next
   
    listnum = glGenLists(1)
    glNewList (listnum,GL_COMPILE)
    glBegin GL_TRIANGLES
   
    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)
           
            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))
       
            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(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))
           
            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))
           
            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))
           
        Next
    Next
   
    glEnd()
    glEndList()
    glCallList(listnum)
   
    glDeleteLists(listnum , NumOfPoints)
    glDeleteLists(points(0), NumOfPoints)
   
end sub



Morphius_WireFrame

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_WireFrame                                    '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub DrawSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    DrawSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle =8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    sleep 1,1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
private sub DrawSphere()
   
    dim as GLuint listnum = 0
    dim as glfloat points(NumOfPoints*3-1)
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
   
    dim as single  US = ( PI * multiplier1*2) / NumOfSegments
    dim as single  VS = ( PI * multiplier2/8) / NumOfSegments
    dim as integer PC = 0
   
    For yc as integer = 0 To NumOfSegments
        UR = sin(VW)
        YP = cos(VW)
        VR = sin(VW)
       
        VW+=VS  + ( (US*2) * (atn(UR+YP+VR)^2) )
        UW = 0
        For xc as integer = 0 To NumOfSegments
            Points(PC*3+0)=cos(PI + UW) * UR
            Points(PC*3+1)=               YP
            Points(PC*3+2)=sin(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)
           
            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(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))
           
            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))
           
        Next
    Next
   
    glEnd()
    glEndList()
    glCallList(listnum)
   
    glDeleteLists(listnum , NumOfPoints)
    glDeleteLists(points(0), NumOfPoints)

end sub



I got a trigger set so it only changes about every 4 (L/R) screen edge bounces..
so it goes back and forth 2 to 3 times between changes.

FIXED / EDITED ( 1/19/2012 9:25PM PST )

[VANYA]

Good.

[joseywales72]

Very nice. I removed the windows.bi dependancy by remarking it out and changing the MessageBox with a simple Print statement. It now works on Linux flawlessly.

[dodicat]

Very nice Albert.
I can't put anything into my system32 folder, but commenting out the first few lines gets the code running.

Would this message box work on Linux?
I doubt it somehow.

Code: Select all

sub messagebox(msg as string)
  shell ("msg * "+ msg)
end
end sub

messagebox("This Screen Saver has no adjustable settings.") 

[joseywales72]

Here is a working messagebox for linux. It uses GTK widgetset.

Code: Select all

#include "gtk/gtk.bi"
sub messagebox_gtk(message as string)
gtk_init( NULL, NULL )
Dim dialog As GtkWidget Ptr = gtk_message_dialog_new(NULL,GTK_DIALOG_DESTROY_WITH_PARENT,GTK_MESSAGE_INFO,GTK_BUTTONS_OK,StrPtr( message ))
gtk_dialog_run( GTK_DIALOG( dialog ) )
gtk_widget_destroy( dialog )
end sub

'example
messagebox_gtk("Hello")
end


It's not my code, I just changed default button and message type. The original code is by Galeon from this thread.
http://www.freebasic.net/forum/viewtopic.php?f=5&t=16256
Hope this helps.

[TJF]

@joseywales72:

Two hints on your code

• gtk_init should be called only once at the beginning of the code.
• gtk_message_dialog_new has a VarArg parameter list and it should be terminated by NULL.

Better use

Code: Select all

#INCLUDE "gtk/gtk.bi"
gtk_init( NULL, NULL )

SUB messagebox_gtk(BYREF message AS STRING)
  VAR dialog = gtk_message_dialog_new( _
    NULL, _
    GTK_DIALOG_DESTROY_WITH_PARENT, _
    GTK_MESSAGE_INFO, _
    GTK_BUTTONS_OK, _
    STRPTR( message ), _
    NULL)
  gtk_dialog_run( GTK_DIALOG( dialog ) )
  gtk_widget_destroy( dialog )
END SUB

'example
messagebox_gtk("Hello")
END

[albert]

I put the Solid and WireFrame code together ..

So now you just hit ( F1 ) while its running ,to switch back and forth.

Just compile and use CMD.EXE to copy Name.EXE to Name.SCR
and then either Windows will let you install it from the current directory by right clicking on it.
Or you'll have to copy the Name.SCR to the C:\Windows\System32 directory with admin privileges.

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                    Morphius_SOLID_or_WireFrame.BAS                           '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." +chr(13)+chr(10)+ _
                                   "While running use F1 to switch between Solid or WireFrame." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub DrawSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as string   line_triangle : line_triangle = "triangle"
dim shared as ubyte    line_triangle_toggle = 0
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd : if color_red  >=.75 then color_red  =.75 : if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd : if color_green>=.75 then color_green=.75 : if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd : if color_blue >=.75 then color_blue =.75 : if color_blue <=.25 then color_blue = .25
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    DrawSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink = inkey
    if ink<>"" then
        if ink=chr(255)+";" then
            if line_triangle = "line" then line_triangle = "triangle" else line_triangle = "line"
        else
            status = 0
        end if
    end if
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle = 8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1=int(rnd*1001)
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    sleep 1,1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
private sub DrawSphere()
   
    dim as GLuint listnum = 0
    dim as glfloat points( NumOfPoints*3)
   
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
   
    dim as single  US = ( PI * multiplier1 * 2 ) / NumOfSegments
    dim as single  VS = ( PI * multiplier2 / 8 ) / NumOfSegments
    dim as integer PC = 0
   
    PC = 0
    For yc as integer = 0 To NumOfSegments
        UR = sin(VW)
        YP = cos(VW)
        VR = sin(VW)
        VW+= VS + ( (US*2) * (atn(UR+YP+VR)^2) )
       
        UW = 0
        For xc as integer = 0 To NumOfSegments
            Points(PC*3+0)=cos(PI + UW) * UR
            Points(PC*3+1)=               YP
            Points(PC*3+2)=sin(PI + UW) * VR
            PC+=1
            UW+=US
        Next
    Next
   
    listnum = glGenLists(1)
    glNewList (listnum,GL_COMPILE)
   
    if line_triangle="line" then
    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)
           
            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(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))
           
            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))
           
        Next
    Next
    end if
   
    if line_triangle="triangle" then
    glBegin GL_TRIANGLES
    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)
           
            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(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))
           
            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(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))
           
            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))

        Next
    Next
    end if

    glEnd()
    glEndList()
    glCallList(listnum)
   
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)

end sub



[albert]

Heres "Morphius_V2" Screen Savers.
Just use cmd.exe to copy *.exe to *.scr

I set the Number of segments to 20 so it make 5,10,15,20 sided objects instead of just 5,10.

Morphius_V2_Solid

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_V2_Solid                                     '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
'Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub DrawSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
'screen 19
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 20
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    DrawSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
    if xt_adj_toggle>= 2 and yt_adj_toggle>=4 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1050 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        'messagebox(0,str(multiplier1)+" _ " + str(multiplier2), "",MB_OK)
        if multiplier1>=1000 then multiplier1=1
    end if
   
    sleep 1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
private sub drawSphere()
  dim as GLuint listnum = 0
  dim as glfloat points(NumOfPoints*3-1)
   
    dim as single  UR,YP,VR,UW,VW,l
    dim as single  US = (PI* multiplier1*2) / NumOfSegments 'horizontal portion
    dim as single  VS = (PI* multiplier2/2) / NumOfSegments 'verticle portion
    dim as integer PC = 0
    For yc as integer = 0 To NumOfSegments
      UR = Sin(VW)
      YP = Cos(VW)
      VR = Sin(VW)
      VW+=VS + ((US*2)+(atn(UR+YP+VR)^2))
         
      UW = 0
      For xc as integer = 0 To NumOfSegments
        Points(PC*3+0)=Sin(PI + UW) * UR/1.125
        Points(PC*3+1)=atn(PI + VW) * YP*VR*UR/1.125
        Points(PC*3+2)=Cos(PI + UW) * VR/1.125
        PC+=1: UW+= US
      Next
    Next
   
    listnum = glGenLists(1)
    glNewList (listnum,GL_COMPILE)
    glBegin GL_TRIANGLES
   
    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)
           
            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))
           
            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))
           
            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))
           
            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))
           
        Next
    Next
   
    glEnd()
    glEndList()
    glCallList(listnum)
   
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)
   
end sub



Morphius_V2_WireFrame

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_V2_WireFrame                                 '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
'Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub DrawSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
'screen 19
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 20
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    DrawSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
    if xt_adj_toggle>= 2 and yt_adj_toggle>=4 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1050 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        'messagebox(0,str(multiplier1)+" _ " + str(multiplier2), "",MB_OK)
        if multiplier1>=1000 then multiplier1=1
    end if
   
    sleep 1,1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
private sub drawSphere()
  dim as GLuint listnum = 0
  dim as glfloat points(NumOfPoints*3-1)
   
    dim as single  UR,YP,VR,UW,VW,l
    dim as single  US = (PI* multiplier1*2) / NumOfSegments 'horizontal portion
    dim as single  VS = (PI* multiplier2/2) / NumOfSegments 'verticle portion
    dim as integer PC = 0
    For yc as integer = 0 To NumOfSegments
      UR = Sin(VW)
      YP = Cos(VW)
      VR = Sin(VW)
      VW+=VS + ((US*2)+(atn(UR+YP+VR)^2))
         
      UW = 0
      For xc as integer = 0 To NumOfSegments
        Points(PC*3+0)=Sin(PI + UW) * UR/1.125
        Points(PC*3+1)=atn(PI + VW) * YP*VR*UR/1.125
        Points(PC*3+2)=Cos(PI + UW) * VR/1.125
        PC+=1: UW+= US
      Next
    Next
   
    listnum = glGenLists(1)
    glNewList (listnum,GL_COMPILE)
    glBegin GL_LINES'TRIANGLES
    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)
           
            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(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))
           
            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))
           
            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))
       
        Next
    next
    glEnd()
    glEndList()
    glCallList(listnum)
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)
end sub



[albert]

I played around with the formulas a little, and made it so there are separate Create,Plot and Delete subroutines

Morphius_Solid_V3

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_Solid_2                                      '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub CreateSphere()
declare sub PlotSphere()
declare sub DeleteSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Setup Open GL Array to hold points
'===============================================================================
dim shared as GLuint listnum = 0
dim shared as glfloat points(NumOfPoints*3-1)
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
CreateSphere()
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    PlotSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle =8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
        DeleteSphere()
        CreateSphere()
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    sleep 1
   
loop
'===============================================================================
'EXIT main loop
'===============================================================================
DeleteSphere()
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
sub CreateSphere()
    'dim as GLuint listnum = 0
    'dim as glfloat points(NumOfPoints*3-1)
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
    dim as single  US = (PI*2*(multiplier1)) / NumOfSegments 'horizontal portion
    dim as single  VS = (PI*2*(multiplier2)) / NumOfSegments 'verticle portion
    dim as integer PC = 0
   
    For yc as integer = 0 To NumOfSegments
        UR = Sin(VW)
        YP = Cos(VW)
        VR = Sin(VW)
        VW+= VS + ( (US*2) * atn(VW) )
       
        UW = 0
        For xc as integer = 0 To NumOfSegments
            Points(PC*3+0)=Sin(       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_TRIANGLES)

    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)
       
        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))
       
        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))
       
        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(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))
       
        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))
        Next
    Next
   
    glEnd()
    glEndList()
    'glCallList(listnum)
   
    'glDeleteLists(listnum , NumOfPoints*3)
    'glDeleteLists(points(0), NumOfPoints*3)
   
end sub
'===============================================================================
'===============================================================================
sub PlotSphere()
    glCallList(listnum)
end sub
'===============================================================================
'===============================================================================
sub DeleteSphere()
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)
end sub



Morphius_WireFrame_V3

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_WireFrame_2                                  '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
'===============================================================================
'declare subs
'===============================================================================
declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub CreateSphere()
declare sub PlotSphere()
declare sub DeleteSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Setup Open GL Array to hold points
'===============================================================================
dim shared as GLuint listnum = 0
dim shared as glfloat points(NumOfPoints*3-1)
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1=timer
dim as single time2
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
CreateSphere()
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    PlotSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle =8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
        DeleteSphere()
        CreateSphere()
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    sleep 1,1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
DeleteSphere()
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
sub CreateSphere()
    'dim as GLuint listnum = 0
    'dim as glfloat points(NumOfPoints*3-1)
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
    dim as single  US = (PI*2*(multiplier1)) / NumOfSegments 'horizontal portion
    dim as single  VS = (PI*2*(multiplier2)) / NumOfSegments 'verticle portion
    dim as integer PC = 0
   
    For yc as integer = 0 To NumOfSegments
        UR = Sin(VW)
        YP = Cos(VW)
        VR = Sin(VW)
        VW+= VS + ( (US*2) * atn(VW) )
       
        UW = 0
        For xc as integer = 0 To NumOfSegments
            Points(PC*3+0)=Sin(       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)
           
            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(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))
           
            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))
           
        Next
    Next
   
    glEnd()
    glEndList()
    'glCallList(listnum)
   
    'glDeleteLists(listnum , NumOfPoints*3)
    'glDeleteLists(points(0), NumOfPoints*3)

end sub
'===============================================================================
'===============================================================================
sub PlotSphere()
    glCallList(listnum)
end sub
'===============================================================================
'===============================================================================
sub DeleteSphere()
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)
end sub



[dodicat]

Hi Albert.
This seems to run well.
I just set my folder options (view) in XP , unchecked Hide extensions for known file types.
I dont know if Windows after XP has this option.
I can just rename .exe to .scr on a right click.

I'll have to modify my own bouncing GLclock saver, fb 24 doesn't allow -- type object -- object is now a keword in fb.

By the way, you don't have to include Windows.bi for a message box, you can access kernel32.dll (or whatever it is in Windows beyond XP).
Here's an example with TWO kinds of messagebox:

Code: Select all



Declare Function msg Alias "MessageBoxW"(n1 As Integer,s1 As Wstring,s2 As Wstring,n2 As Integer) As Integer:Sleep 1

#define msg2(msg)  shell ("msg * "+ str(msg))


msg(0,"This is a message without loading windows.bi","Straight from Kernel32.dll",0)


'MESS AROUND

Type WIDEBOX
    Dim As String  unused_dummy
    Declare property test(l As Integer) As String
End Type

property WIDEBOX.test(l As Integer) As String
var W=String(l,"W")
var I=String(l,"I")
var D=String(l,"D")
var E=String(l,"E")
Return W + I + D + E
End property

Dim As widebox widething

msg(0,widething.test(22),"Width Test",0)

msg2(" ECHO BOX -- Can take strings or numbers, but program runs on")


msg2(widething.test(22))


Sub chars
    Dim As Integer w=Width
    #define rr(f,l) (Rnd*(l-f)+f)
    Dim As Integer h,v
    Do
        v=rr(0,Hiword(w)):h=rr(0,Loword(w)-1)
        Locate v,h
        Color rr(0,7),rr(0,7)
        If Csrlin<Hiword(w) Then   
            Print Chr(rr(11,120))
        End If
    Loop Until Len(Inkey)
End Sub
chars

 

[albert]

Thanks Dodicat for the info.

I've haven't let the SOLID or WIREFRAME scr's run all the way through yet,
I might have to readjust the formulas, it goes to 1001 and I have to see if certain ones show up as flaties 2D.

With the original formulas; I had to check for and cancel or increment every fifth one. they would show up as a flat 2D object.

[dodicat]

Hi Albert.
I notice that Windows Vista doesn't do
shell ("msg * "+ str(msg))
So, I would say that your Win 7 doesn't do it either.
Did you see only one type of message box when you ran my code?
I would say that the command interpreter above Win XP is not backward compatible.
I suppose I'll have to Google for the different commands for shell for Win > Win XP, although I am using XP and will have to access another box to test them out.
I don't suppose there are many still using Win XP these days!

[dafhi]

XP is snappier, but runs hotter at idle. Kudos to 7 for it's power sipping. I am quite impressed, except for cases when I'm away for 5 minutes, 7 decides it needs to exercise some of those unused cycles, I come back and the fan's blowing. Usually it's svchost doing something. Anway, I love 7. I'd love XP more if it had 7's power sip.

I can't run my laptop for very long in the summertime :)

[albert]

@Dodicat

Your mesagebox code, created the mesagebox, just fine in Windows 7.
It ran just fine.

[albert]

I'm up to Version 5 , its fixes the racing, by using dodicats newest "Regulate" sub.

Change the extension of the *.exe to *.scr and put in your c:\Windows\System32 folder or C:\Windows\Wow64

Under Windows 10 "File manager" won't show Windows\System32 or Windows\WOW64 folders,
But you can use FBIDE file ~ open , to get to those two folders , and paste the *.scr's to them.
Under FBIDE click on open , then select the two *.scr's then right click on them and click "copy"
Then still in the file open window goto C:\Windows\System32 or C:\Windows\WOW64 and right click on the files and select paste and paste the files into the folder. A box will come up to authorization to paste the files.
You have to do this from the root or admin account..


Morphius_Solid_V5

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_Solid_5                                      '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
Dim as integer My_Frame_Rate=40
'===============================================================================
'declare subs
'===============================================================================
Dim As Long fps
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub CreateSphere()
declare sub PlotSphere()
declare sub DeleteSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Setup Open GL Array to hold points
'===============================================================================
dim shared as GLuint listnum = 0
dim shared as glfloat points(NumOfPoints*3-1)
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1, time2 , time_1
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
CreateSphere()
dim as double framerate
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    PlotSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
     
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle =8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
        DeleteSphere()
        CreateSphere()
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    Sleep regulate(60,fps),1
   
loop
'===============================================================================
'EXIT main loop
'===============================================================================
DeleteSphere()
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
sub CreateSphere()

    'dim as GLuint listnum = 0
    'dim as glfloat points(NumOfPoints*3-1)
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
    dim as single  US = (PI*2*(multiplier1)) / NumOfSegments 'horizontal portion
    dim as single  VS = (PI*2*(multiplier2)) / NumOfSegments 'verticle portion
    dim as integer PC = 0
   
    For yc as integer = 0 To NumOfSegments
        UR = Sin(yc*VW)
        YP = Cos(yc*VW)
        VR = Sin(yc*VW)
        VW+= VS + ( (US*((rnd*4)+1)) )' * atn(VW) )
       
        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_TRIANGLES
   
    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)
           
            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))
           
            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))
           
            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(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))
           
            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))
        Next
    Next
   
    glEnd()
    glEndList()
    'glCallList(listnum)
   
    'glDeleteLists(listnum , NumOfPoints*3)
    'glDeleteLists(points(0), NumOfPoints*3)
   
end sub
'===============================================================================
'===============================================================================
sub PlotSphere()
    glCallList(listnum)
end sub
'===============================================================================
'===============================================================================
sub DeleteSphere()
    glDeleteLists(listnum , NumOfpoints*3)
    glDeleteLists(points(0), NumOfpoints*3)
end sub



Morphius_WireFrame_V5

Code: Select all

'=============================================================================='
'=============================================================================='
'                                                                              '
'                        Morphius_WireFrame_5                                  '
'                                                                              '
'   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                                                       '
'=============================================================================='
'=============================================================================='
#Include once "windows.bi"  'for message box
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"
'===============================================================================
'take care of screen saver args /s /p /c
'===============================================================================
Print "exe name= "; Command( 0 )
Dim argv As String
argv = Command( 1 )
argv = left(argv,2)
if argv = "" then END
if argv = "/c" then MessageBox( 0, "This Screen Saver has no adjustable settings." , "No Configurations" , MB_OK )
'if argv = "/p" then goto BEGIN
if argv = "/s" then goto BEGIN
End
BEGIN:
Dim as integer My_Frame_Rate=40
'===============================================================================
'declare subs
'===============================================================================
Dim As Long fps
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

declare sub Normalize(v as glfloat ptr,n as glfloat ptr)
declare sub CreateSphere()
declare sub PlotSphere()
declare sub DeleteSphere()
'===============================================================================
'set up GL screen
'===============================================================================
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32,,10

glViewport 0, 0, xres, yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 11.25, 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)
'===============================================================================
'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
dim as ubyte    xt_adj = 1 'toggle for x motion
dim as ubyte    yt_adj = 1 'toggle for y motion
dim as ubyte    xt_adj_toggle = 0 'toggles to trigger morphing
dim as ubyte    yt_adj_toggle = 0
dim as ubyte xt_yt_adj_toggle = 0
'===============================================================================
'Variables for Sphere
'===============================================================================
dim shared as double PI  = ATN(1)*4
dim shared as uinteger NumOfSegments : NumOfSegments = 10
dim shared as uinteger NumOfPoints   : NumOfPoints   = (NumOfSegments+1)*(NumOfSegments+1)
dim shared as single multiplier1=1
dim shared as single multiplier2=1
dim as single color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
dim as single color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
dim as single color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
'===============================================================================
'Setup Open GL Array to hold points
'===============================================================================
dim shared as GLuint listnum = 0
dim shared as glfloat points(NumOfPoints*3-1)
'===============================================================================
'Variables for looping,timing and input
'===============================================================================
dim as single time1 , time2 , time_1
dim as string ink
dim as ubyte status = 1
'===============================================================================
'start main loop
'===============================================================================
CreateSphere()
dim as double framerate
do while status=1
   
    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       
    glColor3f( color_red, color_green , color_blue )
   
    PlotSphere()  'call the Draw-Sphere sub routine
    flip
 
    ink=inkey : if ink<>"" then status = 0 ' any key to quit
   
    xr = xr + xrs
    yr = yr + yrs
    zr = zr + zrs
   
    if xt_adj = 1 then xt+=.01
    if xt_adj = 0 then xt-=.01
    if yt_adj = 1 then yt+=.01
    if yt_adj = 0 then yt-=.01
   
    if xt >= +xres/yres then if xt_adj = 1 then xt_adj = 0 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if xt <= -xres/yres then if xt_adj = 0 then xt_adj = 1 : if xt_adj_toggle<>4 then xt_adj_toggle+=1
    if yt >= +yres/xres then if yt_adj = 1 then yt_adj = 0 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
    if yt <= -yres/xres then if yt_adj = 0 then yt_adj = 1 : if yt_adj_toggle<>8 then yt_adj_toggle+=1
   
   
    if xt_adj_toggle = 4 and yt_adj_toggle =8 then
        if (xt+.25 = 0) or (xt-.25 = 0) then xt_yt_adj_toggle=1
    end if
   
    if xt_yt_adj_toggle=1 then
        multiplier2+=1
        if multiplier2=1001 then multiplier2=1
        if multiplier2 mod 35 = 0 then xt_adj_toggle=0 : yt_adj_toggle=0 : xt_yt_adj_toggle=0 : time1=time2-60
        DeleteSphere()
        CreateSphere()
    end if
   
    time2=timer
    if time2-time1 >=60 then
        color_red  =.25+rnd:if color_red  >=.75 then color_red  =.75:if color_red  <=.25 then color_red  = .25
        color_green=.25+rnd:if color_green>=.75 then color_green=.75:if color_green<=.25 then color_green= .25
        color_blue =.25+rnd:if color_blue >=.75 then color_blue =.75:if color_blue <=.25 then color_blue = .25
        time1=timer
        multiplier1+=1
        if multiplier1 mod 5 = 0 then multiplier1+=1
        if multiplier1=1001 then multiplier1=1
    end if
   
    Sleep regulate(60,fps),1

loop
'===============================================================================
'EXIT main loop
'===============================================================================
DeleteSphere()
END
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'Sphere subs below here
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
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/sqr(l)
    n[0]=v[0]*l
    n[1]=v[1]*l
    n[2]=v[2]*l
  end if
end sub   
'===============================================================================
'===============================================================================
sub CreateSphere()
    'dim as GLuint listnum = 0
    'dim as glfloat points(NumOfPoints*3-1)
    dim as single  UR=0, YP=0, VR=0, UW=0, VW=0, l=0
    dim as single  US = (PI*2*(multiplier1)) / NumOfSegments 'horizontal portion
    dim as single  VS = (PI*2*(multiplier2)) / NumOfSegments 'verticle portion
    dim as integer PC = 0
   
    For yc as integer = 0 To NumOfSegments
        UR = Sin(VW)
        YP = Cos(VW)
        VR = Sin(VW)
        VW+= VS + ( (US*((rnd*4)+1)) )' * atn(VW) )
        'VW+= VS + ( (US*2) * atn(VW) )
       
        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)
           
            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(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))
           
            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))
           
        Next
    Next
   
    glEnd()
    glEndList()
    'glCallList(listnum)
   
    'glDeleteLists(listnum , NumOfPoints*3)
    'glDeleteLists(points(0), NumOfPoints*3)

end sub
'===============================================================================
'===============================================================================
sub PlotSphere()
    glCallList(listnum)
end sub
'===============================================================================
'===============================================================================
sub DeleteSphere()
    glDeleteLists(listnum , NumOfPoints*3)
    glDeleteLists(points(0), NumOfPoints*3)
end sub