EXTERNALROUTINE DRAUGHTS(STRING(12) S) EXTERNALROUTINESPEC CPULIMIT (STRING(255) S) EXTERNALROUTINESPEC PROMPT(STRING(15) S) OWNINTEGER MOB WT = 6 CONSTINTEGER TRUE =1, FALSE = 0 OWNINTEGER BACK WT = 4 OWNINTEGER CENT WT = 4 OWNINTEGER ADV1 WT = 450 OWNINTEGER ADV2 WT = 50 OWNINTEGER CRAMP WT = 6 OWNINTEGER MON = 'Q' OWNINTEGER A WIN = 0 OWNINTEGER SEARCH LIMIT = 3 OWNINTEGER CROWN = 1800 OWNINTEGERARRAY BACK1(1:5) = 77, 75, 73, 71, 64 OWNINTEGERARRAY BACK2(1:5) = 0, 2, 4, 6, 13 OWNINTEGERARRAY CENTSQ(0:7) = 51, 53, 42, 44, 33, 35, 24, 26 OWNINTEGERARRAY MOVE(0:7) = 9, 18, 11, 22, -9,-18,-11,-22 OWNINTEGERARRAY PLAYER1(-1:26) = 'W', 1, 77, 75, 73, 71, 64, 66, 62, 60, 57, 55, 53, 51, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 12, 0 OWNINTEGERARRAY PLAYER2(-1:26) = 'B', 2, 0, 2, 4, 6, 13, 11, 15, 17, 20, 22, 24, 26, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 12, 0 OWNINTEGERARRAY BOARD(-1:78) = C ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ' INTEGERARRAY MIN, MAX(1:12) INTEGERARRAY REPLY(1:9) INTEGERARRAY COMP, OPP(-1:26) INTEGERNAME COMPNUM, OPPNUM INTEGERARRAY PSTACK(1:12); ! piece position take stack INTEGERARRAY TSTACK(1:12); ! piece type stack INTEGERARRAY NSTACK(1:12); ! piece number stack OWNINTEGER SP; ! stack pointer OWNINTEGER ME = 1 OWNINTEGER ONE = 1 OWNINTEGER TWO = 2 OWNINTEGER THREE = 3 INTEGER BEST PIECE, BEST MOVE, BEST TAKE INTEGER VALUEB, I, P, M, PIECE, JMAN, JUMP, DIF, MODIF, MORE INTEGER OLDPOS, NEWPOS, LASTPOS, COMPOS INTEGER NODES, PLY NUMBER, EXPECTED MOVE INTEGER A,B,C,POS !* P L A Y I N G F U N C T I O N S INTEGERFN VALID POS(INTEGER POS) INTEGER I ! on the board? I = POS>>1 RESULT = -1 IF POS < 0 OR POS > 77 C OR I = 4 OR I = 14 OR I = 24 OR I = 34 ! square vacant? CYCLE I = 1, 1, 12 RESULT = 1 IF (I <= COMPNUM AND POS = COMP(I)) C OR (I <= OPPNUM AND POS = OPP(I)) REPEAT RESULT = 0 END INTEGERFN VALID MOVE(INTEGER M, P, INTEGERARRAYNAME COMP, OPP) INTEGER CPOS, I, T UNLESS COMP(P+12) = CROWN START IF COMP(0) = 1 START; ! player 1 RESULT = -1 IF M&4 = 0; ! backward move FINISH ELSE START; ! else player 2 RESULT = -1 IF M&4 # 0; ! backward move FINISH FINISH CPOS = COMP(P) RESULT = -1 UNLESS VALID POS(CPOS+MOVE(M)) = 0 RESULT = 0 IF M&1 = 0; ! ordinary move RESULT = -1 IF OPP(25)=0 I = CPOS+MOVE(M-1); ! else take-move CYCLE T = 1, 1, OPP(25) RESULT = T IF I = OPP(T); ! piece to take? REPEAT RESULT = -1 END INTEGERFN PENDING MOVE(INTEGERARRAYNAME COMP, OPP) INTEGER P, M, T, COMPNUM COMPNUM = COMP(25) RESULT = -1 IF COMPNUM = 0; ! no pieces left!! CYCLE P = 1, 1, COMPNUM CYCLE M = 1, 2, 7 T = VALID MOVE(M, P, COMP, OPP) RESULT = P IF T > 0; ! return piece doing take REPEAT REPEAT ! ordinary moves CYCLE P = 1, 1, COMPNUM CYCLE M = 0, 2, 6 T = VALID MOVE(M, P, COMP, OPP) RESULT = 0 IF T = 0; ! move ok REPEAT REPEAT RESULT = -1; ! no moves END INTEGERFN CROWNING(INTEGER POS, PLAYER) ! assumes valid pos RESULT=TRUE IF (PLAYER = 1 AND POS < 7) C OR (PLAYER = 2 AND POS > 70) RESULT=FALSE END INTEGERFN MOD(INTEGER N) RESULT = -N IF N<0 RESULT = N END INTEGERFN VALUE OF SIDE(INTEGERARRAYNAME COMP, OPP) INTEGER V1, V2, V3, V4, V5, V6, V7 INTEGER P, PP, M, MM, MV, ADV1, VM, PLAYER INTEGERNAME CPOS, CTYPE PLAYER = COMP(0) ! back control V2 = 0 IF OPP(26) = 0 START; ! OPP has no crowns yet IF PLAYER = 1 START; ! player 1 CYCLE P = 1, 1, 5 V2 = V2+BACK WT IF COMP(P) = BACK1(P) REPEAT FINISH ELSE START; ! player 2 CYCLE P = 1, 1, 5 V2 = V2+BACK WT IF COMP(P) = BACK2(P) REPEAT FINISH FINISH V1 = 0; V3 = 0; V4 = 0; V5 = 0; V6 = 0; V7 = 0 CYCLE P = 1, 1, COMP(25) CPOS ==COMP(P); CTYPE == COMP(P+12) ADV1 = 0 ! add up piece values V1 = V1+CTYPE CYCLE M = 0, 1, 7 VM = VALID MOVE(M, P, COMP, OPP) MV = MOVE(M) ! centre control IF CPOS = CENTSQ(M) START V4 = V4+CENT WT V4 = V4+CENT WT+1 IF CTYPE = CROWN FINISH IF VM >= 0 START ! mobility V3 = V3+MOB WT V3 = V3+MOB WT IF VM > 0 IF CTYPE # CROWN START ! advancement 1 IF ADV1 = 0 AND TRUE=CROWNING(CPOS+MV, PLAYER) THEN C V5 = V5+ADV1 WT AND ADV1 = 1 ! advancement 2 IF VM = 0 START; ! ignore jumps to crown CPOS = CPOS+MV CYCLE MM = 0, 2, 6 IF TRUE=CROWNING(CPOS+MOVE(MM), PLAYER) C AND VALID MOVE(MM, P, COMP, OPP) >= 0 START V6 = V6+ADV2 WT; EXIT FINISH REPEAT CPOS = CPOS-MV FINISH FINISH ! cramp IF VM = 0 AND CTYPE = CROWN AND OPP(25) > 0 START CPOS = CPOS+MV CYCLE PP = 1, 1, OPP(25) CYCLE MM = 1, 2, 7 IF VALID MOVE(MM, PP, OPP, COMP) >= 0 START V5 = V5-CRAMP WT; EXIT FINISH REPEAT REPEAT CPOS = CPOS-MV FINISH FINISH REPEAT REPEAT RESULT = V1+V2+V3+V4+V5+V6+V7 END INTEGERFN VALUE OF POS(INTEGERARRAYNAME COMP, OPP) INTEGER VALUE IF PENDING MOVE(COMP, OPP) >= 0 START VALUE = VALUE OF SIDE(COMP, OPP)-VALUE OF SIDE(OPP, COMP)-PLY NUMBER FINISH ELSE VALUE = -100000+PLYNUMBER; ! no mobility!! RESULT = VALUE IF COMP(0) = ME RESULT = -VALUE END ROUTINE MAKE MOVE(INTEGER MV, P, INTEGERNAME T, C INTEGERARRAYNAME COMP, OPP) INTEGERNAME CPOS, CTYPE, OPOS, OTYPE, ONUM, ONUMC CPOS == COMP(P); CTYPE == COMP(P+12) CPOS = CPOS+MV IF T # 0 START; ! a take OPOS == OPP(T); OTYPE == OPP(T+12) ONUM == OPP(25); ONUMC == OPP(26) SP = SP+1 PSTACK(SP) = OPOS; ! save position of taken piece TSTACK(SP) = OTYPE; ! save piece type NSTACK(SP) = T; ! save piece number OPOS = OPP(ONUM); ! remove piece from board ONUM = ONUM-1; ! reduce piece count for opp ONUMC = ONUMC-1 IF OTYPE = CROWN OTYPE = OPP(ONUM+13) FINISH IF CTYPE # CROWN AND TRUE=CROWNING(CPOS, COMP(0)) START CTYPE = CROWN; ! crown piece COMP(26) = COMP(26)+1; ! increase crown count T = 0; ! no more takes FINISH END INTEGERFN TRY POSSIBLE MOVES(INTEGER PLY, DEPTH, C INTEGERARRAYNAME COMP, OPP) INTEGER M,MM,MMM,MMF,P,T,TT,APT,VALUE,TAKES,OLDPOS,OLDTYPE INTEGERNAME MAXPLY, MINPLY INTEGERFN PURSUIT RESULT = 1 IF PLY = 1 RESULT = ¬M&1 END NODES = NODES+1 APT = PENDING MOVE(COMP, OPP) PLY NUMBER = PLY-1 AND RESULT = VALUE OF POS(COMP, OPP) C IF (DEPTH >= SEARCH LIMIT AND APT <=0) OR PLY > 12 MINPLY == MIN(PLY); MINPLY = 100000 MAXPLY == MAX(PLY); MAXPLY =-100000 IF APT >= 0 START; ! COMP able to move IF APT > 0 START; ! take priority P = APT; APT = 2; MMM = 1 ; MMF = 7 SEARCH LIMIT = 2 IF PLY = 1 FINISH ELSE START P = 1; APT = 2; MMM = 0; MMF=6 FINISH CYCLE P = P, 1, COMP(25) OLDPOS = COMP(P); OLDTYPE = COMP(P+12) CYCLE M = MMM, APT, MMF TAKES = 0 T = VALID MOVE(M, P, COMP, OPP) IF T >= 0 START; ! valid move MM = M; TT = T ANOTHER TAKE: TAKES = TAKES+1 IF TT > 0 MAKE MOVE(MOVE(MM), P, TT, COMP, OPP);! try this move IF TT > 0 START; ! another take CYCLE MM = 1, 2, 7 TT = VALID MOVE(MM, P, COMP, OPP) -> ANOTHER TAKE IF TT > 0 REPEAT FINISH VALUE = TRY POSSIBLE MOVES(PLY+1, DEPTH+PURSUIT, OPP, COMP) COMP(P) = OLDPOS; COMP(P+12) = OLDTYPE OPP(25) = OPP(25)+TAKES WHILE TAKES > 0 CYCLE TT = NSTACK(SP) OPP(TT) = PSTACK(SP) OPP(TT+12) = TSTACK(SP) TAKES = TAKES-1 SP = SP-1 REPEAT IF COMP(0) = ME START IF VALUE > MAXPLY START MAXPLY = VALUE IF PLY = 1 START BEST MOVE = M BEST TAKE = T BEST PIECE = P FINISH FINISH RESULT = MAXPLY IF PLY # 1 AND MAXPLY >= MIN(PLY-1) FINISH ELSE START MINPLY = VALUE IF VALUE < MINPLY RESULT = MINPLY IF MINPLY <= MAX(PLY-1) FINISH FINISH REPEAT REPEAT FINISH RESULT = MAXPLY IF COMP(0) = ME RESULT = MINPLY END ROUTINE SAY PLEASE PRINTSTRING("Please re-type your move ") END ROUTINE PRINT BOARD INTEGER I, J, POS CYCLE I = 0, 1, 7 CYCLE J = 0, 2, 6 BOARD(10*I+J+I&1) = '#' REPEAT REPEAT CYCLE I = 1, 1, 12 IF I <= COMP(25) START POS = COMP(I) IF COMP(I+12) = CROWN THEN BOARD(POS) = 'X' C ELSE BOARD(POS) = 'x' FINISH IF I <= OPP(25) START POS = OPP(I) IF OPP(I+12) = CROWN THEN BOARD(POS) = 'O' C ELSE BOARD(POS) = 'o' FINISH REPEAT PRINTSTRING(" A B C D E F G H") CYCLE I = 70, -10, 0 NEWLINE PRINTSYMBOL(I//10+'1') CYCLE J = 0, 1, 7 SPACE PRINTSYMBOL(BOARD(J+I)) REPEAT SPACE PRINTSYMBOL(I//10+'1') REPEAT PRINTSTRING(" A B C D E F G H ") END ROUTINE TROUT(INTEGER OLDPOS, NEWPOS, INTEGERNAME MODE) INTEGER OLDX, OLDY, NEWX, NEWY OLDY = OLDPOS//10; OLDX = OLDPOS-10*OLDY NEWY = NEWPOS//10; NEWX = NEWPOS-10*NEWY IF MODE = 0 THEN PRINTSTRING("DRAFT4's move is ") AND MODE = 1 C ELSE PRINTSTRING(" , ") PRINTSYMBOL(OLDX+'A') PRINTSYMBOL(OLDY+'1') PRINTSYMBOL('-') PRINTSYMBOL(NEWX+'A') PRINTSYMBOL(NEWY+'1') END INTEGERFN POSITION OF(INTEGER S1, S2) RESULT = (S1-'A')+10*(S2-'1') END ROUTINE SKIP SPACES AND NLS SKIP SYMBOL WHILE NEXT SYMBOL=' ' OR NEXT SYMBOL=NL END COMPNUM == COMP(25); OPPNUM == OPP(25) CPULIMIT ("12"); ! FOR EMAS - JGH MOD, AS CS1 WERE RUNNING OUT PRINTSTRING("The Draughts programme DRAFT4.4 ") PRINT STRING("Do you want some help?"); NEWLINE PROMPT(":") READ SYMBOL(REPLY(1)); SKIP SYMBOL WHILE NEXT SYMBOL#NL; SKIP SYMBOL REPLY(1) = REPLY(1)-32 IF REPLY(1)>='a' IF REPLY(1)='Y' START PRINTSTRING(" Moves are typed in in the following form: (e.g.) C3-D4 move the piece on square C3 to square D4.") PRINTSTRING(" C3-E5 move C3 to E5, taking the piece on D4 "); PRINTSTRING(" C3-E5, E5-C7 an example of a multiple jump e.t.c.") FINISH RESTART: EXPECTED MOVE = 0 ! setting up the pieces CYCLE P = -1, 1, 26 COMP(P) = PLAYER1(P) OPP(P) = PLAYER2(P) REPEAT NEWLINE PRINT STRING("Do you want to start?") NEWLINE PROMPT(":") READ SYMBOL(REPLY(1)) REPLY(1) = REPLY(1)-32 IF REPLY(1)>='a' SKIP SYMBOL WHILE NEXT SYMBOL#NL; SKIP SYMBOL IF REPLY(1)='R' START ! Read board position CYCLE P = -1,1,26 COMP(P) = 0 OPP(P) = 0 REPEAT PRINT STRING("Where are your pieces?"); NEWLINE PROMPT(":") CYCLE P = 1,1,12 SKIP SPACES AND NLS READ SYMBOL(A); IF A='.' THEN EXIT READ SYMBOL(B); READ SYMBOL(C) A = A-32 IF A>='a' B = B-32 IF A>='a' POS = POSITION OF(A,B) OPP(P) = POS IF C=' ' THEN OPP(P+12) = 1000 ELSE OPP(P+12) = CROWN REPEAT OPP(0) = 2 OPP(25) = P; ! no of pieces. PRINT STRING("Where are my pieces?"); NEWLINE CYCLE P = 1,1,12 SKIP SPACES AND NLS READ SYMBOL(A); IF A='.' THEN EXIT READ SYMBOL(B); READ SYMBOL(C) A = A-32 IF A>='a' B = B-32 IF B>='a' POS = POSITION OF(A,B) COMP(P) = POS IF C=' ' THEN COMP(P+12) = 1000 ELSE COMP(P+12) = CROWN REPEAT COMP(0) = ME COMP(25) = P; ! NO OF PIECES SKIP SYMBOL; ! NL PROMPT("Your move?") READ SYMBOL(A) SKIP SYMBOL WHILE NEXT SYMBOL#NL; SKIP SYMBOL A = A-32 IF A>='a' IF A='Y' THEN -> READ MOVE ELSE -> COMP MOVE FINISH IF REPLY(1) = 'N' START PRINT STRING("Think of a number please"); NEWLINE READ SYMBOL(I); SKIP SYMBOL I = (I-'0')&3 COMP(-1) = 'B'; OPP(-1) = 'W' PRINTSTRING("DRAFT4's opening move is ") IF I = 1 THEN PRINTSTRING("D6-C5") AND COMP(11) = 42 IF I = 2 THEN PRINTSTRING("D6-E5") AND COMP(11) = 44 IF I = 3 THEN PRINTSTRING("F6-E5") AND COMP(10) = 44 NEWLINE FINISH READ MOVE: PRINT BOARD PROMPT("Your move:") SKIP SYMBOL WHILE NEXT SYMBOL <= ' ' CYCLE I = 1, 1, 8 READ SYMBOL(REPLY(I)) REPLY(I) = REPLY(I)-32 IF REPLY(I)>='a' EXIT IF REPLY(I) = NL 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 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)) IF VALID POS(OLDPOS) = -1 START PRINTSTRING("The square ") PRINT SYMBOL(REPLY(1)); PRINT SYMBOL(REPLY(2)) PRINTSTRING(" does not exist! ") SAY PLEASE -> READ MOVE FINISH M = VALID POS(NEWPOS) IF M = -1 START PRINTSTRING("You cannot move to square ") PRINTSYMBOL(REPLY(4)); PRINTSYMBOL(REPLY(5)) PRINTSTRING("; it does not exist! ") SAY PLEASE -> READ MOVE FINISH IF M = 1 START PRINTSTRING("You cannot move to square ") PRINT SYMBOL(REPLY(4)); PRINT SYMBOL(REPLY(5)) PRINTSTRING("; it is already occupied! ") SAY PLEASE -> READ MOVE FINISH CYCLE P = 1, 1, OPP(25) IF OLDPOS = OPP(P) THENEXIT REPEAT UNLESS OLDPOS = OPP(P) START PRINTSTRING("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 EXPECTED MOVE > 0 START PRINTSTRING("You MUST take the piece that I am offering you ") SAY PLEASE -> READ MOVE FINISH IF MODIF < 12 AND MORE = 'M' START PRINTSTRING("That's not part of a multiple jump move ") SAY PLEASE -> READ MOVE FINISH IF DIF < 0 AND OPP(PIECE+12) # CROWN START PRINTSTRING("You cannot move that piece backwards! ") SAY PLEASE -> READ MOVE FINISH UNLESS MODIF = 11 OR MODIF = 9 OR MODIF = 22 OR MODIF = 18 START PRINTSTRING("That move does not exist in my rule book! ") SAY PLEASE -> READ MOVE FINISH IF MODIF > 11 START JUMP = DIF//2 COMPOS = OLDPOS+JUMP CYCLE I = 1, 1, COMP(25) EXIT IF COMPOS = COMP(I) REPEAT UNLESS COMPOS = COMP(I) START PRINTSTRING("You cannot do that. You are not jumping one of my pieces ") SAY PLEASE -> READ MOVE FINISH JMAN = I FINISH ELSE JMAN = 0 MAKE MOVE(DIF, PIECE, JMAN, OPP, COMP) IF MORE = 'M' START LASTPOS = NEWPOS READ AGAIN: PROMPT("and:") CYCLE I = 1, 1, 8 READ SYMBOL(REPLY(I)) REPLY(I) = REPLY(I)-32 IF REPLY(I)>='a' EXIT IF REPLY(I) = NL 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 PRINTSTRING("That's not part of a multiple jump Please re-type that part ") -> READ AGAIN FINISH COMP MOVE: ! COMPUTER MAKES MOVE. IF COMPNUM = 0 START PRINTSTRING(" I have no pieces left so I suppose you have won ") -> STOP FINISH IF PENDING MOVE(COMP, OPP) = -1 START PRINTSTRING("I cannot move any of my pieces so you win ") -> STOP FINISH ! If in end game then increase search. I = COMPNUM+OPPNUM IF I <= 6 THEN SEARCH LIMIT = 4 ! FIND BEST MOVE. NODES = 0; SP = 0 VALUEB = TRY POSSIBLE MOVES(1, 1, COMP, OPP) IF VALUEB <= -99990 START PRINTSTRING("I resign ") -> STOP FINISH I = 0 ANOTHER TAKE: TROUT(COMP(BEST PIECE), COMP(BEST PIECE)+MOVE(BEST MOVE), I) MAKE MOVE(MOVE(BEST MOVE), BEST PIECE, BEST TAKE, COMP, OPP) IF BEST TAKE > 0 START CYCLE BEST MOVE = 1, 2, 7 BEST TAKE = VALID MOVE(BEST MOVE, BEST PIECE, COMP, OPP) -> ANOTHER TAKE IF BEST TAKE>0 REPEAT FINISH NEWLINE IF MON = 'M' START PRINTSTRING("Nodes considered ="); WRITE(NODES, 4) PRINTSTRING(" Value of board ="); WRITE(VALUEB, 4) NEWLINE FINISH IF OPPNUM = 0 START PRINTSTRING("You have no pieces left so I win ") -> STOP FINISH EXPECTED MOVE = PENDING MOVE(OPP, COMP) IF EXPECTED MOVE = -1 START PRINTSTRING("You cannot move any of your pieces so I win ") -> STOP FINISH IF VALUEB >= 99990 AND AWIN = 0 START PRINTSTRING("He-He! I am going to win!! ") AWIN = 1 FINISH -> READ MOVE STOP: PRINTSTRING(" The final board position is - ") PRINT BOARD END ENDOFFILE