external routine draughts

! DRAFT4.2     Author: Ken Chisholm.
external routine spec emas3(string name s,p, integer name f)
externalroutinespec emas3prompt c
   (stringname text)
INTEGERARRAY COMP,OPP(0:24)
OWNINTEGERARRAY CONSCOMP(0:24)='W',86,66,46,26,17,37,57,77,88,68,
                 48,28,1,1,1,1,1,1,1,1,1,1,1,1
OWNINTEGERARRAY CONSOPP(0:24)='B',13,33,53,73,82,62,42,22,11,31,
                 51,71,1,1,1,1,1,1,1,1,1,1,1,1
OWNINTEGERARRAY CENTSQ(1:8)=33,35,44,46,53,55,64,66
INTEGERARRAY MIN,MAX(1:12)
OWNINTEGERARRAY MOVES(1:8)=-11,-22,9,18,11,22,-9,-18
INTEGERARRAY NO OF BOARDS(1:24)
OWNINTEGERARRAY REPLY(1:8)
OWNINTEGER FEW=8, LESS=4
OWNINTEGER SEARCH LIMIT=3,PLY NUMBER
OWNINTEGER PRINTB='P'
INTEGER  BEST PIECE TO MOVE,BEST MOVE,BEST TAKE,C
VALUEB,I,P,M,PIECE,JMAN,JUMP,DIF,MODIF,PIECEWT,MOBWT,EXCHWT,C
CENTWT,ADVWT,MORE,NPCS,OLDPOS,NEWPOS,LASTPOS,COMPOS,NODES,MON
INTEGER NPOS,CRAMPWT,ADV2WT,AWIN,MAXNO,INDEX,J,K,PIECE ADV

 
emas3("define", "1, boards", i)
MAXNO=0
SELECT INPUT(1)
FOR I=1,1,24 CYCLE
   READ(NO OF BOARDS(I))
   IF NO OF BOARDS(I)> MAXNO THEN MAXNO =NO OF BOARDS(I)
REPEAT
MAXNO=MAXNO+20
BEGIN
INTEGERARRAY BOARDS(1:24,1:MAXNO,1:4)

ROUTINE TRANSLATE(INTEGERARRAYNAME COMP,OPP,INTEGERNAME PIECES,C
COL,CROWNS)
INTEGER I,J,K,PT,CP,KP
PIECES=0;COL=0;CROWNS=0
FOR I=10,20,70 CYCLE
 FOR J=0,11,11 CYCLE
   FOR K=1,2,7 CYCLE
   PT=0;CP=0;KP=0
   FOR P=1,1,12 CYCLE
    IF COMP(P)=(I+J+K)THENSTART
     PT=1;CP=1
     IF COMP(P+12)=2 THEN  KP=1
    FINISH
     IF OPP(P)=(I+J+K) THENSTART
      PT=1;CP=0
      IF OPP(P+12)=2 THEN KP=1
    FINISH
   REPEAT
  PIECES=PIECES<<1+PT
  COL=COL<<1+CP
  CROWNS=CROWNS<<1+KP
 REPEAT
REPEAT
REPEAT
END

INTEGERFN MOD(INTEGER N)
  RESULT=N IF N>=0
  RESULT=-N
END
 
ROUTINE READ BINARY(INTEGERNAME N)
INTEGER S
N=0
SKIP SYMBOL WHILE NEXT SYMBOL=' ' OR NEXT SYMBOL=NL
CYCLE
  READ SYMBOL(S)
N=N<<1+(S-'0')
UNLESS NEXT SYMBOL='0' OR NEXT SYMBOL='1' THENRETURN
REPEAT
END

INTEGERFN NUMBER OF PIECES(INTEGERARRAYNAME COMP,OPP)
INTEGER I,PCS
PCS=0
FOR I=1,1,12 CYCLE
  IF COMP(I)#0 THEN PCS=PCS+1
  IF OPP(I)#0 THEN PCS=PCS+1
REPEAT
RESULT=PCS
END
!
! PLAYING FNS.
!
INTEGERFN CROWNED(INTEGER PIECE,INTEGERARRAYNAME COMP)
INTEGER POS
POS=COMP(PIECE)
IF COMP(0)='W' THENSTART
  IF POS=11 OR POS=31 OR POS=51 OR POS=71 THEN RESULT=2
  RESULT=1
FINISH
!BLACK PIECE.
IF POS=28 OR POS=48 OR POS=68 OR POS=88 THEN RESULT=2
RESULT =1
END

INTEGERFN COND OF(INTEGER POS,INTEGERARRAYNAME COMP,OPP)
INTEGER I
! ON THE BOARD?
IF POS<11 OR POS>88 THEN RESULT=-1
FOR I=19,10,79 CYCLE
  IF POS=I OR POS=I+1 THEN RESULT=-1
REPEAT
FOR I=1,1,12 CYCLE
  IF POS=COMP(I) OR POS=OPP(I) THEN RESULT=2
REPEAT
RESULT=0 ;  ! OKAY.
END
ROUTINE WRITE BINARY (INTEGER N)
INTEGER I
SPACE
FOR I=31,-1,0 CYCLE
   PRINT SYMBOL(N>>I&1+'0')
REPEAT
END

INTEGERFN SIGN(INTEGER N)
IF N<0 THEN RESULT= -1
IF N>0 THEN RESULT=1
RESULT=0
END
INTEGERFN PARITY(INTEGER N)
RESULT=N&1
END

INTEGERFN APPLICABLE MOVE(INTEGER MOVE,P,INTEGERARRAYNAME COMP,OPP)
INTEGER I,T
IF COMP(P)=0 THEN RESULT=-1
IF COMP(0)='W' AND MOVE>4 AND COMP(P+12)=1 THEN RESULT=-1
IF COMP(0)='B' AND MOVE<5 AND COMP(P+12)=1 THEN RESULT=-1
IF PARITY(MOVE)=1 THENSTART
  IF COND OF(COMP(P)+MOVES(MOVE),COMP,OPP)=0 THEN RESULT=0
  RESULT=-1
FINISH
! TAKE MOVE.
IF COND OF(COMP(P)+MOVES(MOVE),COMP,OPP)#0 THEN RESULT=-1
T=COMP(P)+MOVES(MOVE-1)
FOR I=1,1,12 CYCLE
  IF T=OPP(I) THEN RESULT=I
REPEAT
RESULT=-1
END

INTEGERFNSPEC IF SEEN BOARD(INTEGERARRAYNAME COMP,OPP)
!
! EVALUATION FUNCTION.
!
INTEGERFN VALUE OF POSITION(INTEGERARRAYNAME COMP,OPP)
INTEGER V1,V2,V3,V4,V5,V6,V8,V9,P,M,J,B1,B2,APEX,PCS,PC ADV,PC DIFF
IF COMP(0)='W' THENC
V1=IF SEEN BOARD(COMP,OPP) ELSEC
V1=IF SEEN BOARD(OPP,COMP)
IF INDEX#0 THENSTART
   IF COMP(0)='W' THEN V1=V1-PLY NUMBER ELSE V1=V1+PLY NUMBER
   RESULT=V1
FINISH
V1=0 ; !PIECE COUNT.
V2=0;V3=0;V4=0
FOR P=1,1,12 CYCLE
 I=P+12
  IF COMP(I)=1 THEN V1=V1+1
  IF COMP(I)=2 THEN V2=V2+2
  IF OPP(I)=1 THEN V3=V3+1
  IF OPP(I)=2 THEN V4=V4+2
REPEAT
V1=V1+V2-(V3+V4)
! EXCHANGE.
PCS=NUMBER OF PIECES(COMP,OPP)
PC ADV=PIECE ADV
IF COMP(0)='B' THEN PC ADV=-PC ADV
PC DIFF=NPCS-PCS
V9=PC DIFF*SIGN(PC ADV)
V8=0;! GUARD.
IF COMP(0)='W' THEN B1=28 AND B2=68 AND APEX=57 ELSE B1=31 ANDC
 B2=71 AND APEX=42
IF V4=0 THENSTART
  IF COMP(12)=B1 THEN V8=V8+3
  IF COMP(10)=B2 THEN V8=V8+3
  IF COMP(7)=APEX THEN V8=V8+4
FINISH
IF V2=0 THENSTART
B1=59-B1;B2=149-B2;APEX=99-APEX
  IF OPP(10)=B1 THEN V8=V8-3
  IF OPP(12)=B2 THEN V8=V8-3
  IF OPP(7)=APEX THEN V8=V8-4
FINISH
! MOBILITY.
V2=0;V3=0
FOR P=1,1,12 CYCLE
 FOR M=1,1,8 CYCLE
  IF APPLICABLE MOVE(M,P,COMP,OPP)>=0 THENC
   V2=V2+PARITY(M+1)+1
  IF APPLICABLE MOVE(M,P,OPP,COMP)>=0 THENC
   V3=V3+(PARITY(M+1)+1)
 REPEAT
REPEAT
IF V2=0 THENSTART
  IF COMP(0)='W' THEN RESULT= -100000 + PLY NUMBER
  RESULT=100000  - PLY NUMBER
FINISH
V2=V2-V3
V3=0; ! CENTER CONTROL
FOR P=1,1,12 CYCLE
 FOR M=1,1,8 CYCLE
  IF COMP(P)=CENTSQ(M) THEN V3=V3+COMP(P+12)
  IF OPP(P)=CENTSQ(M) THEN V3=V3-OPP(P+12)
 REPEAT
REPEAT
V4=0; ! ADVANCEMENT.
FOR P=1,1,12 CYCLE
 FOR M=1,1,8 CYCLE
  IF APPLICABLE MOVE(M,P,COMP,OPP)>=0 THENSTART
  COMP(P)=COMP(P)+MOVES(M)
   IF CROWNED(P,COMP)=2 AND COMP(P+12)=1 THEN V4=V4+1 ANDC
   COMP(P)=COMP(P)-MOVES(M) ANDEXIT
   COMP(P)=COMP(P)-MOVES(M)
  FINISH
 REPEAT
 FOR M=1,1,8 CYCLE
  IF APPLICABLE MOVE(M,P,OPP,COMP)>=0 THENSTART
   OPP(P)=OPP(P)+MOVES(M)
   IF CROWNED(P,OPP)=2 AND OPP(P+12)=1 THEN V4=V4-1 ANDC
  OPP(P)=OPP(P)-MOVES(M) ANDEXIT
   OPP(P)=OPP(P)-MOVES(M)
  FINISH
 REPEAT
REPEAT
V5=0; ! CRAMP.
FOR P=1,1,12 CYCLE
 FOR M=1,2,7 CYCLE
  IF APPLICABLE MOVE(M,P,OPP,COMP)>=0 THENSTART
   OPP(P)=OPP(P)+MOVES(M)
   FOR I=1,1,12 CYCLE
    FOR J=2,2,8 CYCLE
    IF APPLICABLE MOVE(J,I,COMP,OPP)>=0 THEN V5=V5+OPP(P+12) ANDEXIT
    REPEAT
   REPEAT
   OPP(P)=OPP(P)-MOVES(M)
  FINISH
  IF APPLICABLE MOVE(M,P,COMP,OPP)>=0 THENSTART
   COMP(P)=COMP(P)+MOVES(M)
   FOR I=1,1,12 CYCLE
    FOR J=2,2,8 CYCLE
    IF APPLICABLE MOVE(J,I,OPP,COMP)>=0 THEN V5=V5-COMP(P+12)ANDEXIT
    REPEAT
   REPEAT
   COMP(P)=COMP(P)-MOVES(M)
  FINISH
 REPEAT
REPEAT
! V6 - ADV2.
V6=0
FOR P=1,1,12 CYCLE
 IF COMP(P+12)=1 THENSTART
  FOR M=1,2,7 CYCLE
   IF APPLICABLE MOVE(M,P,COMP,OPP) >=0 THENSTART
   COMP(P)=COMP(P)+MOVES(M)
   FOR J=1,2,7 CYCLE
    IF APPLICABLE MOVE(J,P,COMP,OPP)>=0 THENSTART
     COMP(P)=COMP(P)+MOVES(J)
     IF CROWNED(P,COMP)=2 THEN V6=V6+1 ANDC
     COMP(P)=COMP(P)-MOVES(J) ANDEXIT
     COMP(P)=COMP(P)-MOVES(J)
    FINISH
   REPEAT
   COMP(P)=COMP(P)-MOVES(M)
  FINISH
 REPEAT
 FINISH
REPEAT
FOR P=1,1,12 CYCLE
 IF OPP(P+12)=1 THENSTART
  FOR M=1,2,7 CYCLE
   IF APPLICABLE MOVE(M,P,OPP,COMP)>=0 THENSTART
    OPP(P)=OPP(P)+MOVES(M)
    FOR J=1,2,7 CYCLE
     IF APPLICABLE MOVE(J,P,OPP,COMP)>=0 THENSTART
      OPP(P)=OPP(P)+MOVES(J)
     IF CROWNED(P,OPP)=2 THEN V6=V6-1 ANDC
      OPP(P)=OPP(P)-MOVES(J) AND EXIT
      OPP(P)=OPP(P)-MOVES(J)
     FINISH
    REPEAT
   OPP(P)=OPP(P)-MOVES(M)
  FINISH
 REPEAT
 FINISH
REPEAT
V1=PIECEWT*V1+MOBWT*V2+CENTWT*V3+ADVWT*V4+CRAMPWT*V5+ADV2WT*V6
V1=V1+V8 + EXCHWT*V9 - PLY NUMBER
IF COMP(0)='B' THEN V1 =-V1
RESULT=V1
END

ROUTINESPEC PRINT BOARD
ROUTINE EXPLAIN POS
PRINT STRING("  The method of communicating moves is very similar to
the Algebraic Notation sometimes used in chess.");NEWLINE
PRINT STRING("Examples of valid move types:-
A3-B4
G3-H4P      (Prints the board after my reply)");NEWLINE
PRINT STRING("P           (Just prints the board)");NEWLINE
PRINT STRING("A3-C5,      (To type in
C5-A7       multiple jump moves)");NEWLINE
PRINT STRING("I QUIT      (To resign or stop the game.)"); NEWLINE
PRINT STRING("Here is the board as initially set up -
")
PRINT BOARD
END

ROUTINE SAY PLEASE
PRINT STRING( "Please re-type your move ")
NEWLINE
END

ROUTINE PRINT BOARD
INTEGER I,J,POS,COL,ROW
INTEGERARRAY A(1:64)
INTEGERMAP BOARD(INTEGER I,J)
RESULT==A(8*(I-1)+J)
END
! WIPE BOARD.
FOR I=1,1,64 CYCLE
  A(I)=' '
REPEAT
FOR I=1,2,7 CYCLE
 FOR J=1,2,7 CYCLE
  BOARD(I,J)='%'
  BOARD(I+1,J+1)='%'
 REPEAT
REPEAT
FOR I=1,1,12 CYCLE
 IF COMP(I)#0 THENSTART
  POS=COMP(I)
  ROW=POS//10
  COL=POS-10*ROW
  IF COMP(I+12)=1 THEN BOARD(ROW,COL)='C'ELSE BOARD(ROW,COL)='K'
 FINISH
 IF OPP(I)#0 THENSTART
  POS=OPP(I)
  ROW=POS//10
  COL=POS-10*ROW
  IF OPP(I+12)=1 THEN BOARD(ROW,COL)='o'ELSE BOARD(ROW,COL)='='
 FINISH
REPEAT
NEWLINE;PRINT STRING("   A B C D E F G H")
FOR I=8,-1,1 CYCLE
 NEWLINE
 WRITE(I,1)
 FOR J=1,1,8 CYCLE
  SPACE
  PRINT SYMBOL(BOARD(J,I))
 REPEAT
 WRITE(I,1)
REPEAT
NEWLINE;PRINT STRING( "   A B C D E F G H");NEWLINE
END

ROUTINE TROUT(INTEGER OLDPOS,NEWPOS,MODE)
! TRANSLATES AND OUTPUTS MOVES.
INTEGER X,Y,S1,S2,T1,T2
X=OLDPOS//10
Y=OLDPOS-10*X
S1=X+'A'-1
S2=Y+'0'
X=NEWPOS//10
Y=NEWPOS-10*X
T1=X+'A'-1
T2=Y+'0'
IF MODE =1 THENSTART
 PRINT STRING( "DRAFT4's move is ")
 PRINT SYMBOL(S1);PRINT SYMBOL(S2);PRINT SYMBOL('-')
 PRINT SYMBOL(T1);PRINT SYMBOL(T2)
FINISHELSESTART
 SPACE;PRINT SYMBOL(',');SPACE;PRINT SYMBOL(S1);PRINT SYMBOL(S2)
 PRINT SYMBOL('-');PRINT SYMBOL(T1);PRINT SYMBOL(T2)
FINISH
END

ROUTINE TAKE(INTEGER T,P,MV,INTEGERARRAYNAME COMP,OPP,INTEGERC
MODE,TAKES)
INTEGER M,APP
IF MODE='P' THEN TROUT(COMP(P),COMP(P)+MOVES(MV) ,TAKES+1)
COMP(P)=COMP(P)+MOVES(MV);OPP(T)=0; OPP(T+12)=0
IF COMP(P+12)=1 THENSTART
  COMP(P+12)=CROWNED(P,COMP)
  IF COMP(P+12)=2 THEN RETURN
FINISH
FOR M=2,2,8 CYCLE
 APP=APPLICABLE MOVE(M,P,COMP ,OPP)
 IF APP>0 THEN TAKE(APP,P,M,COMP,OPP,MODE,TAKES+1) ANDRETURN
REPEAT
END

ROUTINE MAKE MOVE(INTEGER M,P,T,INTEGERARRAYNAME COMP,OPP,C
INTEGER MODE)
IF T=0 THENSTART
 IF MODE='P'THEN TROUT(COMP(P),COMP(P)+MOVES(M),1)
 COMP(P)=COMP(P)+MOVES(M)
 UNLESS COMP(P+12)=2 THEN COMP(P+12)=CROWNED(P,COMP)
 RETURN
FINISH
! TAKE MOVE.
TAKE(T,P,M,COMP,OPP,MODE,0)
END

INTEGERFN CAN TAKE(INTEGERARRAYNAME OPP,COMP)
INTEGER P,M
FOR P=1,1,12 CYCLE
 FOR M=2,2,8 CYCLE
  IF APPLICABLE MOVE(M,P,OPP,COMP)>0 THEN RESULT='T'
 REPEAT
REPEAT
RESULT='F'
END

INTEGERFN TRY POSSIBLE MOVES(INTEGER PLY,DEPTH,INTEGERARRAYNAMEC
 COMP,OPP)
INTEGERARRAY TCOMP,TOPP(0:24)
INTEGER APT,P,M,VALUE,TAKEFLAG,I,FOR,MUST TAKE
INTEGERFN PURSUIT VALUE(INTEGER M)
  IF PLY=1 THEN RESULT=1
  RESULT=PARITY(M)
END
NODES =NODES+1
FOR=COMP(0); ! CONSIDER MOVES FOR COMP (='W') OR OPP (='B').
MUST TAKE=CAN TAKE(COMP,OPP)
!     Principle of hot pursuit.
IF (DEPTH>=SEARCH LIMIT AND MUST TAKE='F') OR PLY>12 THENC
PLY NUMBER=PLY-1 AND RESULT=VALUE OF POSITION(COMP,OPP)
MIN(PLY)=100000;MAX(PLY)=-100000;TAKE FLAG=0
IF MUST TAKE='T' THEN TAKE FLAG=1
FOR P=1,1,12 CYCLE
 FOR M=1,1,8 CYCLE
 IF PARITY(M)=1 AND TAKEFLAG=1 THEN APT=-1 ELSEC
 APT=APPLICABLE MOVE(M,P,COMP,OPP)
 UNLESS APT<0 THENSTART
  ! COPY COMP->TCOMP,OPP->TOPP.
  FOR I=0,1,24 CYCLE
    TCOMP(I)=COMP(I)
    TOPP(I)=OPP(I)
  REPEAT
  MAKE MOVE(M,P,APT,TCOMP,TOPP,'Q')
  VALUE=TRY POSSIBLE MOVES(PLY+1,DEPTH+ PURSUIT VALUE(M),TOPP,TCOMP)
  IF VALUE >MAX(PLY) AND FOR='W' THENSTART
   MAX(PLY)=VALUE
   IF PLY=1 THENSTART
    BEST MOVE=M
    BEST PIECE TO MOVE=P
    BEST TAKE=APT
   FINISH
  FINISH
  IF VALUE<MIN(PLY) AND FOR='B' THENSTART
   MIN(PLY)=VALUE
  FINISH
 FINISH
! alpha-beta pruning.
IF FOR='B' AND MIN(PLY)<=MAX(PLY-1) THEN RESULT=MIN(PLY)
IF PLY#1 AND MAX(PLY)>=MIN(PLY-1) AND FOR='W' THENC
RESULT=MAX(PLY)
REPEAT
REPEAT
! mini-maxing.
IF FOR='W' THEN RESULT=MAX(PLY)
RESULT=MIN(PLY)
END

INTEGERFN POSITION OF(INTEGER S1,S2)
RESULT=10*(S1-'A'+1) +(S2-'0')
END

ROUTINE READ REPLY(INTEGERNAME S)
READ SYMBOL(S)
S = S-32 IF S>='a'
SKIP SYMBOL WHILE NEXT SYMBOL#NL
SKIP SYMBOL
END
ROUTINE READ BOARD
INTEGER P,S1,S2,S3,POS
FOR P=1,1,24 CYCLE
  COMP(P)=0
  OPP(P)=0
REPEAT
PRINT STRING("Where are your pieces?");NEWLINE
FOR P=1,1,12 CYCLE
  SKIP SYMBOL WHILE NEXT SYMBOL=' 'OR NEXT SYMBOL=NL
  READ SYMBOL(S1);IF S1='*' THENEXIT
  S1=S1-32 IF S1>='a'
  IF S1='M' THEN MON='M' ANDEXIT
  READ SYMBOL(S2);READ SYMBOL(S3)
  s2=s2-32 if s2>='a'; s3=s3-32 if s3>='a'
  POS=POSITION OF(S1,S2);OPP(P)=POS
  IF S3=' ' THEN OPP(P+12)=1 ELSE OPP(P+12)=2
REPEAT
SKIP SYMBOL
PRINT STRING("Where are my pieces?");NEWLINE
FOR P=1,1,12 CYCLE
  SKIP SYMBOL WHILE NEXT SYMBOL=' 'OR NEXT SYMBOL=NL
  READ SYMBOL(S1);IF S1='*' THENEXIT
  READ SYMBOL(S2);READ SYMBOL(S3)
  s1=s1-32 if s1>='a'
  s2=s2-32 if s2>='a'; s3=s3-32 if s3>='a'
  POS=POSITION OF(S1,S2);COMP(P)=POS
  IF S3=' ' THEN COMP(P+12)=1 ELSE COMP(P+12)=2
REPEAT
SKIP SYMBOL
END

INTEGERFN PIECE COUNT(INTEGER B)
INTEGER P
P=0
CYCLE
    IF B=0 THEN RESULT=P
    IF B&1 =1 THEN P=P+1
    B=B>>1
REPEAT
END

ROUTINE SAY SEEN
PRINT STRING("Partial board recognised") AND NEWLINE IF MON='M'
END
!
! ROTE LEARNING FUNCTIONS.
!
INTEGERFN PARTIAL BOARD MATCH(INTEGER PCS,COL,CRS)
INTEGER I,SIDE1PCS,SIDE1COL,SIDE1CRS,SIDE2PCS,SIDE2COL,SIDE2CRS,A,B,J
INTEGER NSIDE1PCS,NSIDE2PCS
! SPLIT BOARD INTO TWO HALVES
SIDE1PCS=PCS&16_FFFF0000;NSIDE1PCS=PIECE COUNT(SIDE1PCS)
SIDE2PCS=PCS &16_FFFF;NSIDE2PCS=PIECE COUNT(SIDE2PCS)
SIDE1COL=COL&16_FFFF0000; ! SIDE 1 COLOURS
SIDE2COL=COL &16_FFFF;       ! SIDE2 COLOURS
SIDE1CRS=CRS&16_FFFF0000; ! SIDE 1 CROWNS
SIDE2CRS=CRS &16_FFFF;      ! SIDE 2 CROWNS
IF NSIDE1PCS=0 OR NSIDE2PCS=0 THEN RESULT=-120000;    !ONE HALF EMPTY
IF SIDE1PCS=SIDE1COL THEN A=100000 AND -> LOOK AT OTHER HALF
FOR I=1,1,NO OF BOARDS(NSIDE1PCS) CYCLE
      IF SIDE1PCS=BOARDS(NSIDE1PCS,I,1) ANDC
       SIDE1COL=BOARDS(NSIDE1PCS,I,2) ANDC
       SIDE1CRS=BOARDS(NSIDE1PCS,I,3) THEN  A=BOARDS(NSIDE1PCS,I,4) C
      AND -> LOOK AT OTHER HALF
REPEAT
RESULT=-120000 ;  ! NO PARTIAL MATCH FOUND, (IMPOSSIBLE VALUE).
LOOK AT OTHER HALF: IF SIDE2PCS=SIDE2COL THENSTART
                 ! ONE HALF OF THE BOARD ONLY HAS FRIENDLY PIECES ON IT
                     B=100000
                     IF SIGN(A)=SIGN(B) THENRESULT=(A+B)//2
                      RESULT=-120000
                 FINISH
    FOR J=1,1,NO OF BOARDS(NSIDE2PCS) CYCLE
      IF SIDE2PCS=BOARDS(NSIDE2PCS,J,1) ANDC
          SIDE2COL=BOARDS(NSIDE2PCS,J,2) ANDC
           SIDE2CRS=BOARDS(NSIDE2PCS,J,3) THENSTART
             ! CHECK FOR CONFLICTING HALF BOARD VALUES
               B=BOARDS(NSIDE2PCS,J,4)
            IF SIGN(A)=SIGN(B) THEN RESULT=(A+B)//2
            RESULT=-120000
      FINISH
    REPEAT
RESULT=-120000; ! NO PARTIAL BOARD MATCH FOUND, (IMPOSSIBLE VALUE)
END

INTEGERFN IF SEEN BOARD(INTEGERARRAYNAME COMP,OPP)
INTEGER I,PCS,PCS1,COL1,CR1,PCS2,COL2,CR2
PCS=NUMBER OF PIECES(COMP,OPP)
IF PCS=0 THEN INDEX=0 AND RESULT=-120000
IF NO OF BOARDS(PCS)=0 THEN INDEX =0 AND RESULT=-120000
TRANSLATE(COMP,OPP,PCS1,COL1,CR1)
TRANSLATE(OPP,COMP,PCS2,COL2,CR2)
IF PCS<=6 THENSTART
    I=PARTIAL BOARD MATCH(PCS1,COL1,CR1)
    IF I#-120000 THEN  SAY SEEN AND INDEX=-1 AND RESULT=I
FINISH
FOR I=1,1,NO OF BOARDS(PCS) CYCLE
  IF BOARDS(PCS,I,1)=PCS1 AND BOARDS(PCS,I,2)=COL1 ANDC
  BOARDS(PCS,I,3)=CR1 THENSTART
       IF MON='M' THEN PRINT STRING("Board Recognised")AND NEWLINE
       INDEX=I;RESULT=BOARDS(PCS,I,4)
  FINISH
  IF BOARDS(PCS,I,1)=PCS2 AND BOARDS(PCS,I,2)=COL2 ANDC
  BOARDS(PCS,I,3)=CR2 THENSTART
       IF MON='M' THEN PRINT STRING("Board Recognised") AND NEWLINE
       INDEX=I ; RESULT=- BOARDS(PCS,I,4)
  FINISH
REPEAT
INDEX=0
RESULT=-120000
END
ROUTINE REMEMBER BOARD
INTEGER PCS,PIECES,COLOURS,CROWNS,VALUE
PCS=NUMBER OF PIECES(COMP,OPP)
VALUE = IF SEEN BOARD(COMP,OPP)
IF INDEX=-1 THEN RETURN;    ! PARTIAL BOARD MATCH FOUND
IF VALUE = VALUEB  OR VALUE=-VALUEB THEN RETURN
TRANSLATE(COMP,OPP,PIECES,COLOURS,CROWNS)
IF INDEX=0 THEN NO OF BOARDS(PCS)=NO OF BOARDS(PCS)+1 ANDC
   INDEX=NO OF BOARDS(PCS)
IF INDEX>MAXNO THEN NO OF BOARDS(PCS)=NO OF BOARDS(PCS)-1 ANDRETURN
BOARDS(PCS,INDEX,1)=PIECES
BOARDS(PCS,INDEX,2)=COLOURS
BOARDS(PCS,INDEX,3)=CROWNS
BOARDS(PCS,INDEX,4)=VALUEB
IF INDEX# NO OF BOARDS(PCS) AND MON='M' THENC
    PRINT STRING("* Updating Board Evaluation *") AND NEWLINE
END
!
! ** MAIN PROGRAM **
!
! READING IN STORED BOARDS.
FOR I=1,1,24 CYCLE
   IF NO OF BOARDS(I)#0 THENSTART
       FOR J=1,1,NO OF BOARDS(I) CYCLE
          FOR K=1,1,3 CYCLE
             READ BINARY(BOARDS(I,J,K))
          REPEAT
      READ(BOARDS(I,J,4))
       REPEAT
   FINISH
REPEAT
SELECT INPUT(0)
START:
PIECEWT=1000;MOBWT=6;EXCHWT=8
CENTWT=4;ADVWT=550;CRAMPWT=8;ADV2WT=50
AWIN=0
MON='Q'
NEWLINE
PRINT STRING( "The Draughts Program , DRAFT4.2L")
NEWLINES(2)
! Setting up the pieces.
FOR P=0,1,24 CYCLE
  COMP(P)=CONSCOMP(P)
  OPP(P)=CONSOPP(P)
REPEAT
PRINT STRING( "Have you played me before?");NEWLINE
emas3prompt(":")
READ REPLY(REPLY(1))
IF REPLY(1)='N' THEN EXPLAIN POS
PRINT STRING( "Do you want to start?");NEWLINE
emas3prompt(":")
READ REPLY(REPLY(1))
IF REPLY(1)='R' THENSTART
  READ BOARD
  PRINT STRING("Is it your move?");NEWLINE
  READ REPLY(REPLY(1))
  IF REPLY(1)='Y' THEN -> READ MOVE ELSE -> COMP MOVE
FINISH
IF REPLY(1)='N'THENSTART
PRINT STRING("Think of a number");NEWLINE
READ(I);SKIP SYMBOL
I=I&3
 PRINT STRING( "DRAFT4's opening move is ")
IF I=0 THEN PRINT STRING("D6-C5") AND COMP(3)=35
IF I=1 THEN PRINT STRING("B6-C5") AND COMP(4)=35
IF I=2 OR I=3 THEN PRINT STRING("F6-E5")AND COMP(2)=55
 NEWLINE
FINISH
READ MOVE:
IF PRINTB='P'THEN PRINT BOARD
emas3prompt(":")
FOR I=1,1,8 CYCLE
  READ SYMBOL(REPLY(I))
  reply(i)=reply(i)-32 if reply(i)>='a'
  IF REPLY(I)=NL THENEXIT
REPEAT
REPLY(I)=' ' AND I=I+1 UNTIL I=9
IF REPLY(1)='M' THEN MON='M' AND -> READ MOVE
IF REPLY(1)='Q' THEN MON='Q' AND -> READ MOVE
IF REPLY(1)='P' THEN PRINT BOARD AND -> READ MOVE
TRANS: IF REPLY(1)='I'THEN -> STOP
IF REPLY(6)=','THEN MORE='M'ELSE MORE=' '
OLDPOS=POSITION OF(REPLY(1),REPLY(2))
NEWPOS=POSITION OF(REPLY(4),REPLY(5))
!
! MOVE VERIFICATION.
!
IF COND OF(OLDPOS,COMP,OPP)=-1 THENSTART
 PRINT STRING( "The square ");PRINT SYMBOL(REPLY(1))
 PRINT SYMBOL(REPLY(2))
 PRINT STRING(" does not exist!"); NEWLINE
 SAY PLEASE
 -> READ MOVE
FINISH
M=COND OF(NEWPOS,COMP,OPP)
IF M=-1 THENSTART
PRINT STRING( "You cannot move to square ")
 PRINT SYMBOL(REPLY(4));PRINT SYMBOL(REPLY(5))
 PRINT STRING(". It does not exist!");NEWLINE
 SAY PLEASE
 -> READ MOVE
FINISH
IF M=2 THENSTART
 PRINT STRING( "You cannot move to square ")
 PRINT SYMBOL(REPLY(4));PRINT SYMBOL(REPLY(5))
 NEWLINE
 PRINT STRING( "It is already occupied!");NEWLINE
 SAY PLEASE
 -> READ MOVE
FINISH
FOR P=1,1,12 CYCLE
  IF OLDPOS=OPP(P)THENEXIT
REPEAT
UNLESS OLDPOS=OPP(P)THENSTART
 PRINT STRING( "You do not have a piece on square ")
 PRINT SYMBOL(REPLY(1));PRINT SYMBOL(REPLY(2))
 NEWLINE
 SAY PLEASE
 -> READ MOVE
FINISH
PIECE=P
DIF=NEWPOS-OLDPOS
MODIF=MOD(DIF)
IF MODIF<12 AND CAN TAKE(OPP,COMP)='T'THENSTART
PRINT STRING( "You MUST take the piece that I am offering you
")
SAY PLEASE
-> READ MOVE
FINISH
IF MODIF<12 AND MORE='M'THENSTART
PRINT STRING("That's not part of a multiple jump move");NEWLINE
SAY PLEASE
-> READ MOVE
FINISH
IF (DIF=-11 OR DIF=-22 OR DIF=9 OR DIF=18)ANDC
OPP(PIECE+12)=1 THENSTART
PRINT STRING("You cannot move that piece backwards!");NEWLINE
SAY PLEASE
-> READ MOVE
FINISH
UNLESS MODIF=11 OR MODIF=9 OR MODIF=22 OR MODIF=18 THENSTART
PRINT STRING( "That move does not exist in my rule book!");NEWLINE
SAY PLEASE
-> READ MOVE
FINISH
IF MODIF>11 THENSTART
JUMP=DIF//2
COMPOS=OLDPOS+JUMP
FOR I=1,1,12 CYCLE
IF COMPOS=COMP(I)THENEXIT
REPEAT
UNLESS COMPOS=COMP(I)THENSTART
PRINT STRING("You cannot do that.You are not jumping one of my pieces
")
SAY PLEASE
-> READ MOVE
FINISHELSE JMAN=I
FINISHELSE JMAN=0
OPP(PIECE)=OPP(PIECE)+DIF
UNLESS OPP(PIECE+12)=2 THEN OPP(PIECE+12)=CROWNED(PIECE,OPP)
COMP(JMAN)=0 AND COMP(JMAN+12)=0 UNLESS JMAN=0
IF MORE='M'THENSTART
LASTPOS=NEWPOS
READ AGAIN:
emas3prompt("&")
FOR I=1,1,8 CYCLE
  READ SYMBOL(REPLY(I))
  reply(i)=reply(i)-32 if reply(i)>='a'
  IF REPLY(I)=NL THENEXIT
REPEAT
IF REPLY(1)='.'THEN -> COMP MOVE
REPLY(I)=' 'AND I=I+1 UNTIL I=9
OLDPOS=POSITION OF(REPLY(1),REPLY(2))
NEWPOS=POSITION OF(REPLY(4),REPLY(5))
DIF=NEWPOS-OLDPOS
DIF=MOD(DIF)
IF DIF>11 AND OLDPOS=LASTPOS THEN -> TRANS
PRINT STRING("That's not part of a multiple jump");NEWLINE
PRINT STRING("Please re-type that part");NEWLINE
-> READ AGAIN
FINISH
COMP MOVE: ! COMPUTER MAKES MOVE.
NPCS=0
NPOS=0
FOR P=1,1,12 CYCLE
IF COMP(P)#0 THEN NPCS=NPCS+1
IF OPP(P)#0 THEN NPOS=NPOS+1
REPEAT
IF NPCS=0 THENSTART
PRINT STRING( " I have no pieces left so you have won") ;NEWLINE
-> STOP
FINISH
! PIECE ADVANTAGE (FOR COMPUTER).
PIECE ADV=NPCS - NPOS
NPCS=NPCS+NPOS
IF NPCS<=FEW THEN SEARCH LIMIT=SEARCH LIMIT+1 AND FEW=FEW-LESS
I=0
FOR P=1,1,12 CYCLE
  FOR M=1,1,8 CYCLE
   IF APPLICABLE MOVE(M,P,COMP,OPP)>=0 THEN I=1 ANDEXIT
  REPEAT
REPEAT
IF I=0 THENSTART
 PRINT STRING("I cannot move any of my pieces so you win")
 NEWLINE
 -> STOP
FINISH
NODES=0
!
! FIND BEST POSSIBLE MOVE.
VALUEB=TRY POSSIBLE MOVES(1,1,COMP,OPP)
!
REMEMBER BOARD
IF VALUEB<=-99900 THENSTART
  PRINT STRING("I resign");NEWLINE
  -> STOP
FINISH
IF MON='M' THENSTART
  PRINT STRING("Nodes considered = ");WRITE(NODES,3);NEWLINE
  PRINT STRING("Value of board = ");WRITE(VALUEB,3);NEWLINE
  IF PLY NUMBER>3 THEN PRINT STRING("Depth of search = ") ANDC
  WRITE(PLY NUMBER,1) AND NEWLINE
FINISH
MAKE MOVE(BEST MOVE,BEST PIECE TO MOVE,BEST TAKE,COMP,OPP,'P')
NEWLINE
NPOS=0
FOR P=1,1,12 CYCLE
 IF OPP(P)#0 THEN NPOS=1 ANDEXIT
REPEAT
IF NPOS=0 THENSTART
 PRINT STRING( "You have no pieces left so I win");NEWLINE
 -> STOP
FINISH
I=0
FOR P=1,1,12 CYCLE
 FOR M=1,1,8 CYCLE
  IF APPLICABLE MOVE(M,P,OPP,COMP)>=0 THEN I=1 ANDEXIT
 REPEAT
REPEAT
IF I=0 THENSTART
 PRINT STRING("You cannot move any of your pieces so I win")
 NEWLINE
 -> STOP
FINISH
IF VALUEB>=99900 AND AWIN=0 THENSTART
  PRINT STRING("He-He! I am going to win!");NEWLINE
  AWIN=1
FINISH
-> READ MOVE
STOP: NEWLINE
PRINT STRING( "The final board position is -");NEWLINE
PRINT BOARD
PRINT STRING("Play again ?"); NEWLINE
READ REPLY(I)
IF I='Y' THEN -> START
!
! STORING REMEMBERED BOARDS.
!
!OPENOUTPUT(1,"BOARDS.DAT")
!SELECT OUTPUT(1)
!%FOR I=1,1,24 %CYCLE
!   WRITE(NO OF BOARDS(I),5);NEWLINE
!%REPEAT
!%FOR I=1,1,24 %CYCLE
!  NEWLINE
!   %IF NO OF BOARDS(I)#0 %THENSTART
!      %FOR J=1,1,NO OF BOARDS(I) %CYCLE
!          %FOR K=1,1,3 %CYCLE
!             WRITE BINARY(BOARDS(I,J,K))
!             %IF K=2 %THEN NEWLINE
!          %REPEAT
!          WRITE(BOARDS(I,J,4),18)
!          NEWLINE
!      %REPEAT
!   %FINISH
!%REPEAT
end
END
endoffile