07-15-2022, 07:21 PM
Endless ants running about inside a window.
Code: (Select All)
'ants!!!
' a program by James D. Jarvis
'just some ants made with the draw command running about
'press any key to quit
_Title "ANTS!!!"
Screen _NewImage(800, 500, 256)
'_FullScreen
Dim Shared ant$, ax(100), ay(100), am(100), aa(100), ascl(100), aklr(100)
loadCMYK
Color 20, 145
Cls
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
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
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