07-15-2022, 08:20 PM
Added puddles of repellant that will make the ants avoid them and go crazy until they stumble out .
There's some other curious behavior I have not figured out just yet.
There's some other curious behavior I have not figured out just yet.
Code: (Select All)
'ants2!!!
' a program by Jmes D. Jarvis
'just some ants made with the draw command running about the screen avoiding toxic puddles
'press any key to quit
_Title "ANTS 2!!!"
Screen _NewImage(800, 500, 256)
'_FullScreen
Dim Shared ant$, ax(100), ay(100), am(100), aa(100), ascl(100), aklr(100)
Dim Shared b&
Randomize Timer
loadCMYK
Color 20, 145
Cls
b& = _NewImage(800, 500, 256)
_Dest b&
Color 20, 145
Cls
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) = 100 - Int(Rnd * 100)
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)
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)
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
End If
dant aa(a), aklr(a), ascl(a), ax(a), ay(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)) <> 145 And Point(ax(a) + ascl(a) * 4, ay(a)) <> 20 Then
aa(a) = Int(aa(a) + 30)
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