Ants!!!

[euklides]

Very nice !
Red and black ants don't fight each other ?
Score ? How many ants, alive, dead, added ?
Is the population of ants illimited ? So there no end of the play ?
Imagine better poison efficiency ? Variable efficiency ?
Change position of poison ?
If 3 ants are at the same place, why not imagine one of them will be killed by then two others ?
aso... all is possible !
Very, very interesting !!!!

[James D Jarvis]

glad people are enjoying the ants. certainly, have to add in some of those suggestions. 
This version of ANTS!!! let's the user drop in red ants with a mouse click.  After 100 ants are dropped youcan keep on dropping ants but they'll just replace an ant from among the first 20 red ants.

Code: (Select All)

'ants!!!
' a program by James D. Jarvis
'just some ants made with the draw command running about the screen
'there are black and and red ants and they fall victim to the insecticide
' now they fight too
'press any key to quit
_Title "ANTS 5!!!"
Screen _NewImage(800, 500, 256)
'_FullScreen
Dim Shared ant$, ax(100), ay(100), am(100), aa(100), ascl(100), aklr(100), ah(100), asp(100), af(100)
Dim Shared rax(100), ray(100), ram(100), raa(100), rascl(100), raklr(100), rah(100), rasp(100), raf(100)
Dim Shared b&
Dim Shared rac
Randomize Timer
loadCMYK
Color 20, 145
Cls
b& = _NewImage(800, 500, 256)
_Dest b&
Color 20, 145
rac = 0
For y = 0 To 499
    For x = 0 To 798 Step Int(3 + Rnd * 3)
        Draw "c" + Str$(Int(Rnd * 6) + 63) + "bm" + Str$(x) + "," + Str$(y) + "r" + Str$(1 + Int(Rnd * 5))
    Next

Next
For p = 1 To 4
    CircleFill Int(Rnd * 500) + 200, Int(Rnd * 300) + 100, Int(Rnd * 60) + 12, Int(Rnd * 5) + 55
Next p
_Dest 0


ant$ = "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2bm-3,+0e5g5f5h5u5d10u6dg5e5h5"
For a = 1 To 100
    ax(a) = 0 - Int(Rnd * 20)
    ay(a) = Int(Rnd * 300) + 100
    am(a) = Int(Rnd * 3) + 2
    aa(a) = Int(Rnd * 10) - Int(Rnd * 10)
    ascl(a) = Int(Rnd * 6) + 3
    aklr(a) = 20 - Int(Rnd * 4)
    ah(a) = Int(Rnd * 10) + ascl(a) * 2
    asp(a) = ascl(a) - 2
    af(a) = 0
    ' rax(a) = 800 + Int(Rnd * 20)
    ' ray(a) = Int(Rnd * 300) + 100
    ' ram(a) = Int(Rnd * 3) + 2
    ' raa(a) = 180 + Int(Rnd * 10) - Int(Rnd * 10)
    ' rascl(a) = Int(Rnd * 6) + 3
    ' raklr(a) = 178 - Int(Rnd * 4)
    ' rah(a) = Int(Rnd * 10) + rascl(a) * 2
    ' rasp(a) = rascl(a) - 2
    ' raf(a) = 0

    rax(a) = 0
    ray(a) = 0
    ram(a) = 0
    raa(a) = 180 + Int(Rnd * 10) - Int(Rnd * 10)
    rascl(a) = 0
    raklr(a) = 178 - Int(Rnd * 4)
    rah(a) = 0
    rasp(a) = 0
    raf(a) = 0



Next a
ro = _Pi / 180
rac = 0
Do
    _Limit 30
    'Cls
    _PutImage (0, 0), b&, 0

    Do While _MouseInput
        'check for the mouse pointer in the image drawign area

        If _MouseButton(1) Then
            x = _MouseX
            y = _MouseY
            If rac < 100 Then
                rac = rac + 1
                rax(rac) = x
                ray(rac) = y
                ram(rac) = Int(Rnd * 3) + 2
                raa(rac) = 180 + Int(Rnd * 10) - Int(Rnd * 10)
                rascl(rac) = Int(Rnd * 6) + 3
                raklr(rac) = 178 - Int(Rnd * 4)
                rah(rac) = Int(Rnd * 10) + rascl(rac) * 2
                rasp(rac) = rascl(rac) - 2
                raf(rac) = 0
            End If
            If rac > 99 Then
                pick = Int(Rnd * 20) + 1
                '  _Dest b&
                '   PSet (rax(pick), ray(pick))
                '   Draw "s" + Str$(rascl(pick) - 1)
                '   Draw "ta" + Str$(raa(pick)) + "c" + Str$(Int(4 + Rnd * 4)) + "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2"
                ' _Dest 0
                rax(pick) = x
                ray(pick) = y
                ram(pick) = Int(Rnd * 3) + 2
                raa(pick) = 180 + Int(Rnd * 10) - Int(Rnd * 10)
                rascl(pick) = Int(Rnd * 6) + 3
                raklr(pick) = 178 - Int(Rnd * 4)
                rah(pick) = Int(Rnd * 10) + rascl(pick) * 2
                rasp(pick) = rascl(pick) - 2
                raf(pick) = 0
            End If

        End If
    Loop




    For a = 1 To 100
        If Rnd * 6 > 4 Then
            If af(a) < 1 Then
                ax(a) = ax(a) + asp(a) * Sin((aa(a) + 90) * ro)
                ay(a) = ay(a) + asp(a) * Cos((aa(a) + 90) * ro)
            End If
            If a <= rac And raf(a) < 1 Then
                rax(a) = rax(a) + rasp(a) * Sin((raa(a) + 90) * ro)
                ray(a) = ray(a) + rasp(a) * Cos((raa(a) + 90) * ro)
            End If
            If a <= rac Then af(a) = af(a) - 1
            If a <= rac Then raf(a) = raf(a) - 1
            If ax(a) < -20 Or ax(a) > 850 Then
                ax(a) = 0 - (Int(Rnd * 10) + 5)
                ay(a) = Int(Rnd * 300) + 100
                aa(a) = 0
                ascl(a) = Int(Rnd * 6) + 3
            End If
            If ay(a) < -10 Or ay(a) > 650 Then
                ay(a) = Int(Rnd * 300) + 100
                ax(a) = 0 - (Int(Rnd * 10) + 5)
                aa(a) = 0
                ascl(a) = Int(Rnd * 6) + 3
            End If


            If a <= rac And rax(a) < -20 Or rax(a) > 850 Then
                rax(a) = 810 - (Int(Rnd * 10) + 5)
                ray(a) = Int(Rnd * 300) + 100
                raa(a) = 180
                rascl(a) = Int(Rnd * 6) + 3
            End If
            If a <= rac And ray(a) < -10 Or ray(a) > 650 Then
                ray(a) = Int(Rnd * 300) + 100
                rax(a) = 810 - (Int(Rnd * 10) + 5)
                raa(a) = 180
                rascl(a) = Int(Rnd * 6) + 3
            End If




        End If
        dant aa(a), aklr(a), ascl(a), ax(a), ay(a)
        dant raa(a), raklr(a), rascl(a), rax(a), ray(a)

        dc = Int(Rnd * 20) + 1
        Select Case dc
            Case 1 TO 3
                aa(a) = aa(a) - (Int(Rnd * 6) + 2)
            Case 4 TO 17
            Case 18 TO 20
                aa(a) = aa(a) + (Int(Rnd * 6) + 2)
        End Select
        _Source b&
        If Point(ax(a) + ascl(a) * 4, ay(a)) > 54 And Point(ax(a) + ascl(a) * 4, ay(a)) < 61 Then
            aa(a) = Int(aa(a) + 30)
            ah(a) = ah(a) - 1
        Else
            If Rnd * 20 > 18.5 Then
                _Dest b&
                PSet (ax(a), ay(a)), 4
                _Dest 0
            End If
        End If

        dc = Int(Rnd * 20) + 1
        Select Case dc
            Case 1 TO 3
                raa(a) = raa(a) - (Int(Rnd * 6) + 2)
            Case 4 TO 17
            Case 18 TO 20
                raa(a) = raa(a) + (Int(Rnd * 6) + 2)
        End Select
        _Source b&
        If Point(rax(a) + rascl(a) * 4, ray(a)) > 54 And Point(rax(a) + rascl(a) * 4, ray(a)) < 61 Then
            raa(a) = Int(raa(a) + 30)
            rah(a) = rah(a) - 1
        Else
            If Rnd * 20 > 18.5 Then
                _Dest b&
                PSet (rax(a), ray(a)), 4
                _Dest 0
            End If
        End If

        For n = 1 To 100
            bxx = ax(n) + ascl(n) * 2 * Sin((aa(n) + 90) * ro)
            byy = ay(n) + ascl(n) * 2 * Cos((aa(n) + 90) * ro)
            If Int(bxx / 4) = Int((rax(a) + 3) / 4) And Int(byy / 4) = Int((ray(a) + 3) / 4) Then

                ah(n) = ah(n) - Int(1 + Rnd * rascl(a))
                rah(a) = rah(a) - Int(1 + Rnd * ascl(n))
                aa(n) = aa(n) + Int(30 + Rnd * 20)
                raa(a) = raa(a) - Int(30 + Rnd * 20)
                rasp(a) = 0
                asp(n) = 0
                Circle ((ax(n) + rax(a)) / 2, (ay(n) + ray(a) / 2)), ascl(n) + rascl(a), 115
                _Dest b&
                PSet (rax(a), ray(a))
                Draw "ta" + Str$(Int(Rnd * 360)) + "c" + Str$(Int(4 + Rnd * 4)) + "r4"
                _Dest 0
                If raf(a) < 1 Then raf(a) = 12
                If af(n) < 1 Then af(n) = 12
            End If
        Next n
        For n = 1 To 100

            bxx = rax(n) + rascl(n) * 2 * Sin((raa(n) + 90) * ro)
            byy = ray(n) + rascl(n) * 2 * Cos((raa(n) + 90) * ro)

            If Int((ax(a) + 3) / 4) = Int(bxx / 4) And Int((ay(a) + 3) / 4) = Int(byy / 4) Then
                ah(a) = ah(a) - Int(1 + Rnd * rascl(n))
                rah(n) = rah(n) - Int(1 + Rnd * ascl(a))
                aa(a) = aa(a) + Int(30 + Rnd * 20)
                raa(n) = raa(n) - Int(30 + Rnd * 20)
                asp(a) = 0
                rasp(n) = 0
                Circle ((ax(a) + rax(n)) / 2, (ay(a) + ray(n) / 2)), ascl(a) + rascl(n), 115
                _Dest b&
                PSet (ax(a), ay(a))
                Draw "ta" + Str$(Int(Rnd * 360)) + "c" + Str$(Int(4 + Rnd * 4)) + "r4"
                _Dest 0
                If raf(a) < 1 Then raf(n) = 12
                If af(a) < 1 Then af(a) = 12

            End If
        Next n
        asp(a) = asp(a) + Int(Rnd * 2)
        If asp(a) > ascl(a) * 1.5 Then asp(a) = ascl(a)
        rasp(a) = rasp(a) + Int(Rnd * 2)
        If rasp(a) > rascl(a) * 1.5 Then rasp(a) = rascl(a)
        If ah(a) < 1 Then
            _Dest b&
            PSet (ax(a), ay(a))
            Draw "s" + Str$(ascl(a) - 1)
            Draw "ta" + Str$(aa(a)) + "c" + Str$(Int(4 + Rnd * 4)) + "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2"
            _Dest 0
            ay(a) = Int(Rnd * 300) + 100
            ax(a) = 0 - (Int(Rnd * 10) + 5)
            aa(a) = 0
            ascl(a) = Int(Rnd * 6) + 3
            ah(a) = Int(Rnd * 10) + ascl(a) * 2
        End If
        If a <= rac And rah(a) < 1 Then
            _Dest b&
            PSet (rax(a), ray(a))
            Draw "s" + Str$(rascl(a) - 1)
            Draw "ta" + Str$(raa(a)) + "c" + Str$(Int(4 + Rnd * 4)) + "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2"
            _Dest 0
            ray(a) = Int(Rnd * 300) + 100
            rax(a) = 810 - (Int(Rnd * 10) + 5)
            raa(a) = 180
            rascl(a) = Int(Rnd * 6) + 3
            rah(a) = Int(Rnd * 10) + rascl(a) * 2
        End If





    Next a
    aa$ = InKey$
    _Display
Loop Until aa$ <> ""
System




Sub dant (ang, klr, scl, x, y)

    Draw "s" + Str$(scl)
    PSet (x, y)
    Draw "c" + Str$(klr) + "ta" + Str$(ang) + ant$
End Sub

Sub pal_cmyk (pk, c, m, y, k)
    ' create a 256 color palette entry using CMYK
    ' CMYK process color Cyan, Magenta, Yellow, Black  each  expressed as a percent from 0 to 100
    r = 255 * (100 - c)
    r = (r / 100) * ((100 - k) / 100)
    g = 255 * (100 - m)
    g = (g / 100) * ((100 - k) / 100)
    b = 255 * (100 - y)
    b = (b / 100) * ((100 - k) / 100)
    _PaletteColor pk, _RGB32(r, g, b)
End Sub

Sub loadCMYK
    'builing a cmyk pallete
    klr = 0
    c = 0
    m = 0
    y = 0
    k = 0
    For klr = 0 To 255
        Select Case klr
            Case 1 TO 20
                k = k + 5
                c = 0
                m = 0
                y = 0
            Case 21 TO 40
                k = 0
                c = c + 5
                m = 0
                y = 0
            Case 41 TO 60
                k = 0
                c = 0
                m = m + 5
                y = 0
            Case 61 TO 80
                k = 0
                c = 0
                m = 0
                y = y + 5
            Case 81 TO 100
                k = 0
                c = c + 5
                m = m + 5
                y = 0
            Case 101 TO 120
                k = 0
                c = c + 5
                m = 0
                y = y + 5
            Case 121 TO 140
                k = 0
                c = 0
                m = m + 5
                y = y + 5
            Case 121 TO 140
                k = 20
                c = c + 5
                m = m + 5
                y = 0
            Case 141 TO 160
                k = 20
                c = c + 5
                m = 0
                y = y + 5
            Case 161 TO 180
                k = 20
                c = 0
                m = m + 5
                y = y + 5
            Case 181 TO 200
                k = 40
                c = c + 5
                m = m + 5
                y = 0
            Case 201 TO 220
                k = 40
                c = c + 5
                m = 0
                y = y + 5
            Case 221 TO 240
                k = 40
                c = 0
                m = m + 5
                y = y + 5
            Case 241 TO 255
                k = 10 + (klr - 240) * 4
                c = 0
                m = 100
                y = y + 5
        End Select
        pal_cmyk klr, c, m, y, k
        Color 0, klr
    Next klr
End Sub
Sub CircleFill (CX As Long, CY As Long, R As Long, C As Long)
    'sub by SMcNeill makes a filled circle without worrying about using the paint comamnd to fill an empty circle
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

[SierraKen]

LOL wild stuff!