none
Morphius Screen Saver RRS feed

  • Question

  • '=============================================================================='
    '=============================================================================='
    '                                                                              '
    '                        Morphius_Solid_4                                      '
    '                                                                              '
    '   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
    '===============================================================================
    declare Sub regulate(MyFps As integer)
    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
       
        regulate(45) 'set at 40 above
       
        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
       
    loop
    '===============================================================================
    'EXIT main loop
    '===============================================================================
    DeleteSphere()
    END
    '===============================================================================
    '===============================================================================
    '===============================================================================
    '===============================================================================
    'Sphere subs below here
    '===============================================================================
    '===============================================================================
    '===============================================================================
    '===============================================================================
    Sub regulate(MyFps As integer)
        static as double timervalue
        Do While (Timer - TimerValue) < 1/MyFps
        Loop
        timervalue=timer
    End Sub
    '===============================================================================
    '===============================================================================
    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

    Thursday, November 21, 2013 5:13 PM