|
|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC3600/RC7000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC3600/RC7000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - 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«
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»