Code: Select all
'Emergence Behavior Program
'Richard D. Clark
'Public Domain
'Rules:
'1) Bugs of same color want to be selfrange spaces from each other
'2) Bugs of different colors want to be opprange spaces from each other
'3) Bugs will move to location with highest value based on 1 and 2
'***********************************************************************
'The agent type def
type bugtype
row as integer
col as integer
clr as integer
end type
'Location value for bug movement
type loctype
col as integer
row as integer
tval as integer
end type
dim shared bugs (1 to 100) as bugtype
dim shared locs (1 to 8) as loctype
dim shared as integer selfrange, opprange
dim as string key
'Cheap distance calculation.
Function CalcDist(col1 As Integer, row1 As Integer, col2 As Integer, row2 As Integer) As Integer
dim as integer xdiff, ydiff
xdiff = Abs(col1 - col2)
ydiff = Abs(row1 - row2)
If xdiff >= ydiff Then Return xdiff
If ydiff >= xdiff Then Return ydiff
end function
'Initialize bugs
sub InitBugs
dim i as integer
for i = lbound(bugs) to ubound(bugs)
'Set the current location
bugs(i).col = (rnd * 79) + 1
bugs(i).row = (rnd * 59) + 1
bugs(i).clr = (rnd * 1) + 1
next
'This sets the distance preference
selfrange = (rnd * 39) + 1
opprange = (rnd * 39) + 1
end sub
'Determines if location is occupied
function IsOccupied(col as integer, row as integer) as integer
dim as integer i, ret = 0
for i = lbound(bugs) to ubound(bugs)
if bugs(i).row = row and bugs(i).col = col then
ret = 1
exit for
end if
next
return ret
end function
'Process rules calculate location with highest value.
'Bugs will move to location of highest value based on rule 1 and 2.
sub ProcessRules
dim as integer i, j, k, dist1, dist2, tcol, trow, tval
for i = lbound(bugs) to ubound(bugs)
'Clear location map
for k = 1 to 8
locs(k).tval = 0
locs(k).row = 0
locs(k).col = 0
next
for j = lbound(bugs) to ubound(bugs)
'Skip self
if i <> j then
'Get current distance to bug
dist1 = CalcDist(bugs(i).col, bugs(i).row, bugs(j).col, bugs(j).row)
'Color same
if bugs(i).clr = bugs(j).clr then
if dist1 > selfrange then
'Check top left
tcol = bugs(i).col - 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(1).tval += 1
locs(1).row = trow
locs(1).col = tcol
end if
end if
'Check top
tcol = bugs(i).col
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(2).tval += 1
locs(2).row = trow
locs(2).col = tcol
end if
end if
'Check top right
tcol = bugs(i).col + 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(3).tval += 1
locs(3).row = trow
locs(3).col = tcol
end if
end if
'Check right
tcol = bugs(i).col + 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(4).tval += 1
locs(4).row = trow
locs(4).col = tcol
end if
end if
'Check bottom right
tcol = bugs(i).col + 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(5).tval += 1
locs(5).row = trow
locs(5).col = tcol
end if
end if
'Check bottom
tcol = bugs(i).col
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(6).tval += 1
locs(6).row = trow
locs(6).col = tcol
end if
end if
'Check bottom left
tcol = bugs(i).col - 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(7).tval += 1
locs(7).row = trow
locs(7).col = tcol
end if
end if
'Check left
tcol = bugs(i).col - 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(8).tval += 1
locs(8).row = trow
locs(8).col = tcol
end if
end if
elseif dist1 < selfrange then
'Check top left
tcol = bugs(i).col - 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(1).tval += 1
locs(1).row = trow
locs(1).col = tcol
end if
end if
'Check top
tcol = bugs(i).col
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(2).tval += 1
locs(2).row = trow
locs(2).col = tcol
end if
end if
'Check top right
tcol = bugs(i).col + 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(3).tval += 1
locs(3).row = trow
locs(3).col = tcol
end if
end if
'Check right
tcol = bugs(i).col + 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(4).tval += 1
locs(4).row = trow
locs(4).col = tcol
end if
end if
'Check bottom right
tcol = bugs(i).col + 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(5).tval += 1
locs(5).row = trow
locs(5).col = tcol
end if
end if
'Check bottom
tcol = bugs(i).col
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(6).tval += 1
locs(6).row = trow
locs(6).col = tcol
end if
end if
'Check bottom left
tcol = bugs(i).col - 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(7).tval += 1
locs(7).row = trow
locs(7).col = tcol
end if
end if
'Check left
tcol = bugs(i).col - 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(8).tval += 1
locs(8).row = trow
locs(8).col = tcol
end if
end if
end if
else 'color not same
if dist1 > opprange then
'Check top left
tcol = bugs(i).col - 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(1).tval += 1
locs(1).row = trow
locs(1).col = tcol
end if
end if
'Check top
tcol = bugs(i).col
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(2).tval += 1
locs(2).row = trow
locs(2).col = tcol
end if
end if
'Check top right
tcol = bugs(i).col + 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(3).tval += 1
locs(3).row = trow
locs(3).col = tcol
end if
end if
'Check right
tcol = bugs(i).col + 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(4).tval += 1
locs(4).row = trow
locs(4).col = tcol
end if
end if
'Check bottom right
tcol = bugs(i).col + 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(5).tval += 1
locs(5).row = trow
locs(5).col = tcol
end if
end if
'Check bottom
tcol = bugs(i).col
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(6).tval += 1
locs(6).row = trow
locs(6).col = tcol
end if
end if
'Check bottom left
tcol = bugs(i).col - 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(7).tval += 1
locs(7).row = trow
locs(7).col = tcol
end if
end if
'Check left
tcol = bugs(i).col - 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 < dist1 then
locs(8).tval += 1
locs(8).row = trow
locs(8).col = tcol
end if
end if
elseif dist1 < opprange then
'Check top left
tcol = bugs(i).col - 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(1).tval += 1
locs(1).row = trow
locs(1).col = tcol
end if
end if
'Check top
tcol = bugs(i).col
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(2).tval += 1
locs(2).row = trow
locs(2).col = tcol
end if
end if
'Check top right
tcol = bugs(i).col + 1
trow = bugs(i).row - 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(3).tval += 1
locs(3).row = trow
locs(3).col = tcol
end if
end if
'Check right
tcol = bugs(i).col + 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(4).tval += 1
locs(4).row = trow
locs(4).col = tcol
end if
end if
'Check bottom right
tcol = bugs(i).col + 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(5).tval += 1
locs(5).row = trow
locs(5).col = tcol
end if
end if
'Check bottom
tcol = bugs(i).col
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol < 81) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(6).tval += 1
locs(6).row = trow
locs(6).col = tcol
end if
end if
'Check bottom left
tcol = bugs(i).col - 1
trow = bugs(i).row + 1
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) and (trow < 61) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(7).tval += 1
locs(7).row = trow
locs(7).col = tcol
end if
end if
'Check left
tcol = bugs(i).col - 1
trow = bugs(i).row
'See if location is occupied
if (IsOccupied(tcol, trow) <> 1) and (tcol > 0) then
dist2 = CalcDist(tcol, trow, bugs(j).col, bugs(j).row)
if dist2 > dist1 then
locs(8).tval += 1
locs(8).row = trow
locs(8).col = tcol
end if
end if
end if
end if
end if
next
'Set low value
tval = 0
'Move to location with highest value
for k = 1 to 8
if (locs(k).tval >= tval) and (locs(k).row > 0) and (locs(k).col > 0) then
tval = locs(k).tval
'Update bug location
bugs(i).col = locs(k).col
bugs(i).row = locs(k).row
end if
next
next
end sub
sub PrintBugs
dim as integer i
color ,0
cls
for i = lbound(bugs) to ubound(bugs)
locate bugs(i).row, bugs(i).col
color bugs(i).clr
print "O";
next
color 15
locate 1,1: Print "Self range:";selfrange
locate 2,1: Print "Opp range:";opprange
end sub
'Moves bugs based on which rule is selected as first
sub MoveBugs
ProcessRules
PrintBugs
end sub
randomize timer
screen 18
width 80, 60
InitBugs
PrintBugs
do
key = inkey
if key = chr(32) then
InitBugs
PrintBugs
end if
MoveBugs
sleep 1
loop until key = chr(27)