Drawing AI Challenge

[rdc]

Yes, I know the challenge is over, but I am still playing around. Here is a variation of my painter that ends up looking sort of like a modern watercolor:

Code:

Option Explicit
'============================================
'Richard Clark
'Generates a random paint screen
'rickclark58@yahoo.com
'Public Domain: Feel free to use as you want.
'Requires FB .14
'Esc to quite, space for new pattern.
'============================================
'

'misc defines
#Define sw 640
#Define sh 480
#Define numbugs 100
#Define True 1
#Define False 0

'misc consts
Const fbBlack = Rgb(0, 0, 0)

'movement directions
Enum compass
    north = 1
    east
    south
    west
    nwest
    neast
    swest
    seast
End Enum

'screen coord type
Type mcoord
    x As Integer
    y As Integer
End Type

'bug type
Type bugtype
    bcolor As Integer
    bcoord As mcoord
    bdir As Integer
End Type

'main vars
Randomize Timer
Screen 18, 32
Dim Shared bscreen(sw, sh) As Integer
Dim Shared bugs(numbugs) As bugtype
Dim skey As String
Dim Shared titflag As Integer
Dim As Integer mx, my, buttons, nx, ny

'get a random number between low and high
Function GetRandom(lowerbound, upperbound As Integer) As Integer
   GetRandom = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function

'returns a coord based on direction
Function GetCoord(direction As Integer, ccoord As mcoord) As mcoord
    Dim rcoord As mcoord
    
    Select Case direction
        Case north
            rcoord.x = ccoord.x
            rcoord.y = ccoord.y - 1
        Case east
            rcoord.x = ccoord.x + 1
            rcoord.y = ccoord.y
        Case south
            rcoord.x = ccoord.x
            rcoord.y = ccoord.y + 1
        Case west
            rcoord.x = ccoord.x - 1
            rcoord.y = ccoord.y
        Case nwest
            rcoord.x = ccoord.x - 1
            rcoord.y = ccoord.y - 1
        Case neast
            rcoord.x = ccoord.x + 1
            rcoord.y = ccoord.y - 1
        Case swest
            rcoord.x = ccoord.x - 1
            rcoord.y = ccoord.y + 1
        Case seast
            rcoord.x = ccoord.x + 1
            rcoord.y = ccoord.y + 1
    End Select
    Return rcoord    
End Function

'checks to see if screen is full
Function IsFull() As Integer
    Dim As Integer i, j
    Dim As Integer cnt
    Dim ret As Integer = True
    
    For i = 0 To sw - 1
        For j = 0 To sh - 1
            If bscreen(i, j) = 0 Then
                ret = False
                Exit For
            End If
        Next
        If ret = False Then
            Exit For
        End If
    Next
    Return ret
End Function

'plot a bug
Sub PlotBug(b As bugtype)
    With b
        PSet (.bcoord.x, .bcoord.y), .bcolor
        bscreen(.bcoord.x, .bcoord.y) = 1
    End With
End Sub

'clear screen
Sub ClearScreen
    Dim As Integer i, j
    
    Color , fbBlack
    Cls
    For i = 0 To sw - 1
        For j = 0 To sh - 1
            bscreen(i, j) = 0
        Next
    Next    
End Sub


'generate intial bugs
Sub GenBugs
    Dim As Integer x, y, i, bcolor
    
    titflag = False  
    WindowTitle "Bug Paint - Working"
    ClearScreen
    For i = 0 To numbugs - 1
        With bugs(i)
            Do
                'get a random location
                .bcoord.x = GetRandom(0, sw - 1)
                .bcoord.y = GetRandom(0, sh - 1)
            Loop Until bscreen(.bcoord.x, .bcoord.y) = fbBlack
            'get a random color
            .bcolor = Rgb(GetRandom(10, 255), GetRandom(10, 255), GetRandom(10, 255))
            'set the initial direction
            .bdir = GetRandom(north, seast)
            'set the plot
            PlotBug bugs(i)
        End With
    Next
End Sub

'move bugs
Sub MoveBugs
    Dim As mcoord ncoord, scoord, ccoord
    Dim As Integer i, j, k
    Dim cdir As Integer
    
    For i = 0 To numbugs - 1
        With bugs(i)
            'set the defaults
            scoord.x = -1
            scoord.y = -1
            cdir = .bdir
            'looks for open space to grow into
            For j = 1 To 8
                'get the new coord
                ncoord = GetCoord(cdir, .bcoord)
                'make sure we don't go off edge
                If ncoord.x > -1 And ncoord.x < sw Then
                    If ncoord.y > -1 And ncoord.y < sh Then
                        'is this an empty spot
                        If bscreen(ncoord.x, ncoord.y) = 0 Then
                            scoord = ncoord
                            Exit For
                        Else
                            If Point(ncoord.x, ncoord.y) <> fbBlack Then
                                .bcolor = Point(ncoord.x, ncoord.y)
                            End If
                            cdir = GetRandom(north, seast)
                            'cdir += 1
                            'If cdir > seast Then cdir = north
                        End If
                    Else
                        cdir = GetRandom(north, seast)
                        'cdir += 1
                        'If cdir > seast Then cdir = north
                    End If
                Else
                    cdir = GetRandom(north, seast)
                    'cdir += 1
                    'If cdir > seast Then cdir = north
                End If
            Next
            'plot the new postion
            If scoord.x > -1 And scoord.y > -1 Then
                .bcoord = scoord
                'save the direction
                .bdir = cdir
                'plot the bug
                PlotBug bugs(i)
            Else
                If Not IsFull Then
                    Do
                        'get a random location
                        .bcoord.x = GetRandom(0, sw - 1)
                        .bcoord.y = GetRandom(0, sh - 1)
                    Loop Until bscreen(.bcoord.x, .bcoord.y) = 0
                    PlotBug bugs(i)
                End If
            End If
        End With
    Next
End Sub

SetMouse ,,0

'main code
GenBugs
Do
    skey = Inkey$
    If Not IsFull Then
        MoveBugs
    Else
        If Not titflag Then
            WindowTitle "Bug Paint - Done"
        Else
           titflag = True
        End If
    End If
    If skey = Chr$(32) Then
        GenBugs
    End If
Loop Until skey = Chr$(27)
SetMouse ,,1

End