Не удивляйтесь, программа начинается и кончается по нынешним меркам внезапно (но с обоих концов логично, так что, по всей видимости, ничего не утрачено).
ERASE->CUCHOUT; VARS MYLIST FORCEMOVES LINES POINTS OWNER LENS USEDPTS BOARD A1 LINEO THISLINE COUNT1 COUNT2 X3 X2 COUNT3 X1 A3 A2 COUNT SCALE RANSEED FORMLINES GETSPACE MOVEVALUE VALUES TESTFORCE FREEPT FINDL UNMOVE UNWRAP MOVEIT HISMOVE PRINTBOARD MYITEMREAD CNTFOR; FUNCTI SETUP;VARS X; INIT(64)->BOARD; INIT(64)->USEDPTS; INIT(76)->LENS;INIT(76)->OWNER; INIT(64)->POINTS; 76->X; L1: 4->SUBSCR(X,LENS); 0->SUBSCR(X,OWNER); IF X<65 THEN INIT(8)->SUBSCR(X,POINTS); 1->SUBSCR(X,USEDPTS); 0->SUBSCR(X,BOARD) CLOSE; X-1->X; IF X>0 THEN GOTO L1 CLOSE; INIT(76)->LINES; .FORMLINES; NIL->FORCEMOVES; 0->MYLIST; END; FUNCTI MOVE X A B;VARS T U V W Y Z; SUBSCR(X,POINTS)->Y; 1->Z;0->U; IF B THEN .GETSPACE->T; CLOSE; L1: SUBSCR(Z,Y)->W; IF W<0 THEN IF B THEN T;X CLOSE; 0->SUBSCR(X,USEDPTS); U EXIT; SUBSCR(W,LENS)->V; IF B THEN V+SUBSCR(W,OWNER)->SUBSCR(Z,T) CLOSE; IF SUBSCR(W,OWNER)=0 THEN IF V=0 THEN GOTO L2 CLOSE; A->SUBSCR(W,OWNER);3->SUBSCR(W,LENS); ELSEIF SUBSCR(W,OWNER)=A THEN V-1->SUBSCR(W,LENS); IF V=1 THEN 1->U CLOSE; ELSE 0->SUBSCR(W,OWNER);0->SUBSCR(W,LENS); CLOSE; L2: Z+1->Z; GOTO L1; END; FUNCTI LINEFORM; VARS Y Z; 4->COUNT1; INIT(4)->THISLINE; L1: X+1->SUBSCR(COUNT1,THISLINE); SUBSCR(X+1,USEDPTS)->Y; SUBSCR(X+1,POINTS)->Z; LINEO->SUBSCR(Y,Z); -1->SUBSCR(Y+1,Z); Y+1->SUBSCR(X+1,USEDPTS); X+A1->X; COUNT1-1->COUNT1; IF COUNT1>0 THEN GOTO L1 CLOSE; THISLINE->SUBSCR(LINEO,LINES); LINEO+1->LINEO END; FUNCTI GETSPACE; IF MYLIST=0 THEN INIT(8) ELSE MYLIST; SUBSCR(8,MYLIST)->MYLIST CLOSE; END; FUNCTI FREESPACE X; MYLIST->SUBSCR(8,X);X->MYLIST; END; FUNCTI FORMLINES; 1->A1;4->A2;16->A3;1->LINEO; L1: 0->X;1->X1;4->COUNT3; L5: X->X2;X->X3; L2: 4->COUNT2; L3: .LINEFORM; X2+A2->X2; X2->X;COUNT2-1->COUNT2; IF COUNT2>0 THEN GOTO L3 CLOSE; X3+A3->X3;X3->X2;X3->X;COUNT3-1->COUNT3; IF COUNT3>0 THEN GOTO L2 CLOSE; IF X1>0 THEN X1-1->X1;A3;A2;A1;A2+A1; A3->A2->A1;0->X;GOTO L5 CLOSE; IF X1=0 THEN X1-1->X1;->X;A1-X-X->A1;X; IF A1>0 THEN A1->X ELSE -A1->A1;3->X; CLOSE;GOTO L5 CLOSE; ->A3->A1->A2; IF A1>1THEN GOTO L1 CLOSE; 0->X; 21->A1; .LINEFORM; 3->X;19->A1; .LINEFORM; 12->X;13->A1; .LINEFORM; 15->X;11->A1; .LINEFORM; 1->X; L4: 1->SUBSCR(X,USEDPTS); X+1->X;IF X<65 THEN GOTO L4 CLOSE; END; FUNCTI TESTMOVES; VARS X A B C D P1 P2; FINDL(1,0)->X; IF X/=0 THEN L4: X.FREEPT->A; IF SUBSCR(X,OWNER)=8 THEN A EXIT; FINDL(1,X)->B; IF B/=0 THEN B->X; GOTO L4 CLOSE; IF FORCEMOVES.NULL THEN L5: A EXIT; IF A=HD(FORCEMOVES) THEN GOTO L0 CLOSE; PR('i}iTE O{ibKY B TESTFORCE'); NIL->FORCEMOVES;GOTO L5 CLOSE; IF NOT(NULL(FORCEMOVES)) THEN L0: HD(FORCEMOVES); TL(FORCEMOVES)->FORCEMOVES; EXIT; 8->P1;16->P2; 100->CNTFOR; IF .TESTFORCE THEN GOTO L0 CLOSE; P1;P2->P1;->P2; 50->CNTFOR; IF .TESTFORCE THEN HD(FORCEMOVES); NIL->FORCEMOVES; EXIT; INTOF(SCALE* .RANDOM)->COUNT; COUNT->COUNT1; IF SCALE>4 THEN SCALE//2->SCALE->X; CLOSE; -1000000->X; .VALUES; 1->D; L1: IF D=65 THEN C EXIT; IF SUBSCR(D,USEDPTS)=0 THEN GOTO L2 CLOSE; MOVEVALUE(D,Y,Z,V,W)->B; IF B>X THEN COUNT1->COUNT; L3: B->X;D->C; ELSEIF B=X THEN IF COUNT>1 THEN COUNT-1->COUNT;GOTO L3 CLOSE; CLOSE; L2: D+1->D; GOTO L1 END; FUNCTI TESTFORCE; VARS X W FIRST; CNTFOR-1->CNTFOR; 0->X; L4: FINDL(2,X)->X; IF X=0 THEN 0 EXIT; IF SUBSCR(X,OWNER)=P2 THEN GOTO L4 CLOSE; 1->FIRST; X.FREEPT->Y->W; L2: MOVE(W,P1,1)->V; MOVE(Y,P2,1)->V; L3: FINDL(1,0)->Z; IF Z>0 THEN L5:IF SUBSCR(Z,OWNER)=P1 THEN Z.FREEPT::NIL->FORCEMOVES; .UNWRAP EXIT; FINDL(1,Z)->V; IF V THEN V->Z; GOTO L5 CLOSE; MOVE(Z.FREEPT,P1,1)->V; FINDL(1,0)->V; IF V=0 THEN GOTO L7 CLOSE; L6:IF SUBSCR(V,OWNER)=P2 THEN L7: .UNMOVE; GOTO L1; CLOSE; FINDL(1,V)->Z; IF Z THEN Z->V; GOTO L6 CLOSE; MOVE(V.FREEPT,P2,1)->V; GOTO L3 CLOSE; IF CNTFOR AND .TESTFORCE THEN .UNWRAP EXIT; L1: .UNMOVE; ->Y; Y.UNMOVE; IF Y/=W THEN GOTO L1 CLOSE; IF FIRST THEN 0->FIRST; X.FREEPT->W->Y; GOTO L2 CLOSE; GOTO L4 END FUNCTI UNMOVE T X;VARS Z U V W; 1->SUBSCR(X,USEDPTS); SUBSCR(X,POINTS)->Z; 1->U; L1: SUBSCR(U,Z)->V; IF V<0 THEN FREESPACE(T) EXIT; SUBSCR(U,T)->W; LOGAND(W,7)->SUBSCR(V,LENS); LOGAND(W,24)->SUBSCR(V,OWNER); U+1->U; GOTO L1 END; FUNCTI UNWRAP; L1: .UNMOVE; ->X;X.UNMOVE; X::FORCEMOVES->FORCEMOVES; IF X/=W THEN GOTO L1 CLOSE; 1 END; FUNCTI FINDL Y X; L1: X+1->X; IF X=77 THEN 0 EXIT; IF SUBSCR(X,LENS)=Y THEN X EXIT; GOTO L1; END; FUNCTI VALUES; VARS X; 0->Y;0->Z;0->V;0->W;1->X; L1: IF SUBSCR(X,LENS)=2 THEN IF SUBSCR(X,OWNER)=P2 THEN Y+1->Y ELSE Z+1->Z CLOSE; ELSEIF SUBSCR(X,LENS)=3 THEN IF SUBSCR(X,OWNER)=P2 THEN V+1->V ELSE W+1->W CLOSE; CLOSE; X+1->X; IF X<77 THEN GOTO L1 CLOSE; END; FUNCTI MOVEVALUE X A B C D;VARS W Y Z; SUBSCR(X,POINTS)->X; 1->Z; L1: SUBSCR(Z,X)->W; IF W<0 THEN C-4 *D+16 *A-32 *B EXIT; SUBSCR(W,LENS)->Y; IF Y=4 THEN C+1->C ELSEIF Y=3 THEN IF SUBSCR(W,OWNER)=P2 THEN A+1->A ELSE D-1->D CLOSE; ELSEIF Y=2 THEN IF SUBSCR(W,OWNER)=P1 THEN B-1->B CLOSE CLOSE; Z+1->Z;GOTO L1 END; FUNCTI FREEPT X;VARS Y Z; 1->Y; SUBSCR(X,LINES)->X; L1: SUBSCR(Y,X)->Z; IF SUBSCR(Z,USEDPTS)=1 THEN Z CLOSE; Y+1->Y; IF Y<5 THEN GOTO L1 CLOSE; END; FUNCTI MOVEIT X; MOVE(X,8,0); 8->SUBSCR(X,BOARD); (((X-1)//4)//4).PR;.PR;.PR; .PRINTBOARD; END; FUNCTI HISMOVE; VARS L M N; L0: PRSTRING('YOUR MOVE'); L1: .MYITEMREAD->L; IF L="RESIGN" THEN L EXIT; IF L="HELP" THEN IF NOT(NULL(FORCEMOVES)) THEN PRSTRING('I CAN WIN NO MATTER WHAT YOU DO.'); GOTO L0 CLOSE; FINDL(1,0)->L;IF L>0 THEN L.FREEPT->C;GOTO L8 CLOSE; 16->P1;8->P2; 100->CNTFOR; IF TESTFORCE() THEN LENGTH(FORCEMOVES)->M;HD(FORCEMOVES)->N; PRSTRING('YOU CAN FORCE A WIN IN');PR(M); PRSTRING(' MOVES, STARTING AT'); L5: (((N-1)//4)//4).PR;.PR;.PR; 1.NL;NIL->FORCEMOVES; GOTO L0 CLOSE; P1;P2->P1;->P2; 50->CNTFOR; IF .TESTFORCE THEN HD(FORCEMOVES)->N; PRSTRING('I AM IN A STRONG POSITION. HOWEVER, TRY'); GOTO L5 CLOSE; -1000000->X; .VALUES; 1->D; L6: IF D=65 THEN L8: PRSTRING('TRY');(((C-1)//4)//4).PR;.PR;.PR; 1.NL;GOTO L0 CLOSE; IF SUBSCR(D,USEDPTS)=0 THEN GOTO L7 CLOSE; MOVEVALUE(D,Y,Z,V,W)->B; IF B>X THEN B->X; D->C CLOSE; L7: D+1->D; GOTO L6 CLOSE; IF ISCOMPND(L) THEN GOTO L1 CLOSE; IF L<0 OR L>3 THEN L2: PRSTRING('NO SUCH POSITION. PLEASE RETYPE.'); GOTO L0; CLOSE; L3: .MYITEMREAD->M; IF ISCOMPND(M) THEN GOTO L3 CLOSE; IF M<0 OR M>3 THEN GOTO L2 CLOSE; L4: .MYITEMREAD->N; IF ISCOMPND(N) THEN GOTO L4 CLOSE; IF N<0 OR N>3 THEN GOTO L2 CLOSE; 16*L+4*M+N+1->L; IF SUBSCR(L,BOARD)/=0 THEN PRSTRING('THAT POSITION IS ALREADY OCCUPIED. STOP TRYING TO CHEAT.'); GOTO L0 CLOSE; MOVE(L,16,0); 16->SUBSCR(L,BOARD); END; FUNCTI PRINTBOARD; VARS X Y Z; 2.NL;5.SP;0.PR;8.SP;1.PR;8.SP;2.PR;8.SP;3.PR; 2.NL;4->X; L1: 2.SP;0.PR;1.PR;2.PR;3.PR;X-1->X; IF X>0 THEN GOTO L1 CLOSE; 0->Y;1->Z; L2: 1.NL;Y.PR;4->X;4->W; L3: 1.SP; IF SUBSCR(Z,BOARD)=0 THEN PR(".") ELSEIF SUBSCR(Z,BOARD)=16 THEN PR("X") ELSE PR("O") CLOSE; Z+1->Z;X-1->X; IF X>0 THEN GOTO L3 CLOSE; W-1->W; IF W>0 THEN 4->X;Z+12->Z;2.SP;GOTO L3 CLOSE; Y+1->Y; IF Y<4 THEN Z-48->Z;GOTO L2 CLOSE; 2.NL; END; ITEMREAD->MYITEMREAD; FUNCTI PLAY; .SETUP; INTOF(100*POPTIM())->RANSEED; L1: 1.NL; PRSTRING('DO YOU KNOW HOW TO PLAY AGAINST THIS PROGRAM'); .MYITEMREAD->X; IF X="YES" THEN GOTO L3 CLOSE; L2: PRSTRING('THE GAME IS PLAYED ON A 4*4*4 CUBE. THE OBJECT BEING TO PLACE 4 PIECES IN A STRAIGHT LINE; YOUR PIECES ARE SHOWN AS X , MINE AS O . TO MAKE A MOVE YOU HAVE TO TYPE IN 3 NUMBERS, INDICATING PLANE, ROW AND COLUMN; EACH IN THE RANGE 0 TO 3. THUS IN THE BOARD SHOWN BELOW, YOU HAVE A PIECE AT 1 3 2 AND I HAVE ONE AT 2 0 3.'); 16->SUBSCR(31,BOARD); 8->SUBSCR(36,BOARD); .PRINTBOARD; 0->SUBSCR(31,BOARD); 0->SUBSCR(36,BOARD); 'YOU CAN ASK THEN COMPUTER TO SUGGEST A MOVE BY TYPING HELP AND CAN CONCEDE BY TYPING RESIGN '.PRSTRING; L3: 'DO YOU WANT TO START '.PRSTRING; .MYITEMRE->X; .PRINTBOARD; IF X="YES" THEN 16->SCALE; GOTO L4 ELSE 8->SCALE; GOTO L6 CLOSE; L4: .HISMOVE->X; IF X="RESIGN" THEN IF NULL(FORCEMOVES) THEN PRSTRING('I HAD NOT REALISED THAT MY POSITION WAS IMPREGNABLE. ') ELSE PRSTRING('FAIR ENOUGH. ') CLOSE; GOTO L5 CLOSE; IF X THEN .PRINTBOARD; PRSTRING('YOU WIN. ');GOTO L5 CLOSE; L6: 1.NL;PRSTRING('MY MOVE'); .TESTMOVES; IF .MOVEIT THEN 1.NL;PRSTRING('I WIN. '); GOTO L5 CLOSE; GOTO L4; L5: PRSTRING('DO YOU WANT TO PLAY AGAIN'); .MYITEMREAD->X; IF X="YES" THEN .SETUP; GOTO L3 CLOSE; PRSTRING('BACK TO POP2 THEN'); END; VARS RANSEED;FUNCTI RANDOM; (125*RANSEED+1)//16384; .ERASE;->RANSEED; RANSEED/16384;END; CHAROUT->CUCHOUT;4.NL; PRSTRING('TO ENTER PROGRAM, TYPE FOURS; '); VARS OPERATION 1 FOURS; PLAY->NONOP FOURS;
Публикуется, если верить гуглопоиску по текстовым сообщениям, впервые.