A little Life Game

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Hezad
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:

A little Life Game

Postby Hezad » Feb 06, 2007 15:55

Okay, here is my first footstep in the Game of life ^^ That's not really elaborated but maybe it could interest someone.

The conditions are :
- Reproduction if the cell is between two cells
- Death if the cell is too far of an other cell
- Random movement (you can desactivate the movement by changing the variable "deplace" to 0 (line 31)
- Culture transmission by reproduction between the two types of cells (visible by the color changing

and here is the code :)

Code: Select all

'' Life

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,0,0,0,0,0
DATA 0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0
DATA 0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,2,0,0,0,0
DATA 0,2,0,2,0,2,0,2,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0
DATA 0,0,0,0,0,0,0,2,2,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,2,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Type coltype
    r as single
    g as single
    b as single
end type

Dim as integer deplace
'' Fonctionnalites
Deplace=1


Dim as coltype col1,col2
Dim as integer map(19,19),nbreloop,testmap
nbreloop=0
r=250

col1.r=250
col1.g=100
col1.b=100
col2.r=100
col2.g=250
col2.b=100

For i = 0 to 19
    For j=0 to 19
        read map(i,j)
    next
next

Screenres 512,512,16,2

testmap=1

Do
    Screenset 1,0
    Cls
   
   
    For i = 0 to 19
        For j=0 to 19
       
        '' affichage
        if map(i,j)=0 then
            Line (i*25,j*25)-(i*25+25,j*25+25),rgb(100,100,100),b
        elseif map(i,j)=1 then
            Line (i*25,j*25)-(i*25+25,j*25+25),rgb(col1.r,col1.g,col1.b),bf
        elseif map(i,j)=2 then
            Line (i*25,j*25)-(i*25+25,j*25+25),rgb(col2.r,col2.g,col2.b),bf
        end if
       
        '' Reproduction, culture
        if i>0 then
           
            '' rouges
            if map(i,j-1)=1 AND map(i,j+1)=1 then
                map(i,j)=1
            end if
            if map(i-1,j)=1 AND map(i+1,j)=1 then
                map(i,j)=1
            end if
           
            '' verts
            if map(i,j-1)=2 AND map(i,j+1)=2 then
                map(i,j)=2
            end if
            if map(i-1,j)=2 AND map(i+1,j)=2 then
                map(i,j)=2
            end if
           
            '' mix rouge/vert
            if map(i,j-1)=1 AND map(i,j+1)=2 then
                if rnd(1)<.5 then map(i,j)=1 else map(i,j)=2
                col1.b-=.5
                col2.r+=.5
            end if
            if map(i,j+1)=1 AND map(i,j-1)=2 then
                if rnd(1)<.5 then map(i,j)=1 else map(i,j)=2
                col1.b-=.5
                col2.r+=.5
            end if
            if map(i-1,j)=1 AND map(i+1,j)=2 then
                if rnd(1)<.5 then map(i,j)=1 else map(i,j)=2
                col1.b-=.5
                col2.r+=.5
            end if
            if map(i+1,j)=1 AND map(i-1,j+1)=2 then
                if rnd(1)<.5 then map(i,j)=1 else map(i,j)=2
                col1.b-=.5
                col2.r+=.5
            end if
        end if
       
        if col1.b<0 then col1.b=0
        if col1.b>255 then col1.b=255
        if col1.g<0 then col1.g=0
        if col1.g>255 then col1.g=255
        if col2.b<0 then col2.b=0
        if col2.b>255 then col2.b=255
        if col2.g<0 then col2.g=0
        if col2.g>255 then col2.g=255
       
       
        '' Mort
        if i>0 and i<19 and j>0 and j<19 then
            if map(i,j)=1 or map(i,j)=2 then
                if map(i,j-1)=0 and map(i,j+1)=0 and map(i-1,j)=0 and map(i+1,j)=0 then
                    if map(i,j-2)=0 and map(i,j+2)=0 and map(i-2,j)=0 and map(i+2,j)=0 then
                        map(i,j)=0
                    end if
                end if
            end if
        elseif i=0 or j=0 then
            if map(i,j)=1 or map(i,j)=2 then
                if map(i,j+1)=0 and map(i+1,j)=0 then
                    if map(i,j+2)=0 and map(i+2,j)=0 then
                        map(i,j)=0
                    end if
                end if
            end if
        elseif i=19 or j=19 then
            if map(i,j)=1 or map(i,j)=2 then
                if map(i,j-1)=0 and map(i-1,j)=0 then
                    if map(i,j-2)=0 and map(i-2,j)=0 then
                        map(i,j)=0
                    end if
                end if
            end if
        end if
       
        '' deplacement rare
        if deplace=1 then
        if map(i,j)=1 then
            select case int(rnd(1)*7+1)
            case 1
                if map(i,j-1)=0 then map(i,j)=0:map(i,j-1)=1
            case 2
                if map(i,j+1)=0 then map(i,j)=0:map(i,j+1)=1
            case 3
                if map(i-1,j)=0 then map(i,j)=0:map(i-1,j)=1
            case 4
                if map(i+1,j)=0 then map(i,j)=0:map(i+1,j)=1
            end select
        end if
        end if
        if map(i,j)=2 then
            select case int(rnd(1)*7+1)
            case 1
                if map(i,j-1)=0 then map(i,j)=0:map(i,j-1)=2
            case 2
                if map(i,j+1)=0 then map(i,j)=0:map(i,j+1)=2
            case 3
                if map(i-1,j)=0 then map(i,j)=0:map(i-1,j)=2
            case 4
                if map(i+1,j)=0 then map(i,j)=0:map(i+1,j)=2
            end select
        end if   
        next
    next
   
    Locate 1,1:Print "Conditions :"
    Locate 2,1:print "reproduction si entoure"
    Locate 3,1:print "mort si eloigne"
    Locate 4,1:print "deplacement aleatoire"
    Locate 5,1:print "Echange de culture par reproduction"
    Locate 63,1:print nbreloop;" loops effectues"
   
    For i=0 to 19
        For j=0 to 19
            if map(i,j)=1 or map(i,j)=2 then testmap+=1
        next
    next
   
    if testmap<>0 and testmap< i*j then nbreloop+=1
    testmap=0
   
    Screencopy
    screensync
    sleep 500
   
loop until multikey(&h01)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 3 guests