Ants!!!

[James D Jarvis]

Now they fight. The Collison detection isn't great but with the commotion of maybe 100 ants per side on the screen at a time it's not too much of problem. Little bits of ant get strewn about and they change their heading when they fight.
a poison pool can fill up with so many dead ants they can just walk over it and be unharmed as well.

Code: (Select All)

'ants!!!
' a program by Jmes 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 4!!!"
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&
Randomize Timer
loadCMYK
Color 20, 145
Cls
b& = _NewImage(800, 500, 256)
_Dest b&
Color 20, 145

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


Next a
ro = _Pi / 180
Do
    _Limit 30
    'Cls
    _PutImage (0, 0), b&, 0
    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 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
            af(a) = af(a) - 1
            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 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 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 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