sync on
sync rate 0
randomize timer()
set text font "Arial"
set text size 20
 
`Setup
global sw as integer
global sh as integer
sw = screen width()
sh = screen height()
#Constant XRES 150
#Constant YRES 150
#Constant NUM_MESSAGES 25
null=make vector2(1)
null=make vector2(2)
 
`------------ Customize Survival Here -------------
`What amount of hunger will cause an animal to die?
#Constant STARVATION_LEVEL 100
`How many of each species there begin with?
#Constant PREY_BEGIN rnd(50)+40
#Constant PREDATOR_BEGIN rnd(25)+5
`How likely is it for 2 species to reproduce?
`A lower number means a greater chance
#Constant PREY_FERTILITY 200
#Constant PREDATOR_FERTILITY 5000
`How much does food hold off death?
#Constant GRASS_FOOD_VALUE 2
#Constant MEAT_FOOD_VALUE 70
`How fast do the animals move?
#Constant ANIMAL_SPEED 3
`--------------- End Customization ----------------
 
`Animals
numSpecies=11
#Constant RABBIT 1
#Constant FOX 2
#Constant WOLF 3
#Constant HAWK 4
#Constant FISH 5
#Constant DEER 6
#Constant BEAR 7
#Constant BOBCAT 8
#Constant RAT 9
#Constant SQUIRREL 10
#Constant OWL 11
`Animal colors
#Constant RABBIT_COLOR rgb(255, 255, 0)
#Constant FOX_COLOR rgb(255, 0, 0)
#Constant WOLF_COLOR rgb(0, 255, 0)
#Constant HAWK_COLOR rgb(0, 0, 255)
#Constant FISH_COLOR rgb(0, 0, 0)
#Constant DEER_COLOR rgb(255, 0, 255)
#Constant BEAR_COLOR rgb(0, 255, 255)
#Constant BOBCAT_COLOR rgb(255, 255, 255)
#Constant RAT_COLOR rgb(128, 0, 0)
#Constant SQUIRREL_COLOR rgb(0, 0, 128)
#Constant OWL_COLOR rgb(128, 128, 0)
 
`Land square types
#Constant LAND 0
#Constant LAKE 1
#Constant AIR 2
 
type coord
	x as integer
	y as integer
endtype
type coordf
	x as float
	y as float
endtype
type animal_list
	animal1 as integer
	animal2 as integer
	animal3 as integer
endtype
type animal_type
	species as integer
	prey as animal_list
	predator as animal_list
	position as coordf
	landtype as integer
	hunger as float
endtype
global dim animal(-1) as animal_type
global dim land(XRES,YRES) as integer
global dim messages(NUM_MESSAGES) as string
generateLand(XRES,YRES)
displayLand(XRES,YRES)
land_img=1
get image land_img,0,0,sw,sh
ink -1,0
xwidth# = (XRES+0.0)/sw
ywidth# = (YRES+0.0)/sh
for i=1 to numSpecies
	`Number of this species to begin with
	if i=FOX or i=WOLF or i=HAWK or i=BEAR or i=BOBCAT or i=OWL
		numAnimals=PREDATOR_BEGIN
	else
	   numAnimals=PREY_BEGIN
	endif
	for a=1 to numAnimals
	   if i=FISH
	      repeat
		   	xpos=rnd(sw)
	   		ypos=rnd(sh)
			until land(int(xpos*xwidth#),int(ypos*ywidth#))=LAKE
		else
		   if i=RABBIT or i=FOX or i=WOLF or i=DEER or i=BEAR or i=BOBCAT or i=RAT or i=SQUIRREL
		      repeat
			   	xpos=rnd(sw)
		   		ypos=rnd(sh)
				until land(int(xpos*xwidth#),int(ypos*ywidth#))=LAND
			else
		   	xpos=rnd(sw)
	   		ypos=rnd(sh)
			endif
		endif
		generateAnimal(i,xpos,ypos,-rnd(200))
	next a
 
	print str$(i)+"/"+str$(numSpecies)
	sync
	sync
next i
 
addMessage("And then there was light.")
 
btime = timer()
do
sync
 
`Timer based movement
fps=screen fps()
adjust# = 10.0/fps
 
controlAnimals(fps,adjust#)
 
lock pixels
paste image land_img,0,0
displayAnimals()
displayLegend()
displayMessages()
displayTimer(btime)
text 0,sh-20,"Screen FPS: "+str$(fps)
unlock pixels
 
loop
end
 
function generateLand(xtiles,ytiles)
local lakePoint as coord
local newPoint as coord
 
`How many lakes will there be?
lakes=rnd(12)+3
 
for i=1 to lakes
	`Choose lake center
	lakePoint.x=rnd(xtiles-4)+2
	lakePoint.y=rnd(ytiles-4)+2
	e=0
	while e=0
		land(lakePoint.x,lakePoint.y)=LAKE
		direction=rnd(3)
		forceexit=0
		repeat
			newPoint.x=lakePoint.x
			newPoint.y=lakePoint.y
			select direction
			   case 0
					dec newPoint.x,1
				endcase
				case 1
				   inc newPoint.x,1
				endcase
				case 2
				   dec newPoint.y,1
				endcase
				case 3
				   inc newPoint.y,1
				endcase
			endselect
			inc forceexit
		until newPoint.x>=0 and newPoint.x<=xtiles and newPoint.y>=0 and newPoint.y<=ytiles or forceexit>=50
		if forceexit<50
			land(newPoint.x,newPoint.y)=LAKE
			if rnd(2)=0
			   lakePoint.x=newPoint.x
			   lakePoint.y=newPoint.y
			endif
			e=(rnd(500)=0)
		else
			e=1
		endif
	endwhile
next i
endfunction
 
function displayLand(xtiles,ytiles)
local color as dword
xwidth# = sw/(xtiles+0.0)
ywidth# = sh/(ytiles+0.0)
for x=0 to xtiles
	for y=0 to ytiles
	   if land(x,y)=LAND
	      color=rgb(rnd(10), 128+rnd(10), 64+rnd(10))
		endif
		if land(x,y)=LAKE
		   color=rgb(0, 128, 255)
		endif
		ink color,0
		box x*xwidth#,y*ywidth#,(x+1)*xwidth#,(y+1)*ywidth#
	next y
next x
endfunction
 
function generateAnimal(species,xpos,ypos,hunger)
array insert at bottom animal(0)
pos=array count(animal(0))
animal(pos).species=species
animal(pos).position.x=xpos
animal(pos).position.y=ypos
animal(pos).hunger=hunger
select species
	case RABBIT
	   animal(pos).predator.animal1=FOX
	   animal(pos).predator.animal1=HAWK
	   animal(pos).predator.animal3=OWL
	endcase
	case FOX
		animal(pos).prey.animal1=RABBIT
		animal(pos).prey.animal2=RAT
		animal(pos).prey.animal3=SQUIRREL
	endcase
	case WOLF
		animal(pos).prey.animal1=RABBIT
		animal(pos).prey.animal2=RAT
		animal(pos).prey.animal3=SQUIRREL
	endcase
	case HAWK
		animal(pos).prey.animal1=SQUIRREL
		animal(pos).prey.animal2=RAT
		animal(pos).prey.animal3=FISH
		animal(pos).landtype=AIR
	endcase
	case FISH
		animal(pos).predator.animal1=OWL
		animal(pos).predator.animal2=HAWK
		animal(pos).predator.animal3=BEAR
		animal(pos).landtype=LAKE
	endcase
	case DEER
		animal(pos).predator.animal1=BOBCAT
	endcase
	case BEAR
   	animal(pos).prey.animal1=FISH
	endcase
	case BOBCAT
		animal(pos).prey.animal1=DEER
	endcase
	case RAT
		animal(pos).predator.animal1=FOX
		animal(pos).predator.animal2=WOLF
		animal(pos).predator.animal3=OWL
	endcase
	case SQUIRREL
		animal(pos).predator.animal1=HAWK
		animal(pos).predator.animal2=FOX
	endcase
	case OWL
		animal(pos).prey.animal1=SQUIRREL
		animal(pos).prey.animal2=RABBIT
		animal(pos).prey.animal3=RAT
		animal(pos).landtype=AIR
	endcase
endselect
endfunction
 
function controlAnimals(fps, timea#)
arrc = array count(animal(0))
xwidth# = (XRES+0.0)/sw
ywidth# = (YRES+0.0)/sh
 
`Determine interactions
for i=1 to arrc
	killed=0
	animal(i).hunger=animal(i).hunger+1*timea#
 
	`Herbivores can randomly eat grass
	s=animal(i).species
	if s=RABBIT or s=FISH or s=DEER or s=RAT or s=SQUIRREL
	   if rnd(5)=0
	      animal(i).hunger=animal(i).hunger-GRASS_FOOD_VALUE*timea#
	   endif
	endif
 
	`Starvation!
	if animal(i).hunger>STARVATION_LEVEL
	   addMessage("A "+getSpeciesString(s)+" starved.")
	   killed=1
	endif
 
	`If they haven't died yet
	if killed=0
	   npreydist#=1000
	   npreyx#=sw
	   npreyy#=sh
	   nspdist#=1000
	   nspx#=sw
	   nspy#=sh
		set vector2 1, animal(i).position.x, animal(i).position.y
		for i2=1 to arrc `Check an animal against every other animal
		   if i<>i2 `Not including itself
		   	set vector2 2, animal(i2).position.x, animal(i2).position.y
		   	subtract vector2 2,1,2
				dist#=length vector2(2)
 
				`Find nearest pray
				if dist#<npreydist#
				   if animal(i).prey.animal1=animal(i2).species or animal(i).prey.animal2=animal(i2).species or animal(i).prey.animal3=animal(i2).species
						npreydist#=dist#
						npreyx#=animal(i2).position.x
						npreyy#=animal(i2).position.y
					endif
				endif
 
				`Find nearest partner
				if dist#<nspdist#
				   if animal(i).species=animal(i2).species
				      nspdist#=dist#
				      nspx#=animal(i2).position.x
				      nspy#=animal(i2).position.y
					endif
				endif
 
				`If they are close enough to be considered interacting
				if dist#<15
 
				   `Reproduce within species if lucky
				   if animal(i).species=animal(i2).species
 
				      `Prey has a different fertillity than predator to help balance
				      if animal(i).prey.animal1=0 and rnd(int(PREY_FERTILITY/timea#))=0 or rnd(int(PREDATOR_FERTILITY/timea#))=0 and animal(i).prey.animal1>0
 
							`Stop your computer from freezing
							if fps>60
								hunger=animal(i).hunger+animal(i2).hunger
						      generateAnimal(animal(i).species,animal(i).position.x+rnd(6)-3,animal(i).position.y+rnd(6)-3,hunger)
						      inc arrc
								animal(i).hunger=animal(i).hunger*2
								animal(i2).hunger=animal(i2).hunger*2
						      addMessage("A "+getSpeciesString(animal(i).species)+" was born.")
							endif
 
						endif
				   endif
 
				   `Hunt (animal i dies)
				   if animal(i).species=animal(i2).prey.animal1 or animal(i).species=animal(i2).prey.animal2 or animal(i).species=animal(i2).prey.animal3 and animal(i2).hunger>50
						addMessage("A "+getSpeciesString(animal(i2).species)+" ate a "+getSpeciesString(animal(i).species)+".")
						animal(i2).hunger=animal(i2).hunger-MEAT_FOOD_VALUE
						killed=1
					else
					   `Hunt (animal i2 dies)
						if animal(i2).species=animal(i).prey.animal1 or animal(i2).species=animal(i).prey.animal2 or animal(i2).species=animal(i).prey.animal3 and animal(i).hunger>50
						addMessage("A "+getSpeciesString(animal(i).species)+" ate a "+getSpeciesString(animal(i2).species)+".")
						   dec arrc
						   animal(i).hunger=animal(i).hunger-MEAT_FOOD_VALUE
						   array delete element animal(0),i2
						   if i>i2
						      dec i
							endif
							i2=arrc
						endif
					endif
				endif
		   endif
		   if killed=1
     			i2=arrc
		   endif
		next i2
		if killed=0
		   `Movement
		   local newx as float
		   local newy as float
		   newx=animal(i).position.x+(rnd(ANIMAL_SPEED*2)-ANIMAL_SPEED)*timea#
		   newy=animal(i).position.y+(rnd(ANIMAL_SPEED*2)-ANIMAL_SPEED)*timea#
 
			if npreydist#<900
				if npreyx#>animal(i).position.x
				   newx=animal(i).position.x+rnd(ANIMAL_SPEED)*timea#
				else
					newx=animal(i).position.x-rnd(ANIMAL_SPEED)*timea#
				endif
				if npreyy#>animal(i).position.y
				   newy=animal(i).position.y+rnd(ANIMAL_SPEED)*timea#
				else
					newy=animal(i).position.y-rnd(ANIMAL_SPEED)*timea#
				endif
			else
			   if nspdist#<900
					if nspx#>animal(i).position.x
					   newx=animal(i).position.x+rnd(ANIMAL_SPEED)*timea#
					else
						newx=animal(i).position.x-rnd(ANIMAL_SPEED)*timea#
					endif
					if nspy#>animal(i).position.y
					   newy=animal(i).position.y+rnd(ANIMAL_SPEED)*timea#
					else
						newy=animal(i).position.y-rnd(ANIMAL_SPEED)*timea#
					endif
				endif
			endif
 
			if newx>=0 and newx<=sw and newy>=0 and newy<=sh
				if land(int(newx*xwidth#),int(newy*ywidth#))=animal(i).landtype or animal(i).landtype=AIR
					animal(i).position.x=newx
					animal(i).position.y=newy
				endif
			endif
		endif
	endif
	if killed=1
		dec arrc
		array delete element animal(0),i
		dec i
	endif
next i
endfunction
 
function displayAnimals()
arrc = array count(animal(0))
for i=1 to arrc
	select animal(i).species
		case RABBIT
			ink RABBIT_COLOR,0
		endcase
		case FOX
			ink FOX_COLOR,0
		endcase
		case WOLF
			ink WOLF_COLOR,0
		endcase
		case HAWK
			ink HAWK_COLOR,0
		endcase
		case FISH
			ink FISH_COLOR,0
		endcase
		case DEER
			ink DEER_COLOR,0
		endcase
		case BEAR
			ink BEAR_COLOR,0
		endcase
		case BOBCAT
			ink BOBCAT_COLOR,0
		endcase
		case RAT
			ink RAT_COLOR,0
		endcase
		case SQUIRREL
			ink SQUIRREL_COLOR,0
		endcase
		case OWL
			ink OWL_COLOR,0
		endcase
	endselect
	box animal(i).position.x-2,animal(i).position.y-2,animal(i).position.x+2,animal(i).position.y+2
next i
endfunction
 
function displayLegend()
ink 0,0
set cursor 0,5
ink RABBIT_COLOR,0
print "RABBIT"
ink FOX_COLOR,0
print "FOX"
ink WOLF_COLOR,0
print "WOLF"
ink HAWK_COLOR,0
print "HAWK"
ink FISH_COLOR,0
print "FISH"
ink DEER_COLOR,0
print "DEER"
ink BEAR_COLOR,0
print "BEAR"
ink BOBCAT_COLOR,0
print "BOBCAT"
ink RAT_COLOR,0
print "RAT"
ink SQUIRREL_COLOR,0
print "SQUIRREL"
ink OWL_COLOR,0
print "OWL"
endfunction
 
function addMessage(text$)
for i=1 to NUM_MESSAGES-1
	messages(i)=messages(i+1)
next i
messages(NUM_MESSAGES)=text$
endfunction
 
function displayMessages()
ink -1,0
for i=1 to NUM_MESSAGES
	text sw-text width(messages(i)),(i-1)*20,messages(i)
next i
endfunction
 
function getSpeciesString(s)
text$="none"
select s
	case RABBIT
	   text$="Rabbit"
	endcase
	case FOX
	   text$="Fox"
	endcase
	case WOLF
	   text$="Wolf"
	endcase
	case HAWK
	   text$="Hawk"
	endcase
	case FISH
	   text$="Fish"
	endcase
	case DEER
	   text$="Deer"
	endcase
	case BEAR
	   text$="Bear"
	endcase
	case BOBCAT
	   text$="Bobcat"
	endcase
	case RAT
	   text$="Rat"
	endcase
	case SQUIRREL
	   text$="Squirrel"
	endcase
	case OWL
	   text$="Owl"
	endcase
endselect
endfunction text$
 
function displayTimer(begintime)
ink -1,0
time$="Lasted "+str$((timer()-begintime)/1000)+" seconds"
text sw-text width(time$),sh-20,time$
endfunction