DataMuseum.dk

top - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »YLIFE«

└─⟦45bd0f8dd⟧ Bits:30000464 DOMUS disk image
    └─ ⟦this⟧ »/YLIFE« 
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image
    └─ ⟦this⟧ »/YLIFE« 
└─⟦a2e222af0⟧ Bits:30001626 DOMUS disk image
    └─ ⟦this⟧ »/YLIFE« 

TextFile

CONST
TX1='<10>*** L I F E ***<10><0>',
TX2='RANDOM ? <0>',
TX3='LE ? <0>',
TX4='LI ? <0>',
TX5='<10>NO OF GENERATIONS ? <0>',
TX6='OUT ? <0>',
TX7='DELAY ? <0>',
TX8='XYADDR ? <0>',
TX9='XOLD ? <0>',
TX10='POS ? <0>',
TX11='X <0>',
TX12='Y <0>',
TXST='*<0>',
TFF='<12><0>',
CRLF='<13><10>';

VAR
LINE	: STRING(6);
OPSTR	: STRING(6);
M,M0	: STRING(2000);
B	: STRING(4000);
LE,LI	: INTEGER;
I,J,C	: INTEGER;
PERIODS	: INTEGER;
X,Y	: INTEGER;
XY,XYSW	: INTEGER;
MAX	: INTEGER;
GEN,GENEND: INTEGER;
CEND	: INTEGER;
CHAR	: INTEGER;

OUT:	FILE'LPT',1,1,4000,U
	OF STRING(4000);

PROCEDURE CHECK(VAR M:STRING(1);VAR M0:STRING(1);
		VAR LE:INTEGER;VAR C:INTEGER;VAR B:STRING(1));
CODEBODY;

PROCEDURE RANDOM(VAR XN:INTEGER);
CODEBODY RANDM;

PROCEDURE DELAY(VAR PERIODS:INTEGER);
CODEBODY P0023;

PROCEDURE IN;
BEGIN
  OPWAIT(MAX); OPSTR:=LINE; OPIN(LINE);
  IF BYTE OPSTR = 27 THEN GOTO 1;
  DECBIN(OPSTR,I);
END;

PROCEDURE CCONV;
BEGIN
  IF CHAR <= 32 THEN CHAR:=CHAR+96
  ELSE
  IF CHAR <= 64 THEN CHAR:=CHAR+32
  ELSE
  IF CHAR <= 80 THEN CHAR:=CHAR-32;
END;

PROCEDURE OUTXY;
BEGIN
  INSERT(0,OPSTR,3);
  INSERT(6,OPSTR,0);
  IF X > 80 THEN X:=X-80;
  IF X < 0 THEN X:=X+80;
  CHAR:=X; CCONV;
  INSERT(CHAR,OPSTR,1);
  IF Y > 25 THEN Y:=Y-25;
  IF Y < 0 THEN Y:=Y+25;
  CHAR:=Y; CCONV;
  INSERT(CHAR,OPSTR,2);
  OPMESS(OPSTR);
END;


BEGIN
  OPIN(LINE);
  OPMESS(TX1);
  OPMESS(TX6); IN;
  MOVE(OPSTR,0,OUT.ZNAME,0,MAX-1);
1:
  OPMESS(TX5); IN; GENEND:=I;
  REPEAT
    OPMESS(TX4); IN; LI:=I;
    OPMESS(TX3); IN; LE:=I
  UNTIL LI*LE <= 2000;
  OPMESS(TX7); IN; PERIODS:=I;
  OPMESS(TX8); IN;
  IF BYTE OPSTR = 89 THEN XYSW:=1 ELSE XYSW:=0;

  OPEN(OUT,3);
  
  I:=0;
  REPEAT
    INSERT(32,M0,I);
    I:=I+1
  UNTIL I=LE*LI;

  XY:=0;
  OPMESS(TX2); IN;
  IF BYTE OPSTR = 89 THEN		! RANDOM !
  BEGIN
    OPMESS(TX9); IN; X:=I;
    OPMESS(TX10); IN;
    IF I=0 THEN
    BEGIN
      I:=LE+1;
      REPEAT
	RANDOM(X);
        IF X AND 1 <> 0 THEN INSERT(42,M0,I);
        IF I = (I/LE+1)*LE-2 THEN I:=I+2;
        I:=I+1
      UNTIL I >= LE*LI-LE-1;
    END ELSE
    BEGIN
      Y:=LE*(LI-1)-2;
      IF I >= (LE-2)*(LI-2) THEN I:=(LE-2)*(LI-2)-1;
      J:=0;
      REPEAT
        REPEAT
          RANDOM(X);
	  CHAR:=X-X/Y*Y
        UNTIL CHAR > LE;
        IF CHAR-CHAR/LE*LE <> 0 THEN 
        IF (CHAR+1)-(CHAR+1)/LE*LE <> 0 THEN
        BEGIN
          MOVE(M0,CHAR,OPSTR,0,1);
          IF BYTE OPSTR <> 42 THEN
          BEGIN
	    INSERT(42,M0,CHAR);
	    J:=J+1;
          END;
        END
      UNTIL J = I;
    END;
  END ELSE
  BEGIN
    IF XYSW = 0 THEN
    BEGIN
      REPEAT
        OPMESS(TX11); IN; X:=I;
        OPMESS(TX12); IN;
        I:=LE*I+X;
        INSERT(42,M0,I)
      UNTIL I = 0;
      INSERT(32,M0,0);
    END ELSE
  BEGIN
      OPMESS(TFF); IN; I:=I-I/9*9; X:=0; Y:=0;
      REPEAT
        IF BYTE OPSTR = 10 THEN Y:=Y+1;
        IF BYTE OPSTR = 8 THEN X:=X-1;
        IF BYTE OPSTR = 19 THEN
        BEGIN
          INSERT(42,M0,LE*Y+X);
          OPMESS(TXST);
          X:=X+1;
        END;
        IF BYTE OPSTR = 24 THEN X:=X+1;
        IF BYTE OPSTR = 26 THEN Y:=Y-1;
	OUTXY;
        IN
      UNTIL BYTE OPSTR = 13;
    END;
  END;
  OPMESS(TFF);
  
  M:=M0; CEND:=0;
  GEN:=0;
  REPEAT
    IF XY = 0 THEN
    BEGIN
    J:=1;  I:=0;
    PUTREC(OUT,(LE+2)*LI);
    INSERT(29,OUT^,0);
    REPEAT
      MOVE(M,I,OUT^,J,LE);
      J:=J+LE;
      MOVE(CRLF,0,OUT^,J,2);
      I:=I+LE;
      J:=J+2
    UNTIL I >= LE*LI;
    TRANSFER(OUT,(LE+2)*LI,3);
    END ELSE
    BEGIN
      PUTREC(OUT,C);
      MOVE(B,0,OUT^,0,C);
      TRANSFER(OUT,C,3);
      END;

    CHECK(M,M0,LE,C,B);
    IF C-C/16*16 = 0 THEN CEND:=CEND+1 ELSE CEND:=0;
    MOVE(M0,0,M,0,LE*LI));
    IF PERIODS > 0 THEN DELAY(PERIODS);
    WAITTRANSFER(OUT);
    IF XYSW = 1 THEN XY:=1;
    GEN:=GEN+1;
    IF OPTEST <> 0 THEN BEGIN IN; GENEND:=GEN; END;
    IF C = 0 THEN GENEND:=GEN;
    IF CEND = 6 THEN GENEND:=GEN
  UNTIL GEN=GENEND;
  CLOSE(OUT,1);
  X:=0; Y:=22; OUTXY;
  BINDEC(GEN,OPSTR); OPMESS(OPSTR);
  GOTO 1;
END;
«ff»
«nul»