07-16-2022, 06:49 PM
Now there's red and black ants, the poison does them ill and they leave remains and tracks.
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
'press any key to quit
_Title "ANTS 3!!!"
Screen _NewImage(800, 500, 256)
'_FullScreen
Dim Shared ant$, ax(100), ay(100), am(100), aa(100), ascl(100), aklr(100), ah(100)
Dim Shared rax(100), ray(100), ram(100), raa(100), rascl(100), raklr(100), rah(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
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
Next a
ro = _Pi / 180
Do
_Limit 30
'Cls
_PutImage (0, 0), b&, 0
For a = 1 To 100
If Rnd * 6 > 4 Then
ax(a) = ax(a) + ascl(a) * Sin((aa(a) + 90) * ro)
ay(a) = ay(a) + ascl(a) * Cos((aa(a) + 90) * ro)
rax(a) = rax(a) + rascl(a) * Sin((raa(a) + 90) * ro)
ray(a) = ray(a) + rascl(a) * Cos((raa(a) + 90) * ro)
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
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