S=15000; 
/********************************************************************/ 
/*                                                                  */ 
/*                    3-D Spiel des Lebens                          */ 
/*                                                                  */ 
/* geschrieben auf Atari 520ST+; RTOS Level 2,0                     */ 
/********************************************************************/ 
/*                                                                  */ 
/*     (c)                            05.Mai 1987                   */ 
/*     Stefan Seeboth                                               */ 
/*     Voelklingerstr. 9                                            */ 
/*                                                                  */ 
/*     4000 Duesseldorf                                             */ 
/*                                                                  */ 
/* DAS PROGRAMM STELLT EINE ERWEITERUNG DES ZWEIDIMENSIONALEN       */
/* ' SPIEL DES LEBENS ' DAR. JEDE ZELLE HAT JETZT NICHT MEHR NUR 8  */
/* NACHBARN SONDERN 26. EINE GENAUERE BESCHREIBUNG IST IM KOPF DES  */
/* PROGRAMMS.                                                       */
/********************************************************************/ 
/*                                                                  */ 
/* (siehe auch Spektrum der Wissenschaft Mai 1987)                  */ 
/*                                                                  */ 
/********************************************************************/ 
/*-L*/ 
/*                                                                  */ 
/*  Beschreibung:                                                   */ 
/*                                                                  */ 
/*  Das Programm stellt kleine Wurfel in dreidimensionaler          */ 
/*  Darstellung dar. Irgendwo im Rechner tickt nun die Uhr des      */ 
/*  Lebens ( 19 Sekunden + Zeichnen ) die jedes mal nach einer      */ 
/*  Generation schlaegt. Nun entscheidet sich nach festen Regeln    */ 
/*  welcher Wuerfel weiterlebt, welcher erwacht und welcher stirbt. */ 
/*  In diesem Fall ueberleben Wuerfel mit vier oder fuenf Nachbarn  */ 
/*  und an einer stelle die fuenf Nachbarn hat wird der Wuerfel     */ 
/*  aufgeweckt alle anderen sterben an Ueber oder Unterbevoelkerung.*/ 
/*                                                                  */ 
/*  Das Programm besitzt ein kleines Fantasiemuster am Start        */ 
/*  welches sich nach der 9.Generation in einen kleinen " Blinker " */ 
/*  verwandelt und so nun ewig weiterlebt.                          */ 
/*                                                                  */ 
/*  Nach entfernen des Vorgabemusters und entfernen der Bemerkungs- */ 
/*  sternchen an der im Programm bezeichneten Stelle (ab Zeile 171) */ 
/*  kann man auch mit Koordinateneingabe ein neues                  */ 
/*  Muster eingeben und oder sich ein neues Muster schreiben        */ 
/*  Bei eingehender Benutzung ist es aber vieleicht doch besser den */ 
/*  Artikel in der oben genannten Zeitschrift zu lesen, da dort     */ 
/*  auch einige Muster und Tricks beschrieben werden ( Gleiter,     */ 
/*  Blinker, Ball, Mauern etc.).                                    */ 
/*                                                                  */ 
/********************************************************************/ 


MODULE LIFE3D; 

SYSTEM; 

DIALOG: A1<->; 

PROBLEM; 

SPC DIALOG DATION INOUT ALPHIC CONTROL(ALL); 
SPC (SCRSET,SCRCHG,CLEAR,SPRITL,SPRITS) ENTRY GLOBAL; 
DCL AUSSCHALT (1,12) BIT (16); 
DCL AUSSCHNEU (1,12) BIT (16); 
DCL BILD CHAR (5);  /* VORBEREITUNG UM MIT ZWEI BILDERN ZU ARBEITEN */ 
                    /* DANN BLEIBT DER ZEICHENVORGANG UNSICHTBAR    */ 
DCL (XPOS,YPOS) FIXED; 
DCL NEUGENERATION (27,27,27) FIXED;  /* MAXIMALE ANZAHL IST 25 */ 
DCL ALTGENERATION (27,27,27) FIXED;  /*    "       "     "   " */ 

MALEN: PROC; 
  CALL SPRITL (XPOS,YPOS,12,12,BILD,AUSSCHALT); 
  FOR I FROM 1 TO 4 REPEAT 
    AUSSCHNEU(1,1).BIT(I)=AUSSCHALT(1,1).BIT(I); 
    AUSSCHNEU(1,12).BIT(I+8)=AUSSCHALT(1,12).BIT(I+8); 
  END; 
  FOR I FROM 1 TO 3 REPEAT 
    AUSSCHNEU(1,2).BIT(I)=AUSSCHALT(1,2).BIT(I); 
    AUSSCHNEU(1,11).BIT(I+9)=AUSSCHALT(1,11).BIT(I+9); 
  END; 
  FOR I FROM 1 TO 2 REPEAT 
    AUSSCHNEU(1,3).BIT(I)=AUSSCHALT(1,3).BIT(I); 
    AUSSCHNEU(1,10).BIT(I+10)=AUSSCHALT(1,10).BIT(I+10); 
  END; 
  AUSSCHNEU(1,4).BIT(1)=AUSSCHALT(1,4).BIT(1); 
  AUSSCHNEU(1,9).BIT(12)=AUSSCHALT(1,9).BIT(12); 
  CALL SPRITS (XPOS,YPOS,12,12,BILD,AUSSCHNEU); 
END; 

SEITE: PROC; 

  IF BILD EQ 'BILD1' THEN 
    BILD='BILD2'; 
  ELSE 
    BILD='BILD1'; 
  FIN; 
  CALL SCRSET (BILD); 
  CALL CLEAR; 
  CALL SCRCHG(BILD); 

  FOR I FROM 2 TO 26 REPEAT 
    FOR K FROM 2 TO 26 REPEAT 
      FOR L FROM 2 TO 26 REPEAT; 
        IF NEUGENERATION(I,K,L) EQ 1 THEN 
          XPOS=K*8+(30-I)*4; 
          YPOS=(28-L)*8+I*4; 
          CALL MALEN; 
        FIN; 
      END; 
    END; 
  END; 
END; 

LIFE: TASK; 

DCL EINGABE BIT; 
DCL (Z,Y,X) FIXED; 
DCL (HILF,ANZAHL,GESETZT,GENERATION)  FIXED; 
DCL UHR CLOCK; 
DCL DAUER DURATION; 
DCL SCHRIFT(15,112) BIT(16); 

  GENERATION=1; 
  ANZAHL=25*25*25; 
  EINGABE='1'B1; 

  FOR I FROM 1 TO 27 REPEAT 
    FOR K FROM 1 TO 27 REPEAT 
      FOR L FROM 1 TO 27 REPEAT 
        NEUGENERATION(I,K,L)=0; 
        ALTGENERATION(I,K,L)=0; 
      END; 
    END; 
  END; 

  CALL SCRSET('BILD1'); 
  CALL SCRSET('BILD2'); 

 /* DEFINITION DES WUERFELS DEN MAN SIEHT      */ 
 /* NUR DIE ERSTEN 12 PUNKTE WERDEN GEZEICHNET */ 

   AUSSCHNEU(1,1)='0000111111110000'B1; 
   AUSSCHNEU(1,2)='0001010010110000'B1; 
   AUSSCHNEU(1,3)='0010111101110000'B1; 
   AUSSCHNEU(1,4)='0101001011110000'B1; 
   AUSSCHNEU(1,5)='1111111111110000'B1; 
   AUSSCHNEU(1,6)='1000000111110000'B1; 
   AUSSCHNEU(1,7)='1000000111110000'B1; 
   AUSSCHNEU(1,8)='1000000111110000'B1; 
   AUSSCHNEU(1,9)='1000000111110000'B1; 
  AUSSCHNEU(1,10)='1000000111100000'B1; 
  AUSSCHNEU(1,11)='1000000111000000'B1; 
  AUSSCHNEU(1,12)='1111111110000000'B1; 



  /*  EIN FANTASIE-GEBILDE      */ 

  FOR K FROM 6 TO 15 REPEAT 
    FOR L FROM 6 BY 2 TO 20 REPEAT 
      FOR  I FROM 6 TO 10 REPEAT 
        NEUGENERATION(K,L,I)=1; 
      END; 
      FOR I FROM 10 BY 3 TO 20 REPEAT 
        NEUGENERATION(L,I,K)=1; 
      END; 
    END; 
  END; 


/*******************************************************************/ 
/*                                                                 */ 
/*   DIREKTE EINGABE DER WUERFEL MIT KOORDINATEN                   */ 
/*                                                                 */ 
/*******************************************************************/ 
/*WHILE EINGABE REPEAT                                             */ 
/*  CALL SCRCHG('MAIN');                                           */ 
/*  PUT ' GEBEN SIE Z,X,Y KOORDINATE DES ZU SETZENDEN ZELLE EIN!!  */ 
/*                      GRENZEN SIND 0 < ZAHL < 25 '               */ 
/*  TO DIALOG BY SKIP,A,SKIP;                                      */ 
/*  GET Z,X,Y FROM DIALOG;                                         */ 
/*  IF Z NE 0 THEN                                                 */ 
/*    NEUGENERATION(Z+1,Y+1,X+1)=1;                                */ 
/*  ELSE                                                           */ 
/*    EINGABE='0'B1;                                               */ 
/*  FIN;                                                           */ 
    CALL SEITE; 
/*END;                                                             */ 

  REPEAT 
    UHR=NOW; 
    GENERATION=GENERATION+1; 
    GESETZT=0; 
    FOR I FROM 2 TO 26 REPEAT 
      FOR K FROM 2 TO 26 REPEAT 
        FOR L FROM 2 TO 26 REPEAT 
          ALTGENERATION(I,K,L)=NEUGENERATION(I,K,L); 
          NEUGENERATION(I,K,L)=0; 
          IF (I EQ 2) OR (L EQ 2) OR (K EQ 2) OR (I EQ 26) 
          OR (K EQ 26) OR (L EQ 26) THEN 
            ALTGENERATION(I,K,L)=0; 
          FIN; 
        END; 
      END; 
    END; 
    FOR I FROM 2 TO 26 REPEAT 
      FOR K FROM 2 TO 26 REPEAT 
        FOR L FROM 2 TO 26 REPEAT 
          HILF=0; 
          FOR T FROM K-1 TO K+1 REPEAT 
            FOR R FROM L-1 TO L+1 REPEAT 
              HILF=HILF+ALTGENERATION(I-1,T,R); 
              HILF=HILF+ALTGENERATION(I+1,T,R); 
            END; 
          END; 
          FOR T FROM K-1 TO K+1 REPEAT; 
            HILF=HILF+ALTGENERATION(I,T,L-1); 
          END; 
          FOR T FROM K-1 TO K+1 REPEAT 
            HILF=HILF+ALTGENERATION(I,T,L+1); 
          END; 
          HILF=HILF+ALTGENERATION(I,K-1,L); 
          HILF=HILF+ALTGENERATION(I,K+1,L); 

/* NEUGEBURT EINER ZELLE **************************************/ 

          IF HILF EQ 5 THEN 
            NEUGENERATION(I,K,L)=1; 
            GESETZT=GESETZT+1; 
          FIN; 

/**************************************************************/ 

/* UEBERLEBEN EINER ZELLE *************************************/ 

          IF HILF EQ 4 AND 
          (ALTGENERATION(I,K,L) EQ 1) THEN 
            NEUGENERATION(I,K,L)=1; 
            GESETZT=GESETZT+1; 
          FIN; 

/****************************************************************/ 

        END; 
      END; 
    END; 
  CALL SEITE; 
  DAUER=UHR-NOW; 
  PUT GENERATION,'. GENERATION' TO DIALOG; 
  PUT 'MAXANZAHL = ',ANZAHL TO DIALOG BY (2)SKIP,A,LIST,SKIP; 
  PUT '   ANZAHL = ',GESETZT TO DIALOG; 
  PUT 'BENOETIGTE RECHENZEIT' TO DIALOG BY SKIP,SKIP,A,SKIP; 
  PUT DAUER TO DIALOG; 
  PUT TO DIALOG BY (3)SKIP; 
  CALL SPRITL(0,240,240,112,'MAIN',SCHRIFT); 
  CALL SPRITS(399,80,240,112,BILD,SCHRIFT); 
  END; 
END; 
MODEND;