%BEGIN %CONSTINTEGER BIT = X'80000000' %CONSTINTEGER MAX SCORE = +50000 !! %EXTERNALROUTINESPEC PROMPT(%STRING (255) S) %CONSTINTEGER PLYWIDTH = 5 %RECORDFORMAT SQF(%INTEGER P, ATT, DEF, ATTP) %RECORDFORMAT ROWF(%RECORD %ARRAY R(1:8)(SQF)) %OWN %RECORD %ARRAY BRD(1:8) (ROWF) %OWN %RECORD %ARRAY BRDOLD(1:8) (ROWF) %INTEGERARRAY VAL(-6:6) !! PIECE = BRD(Y)_R(X)_P %RECORDFORMAT LISTF(%RECORDNAME L, %INTEGER SCORE, %C %BYTEINTEGER FR, TO, %INTEGER SPEC, CHK) !! SCORE - CONTAINS SCORE FOR THE MOVE !! SPEC - CONTAINS FLAGS FOR QUEENING, CASTLING !! CHK - OPPOSING KING IS IN CHECK %RECORDFORMAT QHF(%RECORDNAME L,%INTEGER HOLD) %RECORDSPEC QHF_L(LISTF) !! %RECORDFORMAT PTF(%INTEGERNAME P) %RECORD %ARRAY PT(1:64) (PTF) !! %CONSTINTEGER KING = 6; ! NB: AND -6 %CONSTINTEGER QUEEN = 5; ! AND -5 %CONSTINTEGER ROOK = 4; ! AND -4 %CONSTINTEGER PAWN = 1; ! AND -1 !! %RECORDNAME FREELIST (QHF) %RECORD MOVE (QHF) %RECORDARRAY LISTA(0:4000) (LISTF) %RECORD %NAME SQ(SQF) !! %OWNINTEGERARRAY PINX(1:32) = 0(32) %OWNINTEGERARRAY PINY(1:32) = 0(32) %INTEGERARRAY PINDX, PINPY(1:32) %OWNINTEGER PIN PT, PX, PY !! %RECORDFORMAT SQIF(%RECORDNAME SQ) %RECORDSPEC SQIF_SQ(SQF) %RECORDARRAY SQI(1:64)(SQIF) %CONSTINTEGERARRAY BIT VAL(1:6)=256,64,32,8,2,1 !! %CONSTINTEGERARRAY PAWN 2D(9:72) = %C 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 3, 3, 3, 20, 20, 3, 3, 3, 4, 6, 6, 50, 50, 6, 6, 4, 8, 9, 30, 55, 55, 30, 9, 8, 10, 10, 35, 60, 60, 35, 10, 10, 100(8), 500(8) !! %CONSTBYTEINTEGERARRAY POSX(1:12) = %C 2, 3, 6, 7, 58, 59, 62, 63, 1, 8, 57, 64 %CONSTINTEGERARRAY POSP(1:12) = %C -2, -3, -3, -2, 2, 3, 3, 2, -4, -4, 4, 4 %CONSTINTEGERARRAY POSPP(1:12) = %C -7(4), 7(4), -10(2), 10(2) !! %CONSTINTEGERARRAY NOLEG MOVE(-1:1) = -24000, 0, 24000 !! %OWNBYTEINTEGERARRAY KMOVE(-1:1) = 0(3) %OWNINTEGERARRAY KCAS(-1:1) = 0(3) !! %RECORD LM(LISTF) %RECORD MMOVE(QHF) !! %INTEGER I, X, Y, PLAY %OWNLONGREAL TIME, TIME2, TIMTT = 15 %OWNINTEGER NO = 1, SCOREA, XDEPTH, PDEPTH, MON, JUST ONE PLY %OWNINTEGER CHK, LAST CHK, PIN REMOVE !! %EXTERNALLONGREALFNSPEC CPU TIME !! %INTEGERFNSPEC N PLY(%INTEGER WHICH, DEPTH, %RECORDNAME CHAIN) %INTEGERFNSPEC SORT AND PRUNE(%RECORDNAME LIST, %C %INTEGER WIDTH, WHICH) %INTEGERFNSPEC SCORE(%INTEGER WHICH, %RECORD %NAME L) %INTEGERFNSPEC MOVES(%INTEGER WHICH, SCRQ) %INTEGERFNSPEC ONEPLY(%INTEGER WHICH, WIDTH) %INTEGERFNSPEC CHANGE BOARD(%RECORDNAME B) %ROUTINESPEC RESTORE BOARD(%RECORDNAME B) %ROUTINESPEC BURP(%RECORD %NAME X, %INTEGER W) %ROUTINESPEC TELL(%RECORD %NAME MOVE, %INTEGER WHICH) %ROUTINESPEC PRINT BOARD %ROUTINESPEC PRINTMOVE(%RECORD %NAME LIST) %INTEGERFNSPEC CHECK YOUR MOVE(%RECORD %NAME LIST) %ROUTINESPEC YOUR MOVE !**** INITIALISATION ETC %CYCLE I = 0, 1, 4000-1 LISTA(I)_L == LISTA(I+1) %REPEAT FREELIST == LISTA(0) !! SELECTINPUT(1) %CYCLE I = -6, 1, 6 READ(VAL(I)) %REPEAT READ(PDEPTH) READ(MON); READ(PLAY) I = 1 %CYCLE Y = 1,1,8 %CYCLE X = 1,1,8 SQ == BRD(Y)_R(X) READ(SQ_P) SQI(I)_SQ == SQ PT(I)_P == SQ_P; I = I+1 %REPEAT %REPEAT SELECT INPUT(0) MMOVE_HOLD = 0; MOVE_HOLD = 0 LM_SCORE = 0; LM_CHK = 0 MMOVE_L == LM PRINTSTRING("Version 2.5 HOW DIFFICULT A GAME DO YOU WANT? 2 = NORMAL STRENGTH, 3 = MORE DIFFICULT ") PROMPT("2-4?") READ(PDEPTH); SKIPSYMBOL PROMPT("Move?") PRINTBOARD !! !! !! N B WHITE PIECES ARE -VE, BLACK ARE +VE !! !**** MAIN LOOP TIME2 = CPUTIME %CYCLE %IF PLAY = 1 %START MOVE_L == RECORD(N PLY(-1, 0, MOVE)) TELL(MOVE_L, -1) I =CHANGE BOARD(MOVE) %FINISHELSESTART YOURMOVE BURP(MMOVE, -1) %FINISH TIME = CPUTIME MOVE_L == RECORD(N PLY(+1, 0, MMOVE_L)) BURP(MOVE, +1) PRINTBOARD SELECT OUTPUT(2); PRINTBOARD; SELECT OUTPUT(0) NO = NO+1 %REPEAT !! %ROUTINE RELEASE CHAIN(%RECORDNAME L) %RECORDSPEC L(LISTF) %RECORD %NAME L2(LISTF) L2 == L %WHILE ADDR(L_L) # 0 %CYCLE L == L_L; ! GO TO BOTTOM OF CHAIN %REPEAT L_L == FREELIST FREELIST == RECORD(ADDR(L2)) %END !! %INTEGERFN N PLY(%INTEGER WHICH, DEPTH, %RECORDNAME CHAIN) %RECORDSPEC CHAIN(LISTF) %INTEGER I, XWHICH, J, SWIDTH, CI, FLAG %RECORD %NAME BPT (QHF) %RECORD %ARRAY B(1:40) (QHF) %RECORD %NAME LIST, LISTX(LISTF) %CONSTINTEGERARRAY XWIDTH(0:10) = 8, 8, 3(9) !! XDEPTH = DEPTH; ! HOLD FOR GLOBAL USE DEPTH = DEPTH+1 SWIDTH = XWIDTH(DEPTH) %IF DEPTH=PDEPTH %THEN SWIDTH=1 LAST CHK = CHAIN_CHK LIST == RECORD(ONE PLY(WHICH, SWIDTH)) I = 1 B(1)_L == RECORD(0) FLAG = 0 %WHILE ADDR(LIST)#0 %CYCLE BPT == B(I) BPT_L == LIST LIST == LIST_L %IF MON#0 %START SELECT OUTPUT(2) SPACES(DEPTH*3) WRITE(DEPTH, 1); SPACES(2); PRINTMOVE(BPT_L) %IF LAST CHK#0 %THEN PRINTSTRING(" FORCED") NEWLINE SELECT OUTPUT(0) %FINISH I = I+1 ! %EXIT %IF LIST == NULL; ! ONLY ONE MOVE ALLOWED ! %EXIT %IF ADDR(LIST) = 0 %AND I = 2; ! SEE ABOVE XWHICH = WHICH!!X'FFFFFFFE' %IF DEPTH < PDEPTH %START CI = CHANGE BOARD(BPT) LISTX == RECORD(N PLY(XWHICH, DEPTH, BPT_L)) LAST CHK = CHAIN_CHK; ! REALLY FOR MONITORING RESTORE BOARD(BPT) %UNLESS ADDR(LISTX)=0 %START BPT_L_SCORE = LISTX_SCORE; ! GET BEST OPP PIECE SCORE RELEASE CHAIN(LISTX); FLAG = FLAG+1 %FINISHELSESTART BPT_L_SCORE = NO LEG MOVE(WHICH) ! %IF BPT_L_CHK = 0 %THEN BPT_L_SCORE = 0; ! ???? %FINISH %FINISH %IF I > SWIDTH %START %IF FLAG # 0 %OR I = 2 %THEN %EXIT; ! MOVE FOUND %IF MON # 0 %START SELECT OUTPUT(2) PRINTSTRING("FORCED TO INCREASE PLYWIDTH ") SELECT OUTPUT(0) %FINISH !! IF NO LEGAL MOVE, SEARCH ALL MOVES ON THIS LEVEL %FINISH %REPEAT RELEASE CHAIN(LIST) %IF ADDR(LIST)#0 LIST == RECORD(0) %IF I = 1 %THEN %RESULT = 0; ! NO LEGAL MOVE %IF I = 2 %THEN %RESULT = ADDR(B(1)_L); ! SINGLE RESULT %CYCLE J = 1, 1, I-1 B(J)_L_L == LIST LIST == B(J)_L; ! STACK THE RESULTS %REPEAT %RESULT = SORT AND PRUNE(LIST, 1, WHICH) ! GET THE 'BEST' RESULT ! NB RESULT == SORT ON PDP11 %END %INTEGERFN ONE PLY(%INTEGER WHICH, WIDTH) %RECORD %NAME LIST(LISTF) !! BRDOLD = BRD; ! HOLD IT (TO ERASE ATT&DEF LIST == RECORD(MOVES(WHICH, 0)) LIST == RECORD (SORT AND PRUNE(LIST, WIDTH, WHICH)) %RESULT = ADDR(LIST) %END !! %INTEGERFN EXVAL(%INTEGER OCC,SIDE1,SIDE2) %INTEGER GAIN,LOSS,NEW %CONSTINTEGERARRAY PCE(1:31)=3,2(6),1(24) !! %CONSTINTEGERARRAY VAL(1:6)=100,300,350,500,900,5000 %CONSTINTEGERARRAY BIT(1:6)=256,64,32,8,2,1 !* +VE RESULT => ATTACKING SIDE HAS GAINED SOMETHING GAIN=VAL(OCC) %IF SIDE1<0 %START PRINTSTRING("PROGRAM ERROR, NEXT MOVE MAY BE STUPID! ") %RESULT = 0 %FINISH %IF SIDE2=0 %THENRESULT=GAIN NEW=SIDE1>>5 %IF NEW#0 %THEN NEW=PCE(NEW) %ELSE NEW=PCE(SIDE1)+3 LOSS=EXVAL(NEW,SIDE2,SIDE1-BIT(NEW)) %IF LOSS<0 %THENRESULT=GAIN %ELSERESULT=GAIN-LOSS %END !! %ROUTINE CHECK PINS(%INTEGER WHICH) %INTEGER I, K, BV %RECORD %NAME SQ(SQF) !! THIS ROUTINE REMOVES THE 'ATTACKS' AND 'DEFENSES' OF ALL THE !! PINNED PIECES. !! THEY ARE NOT DELETED IF THE PINNED PIECE IS ATTACKING THE !! PINNING PIECE !! %RETURN %IF PIN PT=0 %CYCLE I = 1, 1, PIN PT PX = PINX(I); PY = PINY(I) SQ == SQI(PINDX(I))_SQ; ! ATTACKERS SQUARE BV = BIT VAL(PINPY(I)) %IF SQ_ATT&BV#0 %START !! NO PIN %FINISHELSESTART PIN REMOVE = PINPY(I); ! IF ATT>PINNED DEFENSE! K = MOVES(WHICH, 3) SCOREA = SCOREA+SQ_P*5 %FINISH %REPEAT %END !! %INTEGERFN TRY ANOTHER PLY(%INTEGER WHICH) %RECORDNAME LIST2(LISTF) %INTEGER X, WW, XMON %CONSTINTEGERARRAY WWW(-1:1) = 25, 0, -25 %RESULT = 0 %IF JUST ONE PLY = 1; ! ONLY ONE LEVEL JUST ONE PLY = 1; XMON = MON; MON = 1 WW = WHICH!!X'FFFFFFFE' LIST2 == RECORD(MOVES(WW, 0)) JUST ONE PLY = 0; MON = XMON %IF ADDR(LIST2) = 0 %START %RESULT = -NOLEGMOVE(WW)//2 %FINISHELSESTART LIST2 == RECORD(SORT AND PRUNE(LIST2, 1, WW)) X = LIST2_SCORE %FINISH RELEASE CHAIN(LIST2) %UNLESS ADDR(LIST2)=0 %RESULT = X+WWW(WW) %END !! %INTEGER %FN SCORE(%INTEGER WHICH, %RECORD %NAME L) %RECORDSPEC L(LISTF) %INTEGER SCOREB, X, Y, I, P, Q, QQ, PAWNB, WHX, W2 %INTEGER GAIN, SQU, LOSS, NPH, NPH2, BAD, SCOREC %RECORD HOLD(QHF) %RECORDNAME LIST2(LISTF) %RECORD %NAME SQ(SQF) !! !! BRD = BRDOLD; ! CLEAR ATT & DEF PIN PT = 0 %CYCLE I = 1, 1, 64 SQI(I)_SQ_ATT = 0; SQI(I)_SQ_DEF = 0 %REPEAT WHX = WHICH&BIT; ! GET TYPE L_CHK = 0; ! CLEAR FLAG HOLD_L == L; ! MAP TO MOVE P = CHANGE BOARD(HOLD); ! AND MAKE IT SCOREB = 0; SCOREA = 0; SCOREC = 0 P = MOVES(WHICH, 1) SQU = 0 BAD = 0; NPH = 0; NPH2 = 0 %CYCLE Y = 1, 1, 8 %CYCLE X = 1, 1, 8 SQU = SQU+1 SQ == SQI(SQU)_SQ Q = SQ_P %IF Q#0 %START; ! PIECE ON SQUARE %IF Q < 0 %START QQ = -Q; W2 = -1 %FINISHELSESTART QQ = Q; W2 = 1 %FINISH !! P = 0 %IF QQ = 1 %START; ! PAWN %IF Q > 0 %THEN PAWNB= 9-Y %ELSE %C PAWNB = Y P = PAWN 2D(PAWNB*8+X)*Q %FINISH !! %IF Q&BIT = WHX %START !* !* 'MY' PIECEON SQU X,Y !* %IF QQ=6 %START; ! 'MY' KING %IF SQ_ATT # 0 %START RESTORE BOARD(HOLD) %RESULT = MAX SCORE %FINISH ! ILLEGAL MOVE %FINISH %IF SQ_ATT > 0 %START; ! MY PIECE UNDER ATTACK GAIN = EXVAL(QQ, SQ_ATT, SQ_DEF) %IF GAIN > 0 %START GAIN = GAIN+P SCOREA = SCOREA-(GAIN*W2)//10 %IF GAIN > BAD %THEN BAD = GAIN ! PROBLEMS WITH POSITIONAL VALUE %FINISH %FINISH !! ! PIECE EFFECTIVELY LOST %FINISHELSESTART !* !* OPP PIECE (SEE WHICH) ON X,Y !* %IF SQ_ATT # 0 %START GAIN = EXVAL(QQ, SQ_ATT, SQ_DEF) %IF GAIN > 0 %START %IF GAIN >NPH %START NPH2 = NPH; NPH = GAIN %FINISHELSESTART %IF GAIN > NPH2 %THEN NPH2 = GAIN %FINISH %FINISH %IF QQ = 6 %START L_CHK = Q %FINISH %FINISH %FINISH SCOREB = SCOREB+P+VAL(Q) %FINISH %REPEAT %REPEAT LOSS = 0 %IF BAD > 0 %START; ! PLAYER ABOUT TO LOSE %IF ((BAD > 300 %AND NPH > 400) %OR NPH>400) %C %AND BAD < 500 %THEN SCOREC = TRY ANOTHER PLY(WHICH) NPH = NPH//3 LOSS = BAD %IF NPH > BAD %THEN LOSS = NPH2//3 %ELSE %C LOSS = LOSS-NPH %FINISHELSESTART %IF NPH2 # 0 %THEN LOSS = -NPH2 LOSS = LOSS-NPH//6 %FINISH SCOREB = SCOREB+KCAS(-1)+KCAS(1) %CYCLE I = 1, 1, 12; ! CHECK B&N POS SCOREB = SCOREB+POSPP(I) %IF POSP(I) # PT(POSX(I))_P %REPEAT %IF L_CHK # 0 %START SCOREC = TRY ANOTHER PLY(WHICH) %UNLESS SCOREC#0 %FINISH RESTORE BOARD(HOLD); ! UNDO THE MOVE %IF MON&64 # 0 %START SELECT OUTPUT(2) PRINTSTRING("SCORE:") WRITE(SCOREA, 1); WRITE(SCOREB, 1); WRITE(SCOREC, 1) WRITE(BAD, 1); WRITE(NPH, 1); WRITE(NPH2, 1) WRITE(LOSS, 1); NEWLINE SELECT OUTPUT(0) %FINISH %RESULT = SCOREC %IF SCOREC # 0 %RESULT = SCOREB+SCOREA-LOSS*WHICH %END !! %INTEGERFN MOVES(%INTEGER WHICH, SCRQ) %INTEGER X, Y, Q, QQ, WHICHX, A, B, K, I, TYPE, W2, DIAG %INTEGER SPEC, PIN FLAG, PIN PIECE, POX, POY, SQU, IMODK %RECORD %NAME ROW(ROWF) %RECORD %NAME LIST(LISTF) %OWNINTEGERARRAY KCASCH( -1:1) = 1, 0, 8 %SWITCH MOVE(1:6) !! %INTEGER %FN DOM(%INTEGER X0, Y0) %RECORD %NAME SQ(SQF) %INTEGER I, J, K %RECORDNAME LIST2 (LISTF) %RECORD %NAME N(LISTF) !! !* !* SCRQ = 0 STANDARD ENTRY FOR ONE PLY !* +1 ENTRY FROM SCORE !* +2 !* +3 PINNED PIECE ENTRY !* %UNLESS 1 <= X0 <=8 %AND 1 <=Y0<=8 %THEN %RESULT = 0 SQ == BRD(Y0)_R(X0) K = SQ_P %IF SCRQ <= 0 %START %IF K#0 %AND K&BIT = Q&BIT %THEN %C %RESULT = 0 %IF QQ=PAWN %START %IF (TYPE=0 %AND K#0) %OR %C (TYPE=1 %AND K=0) %THEN %RESULT = 0 %IF Y0=1 %OR Y0=8 %THEN SPEC=5*Q; ! QUEEN %FINISH SPEC = 0 N == FREE LIST; FREE LIST == RECORD(ADDR(N_L)) %IF ADDR(FREE LIST) = 0 %START PRINTSTRING("OUT OF FREE CELLS!!! ") %STOP %FINISH N_FR = X<<4+Y N_TO = X0<<4+Y0 N_SPEC = SPEC %IF 6 <= TYPE <= 7 %START N_SPEC = TYPE N_TO = N_FR %FINISH N_SCORE = SCORE(WHICH, N) !! %IF TYPE = 6 %START; ! ILLEGAL CASTLE CHECK %IF ROW_R(6)_ATT # 0 %THEN N_SCORE = MAX SCORE %FINISH %IF TYPE = 7 %START; ! DITTO %IF ROW_R(4)_ATT # 0 %THEN N_SCORE = MAX SCORE %FINISH !! !! %IF N_SCORE = MAX SCORE %START; ! WAS ILLEGAL N_L == FREE LIST; ! RE-LINK IT FREE LIST == RECORD(ADDR(N)) %IF K#0 %THEN %RESULT = 0; ! PIECE IN WAY, NO FURTHER %RESULT= 1; ! MUST TRAVERSE ENTIRE B,R OR Q PATH %FINISH !! !! %IF MON&2=2 %START SELECT OUTPUT(2) SPACES(20) WRITE(XDEPTH, 5) PRINTSTRING('---') PRINTMOVE(N) NEWLINE SELECT OUTPUT(0) %FINISH !! N_L == LIST; LIST == RECORD(ADDR(N)) %IF K=0 %THEN J=1 %ELSE J=0 %FINISHELSESTART J = 2 %IF K # 0 %START %IF QQ=PAWN %AND TYPE=0 %THEN %RESULT = 0 J = 0; ! POSSIBLY NO FURTHER IMODK = IMOD(K) %IF K&BIT = Q&BIT %START; ! ITS A DEFENCE %IF QQ = 5 %START; ! Q 'BEHIND' %IF (DIAG=1 %AND IMODK=3) %OR %C (DIAG=0 %AND IMODK=4) %THEN J=1 %FINISHELSESTART %IF IMODK=5 %START %IF 3<=QQ<=4 %THEN J=1 %FINISH %FINISH ! IF A PIECE DOUBLES UP, THEN KEEP GOING %IF SCRQ # 3 %START %IF PINFLAG = 0 %THEN %C SQ_DEF = SQ_DEF+BIT VAL(QQ) %FINISHELSESTART SQ_DEF = SQ_DEF-BIT VAL(QQ) %FINISH %FINISHELSESTART %IF SCRQ = 3 %START ! PIECE QQ IS ATTACKING K %IF PIN REMOVE >= IMODK %THEN %C SQ_ATT = SQ_ATT-BIT VAL(QQ) %FINISHELSESTART %IF PINFLAG=0 %START SQ_ATT = SQ_ATT+BIT VAL(QQ) PINFLAG=1; J=3 PINPIECE=IMODK; POX=X0; POY=Y0 %FINISHELSESTART %IF IMODK>3 %AND IMODK>PIN PIECE %START %IF PIN PT#0 %START %CYCLE I = 1,1,PIN PT %IF PINX(I)=POX %AND PINY(I)=POY %C %THEN ->NO PIN %REPEAT %FINISH PIN PT = PIN PT+1 PINX(PINPT) = POX PINY(PINPT) = POY PINDX(PINPT) = SQU PINPY(PINPT) = PIN PIECE NO PIN: %FINISH %FINISH %FINISH %FINISH %FINISH SCOREA = SCOREA+W2 %FINISH %RESULT = J %END !! DIAG = 0 LIST == RECORD(0) WHICHX = WHICH&BIT !! %IF SCRQ = 3 %START; ! PIN ENTRY X = PX; Y = PY SQU = (Y-1)*8+X -> PIN ENTRY %FINISH !! SQU = 0 %CYCLE Y = 1,1, 8 %CYCLE X = 1, 1, 8 TYPE = -1 SQU = SQU+1 PIN ENTRY: Q = PT(SQU)_P; ! PICK UP PIECE(X,Y) %IF Q # 0 %AND (Q&BIT = WHICHX %OR %C SCRQ > 0) %START %IF Q<0 %THEN QQ=-Q %AND W2=-1 %ELSE %C QQ = Q %AND W2 = +1 -> MOVE(QQ) MOVE(1): ! PAWN TYPE = 0 PIN FLAG = 0 K = DOM(X, Y-W2) PIN FLAG = 0 K=DOM(X, Y-W2-W2) %IF (Y=2 %OR Y=7) %AND K#0 TYPE = 1 PIN FLAG = 0 K = DOM(X-1, Y-W2); PIN FLAG = 0; K=DOM(X+1, Y-W2) ->OUT !! MOVE(2): ! KNIGHT %CYCLE A = -2, 4, 2 %CYCLE B = -1, 2, 1 PIN FLAG = 0 K = DOM(X+A, Y+B) PIN FLAG = 0 K = DOM(X+B, Y+A) %REPEAT %REPEAT -> OUT !!! MOVE(3): ! BISHOP MOVE(5): ! QUEEN DIAG = 1 I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I-1 K = DOM(X+I, Y+I) %REPEAT I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I-1 K = DOM(X-I, Y+I) %REPEAT I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I-1 K = DOM(X+I, Y-I) %REPEAT I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I-1 K = DOM(X-I, Y-I) %REPEAT -> OUT %IF QQ # QUEEN; ! THE BISHOP MOVE(4): ! ROOK DIAG = 0 K = 1; I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I-1 K = DOM(X, Y+I) %REPEAT I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I+1 K = DOM(X+I, Y) %REPEAT I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I+1 K = DOM(X, Y+I) %REPEAT I = 0; PIN FLAG = 0 %UNTIL K = 0 %CYCLE I = I-1 K = DOM(X+I, Y) %REPEAT -> OUT !! MOVE(6): ! KING ROW == BRD(Y) %CYCLE A = -1, 1, 1 %CYCLE B = -1, 1, 1 %IF A#0 %OR B#0 %START PIN FLAG = 0 K = DOM(X+A, Y+B) ! %IF K#0 %AND W2#WHICH %THEN K MOB=K MOB+1 %FINISH %REPEAT %REPEAT %IF LAST CHK # Q %AND %C KCASCH(W2) = Y %AND KMOVE(W2)=0 %START ! CORRECT ROW AND ABLE TO CASTLE %IF ROW_R(6)_P = 0 = ROW_R(7)_P %AND %C ROW_R(8)_P = ROOK*W2 %START TYPE = 6; K = DOM(7, Y); ! DO CASTLE %FINISH %IF ROW_R(4)_P = 0 =ROW_R(3)_P %AND %C ROW_R(2)_P = 0 %AND ROW_R(1)_P = ROOK*W2 %C %START TYPE = 7; K = DOM(3, Y) %FINISH %FINISH !! OUT: %FINISH %RESULT = 0 %IF SCRQ = 3 %REPEAT %REPEAT CHECK PINS(WHICH) %IF SCRQ > 0 ! ONLY ON SCORE ENTRY %RESULT = ADDR(LIST) %END !! %INTEGERFN SORT AND PRUNE(%RECORDNAME LIST, %C %INTEGER WIDTH, WHICH) %RECORDSPEC LIST(LISTF) %INTEGER I, MAX %RECORD %NAME M1, M2, L, LN, RES (LISTF) %CONSTINTEGERARRAY MAXA(-1:1) = 25000, 0, -25000 !! %RESULT = 0 %IF ADDR(LIST) = 0 RES == RECORD(0) %CYCLE I = 1, 1, WIDTH M1 == RECORD(0) M2 == M1; LN == M1 MAX = MAXA(WHICH) L == LIST %%EXIT %IF ADDR(L) = 0 %WHILE ADDR(L) # 0 %CYCLE %IF (WHICH<0 %AND L_SCORE0 %AND L_SCORE>MAX) %START !! M2 == L; M1 == LN; MAX = L_SCORE %FINISH !! LN == L; L == L_L %REPEAT !! L == M2_L; ! PICKUP ITS POINTER M2_L == RES RES == M2; ! NOTE LINKS BACKWARDS %IF ADDR(M1) = 0 %THEN LIST == L %ELSE %C M1_L == L %REPEAT %IF ADDR(LIST) # 0 %THEN RELEASE CHAIN(LIST) L == RECORD (0) %WHILE ADDR(RES) # 0 %CYCLE M1 == RES_L; ! NEXT LINK RES_L == L; ! LINK TO NEXT L == RES RES == M1 %REPEAT %RESULT = ADDR(L) %END !! %INTEGERFN CHANGE BOARD(%RECORDNAME B) %RECORDSPEC B(QHF) %RECORD %NAME SQ(SQF) %RECORD %NAME ROW(ROWF) %RECORD %NAME LIST(LISTF) %INTEGER FROM, TO, X, Y, X0, Y0, KING, CAS, ROOK LIST == B_L FROM = LIST_FR; TO = LIST_TO X = FROM>>4; X0 = TO>>4 Y = FROM&15; Y0 = TO&15 SQ == BRD(Y0)_R(X0) B_HOLD = SQ_P %IF LIST_SPEC # 0 %START %IF LIST_SPEC >= 6 %START; ! CASTLE %IF SQ_P<0 %START CAS = 1; KING = -6; ROOK = -4; KCAS(-1) = -30 %FINISHELSESTART CAS = 8; KING = 6; ROOK = 4; KCAS(1) = 30 %FINISH ROW == BRD(CAS) %IF LIST_SPEC = 6 %START; ! KING SIDE ROW_R(7)_P = KING; ROW_R(6)_P = ROOK ROW_R(8)_P = 0 %FINISHELSESTART ROW_R(3)_P = KING; ROW_R(4)_P = ROOK ROW_R(1)_P = 0 %FINISH SQ_P = 0 %RESULT = KING %FINISH SQ_P = LIST_SPEC %FINISHELSESTART SQ_P = BRD(Y)_R(X)_P %FINISH BRD(Y)_R(X)_P = 0 %RESULT = SQ_P %END !! %ROUTINE RESTORE BOARD(%RECORDNAME B) %RECORDSPEC B(QHF) %RECORD %NAME SQ(SQF) %RECORD %NAME ROW(ROWF) %RECORD %NAME LIST(LISTF) %INTEGER FROM, TO, X, Y, X0, Y0, KING, CAS, ROOK LIST == B_L FROM = LIST_FR; TO = LIST_TO X = FROM>>4; X0 = TO>>4 Y = FROM&15; Y0 = TO&15 SQ == BRD(Y0)_R(X0) %IF LIST_SPEC # 0 %START %IF LIST_SPEC >= 6 %START; ! CASTLE %IF Y0 = 1 %START CAS = 1; KING = -6; ROOK = -4; KCAS(-1) = 0 %FINISHELSESTART CAS = 8; KING = 6; ROOK = 4; KCAS(1) = 0 %FINISH ROW == BRD(CAS) %IF LIST_SPEC = 6 %START; ! KING SIDE ROW_R(8)_P = ROOK ROW_R(7)_P = 0; ROW_R(6)_P = 0 %FINISHELSESTART ROW_R(1)_P = ROOK ROW_R(3)_P = 0; ROW_R(4)_P = 0 %FINISH SQ_P = KING %RETURN %FINISH %IF Y0=8 %THEN SQ_P=-1 %ELSE SQ_P=1 %FINISH BRD(Y)_R(X)_P = SQ_P SQ_P = B_HOLD %END !! !! %ROUTINE BURP(%RECORD %NAME X, %INTEGER W) %INTEGER I %RECORD %SPEC X(QHF) !! TELL(X_L, W) SELECT OUTPUT(2) PRINTSYMBOL('*'); TELL(X_L, W) SELECT OUTPUT(0) ! %IF W > 0 %AND TIMTT < 3 %AND PDEPTH#1 %THEN PDEPTH=PDEPTH+1 I = CHANGE BOARD(X) %IF I = KING*W %THEN KMOVE(W) = 1 %END !! %ROUTINE TELL(%RECORD %NAME MOVE, %INTEGER WHICH) %RECORDSPEC MOVE(LISTF) %IF ADDR(MOVE) = 0 %START %IF WHICH < 0 %THEN PRINTSTRING('I Win ') %ELSE %C PRINTSTRING("YOU WIN ") %STOP %FINISH !! WRITE(NO, 1) %IF WHICH > 0 %THEN SPACES(25) %ELSE SPACES(4) PRINTMOVE(MOVE) PRINTSTRING("(") %IF WHICH > 0 %START TIMTT = CPUTIME-TIME PRINT(TIMTT, 1, 2) %FINISHELSESTART PRINT(CPUTIME-TIME2, 1, 2) %FINISH PRINTSTRING(" Secs) ") %END !! %ROUTINE PRINTBOARD %CONSTBYTEINTEGERARRAY BLACK(1:64) = %C 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0 !! %ROUTINE LINE PRINTSTRING(" !---!---!---!---!---!---!---!---! ") %END !! %CONSTBYTEINTEGERARRAY PX(-6:6) = %C 'k', 'q', 'r', 'b', 'n', 'p', ' ', 'P', 'N', 'B', 'R', 'Q', 'K' %INTEGER X,Y, I, P, Q %RECORD %NAME ROW(ROWF) !! Q = 1 %CYCLE Y = 8, -1, 1 ROW == BRD(Y) LINE WRITE(Y, 1) %CYCLE X = 1, 1, 8 PRINTSTRING("! ") P = ROW_R(X)_P %IF P # 0 %THEN PRINTSYMBOL(PX(P)) %ELSE %START %IF BLACK(Q) = 1 %THEN PRINTSYMBOL('*') %C %ELSE PRINTSYMBOL(' ') %FINISH %IF P > 0 %THEN PRINTSYMBOL('+') %ELSE %C PRINTSYMBOL(' ') Q = Q+1 %REPEAT PRINTSTRING("! ") %REPEAT LINE PRINTSTRING(" A B C D E F G H ") %END !! !! %ROUTINE PRINTMOVE(%RECORD %NAME LIST) %RECORDSPEC LIST(LISTF) %INTEGER I,J,K %ROUTINE BURP(%INTEGER X) PRINTSYMBOL((X>>4)+'A'-1) PRINTSYMBOL(X&15+'0') SPACE %END !! BURP(LIST_FR); BURP(LIST_TO) %IF LIST_CHK # 0 %THEN PRINTSYMBOL('+') WRITE(LIST_SCORE, 5) %END !! %INTEGER %FN CHECK YOUR MOVE(%RECORD %NAME LIST) %RECORD %SPEC LIST(LISTF) %RECORD %NAME L2, MM(LISTF) %INTEGER I MM == MMOVE_L L2 == LIST %WHILE ADDR(LIST) # 0 %CYCLE %IF LIST_FR = MM_FR %AND LIST_TO = MM_TO %C %START MM_SCORE = LIST_SCORE; MM_CHK = LIST_CHK %RESULT = 1 %FINISH LIST == LIST_L %REPEAT %RESULT = 0 %END !! %INTEGERFN PRINT MOVES(%RECORDNAME LIST) %RECORDSPEC LIST(LISTF) %RECORDNAME L(LISTF) SELECT OUTPUT(2) LIST == RECORD(SORT AND PRUNE(LIST, 100, -1)) L == LIST %CYCLE PRINTMOVE(L); NEWLINE L == L_L %EXIT %IF ADDR(L) = 0 %REPEAT SELECT OUTPUT(0) %RESULT = ADDR(LIST) %END %ROUTINE YOUR MOVE %INTEGER %FN READM(%INTEGERNAME X, Y) %INTEGER I,J SKIPSYMBOL %WHILE NEXTSYMBOL=NL READSYMBOL(I) SKIPSYMBOL %WHILE NEXTSYMBOL=NL READSYMBOL(J) X = I-'A'+1; Y = J-'0' %RESULT = 0 %END %INTEGER I, X, Y, X0, Y0, K %RECORD %NAME LIST(LISTF) !! JUST ONE PLY = 1; ! DONT ALLOW LOOK AHEAD (NO POINT) LIST == RECORD(MOVES(-1, 0)); ! GET OPPS LEGAL MOVES JUST ONE PLY = 0 %IF ADDR(LIST) = 0 %THEN TELL(LIST, -1); ! CHECKMATE %IF MON&1#0 %THEN LIST == RECORD(PRINT MOVES(LIST)) AGAIN: LM_SPEC = 0 %IF NEXTSYMBOL='M' %START; ! MONITOR SKIPSYMBOL PROMPT("MON?"); READ(MON); SKIPSYMBOL PROMPT("Move?") ->AGAIN %FINISH %IF NEXTSYMBOL='X' %START SKIPSYMBOL; SKIPSYMBOL; PPROFILE %FINISH %IF NEXTSYMBOL = 'P' %START PROMPT("NEW PLY?"); SKIPSYMBOL READ(PDEPTH); SKIPSYMBOL PROMPT("Move?") -> AGAIN %FINISH %IF NEXTSYMBOL='O' %START; ! CASTLE X = 0 SKIPSYMBOL; READSYMBOL(I) %IF I # '-' %THEN -> NO READSYMBOL(I); -> NO %IF I#'O' %IF NEXTSYMBOL = '-' %START; ! QUEEN SIDE X = 1; SKIPSYMBOL; SKIPSYMBOL %FINISH LM_SPEC = 6+X LM_FR = 5<<4+1 LM_TO = 5<<4+1 %FINISHELSESTART I = READM(X, Y); I=READM(X0, Y0) %IF NEXTSYMBOL='(' %START SKIPSYMBOL; READSYMBOL(K); SKIPSYMBOL LM_SPEC = (K-'0')*(-1) %FINISH %UNLESS 0AGAIN %FINISH !! LM_FR = X<<4+Y LM_TO = X0<<4+Y0 %FINISH MMOVE_L == LM %IF CHECK YOUR MOVE(LIST) = 0 %THEN ->NO SKIPSYMBOL RELEASE CHAIN(LIST) %END %ENDOFPROGRAM