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))
RECORDFORMAT ROWF(RECORD (SQF) ARRAY R(1:8))
OWN RECORD(ROWF)ARRAY BRD(1:8)
OWN RECORD(ROWF)ARRAY BRDOLD(1:8)
INTEGERARRAY VAL(-6:6)
!! PIECE = BRD(Y)_R(X)_P
RECORDFORMAT LISTF(RECORD(LISTF)NAME L, INTEGER SCORE or integer HOLD, 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(%RECORD(LISTF)%NAME L,%INTEGER HOLD)
{%RECORDSPEC QHF_L(LISTF)
!!
RECORDFORMAT PTF(INTEGERNAME P)
RECORD(PTF)ARRAY PT(1:64)
!!
CONSTINTEGER KING = 6; ! NB: AND -6
CONSTINTEGER QUEEN = 5; ! AND -5
CONSTINTEGER ROOK = 4; ! AND -4
CONSTINTEGER PAWN = 1; ! AND -1
!!
RECORD(LISTF)NAME FREELIST
RECORD(LISTF{QHF}) MOVE
RECORD(LISTF)ARRAY LISTA(0:4000)
RECORD (SQF) NAME SQ
!!
OWNINTEGERARRAY PINX(1:32) = 0(32)
OWNINTEGERARRAY PINY(1:32) = 0(32)
INTEGERARRAY PINDX, PINPY(1:32)
OWNINTEGER PIN PT, PX, PY
!!
RECORDFORMAT SQIF(RECORD(SQF)NAME SQ)
{%RECORDSPEC SQIF_SQ(SQF)
RECORD(SQIF)ARRAY SQI(1:64)
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 (LISTF)LM
RECORD (LISTF{QHF})MMOVE
!!
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, RECORD(LISTF)NAME CHAIN)
INTEGERFNSPEC SORT AND PRUNE(RECORD(LISTF)NAME LIST, C
INTEGER WIDTH, WHICH)
INTEGERFNSPEC SCORE(INTEGER WHICH, RECORD (LISTF)NAME L)
INTEGERFNSPEC MOVES(INTEGER WHICH, SCRQ)
INTEGERFNSPEC ONEPLY(INTEGER WHICH, WIDTH)
INTEGERFNSPEC CHANGE BOARD(RECORD(LISTF{QHF})NAME B)
ROUTINESPEC RESTORE BOARD(RECORD(LISTF{QHF})NAME B)
ROUTINESPEC BURP(RECORD (LISTF{QHF}) NAME X, INTEGER W)
ROUTINESPEC TELL(RECORD (LISTF)NAME MOVE, INTEGER WHICH)
ROUTINESPEC PRINT BOARD
ROUTINESPEC PRINTMOVE(RECORD (LISTF)NAME LIST)
INTEGERFNSPEC CHECK YOUR MOVE(RECORD (LISTF)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(RECORD(LISTF)NAME L)
{%RECORDSPEC L(LISTF)
RECORD(LISTF)NAME L2
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, RECORD(LISTF)NAME CHAIN)
INTEGER I, XWHICH, J, SWIDTH, CI, FLAG
RECORD(LISTF{QHF})NAME BPT
RECORD(LISTF{QHF})ARRAY B(1:40)
RECORD(LISTF)NAME LIST, LISTX
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(LISTF)NAME LIST
!! 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(SQF)NAME SQ
!! 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)
RECORD(LISTF)NAME LIST2
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(LISTF)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(LISTF{QHF}) HOLD
RECORD(LISTF)NAME LIST2
RECORD(SQF)NAME SQ
!!
!! 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(ROWF)NAME ROW
RECORD(LISTF)NAME LIST
OWNINTEGERARRAY KCASCH( -1:1) = 1, 0, 8
SWITCH MOVE(1:6)
!!
INTEGER FN DOM(INTEGER X0, Y0)
RECORD(SQF)NAME SQ
INTEGER I, J, K
RECORD(LISTF)NAME LIST2
RECORD(LISTF)NAME N
!!
!*
!* 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
CYCLE
I = I-1
K = DOM(X+I, Y+I)
REPEAT UNTIL K = 0
I = 0; PIN FLAG = 0
CYCLE
I = I-1
K = DOM(X-I, Y+I)
REPEAT UNTIL K = 0
I = 0; PIN FLAG = 0
CYCLE
I = I-1
K = DOM(X+I, Y-I)
REPEAT UNTIL K = 0
I = 0; PIN FLAG = 0
CYCLE
I = I-1
K = DOM(X-I, Y-I)
REPEAT UNTIL K = 0
-> OUT IF QQ # QUEEN; ! THE BISHOP
MOVE(4): ! ROOK
DIAG = 0
K = 1; I = 0; PIN FLAG = 0
CYCLE
I = I-1
K = DOM(X, Y+I)
REPEAT UNTIL K = 0
I = 0; PIN FLAG = 0
CYCLE
I = I+1
K = DOM(X+I, Y)
REPEAT UNTIL K = 0
I = 0; PIN FLAG = 0
CYCLE
I = I+1
K = DOM(X, Y+I)
REPEAT UNTIL K = 0
I = 0; PIN FLAG = 0
CYCLE
I = I-1
K = DOM(X+I, Y)
REPEAT UNTIL K = 0
-> 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(RECORD(LISTF)NAME LIST, C
INTEGER WIDTH, WHICH)
INTEGER I, MAX
RECORD(LISTF)NAME M1, M2, L, LN, RES
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_SCORE<MAX) OR C
(WHICH>0 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(RECORD(LISTF{QHF})NAME B)
RECORD(SQF)NAME SQ
RECORD(ROWF)NAME ROW
RECORD(LISTF)NAME LIST
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(RECORD(LISTF{QHF})NAME B)
RECORD(SQF)NAME SQ
RECORD(ROWF)NAME ROW
RECORD(LISTF)NAME LIST
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(LISTF{QHF})NAME X, INTEGER W)
INTEGER I
!!
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(LISTF)NAME MOVE, INTEGER WHICH)
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(ROWF)NAME ROW
!!
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(LISTF)NAME LIST)
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(LISTF)NAME LIST)
RECORD(LISTF)NAME L2, MM
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(RECORD(LISTF)NAME LIST)
RECORD(LISTF)NAME L
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(LISTF)NAME LIST
!!
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 0<X<9 AND 0<X0<9 AND C
0<Y<9 AND 0<Y0<9 START
NO: PRINTSTRING("INVALID MOVE - MY FORMAT IS D2D4
")
CYCLE
READSYMBOL(I)
EXIT IF I=NL
REPEAT
->AGAIN
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