Another Way of Life

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Nescio

Betreff: Another Way of Life

 BeitragSa, Okt 20, 2007 17:03
Antworten mit Zitat
Benutzer-Profile anzeigen
Hier noch eine Lebenssimulation, die ich vor ein paar Monaten gemacht habe, ähnlich dem "Way of Life".

Das ganze klappt so:

In einem Gebiet von 25x25 Plätzen leben zufällig viele Tiere. Wenn um einen freien Platz 3 Tiere leben, ensteht auf dem freien Platz ein neues Tier.
Da die Tiere auch altern, sterben sie nach 10 "Generationen".
Wenn um ein tier mehr als 4 Tiere leben stirbt es an Futtermangel, wenn weniger als 2 Tiere um es herum leben stirbt es an Vereinsamung.

Unten gibt es noch ein Diagramm, was den Verlauf der Bevölkerung anzeigt.

Hier der
Code: [AUSKLAPPEN]

Graphics 1024,768,0,2

AppTitle"L I F E   --  Lebenssimulation"

max=25

Dim Feld(max+1,max+1)                           ; Feld erstellen
Dim Feldneu(max+1,max+1)                        ; Ein weiteres Feld

SeedRnd MilliSecs()

For T=1 To max*(Rnd(10,max-5))                     ;Ein paar Plätze mit Leben füllen
   
   Repeat
      XR=Rand(1,max)
      YR=Rand(1,max)
   Until Feldneu(XR,YR)=0
   
   Feldneu(XR,YR)=1
   
   start=start+1

Next


Dim Bev(141)                                    ;Zähler für die letzten Generationen

abg#=0

Repeat


; Generation aktualisieren

   For X=1 To max
      For Y=1 To max
         Feld(X,Y)=Feldneu(X,Y)
      Next
   Next


   ab=ab+1   
   gen=gen+1                                 ;aktuelle Generation                        
   If ab>141 Then                              ;Generationen "verschieben"
      For T=1 To 140
         Bev(T)=Bev(T+1)
      Next
      ab=140
   EndIf

   Bev(ab)=0                                 ;aktulle Bevölkerung auf null (muss noch gezählt werden)


   Cls                                       ;Gitter

   Color 100,100,100
   For X1=0 To max-1
      For Y1=0 To max-1
         Rect X1*20,Y1*20,21,21,0
      Next
   Next


   For X=1 To max
      For Y=1 To max
         
         Nachbarn=0                           ;Nachbarn zählen
         For M=X-1 To X+1
            For N=Y-1 To Y+1
               Nachbarn=Nachbarn+Sgn(Feld(M,N))
            Next
         Next
         
         If Feld(X,Y)>0 Then Nachbarn=Nachbarn-1
         
         If Feld(X,Y)>0 Then                     ;Ist Leben vorhanden?
            If Nachbarn>=2 And Nachbarn<=4 Then      ;Überlebt es?
               FeldNeu(X,Y)=Feld(X,Y)+1
            Else
               FeldNeu(X,Y)=0                  ;Überlebt es nicht?
            EndIf
         Else                              ;Ist kein Leben vorhanden?
            If Nachbarn=3 Then
               FeldNeu(X,Y)=1                  ;Gibt es neues Leben?
            EndIf
         EndIf
         
         If Feld(X,Y)>8 Then FeldNeu(X,Y)=0         ;Alterstod
         
      ;Graphics Darstellung des Volkes
         
         If Feld(X,Y)>0 Then
         
            Color 255-(25*Feld(X,Y)),255-(25*Feld(X,Y)),255-(25*Feld(X,Y))
            Oval (X-1)*20+2,(Y-1)*20+2,16,16
            
            Color 0,0,0
            Text (X-1)*20+10,(Y-1)*20+10,Feld(X,Y),1,1         
         EndIf
         
         Bev(ab)=Bev(ab)+Sgn(Feld(X,Y))            ;"Volkszählung"
                  
      Next
   Next
   
   If minb=0 Then minb=Bev(ab)

; Durchschnitt errechnen
   
   abg=abg+Bev(ab)
   DN#=abg/gen
   
   
; Maximale Bevölkerung aktualisieren

   If Bev(ab)>maxb Then maxb=Bev(ab)
   
; Minimale Bevölkerung aktualisieren
   
   If Bev(ab)<minb Then minb=Bev(ab)
   
; G R A P H I S C H E   D A R S T E L L U N G !   

   Color 0,255,0
   Text (max*20)+20, 10,"Aktuelle Bevölkerung:"+RSet(Bev(ab),29)
   
   Text (max*20)+20, 30,"Durchschnittliche Bevölkerung:"+RSet(Int(DN),20)
   
   Text (max*20)+20, 50,"Maximale Bevölkerung:"+RSet(maxb,29)
   
   Text (max*20)+20, 70,"Minimale Bevölkerung:"+RSet(minb,29)
   
   Text (max*20)+20, 90,"Veränderung gegenüber letzter Generation:"+RSet((Bev(ab)-Bev(ab-1)),9)
   
   Text (max*20)+20,110,"Veränderung gegenüber erster Generation:"+RSet((Bev(ab)-start),10)
   
   Text (max*20)+20,130,"Aktuelle Generation:"+RSet(gen,30)
   
   

   For T=0 To 10
      Color 100,100,100
      Line   0,750-(T*12.5),980,750-(T*12.5)
      Color 192,192,192
      Text 982,750-(T*12.5),RSet(T*50,3),0,1
   Next
   
   Color 255,0,0
   Line 0,750-(DN/4.0),980,750-(DN/4.0)
   
   Color 0,255,0
   For T=1 To ab-1
      Line (T-1)*7,750-(Bev(T)/4.0),(T)*7,750-(Bev(T+1)/4.0)
   Next
   
   Color 255,255,0
   Line 0,750-(maxb/4.0),980,750-(maxb/4.0)
   
   Color 255,127,0
   Line 0,750-(minb/4.0),980,750-(minb/4.0)
   

   
   
   
   If ab=1 Then
      Color 255,0,0
      Text 512,500,"Start mit [Leertaste]",1
      Text 512,520,"Automatischer Ablauf mit [M]",1
      While KeyHit(57)=0
      Wend
   EndIf
   
   If KeyHit(50) Then modus=modus Xor 1
   
   If Modus=0 Then
      WaitKey()
   EndIf

Until KeyHit(1)
End


Ich hoffe es gefällt euch, um kreative Ideen wird gebeten.

MfG

Nescio
Quod est faciendum? Nescio!

Silver_Knee

 BeitragSa, Okt 20, 2007 17:43
Antworten mit Zitat
Benutzer-Profile anzeigen
Anti flimmer-Code: [AUSKLAPPEN]

Graphics 1024,768,0,2
SetBuffer BackBuffer()
AppTitle"L I F E   --  Lebenssimulation"

max=25

Dim Feld(max+1,max+1)                           ; Feld erstellen
Dim Feldneu(max+1,max+1)                        ; Ein weiteres Feld

SeedRnd MilliSecs()

For T=1 To max*(Rnd(10,max-5))                     ;Ein paar Plätze mit Leben füllen
   
   Repeat
      XR=Rand(1,max)
      YR=Rand(1,max)
   Until Feldneu(XR,YR)=0
   
   Feldneu(XR,YR)=1
   
   start=start+1

Next


Dim Bev(141)                                    ;Zähler für die letzten Generationen

abg#=0

Repeat


; Generation aktualisieren

   For X=1 To max
      For Y=1 To max
         Feld(X,Y)=Feldneu(X,Y)
      Next
   Next


   ab=ab+1   
   gen=gen+1                                 ;aktuelle Generation                       
   If ab>141 Then                              ;Generationen "verschieben"
      For T=1 To 140
         Bev(T)=Bev(T+1)
      Next
      ab=140
   EndIf

   Bev(ab)=0                                 ;aktulle Bevölkerung auf null (muss noch gezählt werden)


   Cls                                       ;Gitter

   Color 100,100,100
   For X1=0 To max-1
      For Y1=0 To max-1
         Rect X1*20,Y1*20,21,21,0
      Next
   Next


   For X=1 To max
      For Y=1 To max
         
         Nachbarn=0                           ;Nachbarn zählen
         For M=X-1 To X+1
            For N=Y-1 To Y+1
               Nachbarn=Nachbarn+Sgn(Feld(M,N))
            Next
         Next
         
         If Feld(X,Y)>0 Then Nachbarn=Nachbarn-1
         
         If Feld(X,Y)>0 Then                     ;Ist Leben vorhanden?
            If Nachbarn>=2 And Nachbarn<=4 Then      ;Überlebt es?
               FeldNeu(X,Y)=Feld(X,Y)+1
            Else
               FeldNeu(X,Y)=0                  ;Überlebt es nicht?
            EndIf
         Else                              ;Ist kein Leben vorhanden?
            If Nachbarn=3 Then
               FeldNeu(X,Y)=1                  ;Gibt es neues Leben?
            EndIf
         EndIf
         
         If Feld(X,Y)>8 Then FeldNeu(X,Y)=0         ;Alterstod
         
      ;Graphics Darstellung des Volkes
         
         If Feld(X,Y)>0 Then
         
            Color 255-(25*Feld(X,Y)),255-(25*Feld(X,Y)),255-(25*Feld(X,Y))
            Oval (X-1)*20+2,(Y-1)*20+2,16,16
           
            Color 0,0,0
            Text (X-1)*20+10,(Y-1)*20+10,Feld(X,Y),1,1         
         EndIf
         
         Bev(ab)=Bev(ab)+Sgn(Feld(X,Y))            ;"Volkszählung"
                 
      Next
   Next
   
   If minb=0 Then minb=Bev(ab)

; Durchschnitt errechnen
   
   abg=abg+Bev(ab)
   DN#=abg/gen
   
   
; Maximale Bevölkerung aktualisieren

   If Bev(ab)>maxb Then maxb=Bev(ab)
   
; Minimale Bevölkerung aktualisieren
   
   If Bev(ab)<minb Then minb=Bev(ab)
   
; G R A P H I S C H E   D A R S T E L L U N G !   

   Color 0,255,0
   Text (max*20)+20, 10,"Aktuelle Bevölkerung:"+RSet(Bev(ab),29)
   
   Text (max*20)+20, 30,"Durchschnittliche Bevölkerung:"+RSet(Int(DN),20)
   
   Text (max*20)+20, 50,"Maximale Bevölkerung:"+RSet(maxb,29)
   
   Text (max*20)+20, 70,"Minimale Bevölkerung:"+RSet(minb,29)
   
   Text (max*20)+20, 90,"Veränderung gegenüber letzter Generation:"+RSet((Bev(ab)-Bev(ab-1)),9)
   
   Text (max*20)+20,110,"Veränderung gegenüber erster Generation:"+RSet((Bev(ab)-start),10)
   
   Text (max*20)+20,130,"Aktuelle Generation:"+RSet(gen,30)
   
   

   For T=0 To 10
      Color 100,100,100
      Line   0,750-(T*12.5),980,750-(T*12.5)
      Color 192,192,192
      Text 982,750-(T*12.5),RSet(T*50,3),0,1
   Next
   
   Color 255,0,0
   Line 0,750-(DN/4.0),980,750-(DN/4.0)
   
   Color 0,255,0
   For T=1 To ab-1
      Line (T-1)*7,750-(Bev(T)/4.0),(T)*7,750-(Bev(T+1)/4.0)
   Next
   
   Color 255,255,0
   Line 0,750-(maxb/4.0),980,750-(maxb/4.0)
   
   Color 255,127,0
   Line 0,750-(minb/4.0),980,750-(minb/4.0)
   

   
   
   
   If ab=1 Then
      Color 255,0,0
      Text 512,500,"Start mit [Leertaste]",1
      Text 512,520,"Automatischer Ablauf mit [M]",1
      Flip
      While KeyHit(57)=0
      Wend
      Flip

   EndIf
   
   If KeyHit(50) Then modus=modus Xor 1
   
   Flip
   If Modus=0 Then
      WaitKey()
   EndIf
   Cls
Until KeyHit(1)
End


man nehme backbuffer()

Nescio

 BeitragSa, Okt 20, 2007 20:57
Antworten mit Zitat
Benutzer-Profile anzeigen
hatte ich absichtlich weggelassen, damits schneller läuft

außerdem flimmerts bei mir im fenstermodus kein bisschen
Quod est faciendum? Nescio!

Smily

 BeitragSa, Okt 20, 2007 21:47
Antworten mit Zitat
Benutzer-Profile anzeigen
Das teil heist aber nicht "way of life" sondern "game of life" ^^
Lesestoff:
gegen Softwarepatente | Netzzensur | brain.exe | Unabhängigkeitserklärung des Internets

"Wir müssen die Rechte der Andersdenkenden selbst dann beachten, wenn sie Idioten oder schädlich sind. Wir müssen aufpassen. Wachsamkeit ist der Preis der Freiheit --- Keine Zensur!"
stummi.org

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group