`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$J D ^Ѣ CHECKERS.TEXT CROSSWORD.TEXTc CHASE.TEXT PGAMES1 CRYPTODOC.TEXT CRYPTO.TEXT * MASTER.TEXT *2 MASTER.CODE 2> OTHELLO.TEXT z>N OTHELL1.TEXT zN^ OTHELL2.TEXT z^nOTHELLINIT.TEXTnBLACKJACK.TEXT&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`& DCRYPTO G 8Program by: William Schultheis  %CRYPTO is a program to help you solve short cryptograms such as those  published in the game sections of some newspapers.  % @*** WARNING ** ! *CRYPTO uses BIOSUNIT and the two procedures INVERSE anN^cedure  WRITEPLAIN uses this structure to generate the plaintext solution directly  from the cipher text array, CTEXT.  tters. The program also demonstrates  that the choice of good data structures can really simplify the code. The  status of the solution is contained in the array CTAB which is declared  ARRAY[ALPH] OF RECORD COUNT: INTEGER; PLAIN:CHAR END. The pro until the complete solution appears in the bottom window.  %The program uses fairly straightforward programming techniques. It does  show the power of Pascal set variables to indicate the set of legal inputs  and the set of available plaintext le previous  selection or assign nothing, enter a "/". If you assign a letter to a  cryptogram letter which already has something assigned, the program will  return the previous letter to the available set. Just keep assigning letters gn to the cipher letter. The  program displays a list of available (unused) letters between the two text  windows. If you select a letter which is already used, the computer will  beep at you and wait for another selection. If you want to delete athe work. The letter command prompts you to select  a letter of the alphabet. The letter you enter will be highlighted in  inverse video in the cryptogram and in the solution area at the bottom of the Next you enter the letter which you want to assi%The program displays a command line at the top of the screen. At the  top level of the program you have three commands, E)NTER, L)ETTER, and Q)UIT.  ENTER reruns the input routine. QUIT exits the program. LETTER is the  command that does most of ndow. If you flip to the second  page of the display, you will see a table showing the frequency of occurance  of letters in the cipher alphabet along with the plain text letter assigned  to each cipher letter, initially blank.  at a time. Terminate each line with a CR as you go and  indicate the end of the cryptogram by entering an empty line. The program  will pause a second and display the cryptogram in the top window of the  display and a solution are in the bottom wid *NORMAL. You will have to link the program with *BIOSUNIT.CODE and BIOSSTUFF.CODE. These routines WILL *NOT WORK with Apple Pascal Version 1.1!  %When you run the program it asks you to input the cipher text of a  cryptogram one linePROGRAM CRYPTO;  (* INPUT AND SOLVE A CRYPTOGRAM *)  USES BIOSUNIT;  TYPE #ALPH = 'A'..'Z'; #SETOFCHAR = SET OF CHAR;  VAR #CTEXT: ARRAY[1..5] OF STRING; #LAST: INTEGER; #CTAB: ARRAY[ALPH] OF RECORD ,COUNT: INTEGER; ,PLAIN: CHAR )END; #AVAILSE #SHOWTABLE  END;   BEGIN (*CRYPTO*) #FORMATSCREEN; #INPUT; #REPEAT &CMD:=READCMD('E(NTER, L(ETTER, Q(UIT',['E','L','Q']); &IF CMD = 'L' THEN LETTER; &IF CMD = 'E' THEN INPUT #UNTIL CMD = 'Q'  END.   ,AVAILSET:=AVAILSET+[CTAB[L].PLAIN]; )AVAILSET:=AVAILSET-[C]; )WRITE(C); )CTAB[L].PLAIN:=C &END; #SHOWAVAIL; #WRITETEXT; #WRITEPLAIN  END;   PROCEDURE INPUT;  BEGIN #READTEXT; #COUNTLETTERS; #WRITEPLAIN; #AVAILSET:=['A'..'Z']; #SHOWAVAIL;N DIV 13)*10,1+N MOD 13); #IF C='/' THEN &BEGIN )IF CTAB[L].PLAIN<>CHR(95) THEN ,BEGIN /WRITE(CHR(95)); /AVAILSET:=AVAILSET+[CTAB[L].PLAIN]; /CTAB[L].PLAIN:=CHR(95) ,END &END #ELSE &BEGIN )IF CTAB[L].PLAIN<>CHR(95) THEN 1,12+2*I); /WRITE(CTAB[L].PLAIN) ,END; #NORMAL  END;   PROCEDURE LETTER;  VAR C,L:CHAR; $N:INTEGER;  BEGIN #L:=READCMD('A..Z',['A'..'Z']); #MARKLETTER(L); #N:=ORD(L)-ORD('A'); #C:=READCMD('AVAIL: OR / TO CANCEL',AVAILSET+['/']); #GOTOXY(46+(IF C IN AVAILSET THEN WRITE(C) ELSE WRITE(' ')  END;   PROCEDURE MARKLETTER(L:CHAR);  VAR I,J:INTEGER;  BEGIN #INVERSE; #FOR I:=1 TO LAST DO &FOR J:=1 TO LENGTH(CTEXT[I]) DO )IF CTEXT[I,J]=L THEN ,BEGIN /GOTOXY(J-1,2*I); /WRITE(L); /GOTOXY(J-&READ(KEYBOARD,CH); &IF EOLN(KEYBOARD) THEN CH:=CHR(13); &GOOD:=CH IN OKSET; &IF NOT GOOD THEN WRITE(CHR(7)) #UNTIL GOOD; #READCMD:=CH  END;   PROCEDURE SHOWAVAIL;  VAR C:CHAR;  BEGIN #GOTOXY(0,12); #WRITE('AVAIL:'); #FOR C:='A' TO 'Z' DO &NT=0 THEN WRITE(' ') /ELSE WRITE(COUNT:3); /WRITE(' ',C,':',PLAIN) ,END &END  END;   FUNCTION READCMD(P:STRING;OKSET:SETOFCHAR):CHAR;  VAR CH:CHAR; $GOOD:BOOLEAN;  BEGIN #GOTOXY(0,0); #WRITE('CMD: ',P,CHR(29)); #REPEAT Z'] THEN 2WRITE(CTAB[C].PLAIN) /ELSE 2WRITE(C) ,END &END  END;   PROCEDURE SHOWTABLE;  VAR N:INTEGER; $C:CHAR;  BEGIN #FOR C:='A' TO 'Z' DO &BEGIN )N:=ORD(C)-ORD('A'); )GOTOXY(40+(N DIV 13)*10,1+N MOD 13); )WITH CTAB[C] DO ,BEGIN /IF COULAST DO &BEGIN )GOTOXY(0,2*I); )WRITE(CTEXT[I]) &END  END;   PROCEDURE WRITEPLAIN;  VAR I,J:INTEGER; # C:CHAR;  BEGIN #FOR I:=1 TO LAST DO &BEGIN )GOTOXY(0,12+2*I); )FOR J:=1 TO LENGTH(CTEXT[I]) DO ,BEGIN /C:=CTEXT[I,J]; /IF C IN ['A'..'&BEGIN COUNT:=0; PLAIN:=CHR(95) END; #FOR I:=1 TO LAST DO &FOR J:=1 TO LENGTH(CTEXT[I]) DO )BEGIN ,C:=CTEXT[I,J]; ,IF C IN ['A'..'Z'] THEN /CTAB[C].COUNT:=CTAB[C].COUNT+1 )END  END;   PROCEDURE WRITETEXT;  VAR I:INTEGER;  BEGIN #FOR I:=1 TO ) > 0 THEN )BEGIN CTEXT[I]:=S;I:=I+1 END; &INFO('ENTER TO END INPUT'); #UNTIL (I>5) OR (LENGTH(S)=0); #LAST:=I-1;  END;   PROCEDURE COUNTLETTERS;  VAR I,J:INTEGER; $C:CHAR;  BEGIN #FOR C:='A' TO 'Z' DO WITH CTAB[C] DO  PROCEDURE INFO(S:STRING);  BEGIN #GOTOXY(0,0); #WRITE(S,CHR(29))  END;   PROCEDURE READTEXT;  VAR I:INTEGER; $S:STRING;  BEGIN #INFO('ENTER UP TO 5 LINES OF TEXT'); #I:=1; #REPEAT &GOTOXY(0,2*I); &WRITE(CHR(29)); &READLN(S); &IF LENGTH(ST: SET OF ALPH; #CMD: CHAR; #  PROCEDURE FORMATSCREEN;  VAR I:INTEGER;  BEGIN #WRITE(CHR(12)); #GOTOXY(0,1); #FOR I:=0 TO 39 DO WRITE ('-'); #GOTOXY(0,11); #FOR I:=0 TO 39 DO WRITE ('-'); #GOTOXY(0,13); #FOR I:=0 TO 39 DO WRITE ('-')  END;  SETUP CHOOSE FORM FORMAT ACCEPT MAIN EVAL ` [ON^E ONE TO'); (WRITELN(MAXNUMBEROFLETTERS:15) (END;(*OF THE CONDITIONAL*)  UNTIL (NUMBROFLETTERS>=1) OR #(NUMBROFLETTERS<=MAXNUMBEROFLETTERS);  END;(*OF PROCEDURE CHOOSEDIFFICULTY*) #   PROCEDURE FORMCODEWORD;  VAR I : INTEGER; ELN(' "HARD"=7');  WRITELN(' MAXIMUM=',MAXNUMBEROFLETTERS);  REPEAT #READ(KEYBOARD,ANSWER); #NUMBROFLETTERS:=ORD(ANSWER)-48; %IF (NUMBROFLETTERS<1) OR &(NUMBROFLETTERS>MAXNUMBEROFLETTERS) & THEN (BEGIN (WRITELN('ANSWER MUST BE IN THE RANG (*PROMPT FOR AND RECEIVE NUMBROFLETTERS*)  PAGE(OUTPUT);  GOTOXY(0,YSTART);  WRITELN('HOW MANY LETTERS SHALL I CHOOSE FROM');  WRITELN('TO GET EACH LETTER OF THE CODEWORD?');  WRITELN;  WRITELN(' MININUM=1');  WRITELN(' "EASY"=4');  WRITINPUT.*) #WORDLENGTH:=ORD(ANSWER)-48;  IF (WORDLENGTH<1) OR (WORDLENGTH>MAXWORDSIZE) THEN &WRITELN('WORD LENGTH MUST BE ONE TO ',MAXWORDSIZE,' LETTERS.');  UNTIL (WORDLENGTH>=1) AND (WORDLENGTH<=MAXWORDSIZE);  ('OF LETTERS PER CODEWORD.');  WRITELN;  WRITELN;  WRITELN(' 4= "EASY"');  WRITELN(' 6= "HARD"');  REPEAT #READ(KEYBOARD,ANSWER); #(*CHANGE KEYBOARD INPUT INTO A NUMBER. #THIS STEP NECESSARY TO PREVENT RUN-TIME #ERROR ON ERRONEOUS Y;   CONST YSTART=8; &  VAR ANSWER: CHAR;   BEGIN  (*PROMPT FOR AND RECEIVE WORDLENGTH*)  PAGE(OUTPUT);  GOTOXY(0,YSTART);  WRITELN('HOW LONG DO YOU WISH YOUR CODEWORD');  WRITELN('TO BE? ',MAXWORDSIZE,' IS THE MAXIMUM NUMBER');  WRITELN IF (ANSWER='Y') THEN WISHTOPLAY:=TRUE #ELSE IF (ANSWER='N') THEN &BEGIN &PAGE(OUTPUT); &EXIT(PROGRAM) &END (ELSE SETUP (*KEEP GOING BACK (UNTIL THE FOOL PRESSES EITHER ('Y' OR 'N'!*) (  END;(*OF PROCEDURE SETUP*)   PROCEDURE CHOOSEDIFFICULTE');  WRITELN('DOING AS YOU TRY TO GUESS IT. YOU');  WRITELN('MAY ADJUST THE LEVEL OF DIFFICULTY');  WRITELN('AT WHICH YOU WISH TO PLAY.');  WRITELN;  WRITELN;  WRITELN(' DO YOU WISH TO CONTINUE? (Y/N)');  READ(KEYBOARD,ANSWER); WER : CHAR; $  BEGIN  PAGE(OUTPUT);  GOTOXY(0,YSTART);  WRITELN('THIS PROGRAM WILL ALLOW YOU TO PLAY');  WRITELN('THE GAME OF MASTERMIND WITH YOUR');  WRITELN('APPLE. THE COMPUTER WILL SELECT THE');  WRITELN('CODEWORD AND TELL YOU HOW YOU ARER; $ $CODEWORD, $GUESS : STRING; $ $SAMELEVEL, $ALLRIGHT, $WISHTOQUIT, $WISHTOPLAY : BOOLEAN; $  CHOICES : ARRAY[1..MAXNUMBEROFLETTERS] $ OF CHAR; 9  PROCEDURE SETUP;  CONST YSTART=6 ;  VAR ANSPROGRAM MASTER;  (*POSES MASTERMIND PROBLEMS*)  (*$C PAUL NORRIS, JULY 1980 *)   USES APPLESTUFF;   CONST MAXWORDSIZE=7;  MAXNUMBEROFLETTERS=8;    VAR NUMBROFTRIES, $WORDLENGTH, $NUMBROFLETTERS, $RIGHTPLACE, $WRONGPLACE : INTEG(  BEGIN  (* NOW FORM ARRAY OF LETTERS *)  FOR I:=1 TO NUMBROFLETTERS DO  CHOICES[I]:=CHR(I+ORD('A')-1);   (*INITIALIZE CODEWORD*)  (*CHANGE THIS SECTION IF MAXWORDSIZE IS CHANGED*)  CODEWORD:='AAAAAAA';(*MUST INITIALIZE  IN ORDER TO AVOID INDEXING BEYOND  CURRENT STRING LENGTH*)   (*NOW FORM CODEWORD*)  RANDOMIZE;(*TO AVOID GETTING SAME -CODEWORD EVERY TIME*)  FOR I:=1 TO WORDLENGTH DO  CODEWORD[I]:=CHOICES[1+(RANDOM MOD NUMBROFLETTERS)];   (*CUT CODEWORD DOWNTPLACE AND WRONGPLACE  TO TELL USER HOW HE'S DOING.*)  GOTOXY(0,NUMBROFTRIES+2);  WRITELN(GUESS:8,RIGHTPLACE:12, ,WRONGPLACE:15);   IF (RIGHTPLACE=LENGTH(CODEWORD)) #THEN ALLRIGHT:=TRUE  END;   PROCEDURE SUCCESSROUTINE;   VAR CONT: CHAGUESS) DO %IF (MATCHCODE[I]=FALSE) AND ((MATCHGUESS[J]=FALSE) THEN # IF CODEWORD[I]=GUESS[J] THEN .BEGIN .WRONGPLACE:=WRONGPLACE+1; .MATCHCODE[I]:=TRUE; .MATCHGUESS[J]:=TRUE; .END;   (*NOW PRINT GUESS AT LEFT HAND MARGIN  AND OUTPUT RIGH MATCH. THAT IS, HOW MANY LETTERS IN  GUESS MATCH LETTERS IN CODEWORD, BUT  ARE IN THE WRONG LOCATION. MUST ALSO  INSURE THAT NO LETTER IS MATCHED MORE  THAN ONCE IN EITHER CODEWORD OR GUESS.*)  FOR I:=1 TO LENGTH(CODEWORD) DO #FOR J:=1 TO LENGTH(CE.  MARK THEIR LOCATIONS.*)  FOR I:=1 TO LENGTH(CODEWORD) DO #IF CODEWORD[I]=GUESS[I] THEN &BEGIN &RIGHTPLACE:=RIGHTPLACE+1; &MATCHCODE[I]:=TRUE; &MATCHGUESS[I]:=TRUE &END;   (*OF LOCATIONS NOT MARKED FIND HOW MANY BLES*)  RIGHTPLACE:=0;  WRONGPLACE:=0;  ALLRIGHT:=FALSE;  FOR I:=1 TO LENGTH(CODEWORD) DO #MATCHCODE[I]:=FALSE;  FOR J:=1 TO LENGTH(GUESS) DO #MATCHGUESS[J]:=FALSE;   (*FIND NUMBER OF LETTERS IN GUESS WHICH  ARE THE RIGHT LETTER IN THE RIGHT PLAND;   PROCEDURE EVALUATION;   VAR MATCHCODE: ARRAY [1..MAXWORDSIZE] 0OF BOOLEAN; 0  MATCHGUESS: ARRAY[1..MAXWORDSIZE] 2OF BOOLEAN; % %I, %J: INTEGER; %  BEGIN   IF WISHTOQUIT=TRUE THEN EXIT(EVALUATION);   (*INITIALIZE VARIA&THEN &BEGIN &WRITELN('PRESS ANY KEY TO CONTINUE'); &READ(KEYBOARD,CONT); # GOTOXY(0,NUMBROFTRIES+3); &WRITELN(' ':40);(*CLEAR 4 LINES*) &WRITELN(' ':40); &WRITELN(' ':40); &WRITELN(' ':40) &END  UNTIL (LENGTHOK=TRUE) AND (LETTERSOK=TRUE)  EROFLETTERS]]) &THEN LETTERSOK:=FALSE; #IF LENGTHOK=FALSE THEN &WRITELN('YOUR GUESS HAS WRONG WORDLENGTH'); #IF LETTERSOK=FALSE THEN &WRITELN('USE ONLY LETTERS A THROUGH ', )CHOICES[NUMBROFLETTERS]); #IF (LENGTHOK=FALSE) OR (LETTERSOK=FALSE) &END #ELSE WISHTOQUIT:=FALSE;(*NECESSARY TO #AVOID FALLING THROUGH MAIN PROGRAM #PERPETUALLY ONCE YOU'VE QUIT*) # #IF (LENGTH(GUESS)=WORDLENGTH) THEN &LENGTHOK:=TRUE;  FOR I:=1 TO LENGTH(GUESS) DO  IF NOT (GUESS[I] IN ['A'..CHOICES[NUMBUSER GIVES UP, GIVE HIM CODEWORD*) #IF (GUESS='Q')THEN &BEGIN &WRITELN('THE CODEWORD WAS ',CODEWORD); # WRITELN('PRESS ANY KEY TO CONTINUE'); &READ(KEYBOARD,CONT); &WISHTOQUIT:=TRUE;(*TO AVOID EVALUATION*) &WISHTOPLAY:=FALSE; &EXIT(ACCEPTGUESS)  (*INITIALIZED TO AVOID INDEXING BEYOND  CURRENT LENGTH OF STRING IN COMPILER.  CHANGE IF MAXWORDLENGTH CHANGED*)  REPEAT #LENGTHOK:=FALSE; #LETTERSOK:=TRUE; #GOTOXY(0,NUMBROFTRIES+3); #WRITE('GUESS:'); #READLN(GUESS); # #(* QUIT ROUTINE *) &(*LACE':15);  WRITELN('************************************');  END;   PROCEDURE ACCEPTGUESS;  VAR LENGTHOK, (LETTERSOK: BOOLEAN;  (CONT: CHAR; (I: INTEGER;   BEGIN  GUESS:='AAAAAAA'; PLAYED.');  WRITELN;  WRITELN('PRESS ANY KEY TO CONTINUE.');  READ(KEYBOARD,CONT);   PAGE(OUTPUT);  GOTOXY(0,0);  WRITELN('CODEWORD: ',WORDLENGTH,' LETTERS, ',  ' A THROUGH ',CHOICES[NUMBROFLETTERS]);  WRITELN('GUESS','RIGHT PLACE':15,  'WRONG P TO RIGHT LENGTH*)  DELETE(CODEWORD,WORDLENGTH+1, 'MAXWORDSIZE-WORDLENGTH);  END;(*FORMCODEWORD*)   PROCEDURE FORMATSCREEN;   VAR CONT: CHAR;   BEGIN   PAGE(OUTPUT);  WRITELN('TO GIVE UP,TYPE "Q"');  WRITELN('THE CODEWORD WILL BE DISR;   BEGIN  IF (WISHTOQUIT=TRUE) THEN *EXIT(SUCCESSROUTINE);  WRITELN('YOU GOT IT IN ',NUMBROFTRIES,' TRIES!');  WRITELN('PRESS ANY KEY TO CONTINUE');  READ(KEYBOARD,CONT)  END;   PROCEDURE ANOTHERGAME;   CONST YSTART=10;   VAR ANSWER: CHAR;   BEGIN  PAGE(OUTPUT);  GOTOXY(0,YSTART);  WRITELN('DO YOU WISH TO PLAY ANOTHER GAME?');  READ(KEYBOARD,ANSWER);  IF (ANSWER='Y') THEN WISHTOPLAY:=TRUE #ELSE IF (ANSWER='N') THEN &BEGIN &PAGE(OUTPUT); &WISHTOPLAY:=FALSEȡ ۛA^3YOUR GUESS HAS WRONG WORDLENGTHCצUSE ONLY LETTERS A THROUGH ^צPRESS ANY KEY TO CONTINUE (*******************MצAAAAAAAPצGUESS:PQsצTHE CODEWORD WAS 1צPRESS ANY KEY TO CONTINUE[Z[á KEY TO CONTINUE. צ CODEWORD:  צ LETTERS, צ A THROUGH ^GUESSצ RIGHT PLACE WRONG PLACEצ$*****************k ȡ^A1צAAAAAAAPȡ1؛^쎂11f t TO GIVE UP,TYPE "Q"צTHE CODEWORD WILL BE DISPLAYED.PRESS ANY MININUM=1 "EASY"=4 "HARD"=7 MAXIMUM= 0ōHצ"ANSWER MUST BE IN THE RANGE ONE TO ȍ"0ōNצWORD LENGTH MUST BE ONE TO   LETTERS.Ȅ צ$HOW MANY LETTERS SHALL I CHOOSE FROMצ#TO GET EACH LETTER OF THE CODEWORD?צ"HOW LONG DO YOU WISH YOUR CODEWORDצTO BE?  צ IS THE MAXIMUM NUMBERצOF LETTERS PER CODEWORD.צ 4= "EASY"צ 6= "HARDUESS IT. YOUצ"MAY ADJUST THE LEVEL OF DIFFICULTYצAT WHICH YOU WISH TO PLAY.צ DO YOU WISH TO CONTINUE? (Y/N)YáZNá  Ͷ צ#THIS PROGRAM WILL ALLOW YOU TO PLAY THE GAME OF MASTERMIND WITH YOUR#APPLE. THE COMPUTER WILL SELECT THEצ!CODEWORD AND TELL YOU HOW YOU ARE!DOING AS YOU TRY TO G"@* PAUL NORRIS, JULY 1980 NT: CHAR;   BEGIN   PAGE(OUTPUT);  WRITELN('TO  MASTER &EVALUATION; &UNTIL (ALLRIGHT=TRUE) OR )(WISHTOQUIT=TRUE); #SUCCESSROUTINE; #ANOTHERGAME #END (*OF THE WHILE*)  END.(*PROGRAM*)  $ $ $ $ &END )ELSE ANOTHERGAME  END;(*OF THE PROCEDURE*)    BEGIN (*MAIN PROGRAM*)  SETUP;  WHILE (WISHTOPLAY=TRUE) DO #BEGIN #CHOOSEDIFFICULTY; #FORMCODEWORD; #FORMATSCREEN; #NUMBROFTRIES:=0; &REPEAT &ACCEPTGUESS; &NUMBROFTRIES:=NUMBROFTRIES+1; ( ( (I "[\1ȡȡ1ȡ11盾盾á1ȡfȡP*1盾曾á  1á\3$X[צYOU GOT IT IN  צ TRIES!Pong enough for a distinct, separate *) 8(*terminal bell sound on each square updated *) #spaces = ' '; # TYPE #coordinate = 1..8; #color = (white,black); #squareloc = RECORD 4CASE onboard: BOOLEAN 6; (*ascii value of char making up piece of first mover*) #blackascii = 79; (* " " " " " " " " 2nd " *) #minticks = 22.0; (*min # clock ticks between crt square updates *) # (*--should be l#(* difference in intensity between the black and white pieces while maxi- *) #(* mizing the absolute intensity of the black piece. Avoid characters with*) #(* semantic content, e.g. "W" and "B" are not so good. *) #whiteascii = 9 is good for black, *) #(* especially if it has a rectangular shape. Otherwise, choose characters *) #(* that are centered within the character dot matrix; try to maximize the *) *) #(* OOO *) #(* If your crt has a "block" character (like the cursor on some crts), that*) #(* is good for the white piece, and capital letter Oting/Klaus E Liebold/4-26-78". *)   (* This program provides playing instructions to the user on request. *)   CONST #(* The game pieces are shown on the screen as 2 rows of 3 characters, e.g. *) #(* OOO  (* COPYRIGHT (C) 1979 Software Supply. All rights reserved. *)  (*$S+*)  (* UCSD Pascal *) PROGRAM OTHELLO; (* Steve Brecher 16-Jun-79 *)   (* The position evaluation weights were derived from a FORTRAN program *)  (* headed "from Creative CompuA O^RzRESS ANY KEY TO CONTINUE  צ!DO YOU WISH TO PLAY ANOTHER GAME?YáZNá Z v 3Z%\[ >>0LR^  *1盾曾á  1á\3$X[צYOU GOT IT IN  צ TRIES!PRESS ANY KEY TO CONTINUE  צ!DO YOU WISH TO PLAY ANOTHER GAME?YáZNá Z v 3Z%\[ >>0OF 6TRUE: (row,col: coordinate); 4END; #direction = (north,south,east,west,sw,ne,se,nw); (*pairs of opposites*)  squarestatus = RECORD 4CASE occupied: BOOLEAN OF 6TRUE: (occupier: color ); 6FALSE: (adjacentpieces: ARRAY[color] OF SET of direction); 4END; #gamestatus = RECORD 4boardstatus: ARRAY[coordinate,coordinate] OF squarestatus; 4nextmover: color; 4lastmoveloc: squareloc; 4score: ARRAY[color] OF INTEGER; 4END;  A O^Rz&legalmoves[black] := legallist.movecount; &play(black); &findlegalmoves(status,legallist); &legalmoves[white] := legallist.movecount; &UNTIL (legalmoves[white]=0) and (legalmoves[black]=0);  UNTIL userquits;  END.   (*$I OTHELLINIT*)  (*$I OTHELL1*)  (*$I OTHELL2*)  BEGIN (*PROGRAM OTHELLO*)  REPEAT #initgame; #findlegalmoves(status,legallist); #legalmoves[white] := legallist.movecount; #REPEAT &play(white); &findlegalmoves(status,legallist); Y[direction] OF direction; #legalmoves: ARRAY[color] OF INTEGER; #colorword: ARRAY[color] OF STRING[5]; #usercolor: color; #lastchange: REAL; (*time of last square change on crt*)  ARRAY[coordinate,coordinate] OF position; #status,crtstatus: gamestatus; #square: squareloc; #legallist: movelist; #move: movedesc; #opposdir: ARRA2(* (1,2) and (1,4); for each we want a pointer to the other *) 2(* and to the border square between them (1,3). *) 4CASE specialbordersq: BOOLEAN OF 6TRUE: (otherofpair,between: squareloc); 4END;   VAR #board: (* "special" border squares are those border squares *) 2(* adjacent to a corner or adjacent to board midline; there *) 2(* are 2 pairs of such squares on each border. Sample pair: *) ove: ARRAY[1..30] OF movedesc; 4END;  position = RECORD 4border: BOOLEAN; 4corner: BOOLEAN; 4diagnexttocorner: BOOLEAN; 4incenter4by4: BOOLEAN; 4adjacentsq: ARRAY[direction] OF squareloc; 2 movedesc = RECORD 4moveloc: squareloc; 4points: INTEGER; 4dirsflipped: SET OF direction; 4bordrsqsflipped: INTEGER; 4bordnoncorn: BOOLEAN; 4END; #movelist = RECORD 4movecount: INTEGER; 4okm  FUNCTION flipof(*oldcolor: color): color*);  BEGIN  IF oldcolor = white THEN #flipof := black  ELSE #flipof := white;  END; (*flipof*)   PROCEDURE updatecrt(*VAR oldstatus,newstatus: gamestatus*);  VAR #x,y: coordinate; #direc: direc]; 5IF board[x,y].border AND board[sq.row,sq.col].border THEN 8borderflips := borderflips + direcflips; 5END; 2END; (*IF sq.onboard...*) ) END; (*IF direc IN...*) )IF flips > 0 THEN BEGIN ,movecount := movecount + 1; ,WITH okmove[movecounacentsq[direc]; ;END 8ELSE ;stopdirec := TRUE 5ELSE BEGIN 8direcflips := 0; 8stopdirec := TRUE; 8END; 5UNTIL ( stopdirec OR (NOT sq.onboard) ); 2IF (stopdirec AND (direcflips>0)) THEN BEGIN 5flips := flips + direcflips; 5gooddirs := gooddirs + [/IF sq.onboard THEN BEGIN 2direcflips := 1; 2stopdirec := FALSE; 2REPEAT 5sqstatus := boardstatus[sq.row,sq.col]; 5IF sqstatus.occupied THEN 8IF sqstatus.occupier = oppcolor THEN BEGIN ;direcflips := direcflips + 1; ;sq := board[sq.row,sq.col].adjces[oppcolor]; /END; &IF possible THEN BEGIN )gooddirs := []; )flips := 0; & borderflips := 0; )FOR direc := north TO nw DO ,IF direc IN trydirs THEN BEGIN /sq := board[x,y].adjacentsq[direc]; /sq := board[sq.row,sq.col].adjacentsq[direc]; flipof(nextmover); #movecount := 0; #FOR x := 1 TO 8 DO FOR y := 1 TO 8 DO BEGIN &possible := FALSE; &WITH boardstatus[x,y] DO )IF NOT occupied THEN ,IF adjacentpieces[oppcolor] <> [] THEN BEGIN /possible := TRUE; & trydirs := adjacentpieEAN;  oppcolor: color;  direc: direction;  trydirs,gooddirs: SET OF direction;  possible: BOOLEAN; #sqstatus: squarestatus;  BEGIN  WITH status, legallist DO BEGIN #oppcolor := PROCEDURE findlegalmoves(VAR status: gamestatus; VAR legallist: movelist);  VAR #x,y: coordinate;  sq: squareloc; #flips,direcflips: INTEGER; #borderflips: INTEGER; #stopdirec: BOOLWHILE...*) &END; (*FOR direc...*)  GOTOXY(9,2); #WRITE(score[white]:2); #GOTOXY(9,3); #write(score[black]:2); #END; (*WITH newstatus...*)  GOTOXY(0,0);  END; (*updatecrt*)  rth to nw DO BEGIN &square := lastmoveloc; &WHILE boardstatus[square.row,square.col].occupied AND ,board[square.row,square.col].adjacentsq[direc].onboard DO BEGIN )square := board[square.row,square.col].adjacentsq[direc]; )showpiece(square); )END; (*angecrtsq(square) )ELSE IF oldstatus.boardstatus[row,col].occupier <> 1newstatus.boardstatus[row,col].occupier THEN 1changecrtsq(square); #END; (*showpiece*)   BEGIN (*updatecrt*)  WITH newstatus DO BEGIN #showpiece(lastmoveloc); #FOR direc := no&WRITE(s); &GOTOXY(crtcol,crtline+1); &WRITE(s,CHR(bell)); &lastchange := now; &END; (*changecrtsq*) # #BEGIN (*showpiece*) #WITH square DO &IF newstatus.boardstatus[row,col].occupied THEN )IF NOT oldstatus.boardstatus[row,col].occupied THEN ,chHAR(s,3,c); )crtline := (3*row) - 3; )crtcol := 26 + (6*col); )END; &REPEAT )TIME(h,l); )now := l; )IF now < 0.0 THEN ,now := now + 65536.0; )now := (h*65536.0) + now; )UNTIL (now - lastchange) > minticks; &GOTOXY(crtcol,crtline); crtline,crtcol: INTEGER; # h,l: INTEGER; & now: REAL; &BEGIN &WITH square DO BEGIN )IF newstatus.boardstatus[row,col].occupier = white THEN ,c := CHR(whiteascii) )ELSE ,c := CHR(blackascii); )FILLC direction;  square: squareloc;   PROCEDURE showpiece(square: squareloc);  &PROCEDURE changecrtsq(square: squareloc); &CONST )bell = 7; &VAR )s: PACKED ARRAY[1..3] OF CHAR; )c: CHAR; )t] DO BEGIN /moveloc.onboard := TRUE; /moveloc.row := x; /moveloc.col := y; /points := flips; /dirsflipped := gooddirs; /bordrsqsflipped := borderflips; /END; ,END; )END; (*IF possible...*) # END; (*FOR x :=...FOR y :=...*) #END; (*WITH status, legallist...*)  END; (*findlegalmoves*)   PROCEDURE inputmove(mover: color; legallist: movelist; VAR move: movedesc);  VAR #x,y: coordinate;  xch,ych: CHAR;  i,listindex: INTEGER;  A O^Rzcentpieces[nextmover] := adjacentpieces[nextmover] + R[opposdir[direc]]; /END; #score[nextmover] := score[nextmover] + flips + 1; #score[oppcolor] := score[oppcolor] - flips; #nextmover := oppcolor; #END;  END; (*makemove*)   [sq.row,sq.col].occupier = nextmover;  END # ELSE # IF updateadjacent THEN ,IF direc IN emptyneighbors THEN BEGIN /sq := board[moveloc.row,moveloc.col].adjacentsq[direc]; /IF sq.onboard THEN 2WITH boardstatus[sq.row,sq.col] DO 5adjaX+ [opposdir[direc2]]; ;adjacentpieces[oppcolor]:=adjacentpieces[oppcolor] X- [opposdir[direc2]]; ;END; 5END; ,boardstatus[sq.row,sq.col].occupier := nextmover; ,flips := flips + 1; ,sq := board[sq.row,sq.col].adjacentsq[direc]; ,UNTIL boardstatus NOT (direc2 IN [direc,opposdir[direc]]) THEN BEGIN 5sq2 := board[sq.row,sq.col].adjacentsq[direc2]; 5IF sq2.onboard THEN WITH boardstatus[sq2.row,sq2.col] DO 8IF NOT occupied THEN BEGIN ;adjacentpieces[nextmover]:=adjacentpieces[nextmover] ; # END; #oppcolor := flipof(nextmover); #flips := 0; #FOR direc := north TO nw DO &IF direc IN dirsflipped THEN BEGIN )sq := board[moveloc.row,moveloc.col].adjacentsq[direc]; )REPEAT ) IF updateadjacent THEN /FOR direc2 := north TO nw DO 2IFof direction;  BEGIN  WITH status, move DO BEGIN #lastmoveloc := moveloc; #WITH boardstatus[moveloc.row,moveloc.col] DO BEGIN &emptyneighbors := [north..nw] - adjacentpieces[white] D- adjacentpieces[black]; &occupied := TRUE; &occupier := nextmover PROCEDURE makemove(*VAR status: gamestatus; VAR move: movedesc; updateadjacent: `BOOLEAN*);  VAR #direc,direc2: direction; #sq,sq2: squareloc;  oppcolor: color; #flips: INTEGER; #emptyneighbors: SET oveloc.row = x THEN )IF legallist.okmove[i].moveloc.col = y THEN ,listindex := i; &i := i+1; &UNTIL ((i>legallist.movecount) OR (listindex <> 0));  UNTIL listindex <> 0;  move := legallist.okmove[listindex];  END; (*inputmove*)  )ych := xch; )xch := c; )END; &IF ych IN ['a'..'h'] THEN )ych := CHR(ORD(ych)-32); &UNTIL ((xch IN ['1'..'8']) AND (ych IN ['A'..'H'])); #x := ORD(xch) - ORD('1') + 1; #y := ORD(ych) - ORD('A') + 1;  i := 1; #REPEAT &IF legallist.okmove[i].m c: CHAR;  BEGIN  listindex := 0;  REPEAT #REPEAT &GOTOXY(0,23); &WRITE('Enter move for ',colorword[mover],': '); &GOTOXY(22,23); &READ(xch,ych); &IF ych IN ['1'..'8'] THEN BEGIN (*Want xy but we'll accept yx*) )c := ych;  PROCEDURE calcmove( mover: color; VAR status: gamestatus;  VAR legallist: movelist; VAR bestmove: movedesc);  TYPE #movearray = ARRAY[1..30] OF movedesc;  VAR #bestsofar,cornmoves,m,respcornmoves: INTEGER; #move,moveteIT(checkresponses); /END; )FOR x:=1 TO 8 DO FOR y:=1 TO 8 DO WITH afterresp.boardstatus[x,y] DO ,IF occupied THEN /IF occupier = mover THEN 2FOR direc := north TO nw DO WITH afterresp DO BEGIN 5sq.row := x; 5sq.col := y; 5REPEAT 8sq := board[sq.ro+ 8*respondmove.bordrsqsflipped; )WITH respondmove.moveloc DO ,IF board[row,col].corner THEN BEGIN /points := points - 55; /IF cornmoves > 1 THEN 2IF board[moveloc.row,moveloc.col].corner THEN 5points := points -20; /IF points <= bestsofar THEN 2EX,IF afterresp.boardstatus[row,col].occupier = oppcolor THEN BEGIN /bordnoncorn := FALSE; /points := points - 65; (*40, plus the 25 given in checkposition*) /IF points <= bestsofar THEN 2EXIT(checkresponses); /END ) ELSE /contingent := contingent THEN BEGIN 6move.points := move.points - 5; 6IF move.points <= bestsofar THEN 9EXIT(checkresponses); ) END; )afterresp := aftermove; )makemove(afterresp,respondmove,FALSE); )IF bordnoncorn THEN WITH moveloc DO &REPEAT )respondmove := responses.okmove[r]; )IF NOT board[moveloc.row,moveloc.col].incenter4by4 THEN ,FOR direc := north TO nw DO WITH respondmove DO /IF direc IN dirsflipped THEN WITH moveloc DO 2IF board[row,col].adjacentsq[direc] = move.moveloc gamestatus; &cornercounter: BOOLEAN; &respondmove: movedesc; # counterresp: movelist; #BEGIN #oppcolor := flipof(mover); #WITH move DO BEGIN &contingent := 0; &r := 1; #VAR &contingent,c,r: INTEGER; &x,y: coordinate; &sq: squareloc; &direc: direction; &oppcolor: color; &afterresp: EN sortmoves(okmove, l, j ); #IF i < r THEN sortmoves(okmove, i, r ) #END (* sortmoves *) ;  PROCEDURE checkresponses(mover: color; VAR move: movedesc;  VAR responses: movelist; bestsofar: INTEGER);  (*$G+*) #LABEL 0; WHILE okmove[i].points > baseval DO )i := i+1; &WHILE okmove[j].points < baseval DO )j := j-1; &IF i <= j THEN BEGIN )movetemp := okmove[i]; )okmove[i] := okmove[j]; )okmove[j] := movetemp; )i := i+1; )j := j-1; )END; &UNTIL i > j; #IF l < j THcheckposition*)   PROCEDURE sortmoves(VAR okmove: movearray;  l,r: INTEGER) (*into descending order by points*) ; #VAR # i,j,baseval: INTEGER; #BEGIN #i := l; #j := r; #baseval := okmove[(i+j) DIV 2].points; #REPEAT &&IF points > bestyet THEN BEGIN )bestyet := points; )bestm := m; )end; &END; (*FOR m := 1 TO legallist.movecount...*) #movetemp := legallist.okmove[1]; #legallist.okmove[1] := legallist.okmove[bestm]; #legallist.okmove[bestm] := movetemp; #END; (*BEGIN )IF corner THEN BEGIN ,points := points + 60; ,cornmoves := cornmoves + 1; ,END )ELSE IF border THEN BEGIN 1bordnoncorn := TRUE; 1points := points + 25; 1END .ELSE IF diagnexttocorner THEN 6points := points - 50; )END; estyet: INTEGER; #BEGIN #bestyet := -MAXINT; #cornmoves := 0; #FOR m := 1 TO legallist.movecount DO WITH legallist.okmove[m], Mboard[moveloc.row,moveloc.col] DO # BEGIN &bordnoncorn := FALSE; &IF incenter4by4 THEN )points := points + 10 &ELSE mp: movedesc; #aftermove: gamestatus; #responses: movelist;   PROCEDURE checkposition(VAR legallist: movelist; VAR cornmoves: INTEGER); #VAR &m,bestm,bw,sq.col].adjacentsq[direc]; 8IF NOT sq.onboard THEN ;GOTO 0; 8IF NOT boardstatus[sq.row,sq.col].occupied THEN ;GOTO 0 8UNTIL boardstatus[sq.row,sq.col].occupier = oppcolor; 5END; )makemove(afterresp,respondmove,TRUE); )findlegalmoves(afterresp,counterresp); )cornercounter := FALSE; )c := 1; )WITH counterresp DO ,WHILE ( (c <= movecount) AND (NOT cornercounter) ) DO BEGIN /WITH okmove[c].moveloc DO 2IF board[row,col].corner THEN 5cornercounter := TRUE; /c := c +A O^RN ['Y','y']);  END; (*userquits*)   )   FUNCTION userquits: BOOLEAN;  VAR #playagain: CHAR;  BEGIN  GOTOXY(0,20);  WRITELN(spaces); WRITELN(spaces); WRITELN; WRITE(spaces);  GOTOXY(0,23);  WRITE('Start a new game? (y/n): ');  READ(playagain);  userquits := NOT (playagain I&calcmove(mover,status,legallist,move); #makemove(status,move,TRUE); #updatecrt(crtstatus,status); #crtstatus := status; #END  ELSE BEGIN #WRITE('(No legal moves for ',colorword[mover],')'); #status.nextmover := flipof(mover); #END;  END; (*play*ecount...*)  END; (*calcmove*)   PROCEDURE play(mover: color);  BEGIN  GOTOXY(0,20+ORD(mover));  IF legalmoves[mover] > 0 THEN BEGIN #WRITE(spaces); #IF mover = usercolor THEN &inputmove(mover,legallist,move) #ELSE BEGIN ,checkposition(responses,respcornmoves); ,checkresponses(mover,move,responses,bestsofar); & END; &IF points > bestsofar THEN BEGIN )bestsofar := points; )bestmove := move; )END; &END; (*WITH move...*) #END; (*FOR m := 1 TO legallist.movount DO BEGIN #move := legallist.okmove[m]; #aftermove := status; #makemove(aftermove,move,TRUE); #findlegalmoves(aftermove,responses); #WITH move DO BEGIN &IF responses.movecount = 0 THEN )points := points + 100 &ELSE )IF points > bestsofar THEN  GOTOXY(0,23);  WRITE('Calculating move for ',colorword[mover],'...');  checkposition(legallist,cornmoves);  IF legallist.movecount > 2 THEN  sortmoves(legallist.okmove,2,legallist.movecount);  bestsofar := -MAXINT;  FOR m := 1 TO legallist.movecol] DO /IF occupied THEN 2IF occupier = mover THEN 5WITH status.boardstatus[between.row,between.col] DO 8IF NOT occupied THEN ;points := points - 90; )END;  END; (*WITH move...*) #END; (*checkresponses*) #  BEGIN (*calcmove*) +1*) ,EXIT(checkresponses); ,END; )r := r + 1; )UNTIL r > responses.movecount; &IF bordnoncorn THEN BEGIN )points := points - contingent; )WITH board[moveloc.row,moveloc.col] DO ,IF specialbordersq THEN WITH otherofpair, Istatus.boardstatus[row,c 1; /END; )IF NOT cornercounter THEN BEGIN ,points := points -190;  IF points <= bestsofar THEN /EXIT(checkresponses);  END;  0: )IF afterresp.score[mover] = 0 THEN BEGIN ,points := -MAXINT+1; (*might be our only choice, so (* COPYRIGHT (C) 1979 Software Supply. All rights reserved. *)  (* included file for OTHELLO *)   PROCEDURE updatecrt(VAR oldstatus,newstatus: gamestatus);  FORWARD;  FUNCTION flipof(oldcolor: color): color;  FORWARD;  PROCEDURE makemove(VAR st'); &WRITELN('occupied square. All of the'); &WRITELN('opponent''s pieces which that'); &WRITELN('line crosses are converted '); &WRITELN('to become your pieces. Thus'); &WRITELN('each move "flips" at least '); &WRITELN('one opposing piece. ; &WRITELN('opponent so that a straight '); &WRITELN('line starting at your piece '); &WRITELN('and continuing in the direc-'); &WRITELN('tion of the adjacent oppon- '); &WRITELN('ent hits one of your other '); &WRITELN('pieces before hitting an un-&WRITELN('A move consists of placing '); &WRITELN('one of your pieces on an '); &WRITELN('unoccupied square which is '); &WRITELN('adjacent (vertically, hori- '); &WRITELN('zontally, or diagonally) to '); &WRITELN('a square occupied by your ')ELN('Score'); #WRITELN('-----------'); #WRITELN(CHR(whiteascii),'/White:'); #WRITELN(CHR(blackascii),'/Black:'); #END; (*showemptyboard*) "  PROCEDURE instructions; #VAR &i: INTEGER; #PROCEDURE page1; &BEGIN ); #FOR gamerow := 1 TO 8 DO BEGIN &IF gamerow>1 THEN (* "IF" because no room for topmost border line *) )writeln(blanks,horzdivs); &writeln(blanks:29,gamerow,vertdivs); &writeln(blanks,vertdivs); &END; #write(blanks,colnames); #GOTOXY(4,0); #WRIT | | |'; &horzdivs = '|-----|-----|-----|-----|-----|-----|-----|-----|'; &colnames = ' A B C D E F G H '; # blanks = ' '; #VAR &gamerow : coordinate; #BEGIN #GOTOXY(0,0/otherofpair.row := x-2; /between.row := x-1; /END; ,END; )END; (*IF specialbordersq...*) &END; (*FOR x:= ... FOR y:= ... WITH board[x,y]...*) #END; (*defineboard*) $ #PROCEDURE showemptyboard; #CONST &vertdivs = '| | | | | |een.col := y+1; /END ,ELSE BEGIN /otherofpair.col := y-2; /between.col := y-1; /END; ,END )ELSE BEGIN ,otherofpair.col := y; ,between.col := y; ,IF x IN [2,5] THEN BEGIN /otherofpair.row := x+2; /between.row := x+1; /END ,ELSE BEGIN N [2,4,5,7]) OR (y IN [2,4,5,7]) ); &IF specialbordersq THEN BEGIN )otherofpair.onboard := TRUE; )between.onboard := TRUE; )IF x IN [1,8] THEN BEGIN ,otherofpair.row := x; ,between.row := x; ,IF y IN [2,5] THEN BEGIN /otherofpair.col := y+2; /betw row := x; /south,se,sw: row := x+1; /END; ,CASE direc OF /nw,west,sw: col := y-1; /north,south: col := y; /ne,east,se: col := y+1; /END; ,END; )END; (*FOR direc...WITH adjacentsq...*) &specialbordersq := border AND (NOT corner) AND <( (x I,se: onboard := (x<8) AND (y<8); ,south: onboard := x<8; ,sw: onboard := (x<8) AND (y>1); ,west: onboard := y>1; ,nw: onboard := (x>1) AND (y>1); ,END; (*CASE*) )IF onboard THEN BEGIN ,CASE direc OF /north,ne,nw: row := x-1; /east,west:6]); &diagnexttocorner := (x IN [2,7]) AND (y IN [2,7]); &FOR direc := north TO nw DO WITH adjacentsq[direc] DO BEGIN )CASE direc OF ,north: onboard := x>1; ,ne: onboard := (x>1) AND (y<8); ,east: onboard := y<8; whether clock is on*)  #PROCEDURE defineboard; #BEGIN #FOR x := 1 TO 8 DO FOR y := 1 TO 8 DO WITH board[x,y] DO BEGIN &border := (x IN [1,8]) OR (y IN [1,8]); &corner := (x IN [1,8]) AND (y IN [1,8]); &incenter4by4 := (x IN [3..6]) AND (y IN [3..atus: gamestatus; VAR move: movedesc; updateadjacent: `BOOLEAN);  FORWARD;   SEGMENT PROCEDURE initgame;  CONST #backspace = 8;  VAR #x,y: coordinate; #direc: direction;  answer: CHAR; #h,l,h0,l0: INTEGER; (*for testing '); &WRITE (' (Tap space bar for more...)'); # END; (*page1*) #PROCEDURE page2; &BEGIN &WRITELN('Example: a legal move for '); &WRITELN('white on the first play '); &WRITELN('would be 3E, 4F, 6D, or 5C. '); &WRITELN('To make a move at, e.g., 3E '); &WRITELN('you may type any of: 3E, 3e,'); &WRITELN('E3, or e3. '); &WRITELN('If you have no legal move, '); &WRITELN('you must pass. The object '); &WRITELN('of the game is to end up ')2 1 3 9 P ?^윖] := 'black';  END; (*initgame*)  ;  READ(answer); #UNTIL answer IN ['W','w','B','b'];  IF answer IN ['W','w'] THEN #usercolor := white  ELSE #usercolor := black;  GOTOXY (0,6);  WRITELN(spaces); WRITELN(spaces); WRITELN(spaces);  colorword[white] := 'white';  colorword[black&END; (*FOR...FOR...*) #nextmover := white; #END; (*WITH status...*)  instructions;  GOTOXY(0,6);  WRITELN('White goes first -- Which');  WRITELN('color do you want to play:');  REPEAT #GOTOXY(3,8);  WRITE('W)hite or B)lack? ',CHR(backspace)):= 4 TO 5 DO FOR y := 4 TO 5 DO BEGIN &move.moveloc.row := x; &move.moveloc.col := y; &IF x=y THEN )nextmover := white &ELSE )nextmover := black; &makemove(status,move,TRUE); &updatecrt(crtstatus,status);  crtstatus := status; O FOR y := 1 TO 8 DO WITH boardstatus[x,y] DO BEGIN # occupied := FALSE; # adjacentpieces[white] := []; &adjacentpieces[black] := []; &END; #END;  crtstatus := status;  move.dirsflipped := [];  move.points := 0;  WITH status DO BEGIN #FOR x := succ(direc);  TIME(h,l);  IF (h=h0) AND (l=l0) THEN BEGIN #GOTOXY(20,11); #WRITE('Please turn on the clock.'); #WHILE l=l0 DO &TIME(h,l); #END;  showemptyboard;  WITH status DO BEGIN #score[white] := 0; #score[black] := 0; #FOR x := 1 TO 8 D&GOTOXY(0,5); &WRITE(spaces); &END; #END; (*instructions*) &  BEGIN (*initgame*)  lastchange := 0;  TIME(h0,l0);  defineboard;  FOR direc := north TO NW DO #IF odd(ORD(direc)) THEN  opposdir[direc] := pred(direc) #ELSE &opposdir[direc] ctions? (y/n): '); #READ(answer); #IF NOT (answer IN ['N','n']) THEN BEGIN &GOTOXY(0,5); &page1; &READ(answer); &GOTOXY(0,5); &page2; &READ(answer); &GOTOXY(0,5); &FOR i := 5 TO 22 DO )WRITELN(spaces); &WRITE(spaces); &END #ELSE BEGIN '); &WRITELN('Try to occupy the borders '); &WRITELN('(especially corners!) and '); &WRITELN('avoid giving them to your '); &WRITE ('opponent. (Tap space bar...)'); # END; (*page2*) #BEGIN (*instructions*) #GOTOXY(0,5); #WRITE('Want instru; &WRITELN('occupying more squares than '); &WRITELN('does your opponent. '); &WRITELN('Hints on strategy: Usually '); &WRITELN('the board position of a move'); &WRITELN('is more important than the '); &WRITELN('number of pieces it "flips".PROGRAM BLACKJK; ! !{GAME OF BLACKJACK WRITTEN IN PASCAL BY T.R. STOKES} ! !CONST "XINST = 0; {VARIOUS X-Y COORDS FOR SCREEN MESSAGES} "YINST = 3; "XWIN = 0; "YWIN = 2; "XBET = 0; "YBET = 1; "XOVER =0 THEN CARDVAL:=10; !IF RANK=1 THEN NACES[I]:=NACES[I]+1; !NAC:=NACES[I]; !ANACE:=0; !IF RANK=1 THEN ANACE:=1; !HANDVAL[I]:=HANDVAL[I]+CARDVAL+10*ANACE; #WHILE (HANDVAL[I]>21) AND (NAC>0) DO $BEGIN %NACES[I]:=NACES[I]-1; %HANDVAL[I]:=HANDVAL[I]-10NAMECARD; #GOTOXY(X,Y); #CN:=Y-YHAND0; #WRITE(CN:2,')',NAMRANK:6,' OF ',NAMSUIT); !END; {SHOWHAND} "  PROCEDURE SCORE; !VAR ANACE,NAC,CARDVAL:INTEGER;  BEGIN #CASE PERSON OF "PLAYER:I:=1; "DEALER:I:=2; " END; {CASE} !CARDVAL:=RANK; !IF RANK>1#END; {FOR} !END; {SETUP} ! !PROCEDURE SHOWHAND; "VAR #X,Y,CN :INTEGER; "BEGIN #CASE PERSON OF "PLAYER: #BEGIN $YPLYR:=YPLYR+1; $Y:=YPLYR; $X:=XPLYR; #END; "DEALER: #BEGIN $YDELR:=YDELR+1; $Y:=YDELR; $X:=XDELR; #END; "END; {CASE} ! SUIT} "  PROCEDURE SETUP; !BEGIN "BUST:=FALSE; "BJACK:=FALSE; "PUSH:=FALSE; "WIN:=FALSE; "DBLDOWN:=FALSE; "XPLYR:=0; "YPLYR:=YHAND0; "XDELR:=20; "YDELR:=YHAND0; "FOR I:=1 TO 2 DO #BEGIN $HANDVAL[I]:=0; $NACES[I]:=0; # HANDSIZE[I]:=0; '; $2:NAMSUIT:='DIAMONDS'; $3:NAMSUIT:='HEARTS '; $4:NAMSUIT:='SPADES '; %END {SUITCASE} # END; #END; {NAMECARD} ! "PROCEDURE RANSUIT(CARD:INTEGER); #BEGIN %RANK:=CARD MOD 13; %IF RANK=0 THEN RANK:=13; %SUIT:=(CARD-1) DIV 13 + 1; ! END; {RANS WILL WORK} "IF RANK=1 THEN NAMRANK:='ACE '  ELSE IF RANK>9 THEN $BEGIN %CASE RANK OF $10:NAMRANK:='10 '; $11:NAMRANK:='JACK '; $12:NAMRANK:='QUEEN'; $13:NAMRANK:='KING '; %END {RANKCASE} $END; $BEGIN %CASE SUIT OF $1:NAMSUIT:='CLUBS $BEGIN %TEMP:=DECK[I];  RI:=TRUNC(52*RND+1); %DECK[I]:=DECK[RI]; %DECK[RI]:=TEMP; $END; {FOR} #CLEARTOP; "END; {SHUFFLE} "  PROCEDURE NAMECARD; !BEGIN "NAMRANK:=' '; {MAKE IT ONE BYTE LONG} "NAMRANK[1]:=CHR(RANK+48); {SO THI*SEED+6975) MOD 32767; !END; {RND} !  PROCEDURE FRESHDECK; !BEGIN "FOR I:=1 TO 52 DO #BEGIN $DECK[I]:=I; "END; {FOR} !END; {FRESHDECK} !  PROCEDURE SHUFFLE; !VAR "TEMP,RI:INTEGER;  BEGIN "SHUFMES; "CARDSLEFT:=52; " FOR I:=1 TO 52 DO EGIN  GOTOXY(0,YPLYR); "WRITE(CHR(11)); {CLEAR TO END OF SCREEN} !END; {CLERBOT}   PROCEDURE SHUFMES; !BEGIN "CLEARTOP; "GOTOXY(5,0); "WRITE('SHUFFLING'); !END; {SHUFMES} "  FUNCTION RND:REAL; !BEGIN "RND:=SEED/32767; "SEED:=(12585URE CLEARTOP; !BEGIN "GOTOXY(0,0); "WRITE(CHR(29)); {CLEAR TO END OF LINE} !END; {CLEARTOP} !  PROCEDURE CLEREOL(X,Y:INTEGER); !BEGIN  GOTOXY(X,Y); "WRITE(CHR(29)); {CLEAR TO END OF LINE} !END; {CLEREOL}   PROCEDURE CLERBOT; !B"CHOICE :SET OF CHAR; "XHOLE,YHOLE :INTEGER; "HOLSUIT,HOLRANK :STRING; "DBLDOWN :BOOLEAN; " "  (* SOME MODIFIED FOR APPLE *)  PROCEDURE NEWSCREEN; !BEGIN "WRITE(CHR(12)); !END; {NEWSCREEN} !  PROCED :INTEGER; "BUST,BJACK,PUSH,WIN :BOOLEAN; "XPLYR,YPLYR :INTEGER; "XDELR,YDELR :INTEGER; "I,J :INTEGER; {GENERAL PURPOSE INDICES} "CARDVAL :INTEGER; "REPLY :CHAR; FT :INTEGER; "SEED :INTEGER; "PERSON :VEGAS; "HANDVAL :ARRAY[1..2] OF INTEGER; "NACES :ARRAY[1..2] OF INTEGER; "HANDSIZE :ARRAY[1..2] OF INTEGER; "BET,DOLLARS 5; "YOVER = 4; ! YHAND0= 6; {LEVEL-1 OF CARDS PLAYED} " !TYPE "VEGAS = (PLAYER,DEALER); " !VAR "DECK :ARRAY[1..52] OF INTEGER; "RANK,SUIT :INTEGER; "NAMRANK,NAMSUIT :STRING; "CARDSLE; $END; {WHILE} !IF HANDVAL[I]>21 THEN BUST:=TRUE  END; {SCORE}   PROCEDURE PSCORE; !BEGIN "GOTOXY(XPLYR+6,YPLYR+1); "WRITE('TOTAL = ',HANDVAL[1]:3); !END; {PSCORE} !  PROCEDURE HSCORE; !BEGIN  GOTOXY(XDELR+6,YDELR+1); "WRITE('TOTAL = ',HANDVAL[2]:3); !END; {HSCORE}   PROCEDURE WINNINGS; !BEGIN "IF NOT PUSH THEN #BEGIN $IF DBLDOWN THEN BET:=BET+BET; $IF WIN THEN DOLLARS:=DOLLARS+BET $ELSE DOLLARS:=DOLLARS-BET #END; {NOT PUSH} "CLEREOL(XWIN,YWIN); "WRITE('In) %ELSE WRITE('PAY ',HV+1); #END; {NOT PUSH} !END; {EVALUATE} ! " !BEGIN {MAIN PROGRAM} "CHOICE:=['H','G','D','S']; "NEWSCREEN; "WRITE(' PLEASE ENTER A RANDOM NUMBER - '); "READLN(SEED); "FRESHDECK; "SHUFFLE; "SETUP; "INSTRUCTIONS; "ELSE IF HANDVAL[1]>HANDVAL[2] THEN WIN:=TRUE; ! IF PUSH THEN BEGIN #CLEREOL(XOVER,YOVER); ! WRITE(' - PUSH -'); "END; ! HV:=HANDVAL[2]; "IF (NOT PUSH) AND (NOT BUST) THEN ! BEGIN $CLEREOL(XOVER,YOVER); $IF HV=21 THEN $ WRITE('DEALER HAS 21!!'#END; {WHILE} ! HSCORE; !END; {DEALHOUSE} !  PROCEDURE EVALUATE; !VAR HV:INTEGER; !BEGIN "IF BUST THEN BEGIN #WIN:=TRUE; #CLEREOL(XOVER,YOVER); #WRITE('THE HOUSE BUSTED WITH ',HANDVAL[2]:3); "END "ELSE IF HANDVAL[1]=HANDVAL[2] THEN PUSH:=TRUE [1]:3); #END; {IF BUST} "IF REPLY='D' THEN DBLDOWN:=TRUE; !END; {DEALPLAYER} "  PROCEDURE DEALHOUSE; !BEGIN "PERSON:=DEALER; "SHOHOLE;  WHILE (HANDVAL[2]<17) OR ((HANDVAL[2]=17) AND (NACES[2]>0)) DO " BEGIN # DEAL; $SHOWHAND; $SCORE; ER; !BEGIN ! PERSON:=PLAYER; "REPEAT #DOWHAT; $IF (REPLY='H') OR (REPLY='D') THEN %BEGIN &DEAL; &SHOWHAND; &SCORE; %END #UNTIL BUST OR (REPLY<>'H') OR (REPLY='D'); "IF BUST THEN #BEGIN $CLEREOL(XOVER,YOVER); $WRITE('YOU BUSTED WITH ',HANDVAL(XOVER,YOVER); %WRITE('* * * BLACKJACK !! - PAY 1.5 TIMES BET '); $END {PLAYERS BLACKJACK} #ELSE $BEGIN %CLEREOL(XOVER,YOVER); %WRITE('* * DEALER HAS A BLACKJACK !!'); $END; #END; {BJACK:=TRUE} "END; {TEST21 - NO BLACKJACK} "  PROCEDURE DEALPLAY BEGIN $BJACK:=TRUE; $SHOHOLE; $IF HANDVAL[1]=HANDVAL[2] THEN %BEGIN &PUSH:=TRUE; &CLEREOL(XOVER,YOVER); &WRITE('* * DOUBLE BLACKJACK !!! - PUSH -'); $END {PUSH} #ELSE IF HANDVAL[1]=21 THEN $BEGIN $ WIN:=TRUE; %BET:=BET+BET DIV 2; %CLEREOL TO 2 DO #BEGIN $FOR PERSON:=PLAYER TO DEALER DO %BEGIN &DEAL; &SCORE; &IF (PERSON=DEALER) AND (C=1) THEN NOSHOW &ELSE SHOWHAND %END; {PERSON} #END; {FOR} !END; {DEAL2} !  PROCEDURE TEST21; !BEGIN "IF (HANDVAL[1]=21) OR (HANDVAL[2]=21) THEN ECK[K]; "RANSUIT(CARD); "NAMECARD; "CARDSLEFT:=CARDSLEFT-1; "IF CARDSLEFT=0 THEN SHUFFLE; ! IF PERSON=PLAYER THEN HANDSIZE[1]:=HANDSIZE[1]+1 ! ELSE HANDSIZE[2]:=HANDSIZE[2]+1; !END; {DEAL}   PROCEDURE DEAL2; !VAR #C:INTEGER; !BEGIN "FOR C:=1EAT}  END; {PLAYERIN}   PROCEDURE SHOHOLE; !VAR CN:INTEGER; !BEGIN "GOTOXY(XHOLE,YHOLE); "CN:=YHOLE-YHAND0; "WRITE(CN:2,')',HOLRANK:6,' OF ',HOLSUIT); !END; {SHOHOLE} "  PROCEDURE DEAL; !VAR "K,CARD:INTEGER; !BEGIN "K:=CARDSLEFT; "CARD:=D BEGIN !CLEREOL(XBET,YBET); !WRITE('HOUSE LIMIT IS $200.. BET LIMIT ? (Y/N) '); !READ(B); !IF B<>'N' THEN BET:=200 !ELSE "BEGIN #REPEAT #CLEREOL(XBET,YBET); #WRITE('HOUSE LIMIT IS $200.. BET PLEASE ? '); #READLN(BET); "UNTIL BET<201 !END; {REPOLE:=XDELR; "YHOLE:=YDELR; ! HOLSUIT:=NAMSUIT; "HOLRANK:=NAMRANK; !END; {NOSHOW} !  PROCEDURE INSTRUCTIONS; !BEGIN "GOTOXY(XINST,YINST); "WRITE('H)it, G)ood, D)oubledown, S)plitpair'); !END; {INSTRUCTIONS} !  PROCEDURE PLAYERIN; !VAR B:CHAR; " BEGIN ! CLEREOL(XINST,YINST); $WRITE('NO-NO, NOT AFTER 3 OR MORE!!'); $DOWHAT; #END; !END; {DOWHAT} !  PROCEDURE NOSHOW; !VAR CN:INTEGER; !BEGIN "YDELR:=YDELR+1; "GOTOXY(XDELR,YDELR); "CN:=YDELR-YHAND0; "WRITE(CN:2,') ?????????'); ! XH U.S. of A. Dollars you have $',DOLLARS); !END; {WINNINGS} !  PROCEDURE DOWHAT; !BEGIN "CLEREOL(XOVER,YOVER); "REPEAT #GOTOXY(XOVER,YOVER); #WRITE('YOUR MONEY ? '); #READ(REPLY); "UNTIL REPLY IN CHOICE; ! IF (REPLY='D') AND (HANDSIZE[1]>2) THEN "PLAYERIN; "DOLLARS:=0; "REPEAT #IF BET>0 THEN BEGIN $DEAL2; $TEST21; " IF NOT BJACK THEN %BEGIN &DEALPLAYER; &PSCORE; &IF NOT BUST THEN 'BEGIN (DEALHOUSE; (EVALUATE; " END; {IF NOT BUST} &END; {NOT BJACK} $END; {BET>0} #INSTRUCTIONS; #WINNINGS; #PLAYERIN; " SETUP; #CLERBOT; "UNTIL BET<0 !END. {MAIN PROGRAM}  NTEGER;  BEGIN ETOI:=SQR+(SQR-1) DIV 8; END;   PROCEDURE TAB(N: INTEGER);  BEGIN  WHILE N > 0 DO $BEGIN $N:=N-1; $REPEAT COL := COL + 1; WRITE (ANAL, ' '); $UNTIL (COL MOD 8) = 0;  END;  END;   PROCEDURE REVERSE;  VAR J: 1..4;  BEGIN E, TIME,  PLAYERSI, OPPONSIN, PLAYERKI,  OPPONKING, ORIGINAL: INTEGER;  MSP, BESTMOVE: MOVEPTR;  CH:CHAR;  JMP, PCE: ARRAY[1..9] OF INTEGER;    FUNCTION ITOE(SQ:INTEGER):INTEGER;  BEGIN ITOE := SQ-SQ DIV 9; END;   FUNCTION ETOI(SQR:INTEGER):I DIRECTION: ARRAY[1..4] OF INTEGER;   COL, MOVENUMBER, NUMMOVES: INTEGER;  NEWFLAG, DEBUG, ANALYSIS, FOUNDJUMP, DYNAM: BOOLEAN;  GAIN, LEVEL, PLY, MINIMUMPLY, MAXIMALLEVEL,  PLAYER, OPPON, MAXLEVEL, TOTALKIN, WINNER,  LOSER, MATERIAL, TOTALNUM, LIF ARRAY[1..35, 1..35] OF INTEGER;   DISTTODD, NEARESTDDSQ: ARRAY[1..35] OF INTEGER;   PLAYING: ARRAY[SIDES] OF BOOLEAN;  TOTAL: ARRAY[SIDES] OF INTEGER;   NAME: ARRAY[PIECES] OF STRING[6];  NUMBER: ARRAY[PIECES] OF INTEGER;  INTEGER; &END;   VAR  ANAL: FILE OF CHAR;   BOARD: ARRAY[CONTENTS] OF INTEGER;   GAME: PACKED ARRAY[1..MAXNOMOVES] OF MOVE;  MOVSTK: ARRAY[MOVEPTR] OF MOVE;  KILLER: ARRAY[1..20] OF MOVE;   LOCATION: ARRAY[PIECES,1..12] OF CONTENTS;  DIST:=600; DIROPP=250; DBLDIAG=4;   TYPE  CONTENTS = -9..45;  SIDES = RED..BLACK;  PIECES = -KING..KING;  MOVEPTR = 0..STACKSIZE;  MOVE = RECORD &SOURCE, DEST: CONTENTS; &LENGTH, EVAL: INTEGER; &CROWNED: BOOLEAN; &JUMPEDSQ, JUMPEDPC: ARRAY[1..9] OF (* $L CONSOLE:*)  (*$S+*)  PROGRAM CHECKERS;  CONST SINGLE=2; KING=4; EMPTY=0; INFINITY=32000;  BLACK=1; RED=-1; BRIDGES=50; KINGCENTER=50;  NEARCROWN=75; MYTHICAL=-1; TRADEOFF=20;  CORNER=10; MAXNOMOVES=200; STACKSIZE=200;  MINORBRIDGES=35; TRAPPEDA ENDEVAL G#N^ OPPON:=PLAYER;  PLAYER:=-PLAYER;  OPPONSINGLE:=-OPPONSINGLE;  OPPONKING:=-OPPONKING;  PLAYERSINGLE:=-PLAYERSINGLE;  PLAYERKING:=-PLAYERKING;  FOR J:=1 TO 4 DO "DIRECTION[J]:=-DIRECTION[J];  GAIN:=-GAIN;  END;    PROCEDURE DISPLAY;  VAR J1,J2: INTEGER;  BEGIN  WRITELN;  FOR J1:=0 TO 3 DO BEGIN "WRITE(' '); "FOR J2:=1 TO 4 DO #WRITE(NAME[BOARD[ETOI(8*J1+J2)]]); "WRITELN; "FOR J2:=5 TO 8 DO #WRITE(NAME[BOARD[ETOI(8*J1+J2)]]); "WRITELN; "END;  END;    FUNCTION MIN(I,BER[PCE]+1;  TOTALNUMBER:=TOTALNUMBER+1;  END;    PROCEDURE PRINTGAME;  VAR I: INTEGER;  BEGIN  WRITELN('CHECKERS V01.01');  FOR I:=1 TO MOVENUMBER DO $BEGIN $WRITE(I:3,'. '); $MOVSTK[0]:=GAME[I]; $PRINTMOVE(0); $END;  END;   PROCEDURE AL[RED]-1 !ELSE TOTAL[BLACK]:=TOTAL[BLACK]-1;  NUMBER[PCE]:=NUMBER[PCE]-1;  TOTALNUMBER:=TOTALNUMBER-1;  END; !  PROCEDURE INSERT(PCE:INTEGER);  BEGIN  IF PCE<0 !THEN TOTAL[RED]:=TOTAL[RED]+1 !ELSE TOTAL[BLACK]:=TOTAL[BLACK]+1;  NUMBER[PCE]:=NUM TOTAL[BLACK]:=NUMBER[SINGLE]+NUMBER[KING];  TOTAL[RED]:=NUMBER[-KING]+NUMBER[-SINGLE];  MATERIAL:=3*(NUMBER[KING]-NUMBER[-KING])+ !2*(NUMBER[SINGLE]-NUMBER[-SINGLE]);  END;   PROCEDURE REMOVE(PCE:INTEGER);  BEGIN  IF PCE<0 !THEN TOTAL[RED]:=TOT TO 35 DO #BEGIN #PCE := BOARD[J]; #NUMBER[PCE] := NUMBER[PCE] + 1; #IF PCE<>EMPTY THEN LOCATION[PCE,NUMBER[PCE]] := J; #END;  TOTALKINGS:=NUMBER[KING]+NUMBER[-KING];  TOTALNUMBER:=TOTALKINGS+NUMBER[SINGLE]+ "NUMBER[-SINGLE]; OR I := 1 TO LENGTH DO (WRITE(ITOE(JUMPEDSQ[I]):3); &END; #IF CROWNED THEN WRITE(' CROWN ME'); #WRITELN; #END;  END;    PROCEDURE COUNTPIECES;  VAR J:INTEGER;  PCE: PIECES;  BEGIN  FOR PCE := -KING TO KING DO NUMBER[PCE] := 0;  FOR J:=1 WRITELN('ANALYSIS');  WRITELN; WRITELN;  END;    PROCEDURE PRINTMOVE(P: MOVEPTR);  VAR I: INTEGER;  BEGIN  WRITE('[',P:1,']');  WITH MOVSTK[P] DO BEGIN #WRITE(ITOE(SOURCE):2,'-',ITOE(DEST):2); #IF LENGTH>0 THEN BEGIN &WRITE(' JUMPING '); &F BEGIN  WRITELN;  WRITELN(' CHECKERS VERSION 1.0');  WRITELN('MINIMUMPLY: ',MINIMUMPLY:2);  WRITELN('MAXIMALLEVEL: ',MAXIMALLEVEL:2);  WRITELN('TIME: ',TIME:4);  IF NOT DEBUG THEN WRITE ('NO '); WRITELN('DEBUG');  IF NOT ANALYSIS THEN WRITE('NO ');  PLAYERKING:=KING;  OPPONSINGLE:=-SINGLE;  OPPONKING:=-KING;  DIRECTION[1]:=4;  DIRECTION[2]:=5;  DIRECTION[3]:=-4;  DIRECTION[4]:=-5;  MSP:=0;  END;   FUNCTION RANDOM(N:INTEGER):INTEGER;  BEGIN RANDOM:=1; END;    PROCEDURE WRITEPARAM; ARD[J]:=MYTHICAL;  FOR J:=1 TO 13 DO BOARD[J]:=SINGLE;  FOR J:=14 TO 22 DO BOARD[J]:=EMPTY;  FOR J:=23 TO 35 DO BOARD[J]:=-SINGLE;  BOARD[9]:=MYTHICAL;  BOARD[18]:=MYTHICAL;  BOARD[27]:=MYTHICAL;  PLAYER:=BLACK;  OPPON:=RED;  PLAYERSINGLE:=SINGLE;1 DO "FOR R2:=0 TO 31 DO $BEGIN $COL1:=(R1 MOD 4)*2+1-((R1 MOD 8) DIV 4); $COL2:=(R2 MOD 4)*2+1-((R2 MOD 8) DIV 4); $ROW1:=R1 DIV 4; $ROW2:=R2 DIV 4; $DIST[ETOI(R1+1),ETOI(R2+1)]:= %MAX(ABS(ROW1-ROW2),ABS(COL1-COL2)); $END;  FOR J:=-9 TO 45 DO BO DISTTODD[24]:=1; NEARESTDDSQ[24]:=20;  DISTTODD[28]:=2; NEARESTDDSQ[28]:=20;  DISTTODD[29]:=1; NEARESTDDSQ[29]:=25;  DISTTODD[32]:=3; NEARESTDDSQ[32]:=20;  DISTTODD[33]:=2; NEARESTDDSQ[33]:=25;  DISTTODD[34]:=1; NEARESTDDSQ[34]:=30;  FOR R1:=0 TO 3RESTDDSQ[13]:=21;  DISTTODD[14]:=1; NEARESTDDSQ[14]:=10;  DISTTODD[17]:=1; NEARESTDDSQ[17]:=21;  DISTTODD[19]:=1; NEARESTDDSQ[19]:=15;  DISTTODD[22]:=1; NEARESTDDSQ[22]:=26;  DISTTODD[23]:=2; NEARESTDDSQ[23]:=15; GIN  DISTTODD[2]:=1; NEARESTDDSQ[2]:=6;  DISTTODD[3]:=2; NEARESTDDSQ[3]:=11;  DISTTODD[4]:=3; NEARESTDDSQ[4]:=16;  DISTTODD[7]:=1; NEARESTDDSQ[7]:=11;  DISTTODD[8]:=2; NEARESTDDSQ[8]:=16;  DISTTODD[12]:=1; NEARESTDDSQ[12]:=16;  DISTTODD[13]:=2; NEAJ: INTEGER): INTEGER;  BEGIN  IF I>J THEN MIN:=J ELSE MIN:=I;  END;   FUNCTION MAX(I,J:INTEGER):INTEGER;  BEGIN  IF I>J THEN MAX:=I ELSE MAX:=J;  END;    PROCEDURE INITIALIZE;  VAR P: MOVEPTR;  J,R1,R2,COL1,COL2,ROW1,ROW2: INTEGER;  BEGETMVS;  VAR L, STSQ: INTEGER;    PROCEDURE GETJUMP(A:INTEGER);  VAR INC,S2,S3,R,LNUM,BA:INTEGER;  BEGIN  LNUM:=0;  BA:=ABS(BOARD[A]);  FOR R:=1 TO BA DO $BEGIN $INC:=DIRECTION[R]; $S2:=A+INC; $S3:=S2+INC; $IF ((BOARD[S2]=OPPONSINGLE) OR &(BOARD[S2]=OPPONKING)) AND &(BOARD[S3]=EMPTY) THEN BEGIN )LNUM:=LNUM+1; )L:=L+1; )JMP[L]:=S2; )PCE[L]:=BOARD[S2]; )BOARD[S3]:=BOARD[A]; )BOARD[S2]:=EMPTY; )BOARD[A]:=EMPTY; )GETJUMP(S3); )BOARD[A]:=BOARD[S3]; )BOARD[S3]:=EMPTY; )BOARD[S2]:=PC+THEN VAL:=VAL+MINORBRIDGES; 'IF (BOARD[1]=SINGLE) AND (BOARD[3]=SINGLE) +THEN VAL:=VAL+BRIDGES; 'IF (BOARD[33]=-SINGLE) AND (BOARD[35]=-SINGLE) ) THEN VAL:=VAL-BRIDGES; 'IF (BOARD[32]=-SINGLE) AND (BOARD[34]=-SINGLE) +THEN VAL:=VAL-MINORBRIDGES; VAL; 'IF (TOTALNUMBER>17) OR (TOTALKINGS=0) *THEN OPENEVAL ELSE MIDDLEEVAL; 'FOR J:=5 TO 8 DO (IF BOARD[J]=-SINGLE THEN VAL:=VAL-NEARCROWN; 'FOR J:=28 TO 31 DO (IF BOARD[J]=SINGLE THEN VAL:=VAL+NEARCROWN; 'IF (BOARD[2]=SINGLE) AND (BOARD[4]=SINGLE) )2*(NUMBER[SINGLE]-NUMBER[-SINGLE]); 'VAL:=100*MATERIAL; 'IF MATERIAL>0 THEN WINNER:=BLACK ELSE WINNER:=RED; 'LOSER:=-WINNER; 'LK:=LOSER*KING; WK:=WINNER*KING; 'LS:=LOSER*SINGLE; 'TOTALKINGS:=NUMBER[KING]+NUMBER[-KING]; 'IF TOTALNUMBER<11 THEN ENDEWKLOC,LKLOC]); 1END; -IF LOCAL<2 THEN LOCAL:=2; -D:=D+LOCAL*LOCAL; -END; )VAL:=VAL+D*LOSER; )END; %END;  END;   BEGIN  IF ABS(GAIN)>2 ! THEN VAL:=200*GAIN "ELSE BEGIN 'MATERIAL:=3*(NUMBER[KING]-NUMBER[-KING])+ :=VAL+DBLDIAG*LOSER; )J:=J+5; %UNTIL J>26; %IF DYNAM AND (NUMBER[LK]>0) THEN )BEGIN )D:=0; )FOR J:=1 TO NUMBER[WK] DO -BEGIN -LOCAL:=7; -WKLOC:=LOCATION[WK,J]; -FOR K := 1 TO NUMBER[LK] DO 1BEGIN 1LKLOC:=LOCATION[LK,K]; 1LOCAL:=MIN(LOCAL,DIST[]+BOARD[35]=LOSER*KING 'THEN VAL:=VAL-CORNER*WINNER; %IF TOTALNUMBER+ORIGINALEMPTY<>32 'THEN VAL:=VAL+TRADEOFF*WINNER; %J:=6; %REPEAT )IF (BOARD[J]=LK) OR (BOARD[J]=LS) +THEN VAL:=VAL+DBLDIAG*LOSER; )IF (BOARD[J+4]=LK) OR (BOARD[J+4]=LS) +THEN VAL PROCEDURE MIDDLEEVAL;  BEGIN  END;   PROCEDURE ENDEVAL;  VAR J, K, D, LOCAL: INTEGER;  BEGIN  COUNTPIECES;  IF (TOTALKINGS=2) AND (TOTALNUMBER=2) "THEN ONETOONE "ELSE BEGIN %IF BOARD[1]+BOARD[5]=LK 'THEN VAL:=VAL-CORNER*WINNER; %IF BOARD[31 IF BLOC MOD 5 > 1 THEN $BEGIN $ODIST:=DISTTODD[BLOC]; $PDIST:=DIST[RLOC,NEARESTDDSQ[BLOC]]; $TEMP:=PDIST-ODIST; $IF (TEMP<=1) AND (ABS(TEMP) MOD 2 = (OPPON+1) DIV 2) 'THEN VAL:=VAL-TRAPPED; $END;  END;   PROCEDURE OPENEVAL;  BEGIN  END;  OC:=LOCATION[KING, 1];  RLOC:=LOCATION[-KING,1];  IF RLOC MOD 5 > 1 THEN $BEGIN $ODIST:=DISTTODD[RLOC]; $PDIST:=DIST[BLOC,NEARESTDDSQ[RLOC]]; $TEMP:=PDIST-ODIST; $IF (TEMP<=1) AND (ABS(TEMP) MOD 2 = (OPPON+1) DIV 2) 'THEN VAL:=VAL+TRAPPED; $END; P;  BEGIN  LKLOC:=LOCATION[LOSER*KING,1];  FOR J:=1 TO NUMBER[WK] DO "IF DIRECTOPP(LOCATION[WK,J],LKLOC) AND (LKLOC MOD 5 > 1) $THEN VAL:=VAL+DIROPP*WINNER;  END;    PROCEDURE ONETOONE;  VAR BLOC, RLOC, ODIST, PDIST, TEMP: INTEGER;  BEGIN  BL VAR WKLOC, LS, LKLOC, WK, LK, J, VAL: INTEGER;    FUNCTION DIRECTOPP(S1,S2: INTEGER): BOOLEAN;  BEGIN  DIRECTOPP:=(DIST[S1,S2]=2) AND (ABS(S1-S2) MOD 2 = 1);  IF S1 IN [3,4,8,13,23,28,32,33] THEN DIRECTOPP:=FALSE;  END;    PROCEDURE CHECKOP*END;  END; !  BEGIN  FOUNDJUMP:=FALSE;  L:=0;  FOR STSQ:=1 TO 35 DO !IF (BOARD[STSQ]=PLAYERSING) OR (BOARD[STSQ]=PLAYERKING) #THEN GETJUMP(STSQ);  IF NOT FOUNDJUMP THEN GETMOVE;  END;    FUNCTION STATIC: INTEGER; !FOR J:=1 TO 35 DO #IF (BOARD[J]=PLAYERSINGLE) OR (BOARD[J]=PLAYERKING) %THEN FOR R:=1 TO ABS(BOARD[J]) DO &IF BOARD[J+DIRECTION[R]]=EMPTY 'THEN BEGIN *WITH MOVSTK[MSP] DO BEGIN ,LENGTH:=0; ,SOURCE:=J; ,DEST:=J+DIRECTION[R]; ,END; *MSP:=MSP+1; E[L]; )L:=L-1; )END; &END; !IF (LNUM=0) AND (L>0) THEN BEGIN $FOUNDJUMP:=TRUE; $WITH MOVSTK[MSP] DO BEGIN 'LENGTH:=L; 'JUMPEDSQ:=JMP; 'SOURCE:=STSQ; 'DEST:=A; 'END; $MSP:=MSP+1; $END; !END; ! !PROCEDURE GETMOVE; !VAR J, R: INTEGER; !BEGIN'VAL:=VAL*PLAYER; 'END;  IF ANALYSIS THEN BEGIN $(* TAB(14-LEVEL); $WRITE(ANAL,VAL:5,GAIN:2,LEVEL:2,PLY:2); $*) $WRITELN(ANAL); $COL:=1; $END;  STATIC:=VAL;  END;   PROCEDURE MAKEMOVE(P:MOVEPTR);  VAR PCE, SQ, J: INTEGER;  BEGIN  WITH MOVSTK[P] DO BEGIN #PCE:=BOARD[SOURCE]; #IF PLAYER=BLACK &THEN CROWNED:=(DEST>=32) AND (PCE=PLAYERSINGLE) &ELSE CROWNED:=(DEST<=4) AND (PCE=PLAYERSINGLE); #IF CROWNED THEN BEGIN &BOARD[DEST]:=PLAYERKING; &REMOVE(PCE); &INSERT(PLAYERKING); &  FOR P:=FIRST TO MSP-1 DO "IF MOVSTK[P].EVAL=MAXVAL THEN $BEGIN $MAKEMOVE(P); $J:=STATIC; $IF DEBUG THEN WRITE('=',J:1); $IF J>MV THEN (BEGIN (MV:=J; (BESTMOVE:=P; (END; $IF DEBUG THEN PRINTMOVE(P); $UNMOVE(P); $END;  DYNAM:=FALSE;  MAXVAL #END !ELSE BEGIN #CONTINUING:=(SCOPE>=NUM) OR (PLYMAXIMALLEVEL THEN CONTINUING:=FALSE;  END;    PROCEDURE REEVALUATE;  VAR J, MV: INTEGER;  BEGIN  MV:=-INFINITY;  DYNAM:=TRUE;   FUNCTION EVALUATE(SCOPE,ALPHA,OLDALPHA:INTEGER): INTEGER;  VAR NUM,NEWSCOPE,MAXVAL: INTEGER; %BEST,P,FIRST:MOVEPTR; %DEEPER: BOOLEAN;    FUNCTION CONTINUING: BOOLEAN;  BEGIN  IF FOUNDJUMP THEN BEGIN #NEWSCOPE:=SCOPE; #CONTINUING:=TRUE;2FOR K:=1 TO LENGTH DO 4IF JUMPEDSQ[K]<>INPUTSQ[K+1] THEN GOTO 1; 4MAKEMOVE(P); 4GAME[MOVENUMBER]:=MOVSTK[P]; 4REVERSE; 4GOTO 90; 4END; ,1:END; ,END; (END;  98: WRITELN('MOVE NOT FOUND');  99: MOVENUMBER:=MOVENUMBER-1;  90: MSP:=0;  END;  1 THEN BEGIN .WRITELN('AMBIGOUS MOVE'); .GOTO 99; .END; +MAKEMOVE(TABLE[1]); +GAME[MOVENUMBER]:=MOVSTK[TABLE[1]]; +REVERSE; +GOTO 90; +END )ELSE BEGIN +FOR J:=1 TO MATCHES DO BEGIN .P:=TABLE[J]; .WITH MOVSTK[P] DO 0IF LEN-2=LENGTH THEN BEGIN DO +BEGIN +IF (INPUTSQ[1]=MOVSTK[P].SOURCE) -AND (INPUTSQ[LEN]=MOVSTK[P].DEST) -THEN BEGIN 2MATCHES:=MATCHES+1; 2TABLE[MATCHES]:=P; 2END; +END; (IF LEN=2 THEN BEGIN +IF MATCHES=0 THEN BEGIN .WRITELN('NOT A MOVE'); .GOTO 99; .END; +IF MATCHES>#THEN WRITELN('YOU HAVE NO MOVES') #ELSE BEGIN (MATCHES:=0; (IF LEN<2 THEN BEGIN +WRITELN('MOVE NOT LONG ENOUGH'); +GOTO 99; +END; (IF (NOT FOUNDJUMPS) AND (LEN>2) THEN BEGIN ) WRITELN('THERE ARE NO JUMPS'); +GOTO 99; +END; (FOR P:=0 TO MSP-1 'WRITELN('ILLEGAL MOVE'); 'GOTO 99; 'END; $LEN:=LEN+1; $INPUTSQ[LEN]:=ETOI(N); $IF (CH<>'-') AND (CH<>' ') AND NOT EOLN THEN & BEGIN 'WRITELN('ILLEGAL DELIMITER'); 'GOTO 99; 'END; $IF NOT EOLN THEN READ(CH); $END;  GETMVS;  IF MSP=0 OLN) #DO READ(CH);  WHILE (CH IN ['0'..'9']) AND (NOT EOLN)  DO BEGIN #NUM:=NUM*10+ORD(CH)-ORD('0'); #READ(CH); #END;  READNUMBER:=NUM;  END;   BEGIN  LEN:=0;  WHILE NOT EOLN DO $BEGIN $N:=READNUMBER; $IF (N=0) OR (N>32) THEN & BEGIN +*)  LABEL 1,90,98,99;  VAR INPUTSQ: ARRAY[1..30] OF INTEGER; $P: MOVEPTR; $LEN, N, MATCHES, J, K: INTEGER; $TABLE: ARRAY[1..30] OF MOVEPTR;   FUNCTION READNUMBER: INTEGER;  VAR NUM: INTEGER;  BEGIN  NUM:=0;  WHILE (CH IN ['-',' ']) AND (NOT E&INSERT(PLAYERSINGLE); &END $ELSE BOARD[SOURCE]:=HOLD; #IF LENGTH>0 THEN BEGIN &GAIN:=GAIN-LENGTH; &FOR J:=1 TO LENGTH DO BEGIN )HOLD:=JUMPEDPC[J]; )BOARD[JUMPEDSQ[J]]:=HOLD; )INSERT(HOLD); )END; &END; #END;  END;   PROCEDURE ACCEPT;  (*$GB(1); &END; #END;  END;   PROCEDURE UNMOVE(P:MOVEPTR);  VAR HOLD, J: INTEGER;  BEGIN  WITH MOVSTK[P] DO BEGIN #HOLD:=BOARD[DEST]; #BOARD[DEST]:=EMPTY; #IF CROWNED THEN BEGIN &BOARD[SOURCE]:=PLAYERSINGLE; &REMOVE(HOLD); (LEVEL>0) THEN BEGIN &IF COL=1 THEN TAB(LEVEL-1); &WRITE(ANAL,ITOE(SOURCE):2); &IF LENGTH>0 THEN WRITE(ANAL,'=') ELSE WRITE(ANAL,'-'); &WRITE(ANAL, ITOE(DEST):2); &COL:=COL+5; &IF CROWNED THEN BEGIN )COL:=COL+1; & WRITE(ANAL,'*'); & END; &TAEND # ELSE BOARD[DEST]:=PCE; #BOARD[SOURCE]:=EMPTY; #IF LENGTH>0 THEN BEGIN &GAIN:=GAIN+LENGTH; &FOR J:=1 TO LENGTH DO BEGIN (SQ:=JUMPEDSQ[J]; (PCE:=BOARD[SQ]; (JUMPEDPC[J]:=PCE; (REMOVE(PCE); (BOARD[SQ]:=EMPTY; (END; # END; #IF ANALYSIS AND:=MV;  END;    BEGIN  LEVEL:=LEVEL+1;  MAXVAL:=-INFINITY;  FIRST:=MSP;  BEST:=FIRST;  GETMVS;  NUM:=MSP-FIRST;  IF NOT FOUNDJUMP THEN PLY:=PLY+1;  IF (LEVEL=1) AND (NUM<=1) THEN BEGIN #MAXVAL:=0; #MOVSTK[FIRST].EVAL:=0; #END !ELSE IF NUM>0 THEN BEGIN $P:=FIRST; $DEEPER:=CONTINUING; $WHILE (P0 ,THEN BEGIN 1MOVSTK[0]:=GAME[MOVENUMBER]; 1UNMOVE(0); 1MOVENUMBER:=MOVENUMBER-1; 1REVERSE; 1END; (END; ! !'W': WRITEPARAMETERS; !END ELSE WRITELN('ILLEGAL COMMAND');  E(MOVENUMBER:=0; (NEWFLAG:=FALSE; (PLAYING[RED]:=FALSE; (PLAYING[BLACK]:=FALSE; (TIME:=100; (END; ! !'S': BEGIN (READ(CH); (IF CH IN ['D','L','T'] *THEN CASE CH OF )'D': READ(MINIMUMPLY); )'L': READ(LIFE); )'T': READ(TIME); )END ELSE WRITEL=FALSE; END; )'R': BEGIN PLAYING[RED]:=TRUE; PLAYING[BLACK]:=FALSE; END; )'S': BEGIN PLAYING[RED]:=TRUE; PLAYING[BLACK]:=TRUE; END; )END ELSE WRITELN('ILLEGAL OPTION'); (END;  !'Q': MOVENUMBER:=MOVENUMBER-1; ! !'R': BEGIN (INITIALIZEBOARD; ',STATIC:1); (DYNAM:=FALSE; (REVERSE; (END; ! !'P': BEGIN (READ(CH); (IF CH IN ['B','G','N','R','S'] *THEN CASE CH OF )'B': BEGIN PLAYING[BLACK]:=TRUE;PLAYING[RED]:=FALSE; END; )'G': PRINTGAME; )'N': BEGIN PLAYING[RED]:=FALSE;PLAYING[BLACK]:ENUMBER:=MOVENUMBER-1;  IF CH IN ['A'..'E','P'..'S','U','W'] "THEN CASE CH OF !'A': ANALYSIS:=NOT ANALYSIS; ! !'B': DISPLAY; ! !'C': CLOSE(ANAL); ! !'D': DEBUG:=NOT DEBUG; ! !'E': BEGIN (REVERSE; (DYNAM:=TRUE; (WRITELN('EVALUATION = FOR E:=1 TO 20 DO KILLER[E].SOURCE:=0;  E:=EVALUATE(TIME,INFINITY,INFINITY);  IF NOT NEWFLAG THEN BEGIN "PRINTMOVE(BESTMOVE); "MAKEMOVE(BESTMOVE); "GAME[MOVENUMBER]:=MOVSTK[BESTMOVE]; "END;  REVERSE;  END;    PROCEDURE COMMAND;  BEGIN  MOV>1 $THEN REEVALUATE $ELSE BESTMOVE:=BEST;  MSP:=FIRST;  NEWFLAG:=NUM=0;  EVALUATE:=MAXVAL;  END;    PROCEDURE PLAY;  VAR E:INTEGER;  BEGIN  GAIN:=0;  LEVEL:=0;  PLY:=0;  COUNTPIECES;  ORIGINALEMPTY:=NUMBER[EMPTY]; NALYSIS THEN BEGIN '(* TAB(14-LEVEL); 'WRITE(ANAL,' LOSS',GAIN:2,LEVEL:2,PLY:2); '*) 'WRITELN(ANAL); 'COL:=1; 'END;  END;  KILLER[LEVEL]:=MOVSTK[BEST];  IF MOVSTK[FIRST].LENGTH=0 THEN PLY:=PLY-1;  LEVEL:=LEVEL-1;  IF LEVEL=0 THEN "IF NUMD )ELSE EVAL:=STATIC; (IF MAXVAL FOR THE MAIN MENU. *)   (*WRITTEN FEB 28,1981 BY LANCE FROHMAN*)  (*IDEA FROM FEBDOM CRYPTOGRAM PROGRAM *)  CONST #ASTERISK='********************************************************************************'; #PRINTER_COLUMNS)  (*INSTEAD OF THE CODE TO RETURN TO THE*)  (*MENU. *)  (* FOR QUOTATION PUZZLES JUST TYPE*)  (*IN A SAYING OR QUOTATION AND THE *)  (*COMPUTER WILL CREATE THE PUZZLE.TYPE*)  (* / FOR A NEW PUZZLE AND JUS (*TYPE IN TWO WORDS THAT CONTAIN ONLY *)  (*THE LETTERS IN THE TEN LETTER CODE. *)  (*THE COMPUTER WILL PRINT OUT A LONG *)  (*DIVISION PROBLEM USING THE LAST TWO *)  (*WORDS YOU TYPED IN AS THE DIVIDEND *)  (*AND DIVISOR. JUST TYPE * *)  (* FOR WORD ARITHMETIC PUZZLES, *)  (*TYPE IN A WORD OR PHRASE THAT CONT- *)  (*AINS 10 DIFFERENT LETTERS (DON'T *)  (*TYPE IN THE SPACES). THIS WILL BE *)  (*THE CODE FOR THE DIGITS 0-9. NEXT *) *)  (* FOR CRYPTOQUIZZES FIRST TYPE IN*)  (*THE SUBJECT AND AN EXAMPLE, THEN *)  (*TYPE IN SEVERAL OTHER EXAMPLES WHICH*)  (*WILL BE ENCODED. TYPE / TO *)  (*START A NEW PUZZLE AND JUST TYPE *)  (* FOR THE MAIN MENU.  (*WILL ENCODE AND PRINT IT. TO START A*)  (*NEW CRYPTOGRAM WITH A NEW CODE,PRESS*)  (* / AT THE BEGINNING OF THE *)  (*LINE. TO RETURN TO THE MAIN MENU *)  (*JUST TYPE AT THE BEGINNING *)  (*OF THE LINE. PROGRAM CROSSWORDS;  USES APPLESTUFF;   (*THIS PROGRAM LETS YOU CREATE VARIOUS*)  (*PUZZLES FOUND IN CROSSWORD PUZZLE *)  (*BOOKS. *)  (* FOR CRYPTOGRAMS, TYPE IN A SAY-*)  (*ING OR QUOTATION AND THE COMPUTER *)_STRING*) &ORDINAL:=ORD(CHARACTER)-ADJUST; &STRING_ONE:=COPY('ABCDEFGHIJKLMNOPQRSTUVWXYZ',ORDINAL,1); #END; (*CHAR_TO_STRING*) # #PROCEDURE CRYPTOS; #VAR &CODE:ARRAY['A'..'Z'] OF STRING_SINGLE; &ALPHABET: SET OF 'A'..'Z'; &QUIT,QUOTE_DONE: BOOLEAN; & &PROCEDURE GET_SUBJECT; &VAR )SUBJECT,EXAMPLE: STRING; &BEGIN (*GET_SUBJECT*) )PROMPT('TYPE IN SUBJECT',SUBJECT); )IF SUBJECT='' THEN EXIT(CRYPTOS); )WRITELN(PAPER); )UNDERLINE(CONCAT('SUBJECT: ',SUBJECT),9+LENGTH(SUBSAGE:STRING;BAD_CHAR:CHAR;END_MESSAGE:STRING); ,BEGIN (*ERROR*) /WRITELN(SKIP_A_LINE,BEGIN_MESSAGE,BAD_CHAR,END_MESSAGE); /GOOD_TERM:=FALSE; /EXIT(DECODE); ,END; (*ERROR*) , )BEGIN (*DECODE*) ,NUMBER:=0; ,GOOD_TERM:=TRUE; ,IF CODED_NUMBER='' /TH'S'); /LETTERS_IN_CODE:=LETTERS_IN_CODE+[DIGIT_CODE[LOOP]]; ,END; (*FOR*) )END; (*CHECK_CODE*) & )PROCEDURE DECODE(CODED_NUMBER:STRING;VAR NUMBER:BIG_NUMBER); )VAR ,LOOP,DIGIT: INTEGER; ) CODED_DIGIT: STRING_SINGLE; ) ,PROCEDURE ERROR(BEGIN_MES,FOR LOOP:=1 TO 10 DO ,BEGIN (*FOR*) /IF ((DIGIT_CODE[LOOP]<'A') OR (DIGIT_CODE[LOOP]>'Z')) 2THEN ERROR('ERROR IN CODE, "',DIGIT_CODE[LOOP],'" IS ILLEGAL'); /IF (DIGIT_CODE[LOOP] IN LETTERS_IN_CODE) 2THEN ERROR('ERROR IN CODE, 2 ',DIGIT_CODE[LOOP],'' /WRITELN(SKIP_A_LINE,BEGIN_MESSAGE,BAD_CHAR,END_MESSAGE); /CODE_ERROR:=TRUE; /EXIT(CHECK_CODE); ,END; (*ERROR*) ) )BEGIN (*CHECK_CODE*) ,CODE_ERROR:=FALSE; ,IF LENGTH(DIGIT_CODE)<>10 /THEN ERROR('ERROR, CODE MUST CONTAIN 10 LETTERS',' ',' '); &PROCEDURE GET_CODE; &VAR )LOOP: INTEGER; )LETTERS_IN_CODE: SET OF CHAR; )CODE_ERROR,GOOD_TERM: BOOLEAN; ) )PROCEDURE CHECK_CODE; )VAR ,LOOP: INTEGER; ) ,PROCEDURE ERROR(BEGIN_MESSAGE: STRING;BAD_CHAR:CHAR;END_MESSAGE:STRING); ,BEGIN (*ERROR*)&BEGIN (*POWERS_OF_TEN*) )POWER_OF_TEN[0]:=1; )POWER_OF_TEN[1]:=10; )POWER_OF_TEN[2]:=100; )POWER_OF_TEN[3]:=1000; )POWER_OF_TEN[4]:=10000; )POWER_OF_TEN[5]:=100000; )POWER_OF_TEN[6]:=1000000; )POWER_OF_TEN[7]:=10000000; &END; (*POWERS_OF_TEN*) )#PROCEDURE WORD_ARITHMETIC; #TYPE &BIG_NUMBER=INTEGER[8]; #VAR &DIVIDEND,DIVISOR: BIG_NUMBER; &POWER_OF_TEN: ARRAY[0..7] OF BIG_NUMBER; &DIGIT_CODE,DIVID_STRING,DIVIS_STRING: STRING; &LOOP: INTEGER; &QUIT: BOOLEAN; & &PROCEDURE POWERS_OF_TEN; FALSE; &REPEAT )PAGE(OUTPUT); )QUOTE_DONE:=FALSE; )IF CHOICE=2 ,THEN GET_SUBJECT; )MAKE_CODE; )REPEAT ,ENCODE )UNTIL ,(QUIT OR QUOTE_DONE); )WRITELN(PAPER,SKIP_A_LINE,ASTERISK); &UNTIL )(QUIT); #END; (*CRYPTOS*) (CODED_MESSAGE,CODE[MESSAGE[LOOP]]) AELSE CODED_MESSAGE:= DCONCAT(CODED_MESSAGE,COPY(MESSAGE,LOOP,1)); ;END; (*FOR*) 8WRITELN(PAPER,SKIP_A_LINE,CODED_MESSAGE); 5END; (*IF ELSE*) &END; (*ENCODE*) # #BEGIN (*CRYPTOS*) &ALPHABET:=['A'..'Z']; &QUIT:=RN> IF DONE', ,MESSAGE); )IF (MESSAGE='') ,THEN /QUIT:=TRUE ,ELSE /IF MESSAGE='/' 2THEN 5QUOTE_DONE:=TRUE 2ELSE 5BEGIN (*IF ELSE*) 8FOR LOOP:=1 TO LENGTH(MESSAGE) DO ;BEGIN (*FOR*) >IF MESSAGE[LOOP] IN ALPHABET ATHEN CODED_MESSAGE:= DCONCAT, LETTERS_LEFT:=LETTERS_LEFT-[CODE_LETTER]; ,END; (*FOR*) &END; (*MAKE_CODE*) & &PROCEDURE ENCODE; &VAR )LOOP: 1..256; )MESSAGE,CODED_MESSAGE: STRING; &BEGIN (*ENCODE*) )CODED_MESSAGE:=''; )PROMPT('ENTER LINE TO BE CODED, / FOR NEW CODE, LOOP)); /CHAR_TO_STRING(CODE_LETTER,CODE[LOOP]); ETTER: CHAR); )CONST ,CONVERT_TO_1_TO_26=7.9348E-4; (*26/32767*) )VAR ,RAND_1_TO_26: 1..26; )BEGIN (*RANDOM_LETTER_A_TO_Z*) ,RAND_1_TO_26:=TRUNC(RANDOM*CONVERT_TO_1_TO_26)+1; ,LETTER:=CHR(RAND_1_TO_26+ADJUST); )END; (*RANDOM_LETTER_A_TO_Z*) & &BEJECT)); )PROMPT('TYPE IN EXAMPLE',EXAMPLE); )WRITELN(PAPER,SKIP_A_LINE,'EXAMPLE: ',EXAMPLE); &END; (*GET_SUBJECT*) & &PROCEDURE MAKE_CODE; # VAR )CODE_LETTER,LOOP:'A'..'Z'; )LETTERS_LEFT: SET OF 'A'..'Z'; ) )PROCEDURE RANDOM_LETTER_A_TO_Z(VAR LEN ERROR('ERROR, TERM CANNOT BE BLANK',' ',' '); ,FOR LOOP:=1 TO LENGTH(CODED_NUMBER) DO ,BEGIN (*FOR*) /IF NOT(CODED_NUMBER[LOOP] IN LETTERS_IN_CODE) 2THEN ERROR('ERROR, "',CODED_NUMBER[LOOP],'" IS UNDEFINED'); /CHAR_TO_STRING(CODED_NUMBER[LOOP],CODED_DIGIT); /DIGIT:=POS(CODED_DIGIT,DIGIT_CODE)-1; /NUMBER:=NUMBER*10+DIGIT; ,END; (*FOR*) )END; (*DECODE*) & &BEGIN (*GET_CODE*) )PAGE(OUTPUT); )REPEAT ,DIGIT_CODE:=''; ,LETTERS_IN_CODE:=[]; ,PROMPT('TYPE IOUBLE_LENGTH); )FOR LOOP1:=1 TO 4 DO )BEGIN (*FOR*) ,LINE:=VERTICAL_LINE; ,FOR LOOP2:=1 TO LINE_LENGTH DO ,BEGIN (*FOR*) /PARAGRAPH[LOOP1,LOOP2]:=MESSAGE[(LOOP1-1)*LINE_LENGTH+LOOP2]; /IF PARAGRAPH[LOOP1,LOOP2]=' ' 2THEN LINE:=CONCAT(LINE,'*',VERTI )LINE_LENGTH:=LENGTH(MESSAGE) DIV 4; )DOUBLE_LENGTH:=2*LINE_LENGTH+1; &END; (*GET_QUOTATION*) & &PROCEDURE SET_AND_PRINT_LINEUP; &VAR )LOOP1,LOOP2: INTEGER; )LINE: STRING; &BEGIN (*SET_AND_PRINT_LINEUP*) )UNDERLINE(COPY(BLANKS,1,DOUBLE_LENGTH),D2IF (MESSAGE='') OR (LINE='') THEN QUIT:=TRUE; 2QUOTE_DONE:=TRUE; /END (*IF THEN*) /ELSE 2MESSAGE:=CONCAT(MESSAGE,LINE); )UNTIL ,QUOTE_DONE; )NUMBER_OF_BLANKS:=(256-LENGTH(MESSAGE)) MOD 4; )MESSAGE:=CONCAT(MESSAGE,COPY(BLANKS,1,NUMBER_OF_BLANKS));: BOOLEAN; &BEGIN (*GET_QUOTATION*) )QUOTE_DONE:=FALSE; )MESSAGE:=''; )PAGE(OUTPUT); )REPEAT ,PROMPT('ENTER LINE TO BE CODED, / FOR NEW PUZZLE, IF DONE', /LINE); ,IF (LINE='/') OR (LINE='') /THEN /BEGIN (*IF THEN*) _PUZZLE; #CONST &VERTICAL_LINE='|'; #VAR &MESSAGE: STRING[255]; &DOUBLE_LENGTH,LINE_LENGTH: INTEGER; &PARAGRAPH: ARRAY[1..4,1..65] OF CHAR; &QUIT: BOOLEAN; & &PROCEDURE GET_QUOTATION; &VAR )LINE: STRING; )NUMBER_OF_BLANKS: INTEGER; )QUOTE_DONEF_STRING:40); )WRITELN(PAPER,SKIP_A_LINE,ASTERISK); &END; (*DIVISION*) # #BEGIN (*WORD_ARITHMETIC*) &QUIT:=FALSE; &POWERS_OF_TEN; &REPEAT )GET_CODE; )IF NOT(QUIT) ,THEN DIVISION; &UNTIL )QUIT; #END; (*WORD_ARITHMETIC*) # #PROCEDURE QUOTATION2PRODUCT:=SHORT_PRODUCT*POWER_OF_TEN[SPACES]; 2ENCODE(SHORT_PRODUCT,SHORT_PD_STRING); 2UNDERLINE(SHORT_PD_STRING,40-SPACES); 2DIFFERENCE:=DIFFERENCE-PRODUCT; /END (*IF THEN*) )END; (*FOR*) )ENCODE(DIFFERENCE,SHORT_DF_STRING); )WRITELN(PAPER,SHORT_D 2SPACES:=QUOT_LENGTH-LOOP; 2IF LOOP>1 5THEN 5BEGIN (*IF THEN*) 8SHORT_DIFFERENCE:=DIFFERENCE DIV POWER_OF_TEN[SPACES]; 8ENCODE(SHORT_DIFFERENCE,SHORT_DF_STRING); 8WRITELN(PAPER,SHORT_DF_STRING:(40-SPACES)); 5END; (*IF THEN*) ),40); )WRITELN(PAPER,DIVIS_STRING:(39-(LENGTH(DIVID_STRING))) ,,')',DIVID_STRING); )DIFFERENCE:=DIVIDEND; )FOR LOOP:=1 TO QUOT_LENGTH DO )BEGIN (*FOR*) ,SHORT_PRODUCT:=VALUE(QUOT_DIGITS[LOOP])*DIVISOR; ,IF SHORT_PRODUCT>0 /THEN /BEGIN (*IF THEN*)); )UNDERLINE('0 1 2 3 4 5 6 7 8 9',70); )QUOTIENT:=DIVIDEND DIV DIVISOR; )STR(QUOTIENT,QUOT_DIGITS); )ENCODE(QUOTIENT,QUOT_STRING); )QUOT_LENGTH:=LENGTH(QUOT_STRING); )UNDERLINE(CONCAT(COPY(BLANKS,1,LENGTH(DIVID_STRING)-QUOT_LENGTH+1), ,QUOT_STRING)BEGIN (*ENCODE*) ,CODED_NUMBER:=''; ,STR(NUMBER,NUMBER_STRING); ,FOR LOOP:=1 TO LENGTH(NUMBER_STRING) DO /CODED_NUMBER:=CONCAT(CODED_NUMBER, 2COPY(DIGIT_CODE,VALUE(NUMBER_STRING[LOOP])+1,1)); )END; (*ENCODE*) & &BEGIN (*DIVISION*) )WRITELN(PAPERORT_DIFFERENCE: BIG_NUMBER; )QUOT_DIGITS,QUOT_STRING,SHORT_PD_STRING,SHORT_DF_STRING:STRING; )QUOT_LENGTH,SPACES,LOOP: INTEGER; , )PROCEDURE ENCODE(NUMBER:BIG_NUMBER;VAR CODED_NUMBER:STRING); )VAR ,NUMBER_STRING: STRING; ,LOOP: INTEGER; IVIDEND); )UNTIL ,GOOD_TERM; )REPEAT ,PROMPT('TYPE IN CODED DIVISOR',DIVIS_STRING); ,DECODE(DIVIS_STRING,DIVISOR); )UNTIL ,(GOOD_TERM AND (DIVISOR>0)); &END; (*GET_CODE*) & &PROCEDURE DIVISION; &VAR )QUOTIENT,PRODUCT,SHORT_PRODUCT,DIFFERENCE,SHN CODE FOR DIGITS 0-9',DIGIT_CODE); ,IF DIGIT_CODE='' /THEN /BEGIN (*IF THEN*) 2QUIT:=TRUE; 2EXIT(GET_CODE); /END; (*IF THEN*) /CHECK_CODE; )UNTIL ,NOT(CODE_ERROR); )REPEAT ,PROMPT('TYPE IN CODED DIVIDEND',DIVID_STRING); ,DECODE(DIVID_STRING,DCAL_LINE) 2ELSE LINE:=CONCAT(LINE,' ',VERTICAL_LINE); ,END; (*FOR*) ,UNDERLINE(LINE,DOUBLE_LENGTH); )END; (*FOR*) &END; (*SET_AND_PRINT_LINEUP*) & &PROCEDURE REORDER_LETTERS; &VAR )LOOP1,LOOP2,LOOP3: INTEGER; & )PROCEDURE SWITCH(VAR CHARACT1,CHARACT2: CHAR); )VAR ,SWITCH_CHARACTER: CHAR; )BEGIN (*SWITCH*) ,SWITCH_CHARACTER:=CHARACT1; ,CHARACT1:=CHARACT2; ,CHARACT2:=SWITCH_CHARACTER; )END; (*SWITCH*) & &BEGIN (*REORDER_LETTERS*) )FOR LOOP1:=1 TO LINE_LE PROB P P1 P2 MAP MOVE M C A B n ~pmO^SE; #REPEAT  DISPLAY_CHOICES; &SELECT; #UNTIL &FINISHED;  END. (*MAIN*) # 5:BEGIN (*CHOICE=5*) .FINISHED:=TRUE; .PAGE(OUTPUT); .PAGE(PAPER); .CLOSE(PAPER); +END (*CHOICE=5*) &END; (*CHOICE*) #END; (*SELECT*) #  BEGIN (*MAIN*) #RANDOMIZE; #REWRITE(PAPER,'PRINTER:'); #SKIP_A_LINE:=CHR(13); (**) #FINISHED:=FAL.UNDERLINE('WORD ARITHMETIC',48); .WRITELN(PAPER,SKIP_A_LINE,ASTERISK); .WORD_ARITHMETIC; .END; (*CHOICE=3*) )4:BEGIN (*CHOICE=4*) .UNDERLINE('QUOTATION PUZZLE',48); .WRITELN(PAPER,SKIP_A_LINE,ASTERISK); .QUOTATION_PUZZLE; .END; (*CHOICE=4*) & .UNDERLINE('CRYPTOGRAMS',46); .WRITELN(PAPER,SKIP_A_LINE,ASTERISK); .CRYPTOS; .END; (*CHOICE=1*) )2:BEGIN (*CHOICE=2*) .UNDERLINE('CRYPTOQUIZZES',47); .WRITELN(PAPER,SKIP_A_LINE,ASTERISK); .CRYPTOS; .END; (*CHOICE=2*) )3:BEGIN (*CHOICE=3*) E); #END; (*DISPLAY_CHOICES*) # #PROCEDURE SELECT; #BEGIN (*SELECT*) &REPEAT )GET(KEYBOARD); &UNTIL )(KEYBOARD^>'0') AND (KEYBOARD^<'6'); &CHOICE:=VALUE(KEYBOARD^); &WRITELN(PAPER,SKIP_A_LINE,SKIP_A_LINE); &CASE CHOICE OF )1:BEGIN (*CHOICE=1*) ; &WRITELN(SKIP_A_LINE,'WORD ARITHMETIC........................3'); &WRITELN(SKIP_A_LINE,'QUOTATION PUZZLE.......................4'); &WRITELN(SKIP_A_LINE,'EXIT PROGRAM...........................5'); &GOTOXY(0,20); &WRITELN('TYPE IN CHOICE',SKIP_A_LIN#END; (*QUOTATION_PUZZLE*)  PROCEDURE DISPLAY_CHOICES; #BEGIN (*DISPLAY_CHOICES*) &PAGE(OUTPUT); &WRITELN('MENU':22); &WRITELN(SKIP_A_LINE,'CRYPTOGRAMS............................1'); &WRITELN(SKIP_A_LINE,'CRYPTOQUIZZES..........................2')(*QUOTATION_PUZZLE*) &QUIT:=FALSE; &REPEAT )GET_QUOTATION; )IF MESSAGE<>'' ,THEN ,BEGIN (*IF THEN*) /SET_AND_PRINT_LINEUP; /REORDER_LETTERS; /PRINT_LETTERS; /WRITELN(PAPER,SKIP_A_LINE,ASTERISK); ,END; (*IF THEN*) &UNTIL )QUIT; EGER; &BEGIN (*PRINT_LETTERS*) )FOR LOOP1:=1 TO 4 DO )BEGIN (*FOR*) ,WRITE(PAPER,VERTICAL_LINE); ,FOR LOOP2:=1 TO LINE_LENGTH DO /WRITE(PAPER,PARAGRAPH[LOOP1,LOOP2],VERTICAL_LINE); ,WRITELN(PAPER); )END; (*FOR*) &END; (*PRINT_LETTERS*) 5 #BEGIN NGTH DO ,FOR LOOP2:=1 TO 3 DO /FOR LOOP3:=(LOOP2+1) TO 4 DO 2IF PARAGRAPH[LOOP2,LOOP1] 200 DO RNUM:=RNUM-200;  CLEARSCREEN; "WRITELN(' HOW GOOD A PLAYER ARE $WRITELN('THERE ARE 3 ROBOTS TO START FOR A BEGINNER.'); $WRITELN('THE NUMBER WILL INCREASE AS YOU WIN GAMES !'); $WRITELN; $WRITELN(' GOOD LUCK!!!!!') "END;  END; {END OF INSTRUCTIONS}    PROCEDNE BY RUNNING THEM INTO FENCE POSTS,"*",'); $WRITELN('OR BY RUNNING THEM INTO EACH OTHER.'); $WRITELN('THE DIAGRAM BELOW THE MAZE SHOWS HOW YOU CAN MOVE'); $WRITELN('THE ROBOTS WILL TRY TO FOLLOW YOU.'); WRITELN;WRITELN; $WRITELN(' HERE ARE SOME INSTRUCTIONS'); " WRITELN('YOU,"O",ARE IN A HIGH VOLTAGE MAZE.'); " WRITELN('THE ROBOT COMPUTERS,"R",ARE TRYING TO DESTROY YOU.'); $WRITELN('TO WIN, YOU MUST DESTROY THE COMPUTERS.'); $WRITELN('THIS IS DOONS; {DISPLAY INSTRUCTIONS}  VAR M:CHAR;  BEGIN "CLEARSCREEN; "WRITELN('WELCOME TO THE WONDERFUL EXCITING GAME OF CHASE':60); "GOTOXY(0,3); "WRITE('WOULD YOU LIKE INSTRUCTIONS ? (Y OR N) '); "READ(M); "IF M='Y' THEN "BEGIN $ GOTOXY(COL,ROW); {POSITION CURSOR}  WRITE(SYMBOL)  END; {END OF DOMOVE PROCEDURE}    PROCEDURE CLEARSCREEN; {FOR AN APPLE CHANGE IT FOR OTHER TERMINAL}  BEGIN "WRITE(CHR(CLRSCRN))  END;    PROCEDURE INSTRUCTI :INTEGER;  BEGIN "REPEAT $RNUM:=RNUM*21.182813+31.415917; $RNUM:=RNUM-TRUNC(RNUM); $I:=TRUNC(RNUM*HI); "UNTIL I>LO; "RND:=I;  END; $    PROCEDURE DOMOVE(COL,ROW:INTEGER;SYMBOL:CHAR); {DISPLAY SYMBOL AT I,J ON FIELD}  BEGIN D CHARACTERS}  MOVES : INTEGER; {COUNT OF MOVES} (CRASH : INTEGER; {NO OF ROBOTS "CRASHED"}   FUNCTION RND(LO,HI:INTEGER):INTEGER; {RANDOM NUMBER GENERATOR}  VAR Q :REAL;  I ICULTY} (GAMENU : INTEGER; {GAME NUMBER} (M : CHAR; (NROB : INTEGER; {NUMBER OF ROBOTS} (WINS : INTEGER; {NUMBER OF GAMES WON}  GOODCHAR : SET OF CHAR; {GOO(R : INTEGER; {NUMBER OF ROBOTS LEFT} (RI,RJ : ARRAY[1..ROBMAX] OF INTEGER; {ROBOT COORDINATES} (RNUM : REAL; (DIFF : INTEGER; {DIFFICULTY} (IDIFF : 0..10; {INITIAL DIFF {CLEAR SCREEN CODE}    VAR FIELD : PACKED ARRAY[0..XMAX,0..YMAX] OF CHAR; (AGAIN,PLAY : BOOLEAN; (WIN : BOOLEAN; (MI,MJ : INTEGER; {COORDINATES OF THE MAN} AX HORIZONTAL FIELD DIMENSION} (YMAX = 14; {MAX VERTICAL FIELD DIMENSION} ( (TOP = 2; {SPACE ABOVE FIELD} (SIDE = 5; {SPACE TO LEFT OF FIELD} ( (CLRSCRN = 12; {SYMBOL FOR A ROBOT} (BLANK = ' '; {AN ASCII BLANK} ' (DROB = 3; {STARTING NO OF ROBOTS} (ROBMAX = 20; {MAX NO OF ROBOTS ALLOWED} (XMAX = 39; {MELN;  WHILE NOT (SK IN ['B','I','E','P']) DO "BEGIN $GOTOXY(10,10); $WRITE(' WHAT WAS THAT AGAIN PLEASE ? ',CHR(7)); $READ (SK); $WRITELN "END;  CASE SK OF $'B': IDIFF:=0; $'I': IDIFF:=1; $'E': IDIFF:=3; $'P': IDIFF:=5; "END;  END;    PROCEDURE INITIALIZE; {SET UP BLANK FIELD SURROUNDED BY FENCE}  VAR I,J:INTEGER;  BEGIN "FOR I:=0 TO XMAX DO "BEGIN $FOR J:=0 TO YMAX DO $IF((I=0) OR (I=XMAX) OR (J=0) OR (J=YMAX)) THEN FIELD[I,J]:=EDGE &ELSE FIELD[I,J]:=BLANK #END;  ENDGE NO OF ROBOTS} *WRITE(R:8); *RI[L]:=0; *IF R=0 THEN *BEGIN ,GOTOXY(XMAX+16,CRASH+3); ,WRITELN('GOOD WORK!'); ,GOTOXY(XMAX+8,CRASH+4); ,WRITELN('YOU HAVE DESTROYED THEM ALL!!'); ,WIN:=TRUE; ,PLAY:=FALSE *END; (END; &END; &IF FIELD[RI[L],RJ[LFIELD[RI[L],RJ[L]]:=ROBOT; & DOMOVE(I,J,ROBOT) &END &ELSE &BEGIN (IF ((FIELD[I,J]=OBST) OR (FIELD[I,J]=ROBOT)) THEN (BEGIN *GOTOXY(XMAX+12,CRASH+3); *CRASH:=CRASH+1; *WRITELN('CRASH!! YOU GOT ONE!!'); *R:=R-1; *GOTOXY(53,1); {CHAN&FIELD[RI[L],RJ[L]]:=BLANK; &DOMOVE(RI[L],RJ[L],BLANK); &IF MI>RI[L] THEN RI[L]:=RI[L]+1; &IF MIRJ[L] THEN RJ[L]:=RJ[L]+1; &IF MJ0) AND (WIN)) THEN $BEGIN = EDGE THEN $BEGIN &WIN:=FALSE; &PLAY:=FALSE; &WRITELN('OUCH, YOU GOT ELECTROCUTED!') $END ELSE $BEGIN &IF FIELD[MI,MJ] = ROBOT THEN &WRITELN('THWACK! YOU RAN INTO A ROBOT (TURKEY!)') ELSE &WRITELN('ZZAP! YOU RAN INTO AN ELECTIFIED POST'); &WIN:1; "5: ; "6: MI:=MI+1; "7: BEGIN MI:=MI-1; MJ:=MJ+1 END; "8: MJ:=MJ+1; "9: BEGIN MI:=MI+1; MJ:=MJ+1 END %END; "MOVES:=MOVES+1; "IF FIELD[MI,MJ] = BLANK THEN " BEGIN &DOMOVE(MI,MJ,MAN); &FIELD[MI,MJ]:=MAN " END ELSE "BEGIN $IF FIELD[MI,MJ] $ GOTOXY(10,22); $END; "IF C='Q' THEN $BEGIN %PLAY:=FALSE; %WIN:=FALSE $END; "M:=ORD(C)-48; "FIELD[MI,MJ]:=BLANK; "DOMOVE(MI,MJ,BLANK); &CASE M OF "1: BEGIN MI:=MI-1; MJ:=MJ-1 END; "2: MJ:=MJ-1; "3: BEGIN MI:=MI+1; MJ:=MJ-1 END; "4: MI:=MI-$WRITE(' ',CHR(8)); $READ (C); $IF NOT (C IN GOODCHAR) THEN $BEGIN &GOTOXY(4,21); &BAD:=TRUE; &WRITE('BAD MOVE, PLEASE TRY AGAIN ':33,CHR(7)) $END; "UNTIL (C IN GOODCHAR); "IF BAD THEN $BEGIN $ GOTOXY(4,21); &WRITE(' ':40); MOVE => ');  END; {END OF MAP}   PROCEDURE MOVE; {ENTER YOUR MOVE FROM KEYBOARD}  VAR M : INTEGER;  C : CHAR;  BAD : BOOLEAN;  BEGIN "BAD:=FALSE; "REPEAT GAMENU:3,DIFF:5,R:8,WINS:10,MOVES:8); "GOTOXY(0,0); "FOR J:=0 TO YMAX DO "BEGIN $FOR I:=0 TO XMAX DO WRITE(FIELD[I,J]); " WRITELN "END; "WRITELN; "WRITELN('1 2 3 Q = QUIT'); "WRITELN('4 X 6 5 = NO MOVE'); "WRITE('7 8 9  END; {END OF INNERFIELD}    PROCEDURE MAP; {DISPLAY PLAYING FIELD}  VAR I,J:INTEGER;  BEGIN "CLEARSCREEN; "WRITELN('GAME DIFF ROBOTS WINS MOVE':79); "WRITE(' ':44,:=1 TO POSTS DO "BEGIN $REPEAT &IF DIFF>3 THEN &BEGIN (I:=RND(0,XMAX); (J:=RND(0,YMAX) $ END ELSE &BEGIN (I:=RND(1,XMAX-1); (J:=RND(1,YMAX-1) &END; $UNTIL FIELD[I,J]=BLANK; $FIELD[I,J]:=OBST $END; {NOW DO R ROBOTS}  BEGIN $REPEAT &I:=RND(0,XMAX);J:=RND(0,YMAX); $UNTIL FIELD[I,J]=BLANK; $FIELD[I,J]:=ROBOT; " RI[L]:=I; $RJ[L]:=J "END;  POSTS:=RND(25,35); {NOW SET UP 25 TO 35 POSTS} "FOR L; {END OF INITIALIZE}    PROCEDURE INNERFIELD; {SET UP MAN, ROBOTS AND OBSTRUCTIONS}  VAR I,J,L,POSTS:INTEGER;  BEGIN "MI:=RND(0,XMAX); MJ:=RND(0,YMAX); {LOCATE MAN AT ANY RANDOM POSITION} "FIELD[MI,MJ]:=MAN; "R:=NROB; "FOR L:=1 TO R DO ]]=FIELD[MI,MJ] THEN &BEGIN (WRITELN('ZAP! A COMPUTER GOT YOU!'); (WIN:=FALSE; (PLAY:=FALSE &END; " END;  END;  END; {END OF ROBOTMOVE PROCEDURE}     BEGIN {START OF MAIN PROGRAM} "GOODCHAR:=['1'..'9','Q']; "GAMENU:=1; "WINS:=0; "AGAIN:=TRUE; "PLAY:=TRUE; {INITIALIZE QUIT} "INSTRUCTIONS; {DISPLAY INSTRUCTIONS} "STARTGAME; {INPUT STARTING POSITION AND SKILL LEVEL} "DIFF:=IDIFF; {INITIAL DIFFICULTY LEVEL} "NROB:(IF WINS>15 THEN DIFF:=IDIFF+6; (IF WINS>20 THEN DIFF:=IDIFF+8; (IF WINS>30 THEN DIFF:=IDIFF+12; (NROB:=DROB+2*DIFF &END; $END; "END;  END.  HEN AGAIN:=FALSE ELSE $BEGIN &PLAY:=TRUE; &GAMENU:=GAMENU+1; &IF WIN THEN &BEGIN (WINS:=WINS+1; (IF WINS>2 THEN DIFF:=IDIFF+1; (IF WINS>5 THEN DIFF:=IDIFF+2; $ IF WINS>8 THEN DIFF:=IDIFF+3; (IF WINS>11 THEN DIFF:=IDIFF+4; RITELN(MOVES:8); (DOMOVE(30,18,BLANK) {INPUT NEXT MOVE} &END; &MOVE; {LETS YOU MOVE} &IF(PLAY) THEN ROBOTMOVE {MOVES THE ROBOTS} $END; $GOTOXY(0,21); $WRITE('WOULD YOU LIKE TO PLAY AGAIN (Y OR N) '); " READ(M); $IF M='N' T=DROB+DIFF*2; {INITIAL NUMBER OF ROBOTS} "WHILE AGAIN DO "BEGIN $MOVES:=1;WIN:=TRUE;CRASH:=0; $INITIALIZE; {CLEARS FIELD[X,Y]} $INNERFIELD; {SETS UP PLAYING FIELD} $WHILE PLAY DO $BEGIN &IF MOVES=1 THEN MAP ELSE &BEGIN (GOTOXY(70,1); (W