Qbasicnews.com
July 02, 2020, 05:10:08 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: 1 2 [3]
  Print  
Author Topic: Drawing AI Challenge  (Read 22394 times)
Z!re
*/-\*
*****
Posts: 4599


« Reply #30 on: August 16, 2005, 10:40:55 AM »

Guess what, I found painter.bas:

Code:
DEFINT A-Z
'$DYNAMIC
TYPE dottype
 x AS SINGLE
 y AS SINGLE
 vx AS SINGLE
 vy AS SINGLE
 age AS SINGLE
 sex AS INTEGER
 str AS INTEGER
 dxt AS INTEGER
 vit AS INTEGER
END TYPE
DIM Dot(2048) AS dottype

CLS : SCREEN 13

RANDOMIZE TIMER

numDots = 127
FOR a = 0 TO numDots
 Dot(a).x = 320 * RND
 Dot(a).y = 200 * RND
 Dot(a).vx = 0
 Dot(a).vy = 0
 Dot(a).age = 5 * RND
 Dot(a).sex = CINT(RND)
 Dot(a).str = 3 * RND
 Dot(a).dxt = 3 * RND
 Dot(a).vit = 3 * RND
NEXT

DO
 LINE (20, 20)-(300, 180), 16, B
 FOR a = 0 TO numDots
  med1! = (Dot(a).str + Dot(a).dxt * 4 + Dot(a).vit * 16) / 10
  Dot(a).vx = 0
  Dot(a).vx = 0
  FOR B = 0 TO numDots
   IF B <> a THEN
    med2! = (Dot(B).str + Dot(B).dxt * 4 + Dot(B).vit * 16) / 10
    IF CINT(med1!) = CINT(med2!) THEN
     IF Dot(a).x < Dot(B).x THEN Dot(a).vx = 1
     IF Dot(a).x > Dot(B).x THEN Dot(a).vx = -1
     IF Dot(a).y < Dot(B).y THEN Dot(a).vy = 1
     IF Dot(a).y > Dot(B).y THEN Dot(a).vy = -1
     'IF CINT(5 * RND) = 1 THEN EXIT FOR
    END IF
   END IF
  NEXT

  xb = 0: yb = 0
  IF POINT(Dot(a).x + Dot(a).vx, Dot(a).y) = 0 THEN
   PSET (Dot(a).x, Dot(a).y), 0
   Dot(a).x = Dot(a).x + Dot(a).vx
  ELSE
   xb = 1
  END IF
  IF POINT(Dot(a).x, Dot(a).y + Dot(a).vy) = 0 THEN
   PSET (Dot(a).x, Dot(a).y), 0
   Dot(a).y = Dot(a).y + Dot(a).vy
  ELSE
   yb = 1
  END IF
  IF xb + yb = 2 THEN
   IF POINT(Dot(a).x, Dot(a).y) <> 0 THEN
    FOR f = 1 TO 200
     l4 = POINT(Dot(a).x - f, Dot(a).y)
     l7 = POINT(Dot(a).x - f, Dot(a).y - f)
     l8 = POINT(Dot(a).x, Dot(a).y - f)
     l9 = POINT(Dot(a).x + f, Dot(a).y - f)
     l6 = POINT(Dot(a).x + f, Dot(a).y)
     l3 = POINT(Dot(a).x + f, Dot(a).y + f)
     l2 = POINT(Dot(a).x, Dot(a).y + f)
     l1 = POINT(Dot(a).x - f, Dot(a).y + f)
     dr = INT(8 * RND)
     IF dr = 0 THEN
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
     ELSEIF dr = 1 THEN
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
     ELSEIF dr = 2 THEN
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
     ELSEIF dr = 3 THEN
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
     ELSEIF dr = 4 THEN
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
     ELSEIF dr = 5 THEN
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
     ELSEIF dr = 6 THEN
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
     ELSEIF dr = 7 THEN
      IF l1 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l4 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l7 = 0 THEN Dot(a).x = Dot(a).x - f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l8 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l9 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y - f: EXIT FOR
      IF l6 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y: EXIT FOR
      IF l3 = 0 THEN Dot(a).x = Dot(a).x + f: Dot(a).y = Dot(a).y + f: EXIT FOR
      IF l2 = 0 THEN Dot(a).x = Dot(a).x: Dot(a).y = Dot(a).y + f: EXIT FOR
     END IF
     
    NEXT
   ELSE
    'numDots = numDots + 1
   END IF
  END IF

  IF Dot(a).x <= 20 OR Dot(a).x >= 300 THEN Dot(a).vx = 0: outx = -1 ELSE outx = 0
  IF Dot(a).y <= 20 OR Dot(a).y >= 180 THEN Dot(a).vy = 0: outy = -1 ELSE outy = 0
  IF Dot(a).x < 20 THEN Dot(a).x = 20
  IF Dot(a).x > 300 THEN Dot(a).x = 300
  IF Dot(a).y < 20 THEN Dot(a).y = 20
  IF Dot(a).y > 180 THEN Dot(a).y = 180

  IF outx OR outy THEN dout = dout + 1

  PSET (Dot(a).x, Dot(a).y), Dot(a).str + Dot(a).dxt * 4 + Dot(a).vit * 16
 NEXT

k$ = INKEY$
IF k$ = "n" THEN CLS
IF dout >= numDots / 1.05 THEN dnew = dnew + 1
IF dnew = 3 THEN
 LINE (20, 20)-(300, 180), 16, B
 t! = TIMER + 3: DO: k$ = INKEY$: LOOP UNTIL TIMER >= t! OR k$ <> ""
 CLS : dnew = 0
END IF
dout = 0
LOOP UNTIL k$ = CHR$(27)

I dunno how well it works.. I might have tampered with it after I made painter.exe..
Logged
rdc
Senior Member
**
Posts: 176



WWW
« Reply #31 on: August 16, 2005, 01:22:16 PM »

Quote from: "Z!re"
Winner:
rdc

For the most interessting, and pleasing to look at paintings.


Heh. Cool.

Quote

I don't have time to whip up a trophy or submit to QB Express, hope you can forgive me Sad


I wasn't worried about it. Smiley
Logged

rdc
Senior Member
**
Posts: 176



WWW
« Reply #32 on: August 16, 2005, 02:36:09 PM »

Yes, I know the challenge is over, but I am still playing around. Smiley 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
Logged

Pages: 1 2 [3]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!