http://justbasic.conforums.com/index.cg ... 1270035974
Code:
Code: Select all
' Evolution Simulator
'
' Coded by Impx in 2010
' Code modified by TyCamden in 2015
PRINT "EVOLUTION SIMULATOR v1.1"
PRINT "PRESS [ENTER] TO CONTINUE"
INPUT "";crap
CLS
[beginProgram]
CLS
LET generations = 0
WHILE generations<2
INPUT "How many generations?: ";generations
LET generations = INT(generations)
IF generations<2 THEN PRINT "You must input at least 2 generations."
WEND
LET creatures = 0
WHILE creatures<2
INPUT "How many creatures?: ";creatures
LET creatures = INT(creatures)
IF creatures<2 THEN PRINT "You must input at least 2 creatures."
WEND
LET maxpredators = INT(creatures/10)
IF maxpredators<1 THEN
LET maxpredators = 1
END IF
LET agemax = 0
WHILE agemax<1
INPUT "Maximum Age of any creature?: ";agemax
LET agemax = INT(agemax)
IF agemax<1 THEN PRINT "You must input at least 1 for max age"
WEND
LET predmat = 0
WHILE predmat<1
INPUT "Do you want Predator Mating ON (1) or OFF (2)? ";predmat
LET predmat = INT(predmat)
SELECT CASE predmat
CASE 1, 2
' good
CASE ELSE
LET predmat = 0
END SELECT
WEND
LET mutation = 0
WHILE mutation<1
INPUT "Creature Mutation Chance = 1 in ";mutation
LET mutation = INT(mutation)
IF mutation<1 THEN PRINT "You must input at least 1 mutation"
WEND
IF predmat = 1 THEN ' Predator Mating is ON
LET pmutation = 0
WHILE pmutation<1
INPUT "Predator Mutation Chance = 1 in ";pmutation
LET pmutation = INT(pmutation)
IF pmutation<1 THEN PRINT "You must input at least 1 mutation"
WEND
ELSE
' This will not come into play since Predator Mating is OFF
pmutation = mutation
END IF
LET presstogo = 2
WHILE presstogo=2
INPUT "Do you want to Pause between every generation (0 for No and 1 for Yes)? ";presstogo
LET presstogo = INT(presstogo)
SELECT CASE presstogo
CASE 0, 1
' good
CASE ELSE
LET predmat = 2
END SELECT
WEND
DIM creatures(4,creatures)
DIM predator(5,maxpredators)
DIM killer(maxpredators)
DIM replace(3,1)
DIM predreplace(3,1)
'CREATURE CREATION
'Speed-Strength
FOR q=1 TO creatures
LET tempabiltot = 1500
FOR w=1 TO 3
LET ab = INT((RND(1)*1000)+1)
IF ab > tempabiltot THEN
ab = tempabiltot
END IF
LET creatures(w,q)=ab
LET tempabiltot = tempabiltot - ab
IF tempabiltot<1 THEN
LET tempabiltot = 1
END IF
NEXT w
NEXT q
'PREDATOR CREATION
'Speed-Strength
FOR q=1 TO maxpredators
LET tempabiltot = 1500
FOR w=1 TO 3
LET ab = INT((RND(1)*1000)+1)
IF ab > tempabiltot THEN
ab = tempabiltot
END IF
LET predator(w,q)=ab
LET tempabiltot = tempabiltot - ab
IF tempabiltot<1 THEN
LET tempabiltot = 1
END IF
NEXT w
NEXT q
FOR e=1 TO generations
IF presstogo=1 THEN ' Pause between every generation
PRINT "PRESS ENTER TO CONTINUE"
PRINT
INPUT dummy$
END IF
LET replace(1,1)=0
LET replace(2,1)=0
LET replace(3,1)=0
'PRINTING THE CREATURES
PRINT ""
PRINT ""
PRINT "Generation ";e
PRINT TAB(3);"SPD"; TAB(9);"STR";TAB(15);"MAT";TAB(21);"AGE"
FOR w=1 TO creatures
FOR q=1 TO 4
LET item$=STR$(creatures(q,w))
LET lit = LEN(item$)
SELECT CASE lit
CASE 1
LET item$="000"+item$
CASE 2
LET item$="00"+item$
CASE 3
LET item$="0"+item$
CASE ELSE ' 4
' do nothing
END SELECT
LET tba=((q-1)*5)+1+(q*2)
PRINT TAB(tba);item$;
NEXT q
PRINT ""
NEXT w
PRINT ""
'PRINTING THE PREDATORS
PRINT "Predator:"
PRINT TAB(3);"SPD"; TAB(9);"STR";TAB(15);"MAT";TAB(21);"AGE";TAB(27);"HUN"
FOR w=1 TO maxpredators
FOR q=1 TO 5
LET item$=STR$(predator(q,w))
IF q<5 THEN
LET lit = LEN(item$)
SELECT CASE lit
CASE 1
LET item$="000"+item$
CASE 2
LET item$="00"+item$
CASE 3
LET item$="0"+item$
CASE ELSE ' 4
' do nothing
END SELECT
END IF
LET tba=((q-1)*5)+1+(q*2)
PRINT TAB(tba);item$;
NEXT q
PRINT ""
NEXT w
PRINT ""
'AGE OF CREATURE
FOR q=1 TO creatures
LET creatures(4,q)=creatures(4,q)+1
NEXT q
'AGE OF PREDATOR
FOR q=1 TO maxpredators
LET predator(4,q)=predator(4,q)+1
NEXT q
'ATTACKING THE CREATURES
LET killcount=0
FOR q = 1 TO maxpredators
LET killer(q) = 0
NEXT q
FOR q=1 TO creatures
LET currentdeath = 0
FOR z=1 to maxpredators
IF predator(1,z)>creatures(1,q) AND predator(2,z)>creatures(2,q) THEN
IF currentdeath = 0 THEN
LET killcount=killcount+1
LET currentdeath = 1
LET killer(z)=killer(z)+1
LET creatures(1,q)=0
LET creatures(2,q)=0
LET creatures(3,q)=0
LET creatures(4,q)=0
END IF
END IF
NEXT z
NEXT q
'FEED PREDATORS
IF killcount>0 THEN
FOR gg = 1 to maxpredators
LET predator(5,gg) = predator(5,gg) - killer(gg)
NEXT gg
END IF
IF killcount=creatures THEN
PRINT ""
PRINT ""
PRINT "The predator has killed all the creatures."
GOTO [complete]
END IF
LET predkills=killcount
FOR q=1 TO creatures
IF creatures(4,q)>=agemax THEN
LET killcount=killcount+1
LET agekills = agekills + 1
LET creatures(1,q)=0
LET creatures(2,q)=0
LET creatures(3,q)=0
LET creatures(4,q)=0
END IF
NEXT q
IF killcount=creatures THEN
PRINT "The predator killed ";predkills;" creatures."
PRINT agekills;" creatures dies of old age."
GOTO [complete]
END IF
'TESTING FOR REPLACING CREATURE
FOR q=1 TO creatures
IF replace(3,1)=creatures(3,q) THEN ' same mating stat
IF replace(1,1)=creatures(1,q) THEN ' and same SPD stat
IF replace(2,1)<creatures(2,q) THEN
LET replace(1,1)=creatures(1,q)
LET replace(2,1)=creatures(2,q)
LET replace(3,1)=creatures(3,q)
END IF
ELSE
IF replace(1,1)<creatures(1,q) THEN
LET replace(1,1)=creatures(1,q)
LET replace(2,1)=creatures(2,q)
LET replace(3,1)=creatures(3,q)
END IF
END IF
ELSE ' do not have same mating stat
IF replace(3,1)<creatures(3,q) THEN
LET replace(1,1)=creatures(1,q)
LET replace(2,1)=creatures(2,q)
LET replace(3,1)=creatures(3,q)
END IF
END IF
NEXT q
'REPLACING DEAD CREATURE
FOR q=1 TO creatures
IF creatures(1,q)=0 THEN
x=INT(RND(1)*mutation)+1
IF x=1 THEN
LET creatures(1,q)=replace(1,1)+INT(RND(1)*100)+1
ELSE
LET creatures(1,q)=replace(1,1)
END IF
x=INT(RND(1)*mutation)+1
IF x=1 THEN
LET creatures(2,q)=replace(2,1)+INT(RND(1)*100)+1
ELSE
LET creatures(2,q)=replace(2,1)
END IF
x=INT(RND(1)*mutation)+1
IF x=1 THEN
LET creatures(3,q)=replace(3,1)+INT(RND(1)*100)+1
ELSE
LET creatures(3,q)=replace(3,1)
END IF
LET creatures(4,q)=0
END IF
NEXT q
'TESTING FOR STARVING PREDATORS
LET checkpred=maxpredators
FOR z = 1 to maxpredators
LET predator(5,z)=predator(5,z)+1
IF predator(5,z)>1 THEN ' dies of starvation
LET predator(1,z)=0
LET predator(2,z)=0
LET predator(3,z)=0
LET predator(4,z)=0
LET checkpred = checkpred - 1
END IF
NEXT z
IF checkpred>0 THEN
' at least 1 predator still is alive
'TESTING FOR REPLACING PREDATOR
FOR q=1 TO maxpredators
IF predreplace(3,1)=predator(3,q) THEN ' same mating stat
IF predreplace(1,1)=predator(1,q) THEN ' and same SPD stat
IF predreplace(2,1)<predator(2,q) THEN
LET predreplace(1,1)=predator(1,q)
LET predreplace(2,1)=predator(2,q)
LET predreplace(3,1)=predator(3,q)
END IF
ELSE
IF predreplace(1,1)<predator(1,q) THEN
LET predreplace(1,1)=predator(1,q)
LET predreplace(2,1)=predator(2,q)
LET predreplace(3,1)=predator(3,q)
END IF
END IF
ELSE ' do not have same mating stat
IF predreplace(3,1)<predator(3,q) THEN
LET predreplace(1,1)=predator(1,q)
LET predreplace(2,1)=predator(2,q)
LET predreplace(3,1)=predator(3,q)
END IF
END IF
NEXT q
'REPLACING DEAD PREDATOR(S)
IF predmat = 1 THEN ' predator mating is on
FOR q=1 TO maxpredators
IF predator(1,q)=0 THEN
x=INT(RND(1)*pmutation)+1
IF x=1 THEN
LET predator(1,q)=predreplace(1,1)+INT(RND(1)*100)+1
ELSE
LET predator(1,q)=predreplace(1,1)
END IF
x=INT(RND(1)*mutation)+1
IF x=1 THEN
LET predator(2,q)=predreplace(2,1)+INT(RND(1)*100)+1
ELSE
LET predator(2,q)=predreplace(2,1)
END IF
x=INT(RND(1)*mutation)+1
IF x=1 THEN
LET predator(3,q)=predreplace(3,1)+INT(RND(1)*100)+1
ELSE
LET predator(3,q)=predreplace(3,1)
END IF
LET predator(4,q)=0
LET predator(5,q)=0
END IF
NEXT q
ELSE ' predmat = 2 so predator mating is off
FOR q =1 TO maxpredators
IF predator(1,q)=0 THEN
LET tempabiltot = 1500
FOR w =1 TO 3
LET ab = INT((RND(1)*1000)+1)
IF ab > tempabiltot THEN
ab = tempabiltot
END IF
LET predator(w,q)=ab
LET tempabiltot = tempabiltot - ab
IF tempabiltot<1 THEN
LET tempabiltot = 1
END IF
NEXT w
LET predator(5,q)=0
END IF
NEXT q
END IF
ELSE ' no predators left to mate
FOR q=1 TO maxpredators
LET tempabiltot = 1500
FOR w=1 TO 3
LET ab = INT((RND(1)*1000)+1)
IF ab > tempabiltot THEN
ab = tempabiltot
END IF
LET predator(w,q)=ab
LET tempabiltot = tempabiltot - ab
IF tempabiltot<1 THEN
LET tempabiltot = 1
END IF
NEXT w
LET predator(5,q)=0
NEXT q
END IF
NEXT e
[complete]
PRINT
PRINT
PRINT "PROGRAM COMPLETE."
PRINT "TYPE GO TO BEGIN AGAIN (or END to end program)."
PRINT
INPUT "";crap$
crap$=lower$(crap$)
SELECT CASE crap$
CASE "go"
GOTO [beginProgram]
CASE "end"
END
CASE ELSE
GOTO [complete]
END SELECT
