fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Spiel des Lebens (Fenster + Grafisch) :-)

Uploader:	derDachs
Datum/Zeit:	07.03.2012 15:58:24
'Game of Life (Window-Graphics)

'------------

'eine Zelle hat 8 Nachbarn

'eine tote Zelle mit 3 Lebenden Nachbarn, wird in der nächsten Generation neugeboren

'Lebende mit weniger als 2 Nachbarn, sterben in der nächsten an Einsamkeit

'Lebende mit 2 oder 3, beleiben in der nächsten Gen lebend

'Zellen mit mehr als 3 Nachbarn, sterben



'dies ist ein EndlosFeld, Nachbarn die nicht im sichtbaren Bereich liegen, sind

'jene welche auf der gegenüberliegenden Seite sind.

'linker Nachbar von Zelle(0,0) ist (19,0) bei Feldgrösse 20





'Author: Dennis Briese

#Include "windows.bi"





    '==> Taste Escape zum Beenden und Enter für Neustart







Declare Sub welt_initialisieren(ByRef pGen As Byte Ptr)

Declare Sub zeichne_welt(ByRef pGen As Byte Ptr)

Declare Sub naechsteGen(ByRef pAktGen As Byte Ptr, ByRef pNeuGen As Byte Ptr)

Declare Function anzNachbarn(ByRef pGen As Byte Ptr, Index As Integer) As Integer





#Define SPEED 1

#Define FELDWEITE 15 'hier Experimentieren mit Weltgrösse

#Define ZELLABSTAND 2



Const As Integer ANZZELLEN = FELDWEITE^2





Dim taste   As String

Dim pAktGen As Byte Ptr

Dim pNeuGen As Byte Ptr



pAktGen = Callocate(ANZZELLEN-1,Len(Byte))

pNeuGen = Callocate(ANZZELLEN-1,Len(Byte))







    Screen 19,8,8,0

    ScreenSet 0,1

    Color 0,3

    cls

    welt_initialisieren(pAktGen)



    Do



        taste = InKey



        Sleep 100 \ SPEED



        zeichne_welt(pAktGen)

        naechsteGen(pAktGen,pNeuGen)



        Swap pAktGen,pNeuGen

        SCREENSYNC

        PCOPY



        If taste = Chr(13) Then welt_initialisieren(pAktGen)





    Loop Until (taste = Chr(27)) Or (taste = Chr(255)+"k")



    End



'**********************************************************************



'funktionen



Sub welt_initialisieren(ByRef pGen As Byte Ptr)

    Dim i As Integer = 0

    Dim r As Integer

    Randomize Timer

    Do Until i = ANZZELLEN

        r=Int(Rnd*100)+1

        pGen[i]=IIf(r<50,0,1)

        i=i+1

    Loop

End Sub



Sub zeichne_welt(ByRef pGen As Byte Ptr)

    Dim i As Integer = 0

    Dim As Integer x,y,r,r1,d,c



    d=590\(FELDWEITE)  'radius aus kleinerer Bildschirmgrösse

    r=d/2

    r1=(d/2)-ZELLABSTAND

    Do Until i = ANZZELLEN

        x = i Mod FELDWEITE

        y = i \ FELDWEITE

        c = IIf(pGen[i]=1,15,3)



        Line    (x*d,y*d)-(x*d+d,y*d+d),15,B

        Circle(x*d+r,y*d+r),r1,c

        Paint   (x*d+r,y*d+r),c,c



        i+=1

    Loop

End Sub



Sub naechsteGen(ByRef pAktGen As Byte Ptr, ByRef pNeuGen As Byte Ptr)

    Dim i As Integer = 0

    Dim As Integer x,y,nb,akt

    Do Until i = ANZZELLEN



        nb = anzNachbarn(pAktGen,i)

        akt = pAktGen[i]



        pNeuGen[i]=akt



        If (akt=0) And (nb=3) Then pNeuGen[i]=1

        If (akt=1) And (nb<2) Then pNeuGen[i]=0

        If (akt=1) And (nb>3) Then pNeuGen[i]=0



        i=i+1

    Loop

End Sub



Function anzNachbarn(ByRef pGen As Byte Ptr,Index As Integer) As Integer

    Dim As Integer x,y,lx,rx,oy,uy,nb



    x = index Mod FELDWEITE

    y = index \ FELDWEITE



    lx =  x-1

    rx = (x+1) Mod FELDWEITE

    oy =  y-1

    uy = (y+1) Mod FELDWEITE



    If lx < 0 Then lx = FELDWEITE-1

    If oy < 0 Then oy = FELDWEITE-1





    nb = pGen[ y * FELDWEITE + lx] + pGen[ y * FELDWEITE + rx] 'Nachbar links und rechts

    nb+= pGen[oy * FELDWEITE +  x] + pGen[uy * FELDWEITE +  x] 'Nachbar oben und unten

    nb+= pGen[oy * FELDWEITE + lx] + pGen[uy * FELDWEITE + lx] 'links oben, links unten

    nb+= pGen[oy * FELDWEITE + rx] + pGen[uy * FELDWEITE + rx] 'rechts oben, rechts unten



    Return nb

End Function