FreeBasic

Красивая реализация вращения узора, базой дизайна которого служит шестиугольник.
Платформы: Widows, Linux
Автор: Alexander Pritchard

/'
 ' Recursive Vector Revolution From a Parent Origin
 ' Copyright (c) 2008 Alexander Pritchard (TheAdventMaster@gmail.com)
 ' All Rights Reserved
 ' Contact:  TheAdventMaster@gmail.com
 '
 ' Use of the FreeBASIC Graphics Library, GFXlib 2,
 ' Copyright (c) Angelo Mottola (a.mottola@libero.it) under terms and
 ' conditions of the GNU LGPL - GNU LESSER GENERAL PUBLIC LICENSE:
 '                 Copyright (C) 1991, 1999 Free Software Foundation, Inc.
 '                    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 '
 ' Free for free public use and distribution unless requested otherwise.  You
 ' may not use this program or its contents in any commercial application
 ' without permission from the author.  Doing so without permission may lead
 ' to a request to remove this program and its contents from your application.
 '

 ' This program is distributed in the hope that it will be useful, but WITHOUT
 ' ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 ' FOR A PARTICULAR PURPOSE.
 '/

' </unnecessary licensing>

#INCLUDE Once "gl\gl.bi"
#INCLUDE Once "fbgfx.bi"

#DEFINE false 0
#DEFINE true (Not false)
#DEFINE pi (Atn(1)*4)

'' i am careful...
#DEFINE toRadians(that) ((that)*(pi/180))
#DEFINE toDegrees(that) ((that)*(180/pi))

'' I hate (partially) recoding my vector class for every example I make...
Type Vec2
    As Vec2 Ptr origin
    As Single x, y

    Declare Function getAngle() As Single
    Declare Sub incAngle( Byval degrees As Single )
    Declare Sub setAngle( Byval degrees As Single )
    Declare Function getMagnitude() As Single
    Declare Function ox() As Single
    Declare Function oy() As Single
End Type

Function Vec2.ox() As Single
    If( origin <> 0 ) Then
        Return x + origin->ox()
    Else
        Return x
    End If
End Function

Function Vec2.oy() As Single
    If( origin <> 0 ) Then
        Return y + origin->oy()
    Else
        Return y
    End If
End Function

Sub Vec2.incAngle( Byval degrees As Single )
    setAngle( getAngle() + degrees )
End Sub

Sub Vec2.setAngle( Byval degrees As Single )

    '' keep degrees in range
    If( degrees < 0 ) Then
        degrees = -degrees
        If( degrees >= 360 ) Then
            degrees = degrees Mod 360
        End If
        degrees = 360 - degrees
    Else
        If( degrees >= 360 ) Then
            degrees = degrees Mod 360
        End If
    End If

    '' record current magnitude then set angle
    Dim As Single curMagnitude = getMagnitude()

    x = Cos( toRadians(degrees) ) * curMagnitude
    y = -sin( toRadians(degrees) ) * curMagnitude

End Sub

Function Vec2.getAngle() As Single
    '' get the radians to degrees of our angle
    Dim As Single retVal = toDegrees( -atan2( y, x ) ) + 360

    '' keep the angle in bounds
    If( retVal < 360 ) Then
        Return retVal
    Else
        Return retVal - 360
    End If
End Function

Function Vec2.getMagnitude() As Single
    '' only calculate magnitude if at least one value is != 0
    If( x <> 0 ) Then
        Return Sqr( (x * x) + (y * y) )
    Else
        If( y <> 0 ) Then
            Return Sqr( (x * x) + (y * y) )
        Else
            Return 0
        End If
    End If
End Function


''
''
'''
'''
'''
'''
'''
''''
''''
''''  CODE THAT SORTA DOES STUFF STARTS BELOW!
''''
''''
'''
'''
'''
'''
''
''


Randomize Timer()

'''' GL Technical Specs
'' render child polygons? (potentially really neat effect)
Const As Integer RENDER_CHILD_POLYGONS = true
'' render parent's children polygon? (which can get annoying)
'' only in effect when RENDER_CHILD_POLYGONS is on
Const As Integer RENDER_PARENT_CHILD_POLYGON = false


'''' technical specs
'' number of branches
Const As Integer BRANCH_COUNT = 4
'' number of children each node has
Const As Integer CHILD_COUNT = 6
'' start direction
Const As Integer START_DIRECTION = -1


'''' main setup (modifiers are important, too)
'' RADIUS of each object
Const As Single RADIUS = 30
'' speed of rotation in degrees per second
Const As Single ROTATION_SPEED = 20
'' distance a child is from their parent
Const As Single CHILD_DISTANCE = 200


'''' modifiers
'' RADIUS multiplier from one branch to the next
Const As Single RADIUS_CHANGE = .5
'' rotation speed multiplier from one branch to the next
Const As Single ROTATION_SPEED_CHANGE = .8314
'' distance change from one branch to the next
Const As Single CHILD_DISTANCE_CHANGE = .5


'''' parent node info
'' position... will visibly rotate if <> 0
Const As Integer OFFSET_X = 0
Const As Integer OFFSET_Y = 0


'''' (almost) pretty stuff
'' coloring scheme:  0 = random, 1 = white to black, 2 = black to white, 3 custom color
Const As Integer COLORING_SCHEME = 3
'' ALPHA value for rendering the objects
Const As Single ALPHA = .99f
'' clear color
Const As Single CLEAR_COLOR_R = 0
Const As Single CLEAR_COLOR_G = 0
Const As Single CLEAR_COLOR_B = 0
Const As Single CLEAR_COLOR_A = 1
'' whether we should clear the screen at all
Const As Integer CLEAR_SCREEN = true


'''' custom color data if we chose to use it
'' we edit RGBA individually here.  it's a lot easier than doing otherwise.
Const As Uinteger CUSTOM_COLOR_R = 1f
Const As Uinteger CUSTOM_COLOR_G = .51f
Const As Uinteger CUSTOM_COLOR_B = 0f
'' color change for the RGB values
Const As Single CUSTOM_COLOR_R_CHANGE = 1
Const As Single CUSTOM_COLOR_G_CHANGE = .8
Const As Single CUSTOM_COLOR_B_CHANGE = 1
Const As Single CUSTOM_COLOR_A_CHANGE = .75


Type Vec2Spiral
    As Vec2Spiral Ptr Ptr child
    As Integer numChild

    As Vec2 us
    As Integer direction

    As Single childColorR
    As Single childColorG
    As Single childColorB
    As Single childColorA

    As Single usColorR
    As Single usColorG
    As Single usColorB
    As Single usColorA

    '' used for child creation and updating
    As Single usRotSpeed
    '' used for child creation (see modifiers above)
    As Single usRadius
    As Single usDistance
End Type
Declare Sub deleteTree( Byref that As Vec2Spiral )
Declare Sub createTree( Byref that As Vec2Spiral, Byval curLevel As Integer )
Declare Sub stepTree( Byref that As Vec2Spiral, Byval stepVal As Single )
Declare Sub renderTree( Byref that As Vec2Spiral, Byval curLevel As Integer )



Screenres 640, 480, 32, , fb.GFX_OPENGL
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
glViewport(0, 0, 640, 480)
glOrtho( 0, 640, 480, 0, -1f, 1f )
glMatrixMode(GL_MODELVIEW)
glLoadIdentity
glClear( GL_COLOR_BUFFER_BIT )
If( ALPHA <> 0 ) Then
    If( ALPHA <> 1f ) Then
        glEnable(GL_BLEND)
        glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA )
    End If
End If
For doVar As Integer = 0 To 1
    glColor3f( CLEAR_COLOR_R, CLEAR_COLOR_G, CLEAR_COLOR_B )
    glBegin(GL_QUADS)
    glVertex2f(0, 0)
    glVertex2f(640, 0)
    glVertex2f(640, 480)
    glVertex2f(0, 480)
    glEnd()
    Flip()
Next

'' create our start node
Dim As Vec2Spiral startNode
startNode.us.origin = New Vec2
startNode.us.x = OFFSET_X
startNode.us.y = OFFSET_Y
startNode.us.origin->x = 320
startNode.us.origin->y = 240
startNode.direction = -START_DIRECTION
Select Case As Const COLORING_SCHEME
    Case 0
        startNode.usColorR = Rnd() * 1f
        startNode.usColorG = Rnd() * 1f
        startNode.usColorB = Rnd() * 1f
        startNode.usColorA = ALPHA
    Case 1
        startNode.usColorR = 1f
        startNode.usColorG = 1f
        startNode.usColorB = 1f
        startNode.usColorA = ALPHA
    Case 2
        startNode.usColorR = 0f
        startNode.usColorG = 0f
        startNode.usColorB = 0f
        startNode.usColorA = ALPHA
    Case 3
        startNode.usColorR = CUSTOM_COLOR_R
        startNode.usColorG = CUSTOM_COLOR_G
        startNode.usColorB = CUSTOM_COLOR_B
        startNode.usColorA = ALPHA
End Select
startNode.usRadius = RADIUS
startNode.usRotSpeed = ROTATION_SPEED
startNode.usDistance = CHILD_DISTANCE

'' create an entire set of nodes underneath it
createTree( startNode, 0 )

'' start time
Dim As Single cur = Timer()
Dim As Single last = cur


Do

    '' Yuck.  Very vague.  This code is below... Recursive shiz.
    stepTree( startNode, cur - last )

    If( CLEAR_SCREEN = true ) Then
        glColor4f( CLEAR_COLOR_R, CLEAR_COLOR_G, CLEAR_COLOR_B, CLEAR_COLOR_A )
        glBegin(GL_QUADS)
        glVertex2f(0, 0)
        glVertex2f(640, 0)
        glVertex2f(640, 480)
        glVertex2f(0, 480)
        glEnd()
    End If
    renderTree( startNode, 0 )
    Flip()

    Do
        Sleep(1, 1)
    Loop Until (Timer() - last) >= (1/60)
    last = cur
    cur = Timer()

Loop Until Multikey(1)

Sub deleteTree( Byref that As Vec2Spiral )
    If( that.child <> 0 ) Then
        For doVar As Integer = 0 To that.numChild - 1
            deleteTree( *that.child[doVar] )
        Next
    End If

    '' loop through all our mems deletes it
    For doVar As Integer = 0 To that.numChild - 1
        Delete(that.child[doVar])
        that.child[doVar] = 0
    Next
    Deallocate(that.child)
    that.child = 0
End Sub


Sub createTree( Byref that As Vec2Spiral, Byval curLevel As Integer )
    '' reverse rotation direction for every branch
    Static As Integer curDirection = -START_DIRECTION
    Static As Integer recursionLevel = 0
    If( curLevel <> recursionLevel ) Then
        curDirection = -curDirection
    End If

    '' we're before our max recursion level... create branches
    If( curLevel < BRANCH_COUNT ) Then

        '' create our child list
        that.child = Callocate( Sizeof(Vec2Spiral Ptr) * CHILD_COUNT )
        that.numChild = CHILD_COUNT

        '' set color for fun :-)
        Select Case As Const COLORING_SCHEME
            Case 0
                that.childColorR = Rnd() * 1f
                that.childColorG = Rnd() * 1f
                that.childColorB = Rnd() * 1f
                that.childColorA = ALPHA
            Case 1
                that.childColorR = (1f/BRANCH_COUNT) * (curLevel+1)
                that.childColorG = (1f/BRANCH_COUNT) * (curLevel+1)
                that.childColorB = (1f/BRANCH_COUNT) * (curLevel+1)
                that.childColorA = ALPHA
            Case 2
                that.childColorR = 1f - ((1f/BRANCH_COUNT) * (curLevel+1))
                that.childColorG = 1f - ((1f/BRANCH_COUNT) * (curLevel+1))
                that.childColorB = 1f - ((1f/BRANCH_COUNT) * (curLevel+1))
                that.childColorA = ALPHA
            Case 3
                that.childColorR = CUSTOM_COLOR_R * (CUSTOM_COLOR_R_CHANGE ^ (curLevel+1))
                that.childColorG = CUSTOM_COLOR_G * (CUSTOM_COLOR_G_CHANGE ^ (curLevel+1))
                that.childColorB = CUSTOM_COLOR_B * (CUSTOM_COLOR_B_CHANGE ^ (curLevel+1))
                that.childColorA = ALPHA * (CUSTOM_COLOR_A_CHANGE ^ (curLevel+1))
        End Select

        For doVar As Integer = 0 To CHILD_COUNT - 1

            '' create child at given index
            that.child[doVar] = New Vec2Spiral


            '''' apply modifier data
            '' RADIUS
            that.child[doVar]->usRadius = that.usRadius * RADIUS_CHANGE
            '' rotation speed
            that.child[doVar]->usRotSpeed = that.usRotSpeed * ROTATION_SPEED_CHANGE
            '' distance
            that.child[doVar]->usDistance = that.usDistance * CHILD_DISTANCE_CHANGE

            '''' init child data
            '' direction
            that.child[doVar]->direction = curDirection
            '' origin
            that.child[doVar]->us.origin = @that.us
            '' position (polar)
            that.child[doVar]->us.x = that.child[doVar]->usDistance
            that.child[doVar]->us.setAngle( (360/CHILD_COUNT) * doVar )
            '' color (see that.childColor = above)
            that.child[doVar]->usColorR = that.childColorR
            that.child[doVar]->usColorG = that.childColorG
            that.child[doVar]->usColorB = that.childColorB
            that.child[doVar]->usColorA = that.childColorA


            '' create child tree
            createTree( (*that.child[doVar]), curLevel + 1 )
            curDirection = -curDirection

        Next

    End If

End Sub

Sub stepTree( Byref that As Vec2Spiral, Byval stepVal As Single )
    If( that.child <> 0 ) Then
        For doVar As Integer = 0 To that.numChild - 1
            stepTree( *that.child[doVar], stepVal )
        Next
    End If

    that.us.incAngle( (that.usRotSpeed * stepVal) * that.direction )
End Sub

Sub renderTree( Byref that As Vec2Spiral, Byval curLevel As Integer )
    Dim As Integer renderChild = true

    If( that.child <> 0 ) Then
        For doVar As Integer = 0 To that.numChild - 1
            renderTree( *that.child[doVar], curLevel + 1 )
        Next

        If( RENDER_PARENT_CHILD_POLYGON = false ) Then
            If( curLevel = 0 ) Then
                renderChild = false
            End If
        End If

        If( RENDER_CHILD_POLYGONS = true ) Then
            If( renderChild = true ) Then
                '' render us through our children (live on through your kids???)
                glColor4f( that.childColorR, that.childColorG, that.childColorB, that.childColorA )
                glBegin(GL_POLYGON)
                For doVar As Integer = 0 To that.numChild - 1
                    glVertex2f( that.child[doVar]->us.ox(), that.child[doVar]->us.oy() )
                Next
                glEnd()
            End If
        End If


    Else
        '' render us
        glColor4f( that.usColorR, that.usColorG, that.usColorB, that.usColorA )
        glBegin(GL_POLYGON)
        For doVar As Single = 0f To 360f Step (360f/16f)
            glVertex2f( that.us.ox() + (Cos( toRadians(doVar) ) * that.usRadius), that.us.oY() + (-sin( toRadians(doVar) ) * that.usRadius) )
        Next
        glEnd()
    End If
End Sub