Post by andrian on Mar 20, 2016 8:22:02 GMT -5
Hey everyone! It's been a long time since I posted anything here, but I just whipped this up and thought you all might appreciate it. You'll have to provide your own sprites to make it work properly. For best effect, make Bug.png with a black outline and a white body.
Anyway, here's the code:
The code basically works like this: It generates a number of randomly-colored bugs and sets them against a randomly-colored background. Then a number of predators are placed at random on the map. If a predator sees a bug within its reach, that bug dies. All living bugs then go on to the next generation, and all the dead bugs are replaced with mutated versions of some of the living bugs. The closer a bug's color is to the background color, the harder it is for the predator to see them, thus producing a selection pressure to produce bugs with colors similar to the background.
Feel free to play around with the constants up at the top to see what happens. You'll notice I have code in there to have the background gradually change color over time. Just set BGCHANGERATE to a number greater than zero to watch that happen.
Anyway, here's the code:
const SCREENWIDTH = 1024
const SCREENHEIGHT = 768
' Screen mode
TextMode (TEXT_BUFFERED) ' Don't draw sprites until explicitly told to do so
ResizeSpriteArea (SCREENWIDTH, SCREENHEIGHT)
const COLORNUM# = 256
dim BGRED = rnd() % int(COLORNUM# + 1)
dim BGBLUE = rnd() % int(COLORNUM# + 1)
dim BGGREEN = rnd() % int(COLORNUM# + 1)
const BGCHANGERATE = 0
const BUGNUM = 100
const MUTATIONRATE = 5
const MUTATIONRANGE = 40
const PREDNUM = 50
Struc SBug
dim x
dim y
dim red
dim green
dim blue
dim sprite
dim score
dim alive
EndStruc
Struc SPred
dim x
dim y
dim angle#
dim sprite
end Struc
function colorDifference(r1, g1, b1, r2, g2, b2)
dim reddif = abs(r1-r2)
dim bluedif = abs(b1-b2)
dim greendif = abs(g1-g2)
return reddif+greendif+bluedif
endfunction
function SBug mutateBug (SBug parent)
dim SBug child = parent
if rnd() % 100 < MUTATIONRATE then
child.red = child.red + ((rnd() % (MUTATIONRANGE * 2)) - MUTATIONRANGE)
endif
if rnd() % 100 < MUTATIONRATE then
child.blue = child.blue + ((rnd() % (MUTATIONRANGE * 2)) - MUTATIONRANGE)
endif
if rnd() % 100 < MUTATIONRATE then
child.green = child.green + ((rnd() % (MUTATIONRANGE * 2)) - MUTATIONRANGE)
endif
return child
endfunction
function Collides(x1, y1, r1, x2, y2, r2)
return sqr(pow(x2-x1, 2) + pow(y2-y1, 2)) < r1+r2
endfunction
dim background = NewSprite(LoadTex("Images/Background.png"))
SprSetColor(BGRED/COLORNUM#, BGGREEN/COLORNUM#, BGBLUE/COLORNUM#)
SprSetPos(0,0)
SprSetSize(SCREENWIDTH, SCREENHEIGHT)
SprSetXCentre (0)
SprSetYCentre (0)
SprSetZOrder(1)
dim SBug Bugs(BUGNUM)
dim bugTex = LoadTexture("Images/Bug.png")
dim i
for i = 1 to BUGNUM
Bugs(i).x = rnd() % SCREENWIDTH
Bugs(i).y = rnd() % SCREENHEIGHT
Bugs(i).red = rnd() % int(COLORNUM#)
Bugs(i).green = rnd() % int(COLORNUM#)
Bugs(i).blue = rnd() % int(COLORNUM#)
Bugs(i).alive = true
Bugs(i).sprite = NewSprite(bugTex)
SprSetPos(Bugs(i).x, Bugs(i).y)
SprSetColor(Bugs(i).red/COLORNUM#, Bugs(i).green/COLORNUM#, Bugs(i).blue/COLORNUM#)
SprSetSize(24, 24)
next
dim SPRED Preds(PREDNUM)
dim predTex = LoadTex("Images/Spider.png")
for i = 1 to PREDNUM
Preds(i).x = rnd() % SCREENWIDTH
Preds(i).y = rnd() % SCREENHEIGHT
Preds(i).sprite = NewSprite(predTex)
SprSetPos(Preds(i).x, Preds(i).y)
SprSetSize(48, 48)
next
dim generation = 0
dim SBug NextGeneration(BUGNUM)
dim swapped
dim j
dim SBug temp
dim colorToChange
dim redUp
dim blueUp
dim greenUp
if rnd () % 2 = 1 then
redup = true
endif
if rnd () % 2 = 1 then
greenup = true
endif
if rnd () % 2 = 1 then
blueup = true
endif
while(true)
generation = generation + 1
Cls
print "Generation: " + generation
AnimateSprites()
DrawText()
sleep(1000)
colorToChange = rnd() % 3
if colorToChange = 0 then
if redUp then
BGRED = BGRED + BGCHANGERATE
if BGRED > COLORNUM# then
BGRED = int(COLORNUM#)
redUp = false
endif
else
BGRED = BGRED - BGCHANGERATE
if BGRED < 0 then
BGRED = 0
redUp = true
endif
endif
elseif colorToChange = 1 then
if greenUp then
BGGREEN = BGGREEN + BGCHANGERATE
if BGGREEN > COLORNUM# then
BGGREEN = int(COLORNUM#)
greenUp = false
endif
else
BGGREEN = BGGREEN - BGCHANGERATE
if BGGREEN < 0 then
BGGREEN = 0
greenUp = true
endif
endif
elseif colorToChange = 2 then
if blueUp then
BGBLUE = BGBLUE + BGCHANGERATE
if BGBLUE > COLORNUM# then
BGBLUE = int(COLORNUM#)
blueUp = false
endif
else
BGBLUE = BGBLUE - BGCHANGERATE
if BGBLUE < 0 then
BGBLUE = 0
blueUp = true
endif
endif
endif
BindSprite(background)
SprSetColor(BGRED/COLORNUM#, BGGREEN/COLORNUM#, BGBLUE/COLORNUM#)
'score the bugs, lower scores are better
for i = 1 to BUGNUM
Bugs(i).score = colorDifference(Bugs(i).red, Bugs(i).green, Bugs(i).blue, BGRED, BGGREEN, BGBLUE)
next
for i = 1 to PREDNUM
for j = 1 to BUGNUM
if Collides(Preds(i).x, Preds(i).y, SprXSize(Preds(i).sprite)/2, Bugs(j).x, Bugs(j).y, SprXSize(Bugs(j).sprite)/2) then
if rnd() % int(COLORNUM# * 3) < Bugs(j).score then
Bugs(j).alive = false
endif
endif
next
next
j=1
for i = 1 to BUGNUM
if Bugs(i).alive then
NextGeneration(j) = Bugs(i)
j = j + 1
endif
next
while(j <= BUGNUM)
NextGeneration(j) = mutateBug(Bugs((rnd() % BUGSTOBREED) +1))
j = j + 1
wend
for i = 1 to BUGNUM
DeleteSprite(Bugs(i).sprite)
Bugs(i) = NextGeneration(i)
Bugs(i).x = rnd() % SCREENWIDTH
Bugs(i).y = rnd() % SCREENHEIGHT
Bugs(i).alive = true
Bugs(i).sprite = NewSprite(bugTex)
SprSetPos(Bugs(i).x, Bugs(i).y)
SprSetColor(Bugs(i).red/COLORNUM#, Bugs(i).green/COLORNUM#, Bugs(i).blue/COLORNUM#)
SprSetSize(24, 24)
next
wend
The code basically works like this: It generates a number of randomly-colored bugs and sets them against a randomly-colored background. Then a number of predators are placed at random on the map. If a predator sees a bug within its reach, that bug dies. All living bugs then go on to the next generation, and all the dead bugs are replaced with mutated versions of some of the living bugs. The closer a bug's color is to the background color, the harder it is for the predator to see them, thus producing a selection pressure to produce bugs with colors similar to the background.
Feel free to play around with the constants up at the top to see what happens. You'll notice I have code in there to have the background gradually change color over time. Just set BGCHANGERATE to a number greater than zero to watch that happen.