Evolution Simulator (Kinda)

Just BASIC Games
TyCamden
Posts: 42
Joined: Tue Apr 28, 2009 6:20 am

Evolution Simulator (Kinda)

Post by TyCamden » Wed Mar 25, 2015 9:20 pm

Code from my "evolving" program. See the following for more info:

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