DNA-Bakterien

Übersicht BlitzBasic Codearchiv

Gehe zu Seite 1, 2  Weiter

Neue Antwort erstellen

Fetze

Betreff: DNA-Bakterien

BeitragSo, Jan 09, 2005 20:37
Antworten mit Zitat
Benutzer-Profile anzeigen
Um nicht länger die Schwarmsimulation vollspammen zu müssen, mache ich mal ein eigenes Topic auf für meine DNA-Bakterien.
Für die, die es noch nicht wissen: Hier werden Bakterien simuliert, deren Eigenschaften auf ihrer DNA basieren. Diese DNA besteht
nur aus einsen und Nullen, was in etwa den zwei Möglichkeiten unserer Basenpaar entspricht. Sie wird richtig interpretiert, ohne dass feste
Reihenfolgen oder dergleichen existieren. EIne bestimmte Kombination teilt der Bakterie mit, dass dort ein bestimmter Wert auszulesen gilt.
Die Bakterien sterben nicht nach gewisser Zeit, sondern sobald ihr Genom zu stark zerstört ist oder sie getötet werden. Probiert es einfach mal aus.
Mehrere Anläufe werden nötig sein ^^

In dieser Version habe ich mal als Startvorraussetzung neben einem FotosyntheseBakterium noch eine Fresszelle platziert (Schwarz
am Anfang). Diese bezieht ihre Energie, die sie zum Teilen benötigt, daraus, andere Bakterien (an) zu fressen.

Mit der Leertaste kann man 4 der vorhandenen Genome zufällig auswählen lassen und in ein neues Testgebiet setzen. Quasi mit 4
aus dem alten Test in nem neuen Test weitermachen. Das ist allerdings eher zur CPU-Auslastung.

Hier ist der aktuelle Code:
Code: [AUSKLAPPEN]

;### GRAFIKMODUS U. ZUFALLSGENERATOR ###
Const RES_X=640,RES_Y=480
Graphics RES_X,RES_Y,16,2
SeedRnd MilliSecs()
SetBuffer BackBuffer()
ClsColor 30,30,30
zeittakt=CreateTimer(60)
;#######################################

;### GLOBALE FÜR LINES_INTERSECT ###
Global Intersection_X#
Global Intersection_Y#
Global Intersection_AB#
Global Intersection_CD#
;###################################

;### KONSTANTEN ###
Const DNA_StartLength=8
Const DNA_Shape_Edge_Start$="00000000"
Const DNA_Shape_Edge_End$="00000001"
Const DNA_Genom_Repairtime_Start$="00000010"
Const DNA_Genom_Repairtime_End$="00000011"
Const DNA_Genom_Protection_Start$="00000100"
Const DNA_Genom_Protection_End$="00000101"
Const DNA_Genom_Repairchance_Start$="00000110"
Const DNA_Genom_Repairchance_End$="00000111"
Const DNA_Reproductionrate_Start$="00001000"
Const DNA_Reproductionrate_End$="00001001"
Const DNA_Health_Fotosynth_Start$="00001010"
Const DNA_Health_Fotosynth_End$="00001011"
Const DNA_Health_Eat_Start$="00001100"
Const DNA_Health_Eat_End$="00001101"
Const DNA_Shape_Color_Start$="00001110"
Const DNA_Shape_Color_End$="00001111"

Const NegativeStr$="0"
Const PositiveStr$="1"

Const ReproduceDelay=1000
Const KillHealth=20
Const MaxEatRange=25
Const MaxFotoSynth#=2
Const MaxHealth=100
Const MaxBakterien=30
Const AutoClear=0

Const Shape_MaxEdges=16
Const Shape_MaxEdgeEntf=10
Const Genom_MaxChanges=10
;##################


;### TYPE-FELDER DEFINIEREN ###
Type bakterium ;Eine Bakterie
   ;### NICHT-STATISCHE VARIABLEN ###
   Field x#,y# ;Position
   Field xold#,yold# ;Position von vor einem Frame.
   Field xspeed#,yspeed# ;Geschwindigkeit
   
   Field health# ;Gesundheit des Bakteriums. Sinkt es auf KillHealth, stirbt das Bakterium.
   
   Field genom$ ;Ihr momentanes Genom
   Field genom_changes ;Die Veränderungen am Genom
   
   Field timer_genomrepair ;Der Reperatur-Timer. Zählt bis genom_repairtime*10 hoch
   ;#################################
   
   ;### STATISCHE VARIABLEN ###
   Field shape_edges ;Die Anzahl der Kanten der Form des Bakteriums
   Field shape_edgeX[Shape_MaxEdges] ;Die Position der Kanten der Form des Bakteriums
   Field shape_edgeY[Shape_MaxEdges]
   Field shape_color_r,shape_color_g,shape_color_b ;Die Farbe des Bakteriums
   
   Field genom_repairtime ;Die Zeitabstand / 10, in dem das Genom repariert wird
   Field genom_protection ;Der "Schutz" des Genoms. Je höher, desto seltener Mutiert es.
   Field genom_repairchance ;Die Chance zur Reperatur eines Gens. Je höher, desto höher die Erfolgschance.
   
   Field health_fotosynth ;Die Effizienz der Fotosynthese. In Health pro Zyklus / 100
   Field health_eat ;Die Effizienz des Fressens. In Health pro Zyklus / 25
   
   Field reproductionrate ;Die Vermehrungsrate. Je höher, desto schneller vermehrt sich das Bakterium
   
   Field genom_orig$ ;Das Genom bei geburt der Bakterie
   ;###########################
End Type
;##############################


;### INITIALISIEREN ###
;CreateBakterium(300,100,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001110 000 00001111")
CreateBakterium(300,200,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001100 0 00001101  00001110 000000000000000000000000 00001111")
CreateBakterium(300,300,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 0 00001011  00001100 1100100 00001101  00001110 111111111111111111111111 00001111")
;CreateBakterium(300,400,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001110 000 00001111")
;######################


;### HAUPTSCHLEIFE ###
Repeat
   Cls
   
   UpdateBakterien() ;Bakterien berechnen
   
   If CountBakterien()>MaxBakterien And AutoClear=1 Then ClearArea()
   If KeyHit(57) Then ClearArea()
   ;Text 100,100,GetSuccessGenom$()
   
   WaitTimer(zeittakt)
   Flip
Until KeyHit(1)
;#####################



;### FUNKTIONEN ###
Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen
   b.bakterium=New bakterium
   b\x#=x ;Position
   b\y#=y
   b\xspeed#=0 ;Geschwindigkeit
   b\yspeed#=0
   b\health#=health#
   b\genom$=Replace(genom$," ","") ;Genom festlegen
   b\genom_orig$=b\genom$
   ParseDNA(Handle(b)) ;Genom interpretieren
   Return Handle(b) ;Handle zurückgeben
End Function

Function DeleteBakterium(hndl)
   b.bakterium=Object.bakterium(hndl)
   Delete b.bakterium
End Function

Function KillBakterium(hndl)
   DeleteBakterium(hndl)
End Function

Function UpdateBakterien() ;Bakterien berechnen
   For b.bakterium=Each bakterium ;Bakterien durchgehen
      
      ;Temporär: Speedberechnung. Sollte noch ausgetauscht werden!
      If b\health_eat>10 Then
         tmphndl=GetPreyBakterium(Handle(b),200)
         If tmphndl<>-1 Then
            temp.bakterium=Object.bakterium(tmphndl)
            b\xspeed#=(temp\x#-b\x#)-b\xspeed#;/200
            b\yspeed#=(temp\y#-b\y#)-b\yspeed#;/200
         End If
      End If
      b\xspeed#=b\xspeed#+Rnd(-0.5,0.5)
      b\yspeed#=b\yspeed#+Rnd(-0.5,0.5)
      If b\xspeed#>1 Then b\xspeed#=1
      If b\xspeed#<-1 Then b\xspeed#=-1
      If b\yspeed#>1 Then b\yspeed#=1
      If b\yspeed#<-1 Then b\yspeed#=-1
      
      ;Kollisionsüberprüfung
      For bc.bakterium=Each bakterium
         If Handle(bc)<>Handle(b) Then
            If BakteriumsCollide(Handle(b),Handle(bc)) Then
            ;   b\x#=b\xold#
            ;   b\y#=b\yold#
               b\xspeed#=(b\x#-bc\x#);-b\xspeed#
               b\yspeed#=(b\y#-bc\y#);-b\yspeed#
            End If
         End If
      Next
      
      ;Bewegung
      b\xold#=b\x#
      b\yold#=b\y#
      b\x#=b\x#+b\xspeed#
      b\y#=b\y#+b\yspeed#
      
      ;Fotosynthese
      If b\health_fotosynth>10 Then
         If b\health_fotosynth/100<=MaxFotoSynth# Then
            b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(100))
         End If
      ;   Color 0,255,0
      ;   Rect b\x#,b\y#,2,2,1
      End If
      
      ;Fressen
      If b\health_eat>10 Then
         tmphndl=GetPreyBakterium(Handle(b),MaxEatRange) ;GetPreybakterium durch Genetisch bedingte Fressvorlieben ersetzen
         If tmphndl<>-1 Then
            temp.bakterium=Object.bakterium(tmphndl)
            temp\health#=temp\health#-Float(Float(b\health_eat)/Float(25))
            b\health#=b\health#+Float(Float(b\health_eat)/Float(25))
         End If
      ;   Color 255,0,0
      ;   Rect b\x#,b\y#+2,2,2,1
      End If
      
      If b\health#>MaxHealth Then b\health#=MaxHealth
      
      ;Genombeschädigung durch "Umwelteinflüsse" und Stoffwechsel
      If Rand(0,b\genom_protection)=0 Then
         ;Zu beschädigende Position aussuchen:
         dpos=Rand(1,Len(b\genom$))
         ;Genom$ aufteilen:
         gs1$=Left(b\genom$,dpos)
         gs2$=Right(b\genom$,Len(b\genom$)-dpos)
         ;Wert am Ende des ersten Genom-Teils löschen
         gs1$=Left(gs1$,Len(gs1$)-1)
         ;...und einen beliebigen anderen Wert eintragen
         d$=Str(Rand(0,3))
         If d$="2" Then d$=""
         If d$="3" Then d$=Str(Bin(Rand(0,3)))
         gs1$=gs1$+d$
         ;Und zu guter letzt die DNA wieder zusammenfügen:
         b\genom$=gs1$+gs2$
         b\genom_changes=b\genom_changes+1
      End If
      
      b\timer_genomrepair=b\timer_genomrepair+1 ;Genomreperatur
      If b\timer_genomrepair>=(b\genom_repairtime*10) Then
         ;b\genom$=b\genom_orig$
         For rpos=1 To Len(b\genom_orig$) ;Genom durchgehen
            ;Genom aufteilen:
            gs1$=Left(b\genom$,rpos)
            gs2$=Right(b\genom$,Len(b\genom$)-rpos)
            If gs2$="" Then gs2$=" "
            If gs1$="" Then gs1$=" "
            ;Letzte Stelle abfragen:
            tpg$=Right(gs1$,1)
            tpog$=Mid(b\genom_orig$,rpos,1)
            ;Vergleichen und mit festgelegter Erfolgsquote reparieren
            If tpg$<>tpog$ Then
               If Rand(0,b\genom_repairchance)>0 Then
                  b\genom_changes=b\genom_changes-1
                  gs1$=Left(gs1$,Len(gs1$)-1)
                  gs1$=gs1$+tpog$
               End If
            End If
            ;DNS wieder zusammensetzen
            b\genom$=gs1$+gs2$
         Next
         b\timer_genomrepair=0
      End If
      
   ;   ParseDNA(Handle(b)) ;War mal zu testzwecken drin. Veranschaulichung der Mutation
      
      
      If Rand(-ReproduceDelay,b\reproductionrate)>0 And b\health>50 Then
         CreateBakterium(b\x#,b\y#,b\health#/2,b\genom$)
         b\health#=b\health#/2
      End If
      
      killed=0
      ;Bei unzulässigen Werten wird das Bakterium getötet
      If killed=0 Then If b\shape_edges<=2 Then KillBakterium(Handle(b)) : killed=1 ;Unvollständige Form
      ;und bei zu extremer DNA-Veränderung auch
      If killed=0 Then If b\genom_changes>Genom_MaxChanges Then KillBakterium(Handle(b)) : killed=1
      ;und wenn es dem Bakterium nicht gut geht
      If killed=0 Then If b\health#<=KillHealth Then KillBakterium(Handle(b)) : killed=1
      ;...oder zu gut. Dann muss es sich nämlich um irgendeine Art von DNA-Fehler handeln. Und Fehlerhafte DNA stirbt aus.
      If killed=0 Then If b\health#>MaxHealth Then KillBakterium(Handle(b)) : killed=1
      ;und auch, wenns aus dem Testfeld läuft
      If killed=0 Then If b\x#<0 Or b\x#>RES_X Or b\y#<0 Or b\y#>RES_Y Then KillBakterium(Handle(b)) : killed=1
      
      If killed=0 Then DrawBakterium(Handle(b)) ;Bakterium zeichnen
      
   Next
   Return 1
End Function

Function GetPreyBakterium(hndl,rng)
   b.bakterium=Object.bakterium(hndl)
   For temp.bakterium=Each bakterium
      If Handle(temp)<>Handle(b) Then
         tmpabs=((b\x#-temp\x#)^2+(b\y#-temp\y#)^2)
         If tmpabs<(rng^2) And temp\genom_orig$<>b\genom_orig$ Then
            Return Handle(temp)
         End If
      End If
   Next
   Return -1
End Function

Function DrawBakterium(hndl) ;Bakterium zeichnen
   b.bakterium=Object.bakterium(hndl) ;Bakterium anhand des Handles auswählen
   
   Color 255-b\shape_color_r,255-b\shape_color_g,255-b\shape_color_b
   For dloop=1 To b\shape_edges
      Line b\x#+b\shape_edgeX[dloop]*b\health#/100,b\y#+b\shape_edgeY[dloop]*b\health#/100,b\x#+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100,b\y#+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100
   Next
   ;Text b\x#,b\y#,b\health#
   
   Return 1
End Function


Function ParseDNA(hndl) ;Genom interpretieren
   b.bakterium=Object.bakterium(hndl) ;Bakterium anhand seines Handles auswählen
   
   ;Variablen nullen, falls nicht genullt
   b\shape_edges=0
   b\genom_repairtime=0
   
   For ploop=1 To Len(b\genom$) Step DNA_StartLength ;Genom durchgehen
      startsearch$=Mid(b\genom$,ploop,DNA_StartLength) ;...und dabei jedesmal DNA_StartLength Zeichen von der jetzigen Position aus einlesen
      Select startsearch$ ;Inhalt auf übereinstimmung mit Lesemarken prüfen.
      
      Case DNA_Shape_Edge_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Shape_Edge_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         xtempbin$=Mid(resultbinary$,1,(Len(resultbinary$)/2)) ;Koordinate in X und Y aufteilen
         ytempbin$=Mid(resultbinary$,(Len(resultbinary$)/2+1),-1)
         If xtempbin$="" Then xtempbin$="0"
         If ytempbin$="" Then ytempbin$="0"
         ;Aus der ersten Zahl as Vorzeichen auslesen:
         vorzeichen$=Left(xtempbin$,1)
         xtempbin$=RSet$(xtempbin$,Len(xtempbin$)-1)
         If vorzeichen$=NegativeStr$ Then xtemp=-BinToDezi(xtempbin$)
         If vorzeichen$=PositiveStr$ Then xtemp=BinToDezi(xtempbin$)
         vorzeichen$=Left(ytempbin$,1)
         ytempbin$=RSet$(ytempbin$,Len(ytempbin$)-1)
         If vorzeichen$=NegativeStr$ Then ytemp=-BinToDezi(ytempbin$)
         If vorzeichen$=PositiveStr$ Then ytemp=BinToDezi(ytempbin$)
         If xtemp<-Shape_MaxEdgeEntf Then xtemp=-Shape_MaxEdgeEntf
         If xtemp>Shape_MaxEdgeEntf Then xtemp=Shape_MaxEdgeEntf
         If ytemp<-Shape_MaxEdgeEntf Then ytemp=-Shape_MaxEdgeEntf
         If ytemp>Shape_MaxEdgeEntf Then ytemp=Shape_MaxEdgeEntf
         ;fertig interpretiertes Ergebnis eintragen
         b\shape_edges=b\shape_edges+1
         If b\shape_edges>Shape_MaxEdges Then b\shape_edges=Shape_MaxEdges
         b\shape_edgeX[b\shape_edges]=xtemp
         b\shape_edgeY[b\shape_edges]=ytemp
      
      Case DNA_Genom_Repairtime_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Repairtime_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_repairtime=resultdezi
         
      Case DNA_Genom_Protection_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Protection_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_protection=resultdezi
         
      Case DNA_Genom_Repairchance_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Repairchance_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_repairchance=resultdezi
      
      Case DNA_Reproductionrate_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Reproductionrate_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\reproductionrate=resultdezi
      
      Case DNA_Health_Fotosynth_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Health_Fotosynth_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\health_fotosynth=resultdezi
      
      Case DNA_Health_Eat_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Health_Eat_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\health_eat=resultdezi
         
      Case DNA_Shape_Color_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Shape_Color_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         Repeat
            resultbinary$=resultbinary$+"0"
         Until Len(resultbinary$)>=3
         rtempbin$=Mid(resultbinary$,1,Ceil(Len(resultbinary$)/3)) ;Wert in R,G und B aufteilen
         gtempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3),Ceil(Len(resultbinary$)/3))
         btempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3*2),-1)
         If rtempbin$="" Then rtempbin$=" "
         If gtempbin$="" Then gtempbin$=" "
         If btempbin$="" Then btempbin$=" "
         rtempdezi=BinToDezi(rtempbin$)
         gtempdezi=BinToDezi(gtempbin$)
         btempdezi=BinToDezi(btempbin$)
         If rtempdezi>255 Then rtempdezi=255
         If gtempdezi>255 Then gtempdezi=255
         If btempdezi>255 Then btempdezi=255
         ;fertig interpretiertes Ergebnis eintragen
         b\shape_color_r=rtempdezi
         b\shape_color_g=gtempdezi
         b\shape_color_b=btempdezi
      
      End Select
   Next
   
   Return 1
End Function


Function BinToDezi(binary$)
   For i=1 To Len(binary$) ;Binäres Ergebnis in Dezimale Zahl umformen
      If Mid$(binary$,i,1)="1" Then result=result+2^(Len(binary$)-i)
   Next
   Return result
End Function


Function Shape_NormalizeEdgeNum(hndl,num)
   b.bakterium=Object.bakterium(hndl)
   
   Repeat
      If num>b\shape_edges Then num=num-b\shape_edges
      If num<1 Then num=num+b\shape_edges
   Until num<=b\shape_edges And num>=1
   
   Return num
End Function

Function BakteriumsCollide(hndl,hndl2)
   If hndl=hndl2 Then Return 0
   
   b1.bakterium=Object.bakterium(hndl)
   b2.bakterium=Object.bakterium(hndl2)
   
   For eloop=1 To b1\shape_edges
      For floop= 1 To b2\shape_edges
         x1#=b1\x#+b1\shape_edgeX[eloop]*b1\health#/100
         x2#=b1\x#+b1\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b1),eloop+1)]*b1\health#/100
         x3#=b2\x#+b2\shape_edgeX[floop]*b2\health#/100
         x4#=b2\x#+b2\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b2),floop+1)]*b2\health#/100
         y1#=b1\y#+b1\shape_edgeY[eloop]*b1\health#/100
         y2#=b1\y#+b1\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b1),eloop+1)]*b1\health#/100
         y3#=b2\y#+b2\shape_edgeY[floop]*b2\health#/100
         y4#=b2\y#+b2\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b2),floop+1)]*b2\health#/100
         If Lines_Intersect(x1#,y1#,x2#,y2#,x3#,y3#,x4#,y4#) Then
            Return 1
         End If
      Next
   Next
   
   Return 0
End Function

Function Lines_Intersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#)
   Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#)
   Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#)

   If Rd# = 0
      
      ; Lines are parralel.

      ; If Rn# is also 0 then lines are coincident.  All points intersect.
      ; Otherwise, there is no intersection point.
   
      Return False
   
   Else
   
      ; The lines intersect at some point.  Calculate the intersection point.
   
                Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#)

      Intersection_AB# = Rn# / Rd#
      Intersection_CD# = Sn# / Rd#
      If Intersection_AB#<0 Or Intersection_AB#>1 Then Return False
      If Intersection_CD#<0 Or Intersection_CD#>1 Then Return False

      Intersection_X# = Ax# + Intersection_AB#*(Bx#-Ax#)
      Intersection_Y# = Ay# + Intersection_AB#*(By#-Ay#)
         
      Return True
      
   EndIf
End Function

Function ClearArea()
;   tmp$=GetSuccessGenom$()
;   KillAll()
;   CreateBakterium(300,200,100,tmp$)
   tmp1$=GetRandomGenom$()
   tmp2$=GetRandomGenom$()
   tmp3$=GetRandomGenom$()
   tmp4$=GetRandomGenom$()
   KillAll()
   CreateBakterium(150,100,100,tmp1$)
   CreateBakterium(450,100,100,tmp2$)
   CreateBakterium(150,300,100,tmp3$)
   CreateBakterium(450,300,100,tmp4$)
End Function

Function KillAll()
   For b.bakterium=Each bakterium
      KillBakterium(Handle(b))
   Next
End Function

Function GetRandomGenom$()
   Local gtemp$[10000]
   For b.bakterium=Each bakterium
      gnum=gnum+1
      gtemp[gnum]=b\genom_orig$
   Next
   Return gtemp[Rand(1,gnum)]
End Function

Function GetSuccessGenom$()
   Local gtemp$[10000]
   Local gsuccess[10000]
   gnum=0
   For b.bakterium=Each bakterium
      If gnum>0 Then
         For gloop=1 To gnum
            If b\genom_orig$=gtemp[gloop] Then gsuccess[gloop]=gsuccess[gloop]+1 : gfound=1
         Next
      End If
      If gfound=0 Then
         gnum=gnum+1
         gtemp[gnum]=b\genom_orig$
         gsuccess[gnum]=1
      End If
   Next
   For gloop=1 To gnum
      If gsuccess[gnum]>bestsuccess Then
         bsnum=gloop
         bestsuccess=gsuccess[gnum]
      End If
   Next
   Return gtemp[bsnum]
End Function


Function CountBakterien()
   For b.bakterium=Each bakterium
      num=num+1
   Next
   Return num
End Function
;##################

hamZta

Administrator

BeitragSo, Jan 09, 2005 20:41
Antworten mit Zitat
Benutzer-Profile anzeigen
ui, fängt stark zum ruckeln, wenige sekunden nach start (ohne debugmodus), nach ein paar seks kommts dann ganz zum stillstand :/

p4 2.66 laptop
512 ddram
radeon9000 mobil.
Blog.

Fetze

BeitragSo, Jan 09, 2005 20:50
Antworten mit Zitat
Benutzer-Profile anzeigen
Natürlich ruckelt das, is doch klar.
1. wegen dem Line-Befehl
2. wegen Kollisionsabfrage der Bakterien
3. wegen Anzahl der Bakterien
4. wegen dem DNA-Parser, der bei der Teilung aufgerufen wird.

Das Programm ist nicht dazu da, schnell zu laufen. Das Programm ist dazu da, Evolution zu simulieren. Naja, jedenfalls, wenn man das so nennen kann, die die Möglichkeiten ja etwas beschränkt sind. Obwohl... teilweise hatte ich schon wirklich überraschende Bakterienkulturen... *g*
 

cavebird

BeitragMo, Jan 10, 2005 0:22
Antworten mit Zitat
Benutzer-Profile anzeigen
Irgendwie macht das Spaß! Aber mach das mal bunter. Ich habe meistens nur weiße und schwarze...
MegaUpload.de -- Uploade bis zu 2MB pro Bild !!DEIN PARTNER IN SACHEN UPLOAD --bitte weiterempfehlen, nur so können wir bekannt werden...

Fetze

BeitragMo, Jan 10, 2005 14:29
Antworten mit Zitat
Benutzer-Profile anzeigen
Wie soll ich die bitteschön bunter machen? Ihre Farbe hängt von ihrer DNA ab ^^

Hatte bei meiner letzten Simulation übrigens ein sehr interessantes Ergebnis: Eine Fünfeckige, Grüne Bakterienart, die per Fotosynthese Energie gewinnt. Sie hatte jedoch eine relativ hohe Mutationsrate, was normalerweise den Tod einer Art bedeutet. Jedoch nicht bei den Grünen Fünfecken: Die hatten zwar häufig mutationen, diese wurden aber sofort von allen gemeinsam gefressen. Und da eine Zelle auch ihre Energie teilt, die Mutationszelle also die Hälfte der Energie der Mutterzelle hat, aber alle Zellen zusammen die mutierte Tochterzelle fressen, hatte das den Effekt, dass die Bakterien alle die in etwa gleiche Energie hatten, da sie ständig gleichmäßig aufgeteilt wurde. Wenn dieser Art, die sich aufgrund dieses Verhaltens immer im Schwarm aufgehalten hat, eine andere Bakterienart zu nahe kam, wurde sie gefressen und somit vernichtet. Hätte meine Art gerne ein paar Experimenten unterzogen, aber leider hatte ich aufgrund fehlender Funktionen keine Möglichkeit, an ihre DNA zu kommen Sad

Hier mal meine aktuelle Version:
Code: [AUSKLAPPEN]

;### GRAFIKMODUS U. ZUFALLSGENERATOR ###
Const RES_X=640,RES_Y=480
Graphics RES_X,RES_Y,16,2
SeedRnd MilliSecs()
SetBuffer BackBuffer()
ClsColor 30,30,30
zeittakt=CreateTimer(60)
;#######################################

;### GLOBALE FÜR LINES_INTERSECT ###
Global Intersection_X#
Global Intersection_Y#
Global Intersection_AB#
Global Intersection_CD#
;###################################

;### KONSTANTEN ###
Const DNA_StartLength=8
Const DNA_Shape_Edge_Start$="00000000"
Const DNA_Shape_Edge_End$="00000001"
Const DNA_Genom_Repairtime_Start$="00000010"
Const DNA_Genom_Repairtime_End$="00000011"
Const DNA_Genom_Protection_Start$="00000100"
Const DNA_Genom_Protection_End$="00000101"
Const DNA_Genom_Repairchance_Start$="00000110"
Const DNA_Genom_Repairchance_End$="00000111"
Const DNA_Reproductionrate_Start$="00001000"
Const DNA_Reproductionrate_End$="00001001"
Const DNA_Health_Fotosynth_Start$="00001010"
Const DNA_Health_Fotosynth_End$="00001011"
Const DNA_Health_Eat_Start$="00001100"
Const DNA_Health_Eat_End$="00001101"
Const DNA_Shape_Color_Start$="00001110"
Const DNA_Shape_Color_End$="00001111"

Const NegativeStr$="0"
Const PositiveStr$="1"

Const ReproduceDelay=1000
Const KillHealth=20
Const MaxEatRange=15
Const MaxFotoSynth#=2
Const MaxHealth=100
Const MaxBakterien=30
Const AutoClear=0

Const Shape_MaxEdges=16
Const Shape_MaxEdgeEntf=10
Const Genom_MaxChanges=10
;##################


;### TYPE-FELDER DEFINIEREN ###
Type bakterium ;Eine Bakterie
   ;### NICHT-STATISCHE VARIABLEN ###
   Field x#,y# ;Position
   Field xold#,yold# ;Position von vor einem Frame.
   Field xspeed#,yspeed# ;Geschwindigkeit
   
   Field health# ;Gesundheit des Bakteriums. Sinkt es auf KillHealth, stirbt das Bakterium.
   
   Field genom$ ;Ihr momentanes Genom
   Field genom_changes ;Die Veränderungen am Genom
   
   Field timer_genomrepair ;Der Reperatur-Timer. Zählt bis genom_repairtime*10 hoch
   ;#################################
   
   ;### STATISCHE VARIABLEN ###
   Field shape_edges ;Die Anzahl der Kanten der Form des Bakteriums
   Field shape_edgeX[Shape_MaxEdges] ;Die Position der Kanten der Form des Bakteriums
   Field shape_edgeY[Shape_MaxEdges]
   Field shape_color_r,shape_color_g,shape_color_b ;Die Farbe des Bakteriums
   
   Field genom_repairtime ;Die Zeitabstand / 10, in dem das Genom repariert wird
   Field genom_protection ;Der "Schutz" des Genoms. Je höher, desto seltener Mutiert es.
   Field genom_repairchance ;Die Chance zur Reperatur eines Gens. Je höher, desto höher die Erfolgschance.
   
   Field health_fotosynth ;Die Effizienz der Fotosynthese. In Health pro Zyklus / 100
   Field health_eat ;Die Effizienz des Fressens. In Health pro Zyklus / 25
   
   Field reproductionrate ;Die Vermehrungsrate. Je höher, desto schneller vermehrt sich das Bakterium
   
   Field genom_orig$ ;Das Genom bei geburt der Bakterie
   ;###########################
End Type
;##############################


;### INITIALISIEREN ###
;CreateBakterium(300,100,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001110 000 00001111")
CreateBakterium(300,200,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001100 0 00001101  00001110 000000000000000000000000 00001111")
CreateBakterium(300,300,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 0 00001011  00001100 1100100 00001101  00001110 111111111111111111111111 00001111")
;CreateBakterium(300,400,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001110 000 00001111")
;######################


;### HAUPTSCHLEIFE ###
Repeat
   Cls
   
   UpdateBakterien() ;Bakterien berechnen
   
   If CountBakterien()>MaxBakterien And AutoClear=1 Then ClearArea()
   If KeyHit(57) Then ClearArea()
   ;Text 100,100,GetSuccessGenom$()
   
   WaitTimer(zeittakt)
   Flip
Until KeyHit(1)
;#####################



;### FUNKTIONEN ###
Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen
   b.bakterium=New bakterium
   b\x#=x ;Position
   b\y#=y
   b\xspeed#=0 ;Geschwindigkeit
   b\yspeed#=0
   b\health#=health#
   b\genom$=Replace(genom$," ","") ;Genom festlegen
   b\genom_orig$=b\genom$
   ParseDNA(Handle(b)) ;Genom interpretieren
   Return Handle(b) ;Handle zurückgeben
End Function

Function DeleteBakterium(hndl)
   b.bakterium=Object.bakterium(hndl)
   Delete b.bakterium
End Function

Function KillBakterium(hndl)
   DeleteBakterium(hndl)
End Function

Function UpdateBakterien() ;Bakterien berechnen
   For b.bakterium=Each bakterium ;Bakterien durchgehen
      
      ;Temporär: Speedberechnung. Sollte noch ausgetauscht werden!
      If b\health_eat>10 Then
         tmphndl=GetPreyBakterium(Handle(b),200)
         If tmphndl<>-1 Then
            temp.bakterium=Object.bakterium(tmphndl)
            b\xspeed#=(temp\x#-b\x#)-b\xspeed#;/200
            b\yspeed#=(temp\y#-b\y#)-b\yspeed#;/200
         End If
      End If
      b\xspeed#=b\xspeed#+Rnd(-0.5,0.5)
      b\yspeed#=b\yspeed#+Rnd(-0.5,0.5)
      If b\xspeed#>1 Then b\xspeed#=1
      If b\xspeed#<-1 Then b\xspeed#=-1
      If b\yspeed#>1 Then b\yspeed#=1
      If b\yspeed#<-1 Then b\yspeed#=-1
      
      ;Kollisionsüberprüfung
      For bc.bakterium=Each bakterium
         If Handle(bc)<>Handle(b) Then
            If BakteriumsCollide(Handle(b),Handle(bc)) Then
            ;   b\x#=b\xold#
            ;   b\y#=b\yold#
               b\xspeed#=(b\x#-bc\x#);-b\xspeed#
               b\yspeed#=(b\y#-bc\y#);-b\yspeed#
            End If
         End If
      Next
      
      ;Bewegung
      b\xold#=b\x#
      b\yold#=b\y#
      b\x#=b\x#+b\xspeed#
      b\y#=b\y#+b\yspeed#
      
      ;Fotosynthese
      If b\health_fotosynth>10 Then
         If b\health_fotosynth/100<=MaxFotoSynth# Then
            b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(100))
         End If
      ;   Color 0,255,0
      ;   Rect b\x#,b\y#,2,2,1
      End If
      
      ;Fressen
      If b\health_eat>10 Then
         tmphndl=GetPreyBakterium(Handle(b),MaxEatRange) ;GetPreybakterium durch Genetisch bedingte Fressvorlieben ersetzen
         If tmphndl<>-1 Then
            temp.bakterium=Object.bakterium(tmphndl)
            temp\health#=temp\health#-Float(Float(b\health_eat)/Float(25))
            b\health#=b\health#+Float(Float(b\health_eat)/Float(25))
         End If
      ;   Color 255,0,0
      ;   Rect b\x#,b\y#+2,2,2,1
      End If
      
      If b\health#>MaxHealth Then b\health#=MaxHealth
      
      ;Genombeschädigung durch "Umwelteinflüsse" und Stoffwechsel
      If Rand(0,b\genom_protection)=0 Then
         ;Zu beschädigende Position aussuchen:
         dpos=Rand(1,Len(b\genom$))
         ;Genom$ aufteilen:
         gs1$=Left(b\genom$,dpos)
         gs2$=Right(b\genom$,Len(b\genom$)-dpos)
         ;Wert am Ende des ersten Genom-Teils löschen
         gs1$=Left(gs1$,Len(gs1$)-1)
         ;...und einen beliebigen anderen Wert eintragen
         d$=Str(Rand(0,3))
         If d$="2" Then d$=""
         If d$="3" Then d$=Str(Bin(Rand(0,3)))
         gs1$=gs1$+d$
         ;Und zu guter letzt die DNA wieder zusammenfügen:
         b\genom$=gs1$+gs2$
         b\genom_changes=b\genom_changes+1
      End If
      
      b\timer_genomrepair=b\timer_genomrepair+1 ;Genomreperatur
      If b\timer_genomrepair>=(b\genom_repairtime*10) Then
         ;b\genom$=b\genom_orig$
         For rpos=1 To Len(b\genom_orig$) ;Genom durchgehen
            ;Genom aufteilen:
            gs1$=Left(b\genom$,rpos)
            gs2$=Right(b\genom$,Len(b\genom$)-rpos)
            If gs2$="" Then gs2$=" "
            If gs1$="" Then gs1$=" "
            ;Letzte Stelle abfragen:
            tpg$=Right(gs1$,1)
            tpog$=Mid(b\genom_orig$,rpos,1)
            ;Vergleichen und mit festgelegter Erfolgsquote reparieren
            If tpg$<>tpog$ Then
               If Rand(0,b\genom_repairchance)>0 Then
                  b\genom_changes=b\genom_changes-1
                  gs1$=Left(gs1$,Len(gs1$)-1)
                  gs1$=gs1$+tpog$
               End If
            End If
            ;DNS wieder zusammensetzen
            b\genom$=gs1$+gs2$
         Next
         b\timer_genomrepair=0
      End If
      
   ;   ParseDNA(Handle(b)) ;War mal zu testzwecken drin. Veranschaulichung der Mutation
      
      
      If Rand(-ReproduceDelay,b\reproductionrate)>0 And b\health>50 Then
         CreateBakterium(b\x#,b\y#,b\health#/2,b\genom$)
         b\health#=b\health#/2
      End If
      
      killed=0
      ;Bei unzulässigen Werten wird das Bakterium getötet
      If killed=0 Then If b\shape_edges<=2 Then KillBakterium(Handle(b)) : killed=1 ;Unvollständige Form
      ;und bei zu extremer DNA-Veränderung auch
      If killed=0 Then If b\genom_changes>Genom_MaxChanges Then KillBakterium(Handle(b)) : killed=1
      ;und wenn es dem Bakterium nicht gut geht
      If killed=0 Then If b\health#<=KillHealth Then KillBakterium(Handle(b)) : killed=1
      ;...oder zu gut. Dann muss es sich nämlich um irgendeine Art von DNA-Fehler handeln. Und Fehlerhafte DNA stirbt aus.
      If killed=0 Then If b\health#>MaxHealth Then KillBakterium(Handle(b)) : killed=1
      ;und auch, wenns aus dem Testfeld läuft
      If killed=0 Then If b\x#<0 Or b\x#>RES_X Or b\y#<0 Or b\y#>RES_Y Then KillBakterium(Handle(b)) : killed=1
      
      If killed=0 Then DrawBakterium(Handle(b)) ;Bakterium zeichnen
      
   Next
   Return 1
End Function

Function GetPreyBakterium(hndl,rng)
   b.bakterium=Object.bakterium(hndl)
   For temp.bakterium=Each bakterium
      If Handle(temp)<>Handle(b) Then
         tmpabs=((b\x#-temp\x#)^2+(b\y#-temp\y#)^2)
         If tmpabs<(rng^2) And temp\genom_orig$<>b\genom_orig$ Then
            Return Handle(temp)
         End If
      End If
   Next
   Return -1
End Function

Function DrawBakterium(hndl) ;Bakterium zeichnen
   b.bakterium=Object.bakterium(hndl) ;Bakterium anhand des Handles auswählen
   
   Color 255-b\shape_color_r,255-b\shape_color_g,255-b\shape_color_b
   For dloop=1 To b\shape_edges
      Line b\x#+b\shape_edgeX[dloop]*b\health#/100,b\y#+b\shape_edgeY[dloop]*b\health#/100,b\x#+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100,b\y#+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100
   Next
   ;Text b\x#,b\y#,b\health#
   
   Return 1
End Function


Function ParseDNA(hndl) ;Genom interpretieren
   b.bakterium=Object.bakterium(hndl) ;Bakterium anhand seines Handles auswählen
   
   ;Variablen nullen, falls nicht genullt
   b\shape_edges=0
   b\genom_repairtime=0
   
   For ploop=1 To Len(b\genom$) Step DNA_StartLength ;Genom durchgehen
      startsearch$=Mid(b\genom$,ploop,DNA_StartLength) ;...und dabei jedesmal DNA_StartLength Zeichen von der jetzigen Position aus einlesen
      Select startsearch$ ;Inhalt auf übereinstimmung mit Lesemarken prüfen.
      
      Case DNA_Shape_Edge_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Shape_Edge_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         xtempbin$=Mid(resultbinary$,1,(Len(resultbinary$)/2)) ;Koordinate in X und Y aufteilen
         ytempbin$=Mid(resultbinary$,(Len(resultbinary$)/2+1),-1)
         If xtempbin$="" Then xtempbin$="0"
         If ytempbin$="" Then ytempbin$="0"
         ;Aus der ersten Zahl as Vorzeichen auslesen:
         vorzeichen$=Left(xtempbin$,1)
         xtempbin$=RSet$(xtempbin$,Len(xtempbin$)-1)
         If vorzeichen$=NegativeStr$ Then xtemp=-BinToDezi(xtempbin$)
         If vorzeichen$=PositiveStr$ Then xtemp=BinToDezi(xtempbin$)
         vorzeichen$=Left(ytempbin$,1)
         ytempbin$=RSet$(ytempbin$,Len(ytempbin$)-1)
         If vorzeichen$=NegativeStr$ Then ytemp=-BinToDezi(ytempbin$)
         If vorzeichen$=PositiveStr$ Then ytemp=BinToDezi(ytempbin$)
         If xtemp<-Shape_MaxEdgeEntf Then xtemp=-Shape_MaxEdgeEntf
         If xtemp>Shape_MaxEdgeEntf Then xtemp=Shape_MaxEdgeEntf
         If ytemp<-Shape_MaxEdgeEntf Then ytemp=-Shape_MaxEdgeEntf
         If ytemp>Shape_MaxEdgeEntf Then ytemp=Shape_MaxEdgeEntf
         ;fertig interpretiertes Ergebnis eintragen
         b\shape_edges=b\shape_edges+1
         If b\shape_edges>Shape_MaxEdges Then b\shape_edges=Shape_MaxEdges
         b\shape_edgeX[b\shape_edges]=xtemp
         b\shape_edgeY[b\shape_edges]=ytemp
      
      Case DNA_Genom_Repairtime_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Repairtime_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_repairtime=resultdezi
         
      Case DNA_Genom_Protection_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Protection_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_protection=resultdezi
         
      Case DNA_Genom_Repairchance_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Repairchance_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_repairchance=resultdezi
      
      Case DNA_Reproductionrate_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Reproductionrate_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\reproductionrate=resultdezi
      
      Case DNA_Health_Fotosynth_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Health_Fotosynth_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\health_fotosynth=resultdezi
      
      Case DNA_Health_Eat_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Health_Eat_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\health_eat=resultdezi
         
      Case DNA_Shape_Color_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Shape_Color_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         Repeat
            resultbinary$=resultbinary$+"0"
         Until Len(resultbinary$)>=3
         rtempbin$=Mid(resultbinary$,1,Ceil(Len(resultbinary$)/3)) ;Wert in R,G und B aufteilen
         gtempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3),Ceil(Len(resultbinary$)/3))
         btempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3*2),-1)
         If rtempbin$="" Then rtempbin$=" "
         If gtempbin$="" Then gtempbin$=" "
         If btempbin$="" Then btempbin$=" "
         rtempdezi=BinToDezi(rtempbin$)
         gtempdezi=BinToDezi(gtempbin$)
         btempdezi=BinToDezi(btempbin$)
         If rtempdezi>255 Then rtempdezi=255
         If gtempdezi>255 Then gtempdezi=255
         If btempdezi>255 Then btempdezi=255
         ;fertig interpretiertes Ergebnis eintragen
         b\shape_color_r=rtempdezi
         b\shape_color_g=gtempdezi
         b\shape_color_b=btempdezi
      
      End Select
   Next
   
   Return 1
End Function


Function BinToDezi(binary$)
   For i=1 To Len(binary$) ;Binäres Ergebnis in Dezimale Zahl umformen
      If Mid$(binary$,i,1)="1" Then result=result+2^(Len(binary$)-i)
   Next
   Return result
End Function


Function Shape_NormalizeEdgeNum(hndl,num)
   b.bakterium=Object.bakterium(hndl)
   
   Repeat
      If num>b\shape_edges Then num=num-b\shape_edges
      If num<1 Then num=num+b\shape_edges
   Until num<=b\shape_edges And num>=1
   
   Return num
End Function

Function BakteriumsCollide(hndl,hndl2)
   If hndl=hndl2 Then Return 0
   
   b1.bakterium=Object.bakterium(hndl)
   b2.bakterium=Object.bakterium(hndl2)
   
   For eloop=1 To b1\shape_edges
      For floop= 1 To b2\shape_edges
         x1#=b1\x#+b1\shape_edgeX[eloop]*b1\health#/100
         x2#=b1\x#+b1\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b1),eloop+1)]*b1\health#/100
         x3#=b2\x#+b2\shape_edgeX[floop]*b2\health#/100
         x4#=b2\x#+b2\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b2),floop+1)]*b2\health#/100
         y1#=b1\y#+b1\shape_edgeY[eloop]*b1\health#/100
         y2#=b1\y#+b1\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b1),eloop+1)]*b1\health#/100
         y3#=b2\y#+b2\shape_edgeY[floop]*b2\health#/100
         y4#=b2\y#+b2\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b2),floop+1)]*b2\health#/100
         If Lines_Intersect(x1#,y1#,x2#,y2#,x3#,y3#,x4#,y4#) Then
            Return 1
         End If
      Next
   Next
   
   Return 0
End Function

Function Lines_Intersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#)
   Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#)
   Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#)

   If Rd# = 0
      
      ; Lines are parralel.

      ; If Rn# is also 0 then lines are coincident.  All points intersect.
      ; Otherwise, there is no intersection point.
   
      Return False
   
   Else
   
      ; The lines intersect at some point.  Calculate the intersection point.
   
                Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#)

      Intersection_AB# = Rn# / Rd#
      Intersection_CD# = Sn# / Rd#
      If Intersection_AB#<0 Or Intersection_AB#>1 Then Return False
      If Intersection_CD#<0 Or Intersection_CD#>1 Then Return False

      Intersection_X# = Ax# + Intersection_AB#*(Bx#-Ax#)
      Intersection_Y# = Ay# + Intersection_AB#*(By#-Ay#)
         
      Return True
      
   EndIf
End Function

Function ClearArea()
;   tmp$=GetSuccessGenom$()
;   KillAll()
;   CreateBakterium(300,200,100,tmp$)
   tmp1$=GetRandomGenom$()
   tmp2$=GetRandomGenom$()
   tmp3$=GetRandomGenom$()
   tmp4$=GetRandomGenom$()
   KillAll()
   CreateBakterium(150,100,100,tmp1$)
   CreateBakterium(450,100,100,tmp2$)
   CreateBakterium(150,300,100,tmp3$)
   CreateBakterium(450,300,100,tmp4$)
End Function

Function KillAll()
   For b.bakterium=Each bakterium
      KillBakterium(Handle(b))
   Next
End Function

Function GetRandomGenom$()
   Local gtemp$[10000]
   For b.bakterium=Each bakterium
      gnum=gnum+1
      gtemp[gnum]=b\genom_orig$
   Next
   Return gtemp[Rand(1,gnum)]
End Function

Function GetSuccessGenom$()
   Local gtemp$[10000]
   Local gsuccess[10000]
   gnum=0
   For b.bakterium=Each bakterium
      If gnum>0 Then
         For gloop=1 To gnum
            If b\genom_orig$=gtemp[gloop] Then gsuccess[gloop]=gsuccess[gloop]+1 : gfound=1
         Next
      End If
      If gfound=0 Then
         gnum=gnum+1
         gtemp[gnum]=b\genom_orig$
         gsuccess[gnum]=1
      End If
   Next
   For gloop=1 To gnum
      If gsuccess[gnum]>bestsuccess Then
         bsnum=gloop
         bestsuccess=gsuccess[gnum]
      End If
   Next
   Return gtemp[bsnum]
End Function


Function CountBakterien()
   For b.bakterium=Each bakterium
      num=num+1
   Next
   Return num
End Function
;##################

VirtualDreams

BeitragMo, Jan 10, 2005 21:33
Antworten mit Zitat
Benutzer-Profile anzeigen
Je mehr Bakterien es werden desto ruckliger wird. Sagen wir mal es waren ca 100 auf dem screen da war das alles schon ne diashow...
Zitat: "Ich habe ein Programm geschrieben und das funst nich. Warum nich Question Jetzt warte ich schon über 10 Minuten und es hat immer noch keiner geantwortet. Evil or Very Mad Könnt ihr das nich ?"

Fetze

BeitragMo, Jan 10, 2005 23:47
Antworten mit Zitat
Benutzer-Profile anzeigen
Is doch klar. Und je komplexer ihre Formen, desto ruckeliger wird es ebenfalls, denn die Kollisionsabfrage mit LineIntersect braucht auch schon ihre Zeit Wink

Ctuchik

BeitragDi, Jan 11, 2005 0:46
Antworten mit Zitat
Benutzer-Profile anzeigen
Woran siehst du eigentlich was deine Endbakterien so können:
Zitat:
Eine Fünfeckige, Grüne Bakterienart, die per Fotosynthese Energie gewinnt. Sie hatte jedoch eine relativ hohe Mutationsrate


Wird doch nirgends angezeigt! Das müsstest du mal einbauen!
Ansonsten: Hut ab, sowas wollte ich auch schon lange mal machen, bin aber irgendwie nie dazu gekommen! Smile
Zu den Nebenwirkungen gehören trockener Mund, Übelkeit, Erbrechen, Harnstau, schmerzhafter rektaler Juckreiz, Halluzinationen, Demenz, Psychose, Koma, Tod und Mundgeruch!
Magie eignet sich nicht für alle!
Fraget euren Arzt oder Apotheker!
  • Zuletzt bearbeitet von Ctuchik am Di, Jan 11, 2005 15:48, insgesamt einmal bearbeitet

Firstdeathmaker

BeitragDi, Jan 11, 2005 1:16
Antworten mit Zitat
Benutzer-Profile anzeigen
Das würde ich auch gerne wissen. Kannst du mir diese Bakterien entschlüsseln?:

user posted image
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image

Lord_Vader

BeitragDi, Jan 11, 2005 16:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Find ich ne klasse idee Smile

Selbst wenns ruckelt also es macht spaß Smile
Das wollte ich eigentlich so ähnlich auch mal machen, mit robotern aber keine evolution in der art. Klasse idee speicher ich mir mal schnell Wink

Und LOL: Wenn ich ne .exe draus mach dann erm vermehren sie sich net und schwirren irgendwann ab O_o

Edit: Ok ne war zufall xD

Mr.Keks

BeitragDi, Jan 11, 2005 16:19
Antworten mit Zitat
Benutzer-Profile anzeigen
ich habe das ganze mal eben optimiert, indem ich die kollision auf eine entfernungsmessung beschränkte und die bakterien in images zwischenspeicherte und nur selten aktuallisierte. jetzt läufts bei normalen zahlen noch flüssig genug.
MrKeks.net

Lord_Vader

BeitragDi, Jan 11, 2005 18:50
Antworten mit Zitat
Benutzer-Profile anzeigen
Kannste mal den Code pasten? Oder is der hier irgentwo ich seh nix. Wenns dann noch realistisch genug is reicht das ja völlig Smile

Mooch

Betreff: ...

BeitragDi, Jan 11, 2005 19:04
Antworten mit Zitat
Benutzer-Profile anzeigen
@Fetze: Kannst du nich mal ne Funktion einbauen, die sämtliche Auftretenden DNA's in einer Datei speichert?
Pentium IV 3.0Ghz; nVidia Geforce 6800;
Microsoft Windows XP Home SP2; BlitzBasic 3D

.:: Sites ::.
.:: http://www.fl4sh-clan.de/ ::.


Fetze

BeitragDi, Jan 11, 2005 20:23
Antworten mit Zitat
Benutzer-Profile anzeigen
Ja, ich sollte allgemein mal Diagnose- und Experimentier-Tools einbauen. Aber rechnet mal nicht mit Updates, mein Hauptprojekt geht vor und das hier mache ich nur, wenn ich grad wirklich zu viel Zeit hab *g*

@Ctuchik
habe sie nicht entschlüsselt. Das sieht man doch: Es gibt derzeit nur 2 Arten der Energiegewinnung: Fressen und Fotosynthese. Und wenn sie sich auch vermehren, wenn nix zum fressen da is, dann ist es wohl Fotosynthese.

@Firstdeathmaker
Würde ich gerne, aber wenn ichs überhaupt kann, dann nur, wenn ich die leutz in Bewegung sehe. Wie hast du so eine Artenvielfalt bekommen? Bei mir gibts meistens nur so 1-2 dominante Rassen, die die anderen verdrängen. Und dann wirds langweilig, weil die meistens eine extrem geringe Mutationsrate haben.

@Inarie
Gibste mir bitte mal deine Optimierung? ^^

Mr.Keks

BeitragDi, Jan 11, 2005 21:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Code: [AUSKLAPPEN]
;### GRAFIKMODUS U. ZUFALLSGENERATOR ###
Const RES_X=1024,RES_Y=768
Graphics RES_X,RES_Y,16,2
SeedRnd MilliSecs()
SetBuffer BackBuffer()
;ClsColor 30,30,30
AutoMidHandle 1
;zeittakt=CreateTimer(60)
;#######################################

;### GLOBALE FÜR LINES_INTERSECT ###
Global Intersection_X#
Global Intersection_Y#
Global Intersection_AB#
Global Intersection_CD#
;###################################

;### KONSTANTEN ###
Const DNA_StartLength=8
Const DNA_Shape_Edge_Start$="00000000"
Const DNA_Shape_Edge_End$="00000001"
Const DNA_Genom_Repairtime_Start$="00000010"
Const DNA_Genom_Repairtime_End$="00000011"
Const DNA_Genom_Protection_Start$="00000100"
Const DNA_Genom_Protection_End$="00000101"
Const DNA_Genom_Repairchance_Start$="00000110"
Const DNA_Genom_Repairchance_End$="00000111"
Const DNA_Reproductionrate_Start$="00001000"
Const DNA_Reproductionrate_End$="00001001"
Const DNA_Health_Fotosynth_Start$="00001010"
Const DNA_Health_Fotosynth_End$="00001011"
Const DNA_Health_Eat_Start$="00001100"
Const DNA_Health_Eat_End$="00001101"
Const DNA_Shape_Color_Start$="00001110"
Const DNA_Shape_Color_End$="00001111"

Const NegativeStr$="0"
Const PositiveStr$="1"

Const ReproduceDelay=1000
Const KillHealth=1
Const MaxEatRange=35
Const MaxFotoSynth#=4
Const MaxHealth=150
Const MaxBakterien=30
Const AutoClear=0

Const Shape_MaxEdges=16
Const Shape_MaxEdgeEntf=10
Const Genom_MaxChanges=40
;##################

Dim Resources#(res_x/32,res_y/32,1); "Resourcen", die die Zellen benötigen.
                           ; 0 : O2
                           ; 1 : CO2
                           ; 2 :
                           
                           
;### TYPE-FELDER DEFINIEREN ###
Type bakterium ;Eine Bakterie
   ;### NICHT-STATISCHE VARIABLEN ###
   Field x#,y# ;Position
   Field xold#,yold# ;Position von vor einem Frame.
   Field xspeed#,yspeed# ;Geschwindigkeit
   
   Field health# ;Gesundheit des Bakteriums. Sinkt es auf KillHealth, stirbt das Bakterium.
   
   Field genom$ ;Ihr momentanes Genom
   Field genom_changes ;Die Veränderungen am Genom
   
   Field timer_genomrepair ;Der Reperatur-Timer. Zählt bis genom_repairtime*10 hoch
   ;#################################
   
   ;### STATISCHE VARIABLEN ###
   Field shape_edges ;Die Anzahl der Kanten der Form des Bakteriums
   Field shape_edgeX[Shape_MaxEdges] ;Die Position der Kanten der Form des Bakteriums
   Field shape_edgeY[Shape_MaxEdges]
   Field shape_color_r,shape_color_g,shape_color_b ;Die Farbe des Bakteriums
   
   Field img ; Vorberechnetes Bild zum Line-Sparen.
   
   Field genom_repairtime ;Die Zeitabstand / 10, in dem das Genom repariert wird
   Field genom_protection ;Der "Schutz" des Genoms. Je höher, desto seltener Mutiert es.
   Field genom_repairchance ;Die Chance zur Reperatur eines Gens. Je höher, desto höher die Erfolgschance.
   
   Field health_fotosynth ;Die Effizienz der Fotosynthese. In Health pro Zyklus / 100
   Field health_eat ;Die Effizienz des Fressens. In Health pro Zyklus / 25
   
   Field reproductionrate ;Die Vermehrungsrate. Je höher, desto schneller vermehrt sich das Bakterium
   
   Field genom_orig$ ;Das Genom bei geburt der Bakterie
   ;###########################
End Type
;##############################


;### INITIALISIEREN ###

RndEnviron()

CreateBakterium(200,100,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001110 000 00001111")
CreateBakterium(400,500,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 1100100 00001011  00001100 0 00001101  00001110 000000000000000000000000 00001111")
CreateBakterium(200,140,100,"00000000 0100 0100 00000001  00000000 1100 0100 00000001  00000000 1100 1100 00000001  00000000 0100 1100 00000001  00000010 1100100 00000011  00000100 1010 00000101  00000110 0101 00000111  00001000 110010 00001001  00001010 0 00001011  00001100 1100100 00001101  00001110 111111111111111111111111 00001111")


;######################


;### HAUPTSCHLEIFE ###
Repeat
   Cls
   
   DrawEnviron()
   UpdateBakterien() ;Bakterien berechnen
   count = CountBakterien()
   If count>MaxBakterien And AutoClear=1 Then ClearArea()
   If KeyHit(57) Then ClearArea()
   Text 100,100,count
   
   ;WaitTimer(zeittakt)
   Flip 0
Until KeyHit(1)
;#####################
End


;### FUNKTIONEN ###
Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen
   b.bakterium=New bakterium
   b\xspeed#=0 ;Geschwindigkeit
   b\yspeed#=0
   b\health#=health#
   b\genom$=Replace(genom$," ","") ;Genom festlegen
   b\genom_orig$=b\genom$
   ParseDNA(Handle(b)) ;Genom interpretieren
   b\x   = 10
   b\y   = 10
   b\img = CreateImage(60,60)
   SetBuffer ImageBuffer(b\img)
   DrawBakterium(Handle(b))
   SetBuffer BackBuffer()
   b\x#=x ;Position
   b\y#=y
   Return Handle(b) ;Handle zurückgeben
End Function

Function DeleteBakterium(hndl)
   b.bakterium=Object.bakterium(hndl)
   FreeImage b\img
   Delete b.bakterium
End Function

Function KillBakterium(hndl)
   DeleteBakterium(hndl)
End Function

Function UpdateBakterien() ;Bakterien berechnen
   For b.bakterium=Each bakterium ;Bakterien durchgehen
       If Rand(25) = 10
         SetBuffer ImageBuffer(b\img)
         Cls
         DrawBakterium(Handle(b))
         SetBuffer BackBuffer()
      End If
      ;Temporär: Speedberechnung. Sollte noch ausgetauscht werden!
      If b\health_eat>10 Then
         tmphndl=GetPreyBakterium(Handle(b),200)
         If tmphndl<>-1 Then
            temp.bakterium=Object.bakterium(tmphndl)
            b\xspeed#=(temp\x#-b\x#)-b\xspeed#;/200
            b\yspeed#=(temp\y#-b\y#)-b\yspeed#;/200
         End If
      End If
      b\xspeed#=b\xspeed#+Rnd(-0.5,0.5)
      b\yspeed#=b\yspeed#+Rnd(-0.5,0.5)
      If b\xspeed#>1 Then b\xspeed#=1
      If b\xspeed#<-1 Then b\xspeed#=-1
      If b\yspeed#>1 Then b\yspeed#=1
      If b\yspeed#<-1 Then b\yspeed#=-1
       
      ;Kollisionsüberprüfung
      If Rand(3)=2
       For bc.bakterium=Each bakterium
         If Handle(bc)<>Handle(b) Then
            If BakteriumsCollide(Handle(b),Handle(bc)) Then
            ;   b\x#=b\xold#
            ;   b\y#=b\yold#
               b\xspeed#=(b\x#-bc\x#);-b\xspeed#
               b\yspeed#=(b\y#-bc\y#);-b\yspeed#
            End If
         End If
        Next
     EndIf
       
      ;Bewegung
      b\xold#=b\x#
      b\yold#=b\y#
      b\x#=b\x#+b\xspeed#
      b\y#=b\y#+b\yspeed#
      
      If resources(b\x/32,b\y/32,0) > 1
         resources(b\x/32,b\y/32,0) = resources(b\x/32,b\y/32,0) - 1
         resources(b\x/32,b\y/32,1) = resources(b\x/32,b\y/32,1) + 1
         If Not (b\health_fotosynth>10 And resources(b\x/32,b\y/32,1) < 10)
            b\health = b\health + .3
         EndIf
      Else
         b\health = b\health - .5
      EndIf
       
      ;Fotosynthese
      If b\health_fotosynth>5 Then
         If b\health_fotosynth/100<=MaxFotoSynth# Then
         If resources(b\x/32,b\y/32,1) > 1
               b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(120))
            resources(b\x/32,b\y/32,0) = resources(b\x/32,b\y/32,0)+Float(Float(b\health_fotosynth)/20.00)
            resources(b\x/32,b\y/32,1) = resources(b\x/32,b\y/32,1)-Float(Float(b\health_fotosynth)/20.00)
         EndIf
         End If
      ;   Color 0,255,0
      ;   Rect b\x#,b\y#,2,2,1
      End If
       
      ;Fressen
      If b\health_eat>5 And Rand(10)=4 Then
         tmphndl=GetPreyBakterium(Handle(b),MaxEatRange) ;GetPreybakterium durch Genetisch bedingte Fressvorlieben ersetzen
         If tmphndl<>-1 Then
            temp.bakterium=Object.bakterium(tmphndl)
            temp\health#=temp\health#-Float(Float(b\health_eat)/Float(30))
            b\health#=b\health#+Float(Float(b\health_eat)/Float(30))
         End If
      ;   Color 255,0,0
      ;   Rect b\x#,b\y#+2,2,2,1
      End If
       
      If b\health#>MaxHealth Then b\health#=MaxHealth
       
      ;Genombeschädigung durch "Umwelteinflüsse" und Stoffwechsel
      If Rand(0,b\genom_protection)=0 Then
         ;Zu beschädigende Position aussuchen:
         dpos=Rand(1,Len(b\genom$))
         ;Genom$ aufteilen:
         gs1$=Left(b\genom$,dpos)
         gs2$=Right(b\genom$,Len(b\genom$)-dpos)
         ;Wert am Ende des ersten Genom-Teils löschen
         gs1$=Left(gs1$,Len(gs1$)-1)
         ;...und einen beliebigen anderen Wert eintragen
         d$=Str(Rand(0,3))
         If d$="2" Then d$=""
         If d$="3" Then d$=Str(Bin(Rand(0,3)))
         gs1$=gs1$+d$
         ;Und zu guter letzt die DNA wieder zusammenfügen:
         b\genom$=gs1$+gs2$
         b\genom_changes=b\genom_changes+1
      End If
       
      b\timer_genomrepair=b\timer_genomrepair+1 ;Genomreperatur
      If b\timer_genomrepair>=(b\genom_repairtime*10) Then
         ;b\genom$=b\genom_orig$
         For rpos=1 To Len(b\genom_orig$) ;Genom durchgehen
            ;Genom aufteilen:
            gs1$=Left(b\genom$,rpos)
            gs2$=Right(b\genom$,Len(b\genom$)-rpos)
            If gs2$="" Then gs2$=" "
            If gs1$="" Then gs1$=" "
            ;Letzte Stelle abfragen:
            tpg$=Right(gs1$,1)
            tpog$=Mid(b\genom_orig$,rpos,1)
            ;Vergleichen und mit festgelegter Erfolgsquote reparieren
            If tpg$<>tpog$ Then
               If Rand(0,b\genom_repairchance)>0 Then
                  b\genom_changes=b\genom_changes-1
                  gs1$=Left(gs1$,Len(gs1$)-1)
                  gs1$=gs1$+tpog$
               End If
            End If
            ;DNS wieder zusammensetzen
            b\genom$=gs1$+gs2$
         Next
         b\timer_genomrepair=0
      End If
       
   ;   ParseDNA(Handle(b)) ;War mal zu testzwecken drin. Veranschaulichung der Mutation
       
       
      If Rand(-ReproduceDelay,b\reproductionrate)>0 And b\health>70 Then
      CreateBakterium(b\x#,b\y#,b\health#/2,B\genom$)
         b\health#=b\health#/1.5
      End If
       
      killed=0
      ;Bei unzulässigen Werten wird das Bakterium getötet
      If killed=0 Then If b\shape_edges<=2 Then KillBakterium(Handle(b)) : killed=1 ;Unvollständige Form
      ;und bei zu extremer DNA-Veränderung auch
      If killed=0 Then If b\genom_changes>Genom_MaxChanges Then KillBakterium(Handle(b)) : killed=1
      ;und wenn es dem Bakterium nicht gut geht
      If killed=0 Then If b\health#<=KillHealth Then KillBakterium(Handle(b)) : killed=1
      ;...oder zu gut. Dann muss es sich nämlich um irgendeine Art von DNA-Fehler handeln. Und Fehlerhafte DNA stirbt aus.
   If killed=0 Then If b\reproductionrate > 200 Then KillBakterium(Handle(b)) : killed=1     
;If killed=0 Then If b\health#>MaxHealth Then KillBakterium(Handle(b)) : killed=1
      ;und auch, wenns aus dem Testfeld läuft
      If killed=0 Then If b\x#<0 Or b\x#>RES_X Or b\y#<0 Or b\y#>RES_Y Then KillBakterium(Handle(b)) : killed=1
       
      If killed=0 Then DrawImage b\img,b\x,b\y;DrawBakterium(Handle(b)) ;Bakterium zeichnen
       
   Next
   Return 1
End Function

Function GetPreyBakterium(hndl,rng)
   b.bakterium=Object.bakterium(hndl)
   For temp.bakterium=Each bakterium
      If temp<>b Then
         tmpabs=((b\x#-temp\x#)^2+(b\y#-temp\y#)^2)
         If tmpabs<(rng^2) And temp\genom_orig$<>b\genom_orig$ Then
            Return Handle(temp)
         End If
      End If
   Next
   Return -1
End Function

Function DrawBakterium(hndl) ;Bakterium zeichnen
   b.bakterium=Object.bakterium(hndl) ;Bakterium anhand des Handles auswählen
   
   Color 255-b\shape_color_r,255-b\shape_color_g,255-b\shape_color_b
   For dloop=1 To b\shape_edges
      Line 30+b\shape_edgeX[dloop]*b\health#/100,30+b\shape_edgeY[dloop]*b\health#/100,30+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100,30+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100
   Next
   Color 255,255,255
   ;Text b\x#,b\y#,b\health#
   
   Return 1
End Function


Function ParseDNA(hndl) ;Genom interpretieren
   b.bakterium=Object.bakterium(hndl) ;Bakterium anhand seines Handles auswählen
   
   ;Variablen nullen, falls nicht genullt
   b\shape_edges=0
   b\genom_repairtime=0
   
   For ploop=1 To Len(b\genom$) Step DNA_StartLength ;Genom durchgehen
      startsearch$=Mid(b\genom$,ploop,DNA_StartLength) ;...und dabei jedesmal DNA_StartLength Zeichen von der jetzigen Position aus einlesen
      Select startsearch$ ;Inhalt auf übereinstimmung mit Lesemarken prüfen.
       
      Case DNA_Shape_Edge_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Shape_Edge_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         xtempbin$=Mid(resultbinary$,1,(Len(resultbinary$)/2)) ;Koordinate in X und Y aufteilen
         ytempbin$=Mid(resultbinary$,(Len(resultbinary$)/2+1),-1)
         If xtempbin$="" Then xtempbin$="0"
         If ytempbin$="" Then ytempbin$="0"
         ;Aus der ersten Zahl as Vorzeichen auslesen:
         vorzeichen$=Left(xtempbin$,1)
         xtempbin$=RSet$(xtempbin$,Len(xtempbin$)-1)
         If vorzeichen$=NegativeStr$ Then xtemp=-BinToDezi(xtempbin$)
         If vorzeichen$=PositiveStr$ Then xtemp=BinToDezi(xtempbin$)
         vorzeichen$=Left(ytempbin$,1)
         ytempbin$=RSet$(ytempbin$,Len(ytempbin$)-1)
         If vorzeichen$=NegativeStr$ Then ytemp=-BinToDezi(ytempbin$)
         If vorzeichen$=PositiveStr$ Then ytemp=BinToDezi(ytempbin$)
         If xtemp<-Shape_MaxEdgeEntf Then xtemp=-Shape_MaxEdgeEntf
         If xtemp>Shape_MaxEdgeEntf Then xtemp=Shape_MaxEdgeEntf
         If ytemp<-Shape_MaxEdgeEntf Then ytemp=-Shape_MaxEdgeEntf
         If ytemp>Shape_MaxEdgeEntf Then ytemp=Shape_MaxEdgeEntf
         ;fertig interpretiertes Ergebnis eintragen
         b\shape_edges=b\shape_edges+1
         If b\shape_edges>Shape_MaxEdges Then b\shape_edges=Shape_MaxEdges
         b\shape_edgeX[b\shape_edges]=xtemp
         b\shape_edgeY[b\shape_edges]=ytemp
       
      Case DNA_Genom_Repairtime_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Repairtime_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_repairtime=resultdezi
         
      Case DNA_Genom_Protection_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Protection_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_protection=resultdezi
         
      Case DNA_Genom_Repairchance_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Genom_Repairchance_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\genom_repairchance=resultdezi
       
      Case DNA_Reproductionrate_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Reproductionrate_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\reproductionrate=resultdezi
       
      Case DNA_Health_Fotosynth_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Health_Fotosynth_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\health_fotosynth=resultdezi
       
      Case DNA_Health_Eat_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Health_Eat_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         resultdezi=BinToDezi(resultbinary$)
         ;fertig interpretiertes Ergebnis eintragen
         b\health_eat=resultdezi
         
      Case DNA_Shape_Color_Start$ ;Lesemarke DNS_Shape_Edge_Start$
         tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen
         For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen
            temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen
            If temp$=DNA_Shape_Color_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen
               tempnumend=ploop2 ;Endposition speichern
               ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden
               Exit
            End If
         Next
         resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen
         Repeat
            resultbinary$=resultbinary$+"0"
         Until Len(resultbinary$)>=3
         rtempbin$=Mid(resultbinary$,1,Ceil(Len(resultbinary$)/3)) ;Wert in R,G und B aufteilen
         gtempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3),Ceil(Len(resultbinary$)/3))
         btempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3*2),-1)
         If rtempbin$="" Then rtempbin$=" "
         If gtempbin$="" Then gtempbin$=" "
         If btempbin$="" Then btempbin$=" "
         rtempdezi=BinToDezi(rtempbin$)
         gtempdezi=BinToDezi(gtempbin$)
         btempdezi=BinToDezi(btempbin$)
         If rtempdezi>255 Then rtempdezi=255
         If gtempdezi>255 Then gtempdezi=255
         If btempdezi>255 Then btempdezi=255
         ;fertig interpretiertes Ergebnis eintragen
         b\shape_color_r=rtempdezi
         b\shape_color_g=gtempdezi
         b\shape_color_b=btempdezi
       
      End Select
   Next
   
   Return 1
End Function


Function BinToDezi(binary$)
   For i=1 To Len(binary$) ;Binäres Ergebnis in Dezimale Zahl umformen
      If Mid$(binary$,i,1)="1" Then result=result+2^(Len(binary$)-i)
   Next
   Return result
End Function


Function Shape_NormalizeEdgeNum(hndl,num)
   b.bakterium=Object.bakterium(hndl)
   
   Repeat
      If num>b\shape_edges Then num=num-b\shape_edges
      If num<1 Then num=num+b\shape_edges
   Until num<=b\shape_edges And num>=1
   
   Return num
End Function

Function BakteriumsCollide(hndl,hndl2)
   If hndl=hndl2 Then Return 0
   
   b1.bakterium=Object.bakterium(hndl)
   b2.bakterium=Object.bakterium(hndl2)
   
   If ((b1\x-b2\x)^2+(b1\y-b2\y)^2) < 50 Then Return 1

   Return 0
End Function

Function Lines_Intersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#)
   Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#)
   Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#)

   If Rd# = 0
       
      ; Lines are parralel.

      ; If Rn# is also 0 then lines are coincident.  All points intersect.
      ; Otherwise, there is no intersection point.
   
      Return False
   
   Else
   
      ; The lines intersect at some point.  Calculate the intersection point.
   
                Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#)

      Intersection_AB# = Rn# / Rd#
      Intersection_CD# = Sn# / Rd#
      If Intersection_AB#<0 Or Intersection_AB#>1 Then Return False
      If Intersection_CD#<0 Or Intersection_CD#>1 Then Return False

      Intersection_X# = Ax# + Intersection_AB#*(Bx#-Ax#)
      Intersection_Y# = Ay# + Intersection_AB#*(By#-Ay#)
         
      Return True
       
   EndIf
End Function

Function ClearArea()
;   tmp$=GetSuccessGenom$()
;   KillAll()
;   CreateBakterium(300,200,100,tmp$)
   tmp1$=GetRandomGenom$()
   tmp2$=GetRandomGenom$()
   tmp3$=GetRandomGenom$()
   tmp4$=GetRandomGenom$()
   KillAll()
   CreateBakterium(150,100,100,tmp1$)
   CreateBakterium(450,100,100,tmp2$)
   CreateBakterium(150,300,100,tmp3$)
   CreateBakterium(450,300,100,tmp4$)
End Function

Function KillAll()
   For b.bakterium=Each bakterium
      KillBakterium(Handle(b))
   Next
End Function

Function GetRandomGenom$()
   Local gtemp$[10000]
   For b.bakterium=Each bakterium
      gnum=gnum+1
      gtemp[gnum]=b\genom_orig$
   Next
   Return gtemp[Rand(1,gnum)]
End Function

Function GetSuccessGenom$()
   Local gtemp$[10000]
   Local gsuccess[10000]
   gnum=0
   For b.bakterium=Each bakterium
      If gnum>0 Then
         For gloop=1 To gnum
            If b\genom_orig$=gtemp[gloop] Then gsuccess[gloop]=gsuccess[gloop]+1 : gfound=1
         Next
      End If
      If gfound=0 Then
         gnum=gnum+1
         gtemp[gnum]=b\genom_orig$
         gsuccess[gnum]=1
      End If
   Next
   For gloop=1 To gnum
      If gsuccess[gnum]>bestsuccess Then
         bsnum=gloop
         bestsuccess=gsuccess[gnum]
      End If
   Next
   Return gtemp[bsnum]
End Function


Function CountBakterien()
   For b.bakterium=Each bakterium
      num=num+1
   Next
   Return num
End Function
;##################


Function RndEnviron()
   For x = 0 To res_x/32
      For y = 0 To res_y/32
         Resources(x,y,0) = Rnd(100,200)
         Resources(x,y,1) = Rnd(100,200)
      Next
   Next
End Function

Function DrawEnviron()
   For x = 1 To res_x/32
      For y = 1 To res_y/32
         g = resources(x,y,0)
         r = resources(x,y,1)
         If g > 255 Then g = 255
         If g < 0 Then g = 0
         If r > 255 Then r = 255
         If r < 0 Then r = 0
         Color r/2,g/2,0
         Rect x*32-32,y*32-32,32,32
      Next
   Next
End Function
MrKeks.net

Lord_Vader

BeitragDi, Jan 11, 2005 22:10
Antworten mit Zitat
Benutzer-Profile anzeigen
Eindeutig ein kleines meisterwerk. Klasse gemacht Inarie!
 

Edlothiol

BeitragMi, Jan 12, 2005 15:36
Antworten mit Zitat
Benutzer-Profile anzeigen
Ja, wirklich gut. Ich hatte grade eine riesige Kolonie kleiner weißer Dreiecke, die Fotosynthese betrieben. Dann kamen von oben blaue Striche, die sich durch die Dreiecksansammlungen gefressen haben Smile
 

Scorp.ius

BeitragDo, Jan 13, 2005 21:23
Antworten mit Zitat
Benutzer-Profile anzeigen
also ich hatte gerade eine art, die wohl irgendwie sehr erfolgreich war, ich musste das programm schließlich abbrechen, da ich bereits über 1500 von denen auf dem schrim hatte und es zwischen zwei bildern ca. 5 sekunden dauerte Shocked


schickes Program

ich hatte sowas auch mal vor (damals noch auf dem Amiga mit AMOS-Basic), leider habe ich es nicht so richtig hinbekommen, vielleicht probiere ich es ja mal wieder Smile
 

ke^kx

BeitragDo, Jan 13, 2005 21:47
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich glaub ich hatte so ähnliche, die haben mit jedem Schleifendurchlauf so um 100 zugenommen Shocked

cooles Proggramm,
Jiriki
http://i3u8.blogspot.com
Asus Striker II
Intel Core2Quad Q9300 @ 2,5 GHz (aber nur zwei Kerne aktiv aufgrund der Instabilität -.-)
Geforce 9800 GTX
2GB RAM

Ebola33

BeitragFr, Jan 14, 2005 7:33
Antworten mit Zitat
Benutzer-Profile anzeigen
Mein lieber Schwarm,
user posted image

Am Anfang waren die weissen dominant und haben sich vermehrt wie die Fliegen. Bis die roten kamen die zum Schluss alles vertilgt haben*gg*
Geiles Programm.
ansteckend... Wink
verstaubtes Projekt : http://www.mitglied.lycos.de/ebola33/

Gehe zu Seite 1, 2  Weiter

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group