`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^WW FORMAT.TEXTvg FORMAT.DOC.TEXT" FORMAT.CODEvgT FORMAT1.TEXTvg۞  FLOWER.TEXTvgU  STARS.TEXT=vge SQUARES.TEXTvgePSCAL02 PILOT.TEXT=vgW PILOT.CODE=vgW*PILOT.DOC.TEXTgW*5 PRETTY.CODEvgT5Y PRETTY.TEXTvg*YcPRETTY.DOC.TEXTc FORMAT2.TEXTvg BLACKJACK.TEXTgBLACKJACK.CODEg&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&PROGRAM PILOT;    CONST "apostrophe='''';  el=10;{ label for end of procedure or program }  VAR "badsyntax:BOOLEAN; "zzz, { snooze string to interrupt translation } "ws, { the work string } "name:STRING; "I,O:Text; "VBEGIN readln(i,ws);writeln(ws); (writeln(o,'PROCEDURE ',copy(ws,3,length(ws)-2),';'); (writeln(o,'LABEL 0,1,2,3,4,5,6,7,8,9,10;'); (writeln(o,'BEGIN'); & While (i^<>'*') and (not(eof(i))) DO *line; (writeln(o,el,':END;'); (readln(i) &END; $writele expected'); &4: IF (ws[3] IN variables)and(ws[4]='s') THEN +writeln(o,'readln(',copy(ws,3,2),');') )ELSE error('String variable expected') )END &END;skip !END; ! !BEGIN{translate} # writeln('Translating...'); $heading;skip; $WHILE i^='*' DO &#'X':writeln(o,'flag:=',copy(ws,3,length(ws)-2),';'); #'A':IF length(ws)>4 THEN error('Ask statment too long') 'ELSE CASE length(ws) OF &2: writeln(o,'readln(ans);'); &3: IF ws[3] IN variables THEN writeln(o,'readln(',ws[3],');') )ELSE error('Variabl' END; #'J':BEGIN 'IF not (ws[3] IN digits) THEN error('Digit expected'); 'writeln(o,'GOTO ',ws[3],';') 'END; #'E':writeln(o,'GOTO ',el,';'); #'C':writeln(o,copy(ws,3,length(ws)-2),';'); #'U':writeln(o,copy(ws,3,length(ws)-2)); or('Illegal command') #ELSE CASE ws[1] OF # $ #'R':writeln(o,'{',copy(ws,3,length(ws)-2),'}'); #'T':T(ws); #'M': BEGIN IF ws[3]='@'THEN *writeln(o,'match(',copy(ws,4,length(ws)-4),');') *ELSE writeln(o,'match(''',copy(ws,3,length(ws)-2),''');'); gth(ws)-1) $END; $ !IF length(ws)>2 THEN IF ws[3]=' ' THEN delete(ws,3,1); !IF length(ws)<2 THEN $ERROR('Line too short') !ELSE #IF ws[2]<>':' THEN &ERROR('COLON EXPECTED') !ELSE #IF not (ws[1] IN ['T','R','A','M','J','E','C','U','X']) THEN &err#IF i^ IN digits THEN #BEGIN read (i,c); write(o,c,':'); #skip; IF i^IN digits THEN error('Label must be single digit') #END; #readln(i,ws); !If ws[1] IN['Y','N'] THEN ! BEGIN &IF ws[1]='Y' THEN (write(o,'IF not flag THEN '); (ws:=copy(ws,2,len''',',ws,i) $ELSE insert(',''',ws,i); $i:=i+1; b:=not(b) $END; !I:=I+1 !END; ! #writeln(o,'(''',copy(ws,3,length(ws)-2),''');'); #IF not b THEN error('Unmatched @') !END; ! !PROCEDURE line; !VAR #j: INTEGER; !BEGIN #skip; ws:=copy(ws,1,length(ws)-1) "ELSE write(o,'ln'); "i:=1; b:=true; "WHILE i<=length(ws) DO $BEGIN $IF(ws[i]=apostrophe) and b THEN &BEGIN (insert(apostrophe,ws,i); i:=i+1 &END "  ELSE "IF ws[i]='@' THEN $BEGIN delete (ws,i,1); $IF b THEN INSERT(='a' TO 'z' DO %BEGIN 'write(o,c,':=0;',c,'s:='''';'); 'IF ord(c)mod 4=0 THEN writeln(o); %END; #writeln(o,'END;');  END;   PROCEDURE T(ws:STRING);   VAR #i:INTEGER; #b:BOOLEAN; #  BEGIN  "write(o,'write'); "IF ws[length(ws)]=';'THEN $#writeln(o,'PROCEDURE match(S:STRING);VAR x,y:STRING;'); #writeln(o,'BEGIN x:=concat('','',ans,'',''); y:=concat('','',s,'','');'); #writeln(o,'flag:=pos(x,y)>0'); #writeln(o,'END;'); #writeln(o,'PROCEDURE initialize;'); #writeln(o,'BEGIN'); #FOR c:,'VAR a,b,c,d,e,f,g,h,i,j,k,'); #writeln(o,'l,m,n,o,p,q,r,s,t,u,v,w,x,y,z:INTEGER;'); #writeln(o,'as,bs,cs,ds,es,fs,gs,hs,is,js,ks,ls,'); #writeln(o,'ms,ns,os,ps,qs,rs,ss,ts,us,vs,ws,xs,ys,zs:STRING;'); #writeln(o,'ans:STRING;flag:BOOLEAN;'); BEGIN "WHILE i^=' ' DO get(i)  END;   PROCEDURE translate;   PROCEDURE heading;  BEGIN  #writeln(o,'PROGRAM',name,';'); #writeln(o,'(*$G+*)'); #writeln(o,'LABEL 0,1,2,3,4,5,6,7,8,9,10;'); #writeln(o,'TYPE charset=SET OF CHAR;'); #writeln(oariables,digits,letters:SET OF CHAR; "c:CHAR; "j:INTEGER; "  PROCEDURE error(message:STRING);  BEGIN #writeln(ws); #writeln('ERROR: ',message); #writeln('Type anything to continue'); #readln(zzz); #badsyntax:=true  END;    PROCEDURE skip; n('*:',name); $writeln(o,'BEGIN initialize; '); $WHILE not eof(i) DO &line; $writeln(o,el,':END.')  END;    BEGIN {PILOT} "variables:=['a'..'z'];digits:=['0'..'9']; letters:=['A'..'Z']; "badsyntax:=false; "write('Translate what file?'); "readln(name); "reset(i,concat(name,'.TEXT')); "rewrite(o,concat('/',name,'.TEXT')); "translate; "IF badsyntax THEN $close(o,purge) "ELSE %close(o,lock)  END.  & statment too long-צ readln(ans);-5צreadln(-);Variable expected}--sÄ;readln(-צ);צString variable expecDigit expectedצGOTO -;GOTO  ;--;--flag:=--;-šצAsk4*$Illegal command-{--}--@á?צmatch(--);?match('--');- :Label must be single digit-P-@9-YáIF not flag THEN ---P-š- á--ɡLine too short-:ˡCOLON EXPECTED-,-P ln+,+ȡf+',צ'P+++=+@á3+,צ',P+ ,'P+++,,++('--צ');,צ Unmatched @N ;צPROCEDURE initialize;BEGINa z ȡP :=0; s:=''; á  צEND;oتPwrite;á-s,ts,us,vs,ws,xs,ys,zs:STRING;צans:STRING;flag:BOOLEAN;צ)PROCEDURE match(S:STRING);VAR x,y:STRING;3BEGIN x:=concat(',',ans,','); y:=concat(',',s,',');צflag:=pos(x,y)>0צEND,1,2,3,4,5,6,7,8,9,10;צTYPE charset=SET OF CHAR;VAR a,b,c,d,e,f,g,h,i,j,k,&l,m,n,o,p,q,r,s,t,u,v,w,x,y,z:INTEGER;$as,bs,cs,ds,es,fs,gs,hs,is,js,ks,ls,1ms,ns,os,ps,qs,rs,sتP-ERROR: Type anything to continueVPLR á  צPROGRAM;צ(*$G+*)LABEL 0"> PILOT ted {8AX0, @ "&,. DHJYTTranslating...*á򥁬-P- PROCEDURE --;צLABEL 0,1,2,3,4,5,6,7,8,9,10;BEGIN*˥  צ:END;צ*:צBEGIN initialize;   צ:END.2yit stands now, has  twenty-six integer variables "A" to  "Z" and twenty-six string variables  "AS" to "ZS". Of course outher  variables may be added as needed by  making trivial modifications to the  preprocessor.   Procedure ERROR handles errormal manner.  Changes from standard PILOT  COMMANDS ARE AS FOLLOWS.  !(1) Tne assignment operator is  Pascal's ":=" rather than BASIC'S  "=".  (2) the tokens "Y" and "N" must  precede, not follow their related  commands.  (3) PILOT/P as  displayed along with an error message,  and processing is interrupted untill  the user signals the program to  continue. If errors are discovered,  the output file is purged; otherwise,  the output file may be compiled and  executed in the noogram to be processed. The  preprocessor then writes its  translation onto a text file whose  name is the input file name preceded  by a slash-for example, /DEMO.TEXT.  &If a syntax error is discovered,  the line containing the error is P simply by adding a  WRITE statment to the transltor.  %Once a PILOT/P program has been  edited and saved, the perprocessor is  invoked by executing the file  PILOT.CODE . the preprocessor then  prompts for the file containing the  PILOT prer-aided  instruction (CAI) programs.  %This PREPROCESSOR accepts PILOT/P  source code and translates it into  Pascal source code. The translated  program may be run like any outher  Pascal program. Any Pascal feature may  be added to PILOT/PILOT/P FROM JULY 1980 BYTE page 154   PILOT/P: Implementing a Highlevel  Language in a Hurry -by- DAVID MUNDIE   %PILOT is a simple but  entertaining language which is useful  for introducing beginners to computing  and for writing computO^WWnRץٳTranslate what file?P P צ.TEXTU  / Q .TEXTV  hNf( *˥  צ:END;צ*:צBEGIN initialize;   צ:END.2ynRץٳTranslate what file?P P צ.TEXTU  / Q .TEXTV rs, as  described above.Procedure SKIP skips  leading blanks,so that PILOT/P  programs may be intended for maximum  legiblilty. Procedure HEADING writes  the heading for the target program,  including declarations for all global  constants,variables,types, procedures  and functions. It is here that  PILOT/P's features may be expanded  indefinitely. As a trivial example the  real variable "f1", the file "f1", and  the array fo strings "a1" may be added  to PILOT/P's vatment or series of  statmentsmay be used.( The  perprocessor automaticlly adds a  trailing semicolon as a statment  separator.)    U: Any Pascal statment or  statment fragment may be used.(The  preprocessor does not add a trailling expression may  be used if it is surrounded by at-  signs !Example: M@concat(vs,'ing')@    X: Any Pascal boolean expression may  be used, wheather arithmetic or not  Example: X:copy(ns,1,1)='T'  X:length(ans)>10    C: Any Pascal sta (@). This facility gives the PILOT/P  programer full control over the  display,and elimites the need for such  commands as 1802 PILOT's K command.  Example: T:@char(12)@ clears the  screen on many video terminals.    M: Any Pascal string YNBOL USE   *: Parameters may be included  Pascal-fashion after the procedure  name.  Example: *:TEST(s:string)   T: Any Pascal writ-parameter list  may be included between the at-signs :=i+1 C:getchoice   U: Not needed. the compute command  fufills the function of the standard U  command.    XXXXXXX TABLE 1 STANDARD PILOT  COMMANDS USED IN PILOT/P SHOWN  ABOVEXXX  =:=:=:=:=:=:=:=:=:=:=:=:=:=:=:=:=:=:=:=:    S(c<11)   X: Examine the following bolean  expression and set the flag  accordingly. Operators are +,-  ,*,/,=,<,<=,>=,<>,AND,OR,and NOT.   C: Compute or call. Perform the  follong assignment,or invoke the  following subroutine !Example: C:i T: type reminder of the terminal.  Variables may be displayed if their  names are surrounded by at signs (@).   M: match ANS to the following string.  A string variable may be used if its  name is included between at-signs "Example X:(c>0)and assigned to that ariable. If not,  input is asigned to the special string  variable ANS.   J: Jump to the following labels must  be single digits   E: Exit from the main program(or the  current subroutine)   R: Remark  second occurrence marks rhe end of the  subroutine.   Y Executes the following command if  the flag is true.   N Execute the following comand if flag  is true   A: Accept input from the terminal. If  followed by a variable name, input is ocedure TRANSLATE,you  could allow the PILOT programmer to  declare local  variables,types,proceedures, and so  on.    SYMBOL USE   *: Identifies and delimits  subroutines, the first occurrence is  followed by subroutine nam,while the   the output file depending on wheather  or not syntax errors were encountered.   %The preprocessor is currently  restricted to the ten digits 0 thru 9  for Pascal/p's labels. They can be  modified for only needed labels. By  mdifying the prT delimiter "@" and inserting  apostrophes as needed. Procedure LINE  is the heart of the program; it  converts one line of PILOT code into  one line of Pascal code. the main  program opens appropriate actions on "write" or  "writeln" statment. The last character  in the work string WS is examined to  determine wheather or not to suppress  the carage return at the end of the  line. The preprocessor then goes  through the work string removing the  PILOriables by simply  adding:   writeln(o,'r1:real;f1:text;a1:array  1..10 of string');   after the other declarations in  HEADING.   T is a sprcial procedure to handle the  messy transformation of a PILOT "type"  (T) command into a Pascal semicolon.) The following example  shows how Pascal's REPEAT statment may  be used in PILOT/P:   *: Getchoice( var c:integer)  R: Accepts a number and checks  its value  #R: #U: REPEAT #T: What is your choice(1 to 10)?; #A: c #X: c in [1..10] "NT: @c@ is out of range #U: UNTIL flag #*:     **** THESE PILOT COMMANDS HAVE  EXTENSIONS IN Pilot/p ******    ɡ*+4B*)Ä}ÍÍÍ*)Ä }áC Nۨ" ȡ̀̀ʀʀȡgʀ٢!"٢٢""٢٢٨s fs Ws7ss'ás á0ڢ ڢsˡs" ٢ ٢"@٢٢"`٢٢"ǀ٢٢ "٢٢"٢٢"٢٢ "٢٢٢"٢ ٢"٢ ٢"٢n ٢8r"٢٢8"٢٢"٢٢٢٢ "!٢٢ "٢٢n"٢٢"٢٢"!٢٢"٢٢""L٢٢"L٢٢"L٢8٢"٢x٢"٢٢ "٢٢ "٢٢ ":=ר(*ר ; : = ( ) { }  .l~"D٢٢"L٢x٢"L٢x٢"D٢٢ case   of   for  while  with  do  if  then  else  end  until ߳n program  function  procedure  label  const  type  var  begin  repeat   record   case  " PRETTYPR !ƀʀ ʀaAƀʀ ʀʀ̀͹̀ ̀ʀʀȡƀʀ  ʀ̀͹̀̀ʀʀÍ#ƀΥʀ ̀ӹʀ̀Թʀӡʀ@j  6- %  #\ d á"  á$8á"0& : ۨڨ ߿ ݿ Í p   ᓡ)  Íߥr  (*$S+*)  PROGRAM PRETTYPRINT;   CONST maxsymbolsize = 200 (* max # of char in symbol scanned by scanner*); 'maxstacksize = 100 (* max # of symbols causing indentation that may =be stacked *); 'maxkeylength = 10 (* max length Pascal reserved word V P1 P2 IV Z u)u)O^ *ECCɡ CCC0ɡCCD!ةCDCFrsץBDCnpr    !ˡ  "      !     FFFs%h 4Z>f,L6lZ\~ F n * FB! % 2 ةCECšECCɡ CCC0ɡCCD!ةCDCFrsץBDCnpr    !ˡ  "     Eۣɂ4 Hڣ˥DDڣʂC DڣʂCڣɂHš.DCڣɂHȡCڣHɡ Hڣɕ٥DإD % 2 ةCECšF0ܫC3 B ٫CDHɡ0F DD٣٣ń ٢٣@ȡF ٚ,ۣȡFۢBdإzBdBB"e@BBzBdٚzBdؚ0šȡF,á DáDáDDá DšD if you simply want to print it out,צ6 type "PRINTER:") -->F  BáhBdáh*٥zP=Welcome to the Pascal prettyprinter. Please type the name ofצ#the textfile you wish as input --> sצ3Now the filename to which you want the output sent.- (NOTE: á  "3b  n (; G > 5Í!B;6 3 \ښۢۢۢáۢۢۢۢ*);  maxlinesize = 72 (* max length of line output by program *); 'slofail1 = 30 (* up to this column position, margin will be indented 8by "indent1". *); 'slofail2 = 48 (* up to this column positn, each time "indentbytab" is 8invoked, the margin will be indented by "indent2." *);  indent1 = 3; 'indent2 = 1; 'space = ' '; ' '  TYPE keysymbol = (progsym, funcsym, procsym, labelsym, 4constsym, typesym, varsym, beginsym, 4repeatsym, recordsym,&lngth := succ (lngth); &valu [lngth] := currchar.valu $END  END (*storenextchar*);    PROCEDURE Skipspaces ( (* updating*) VAR currchar, nextchar : charinfo; 7(*returning*) VAR spacesbefore, crsbefore: integer);  BEGIN "spacesbefore := 0; Storenextchar (* from input *) 0( (*updating *) VAR lngth : integer; @VAR currchar, Dnextchar : charinfo; 2(*placing in*)VAR valu : lstring);  BEGIN (*storenextchar*) "getchar (nextchar, currchar); "IF lngth < maxsymbolsize $THEN BEGIN := quote 0ELSE IF infile^ = space 2THEN name := blank 2ELSE name := otherchar; &IF name IN [filemark, endofline] (THEN valu := space (ELSE valu := infile^; &IF name <> filemark THEN get(infile) $END (*with*)  END; (*getchar*)     PROCEDURE $BEGIN &IF eof (infile) & THEN name := filemark (ELSE IF eoln (infile) *THEN name := endofline *ELSE IF infile^ IN ['A'..'Z', 'a'..'z'] ,THEN name := letter ,ELSE IF infile^ in ['0'..'9'] .THEN name := digit .ELSE IF infile^ = '''' 0THEN name%infilename, outfilename: STRING [20]; % %  (*$IINITVAR.TEXT*)    PROCEDURE Getchar (* from input *) ((* updating *) VAR nextchar: charinfo; D(* returning *)VAR currchar: charinfo);  BEGIN (* getchar *) "currchar := nextchar; "WITH nextchar DO : sglchartable; %stack : symbolstack; %top : integer; %startpos, (* starting position of last symbol written *) %currlinepos, currmargin: integer;  infile, outfile : TEXT; charinfo; %currsym, nextsym : symbolinfo; %crpending : boolean; %ppoption : optiontable; %keyword : keywordtable; %dblchars : dblchrset; %dblchar : dblchartable; %sglchar rinfo = RECORD 5name : charname; 5valu : char 2END; ' 'stackentry = RECORD 7indentsymbol: keysymbol; 7prevmargin : integer 4END; 4 'symbolstack = ARRAY [1..maxstacksize] OF stackentry; ' '  VAR recordseen: boolean; %currchar, nextchar :3valu : lstring; 3lngth : integer; 3spacesbefore : integer; 3crsbefore : integer 0END; 0 'symbolinfo = ^symbol; ' 'charname = (letter, digit, blank, quote, 3endofline, filemark, otherchar); 3 'chames..opencomment; ' 'dblchartable = ARRAY [becomes..opencomment] of specialchar;  'sglchartable = ARRAY [semicolon..period] OF char; ' 'lstring = ARRAY [1..maxsymbolsize] OF char; ' 'symbol = RECORD 3name : keysymbol; tors: keysymset 4END; 4 'optiontable = ARRAY [keysymbol] OF tableentry; ' 'key = PACKED ARRAY [1..maxkeylength] OF CHAR; ' 'keywordtable = ARRAY [progsym..untilsym] OF key; ' 'specialchar = PACKED ARRAY [1..2] OF CHAR; ' 'dblchrset = SET OF becopacebefore, 1spaceafter, gobblesymbols, indentbytab, 1indenttoclp, crafter); ' 'optionset = SET OF option; ' 'keysymset = SET OF keysymbol; ' 'tableentry = RECORD 8optionsselected : optionset; 8dindentsymbols : keysymset; 8gobbletermina4closecomment,semicolon, colon, equals, 4openparen, closeparen, openbracket, closebracket, 4period, endoffile, othersym); ' 'option = (crsuppress, crbefore, blanklinebefore, 1dindentonkeys, dindent, s casesym, casevarsym, 4ofsym, forsym, whilesym, withsym, 4dosym, ifsym, thensym, elsesym, 4endsym, untilsym, becomes, opencomment, "crsbefore := 0; "WHILE nextchar.name IN [blank, endofline] DO $BEGIN &getchar (nextchar, currchar); &CASE currchar.name OF (blank : spacesbefore := succ (spacesbefore); (endofline : BEGIN 6crsbefore := succ (crsbefore); 6spacesbefore := 0 4END &END (*case*) $END (*while*)  END (*Skipspaces*);    PROCEDURE Getcomment (* from input, updating: *) /(VAR currchar, nextchar: charinfo; 0VAR name : keysymbol; 0VAR valu : lstring; 0VAR lngth : integ*ELSE thischar := succ(thischar) $END; "IF hit $THEN chartype := thischar $ELSE chartype := othersym  END (*Chartype*);     PROCEDURE Getspecialchar ( (* from input *) 0(* updating *) VAR currchar, nextchar: charinfo; 0(* returning*) VAR namLSE thischar := succ(thischar); " "(* now is chartype ;, :, (, ), {, }, or . *) "IF NOT hit $THEN BEGIN &thischar := semicolon; &WHILE NOT (hit OR (pred(thischar) = period)) DO (IF currchar.valu = sglchar[thischar] *THEN hit := true [1] := currchar.valu; "nexttwochars[2] := nextchar.valu; "thischar := becomes; "hit := false; " "(* Find out if chartype is ":=" or "(*" *) "WHILE NOT (hit or (thischar = closecomment)) DO $IF nexttwochars = dblchar [thischar] &THEN hit := true &Ength, currchar, nextchar, valu) $END; "name := othersym  END (*getcharliteral*);    FUNCTION Chartype (currchar, nextchar: charinfo): keysymbol;   VAR nexttwochars: specialchar; %hit: boolean; %thischar: keysymbol; %  BEGIN "nexttwochars"WHILE nextchar.name = quote DO $BEGIN &Storenextchar (lngth, currchar, nextchar, valu); &WHILE NOT (nextchar.name IN [quote, endofline, filemark]) DO (Storenextchar (lngth, currchar, nextchar, valu); &IF nextchar.name = quote (THEN Storenextchar (l, valu); "name := othersym  END (*Getnumber*);    PROCEDURE Getcharliteral ( (* from input *) 0(* updating *) VAR currchar, nextchar: charinfo; 0(* returning*) VAR name : keysymbol; ?VAR valu : lstring; ?VAR lngth : integer );  BEGIN DURE Getnumber ( (*from input*) 0(* updating *) VAR currchar, nextchar: charinfo; 0(* returning*) VAR name : keysymbol; ?VAR valu : lstring; ?VAR lngth : integer );  BEGIN "WHILE nextchar.name = digit DO $Storenextchar (lngth, currchar, nextchare (valu, lngth); "IF name IN [recordsym, casesym, endsym] $THEN CASE name OF &recordsym : recordseen := true; &casesym : IF recordseen THEN name := casevarsym; &endsym : recordseen := false $END (*case*)  END (*Getidentifier*);     PROCE8(* updating *) VAR currchar, nextchar: charinfo; 8(* returning*) VAR name : keysymbol; GVAR valu : lstring; GVAR lngth: integer );  BEGIN "WHILE nextchar.name IN [letter, digit] DO $Storenextchar (lngth, currchar, nextchar, valu); "name := idtyp= succ(untilsym))) DO (IF keyvalu = keyword [thiskey] *THEN hit := true *ELSE thiskey := succ (thiskey); &IF hit THEN idtype := thiskey $END  END (*Idtype*);    PROCEDURE Getidentifier ( (*from input*) (* switch to lower case*) *THEN keyvalu [i] := CHR (ORD (valu [i]) + ORD ('a') - ORD ('A')) *ELSE keyvalu [i] := valu [i]; &FOR i := lngth+1 TO maxkeylength DO keyvalu [i] := space; &thiskey := progsym; &hit := false; &WHILE NOT (hit OR (thiskey ) valu:lstring; (*using*) lngth:integer): keysymbol;   VAR i: integer; %keyvalu: key; %hit: boolean; %thiskey: keysymbol; %  BEGIN "idtype := othersym; "IF lngth <= maxkeylength THEN $BEGIN &FOR i := 1 TO lngth DO (IF valu [i] IN ['A'..'Z'] "IF (currchar.valu = '*') AND (nextchar.valu = ')') $THEN BEGIN &storenextchar (lngth, currchar, nextchar, valu); &name := closecomment $END;  IF currchar.valu = '}' THEN name := closebracket  END (*Getcomment*);     FUNCTION Idtype ( (*of*er);  BEGIN "name := opencomment; "WHILE NOT ( ((currchar.valu = '*') AND (nextchar.valu = ')')) -OR (currchar.valu = '}') -OR (nextchar.name = endofline) -OR (nextchar.name = filemark)) DO $storenextchar (lngth, currchar, nextchar, valu); e : keysymbol; ?VAR valu : lstring; ?VAR lngth : integer );  BEGIN "Storenextchar (lngth, currchar, nextchar, valu); "name := Chartype (currchar, nextchar); "IF name IN dblchars $THEN Storenextchar (lngth, currchar, nextchar, valu);  END (* Getspecialchar *);    PROCEDURE Getnextsymbol ( (* from input *) 0(* updating *) VAR currchar, nextchar: charinfo; 0(* returning*) VAR name : keysymbol; ?VAR valu : lstring; ?VAR lngth : integer );  BEGIN "CASE nextchar.name OF " letter : G%prevmargin : integer;  BEGIN "IF NOT stackempty $THEN &BEGIN (REPEAT *popstack (indentsymbol, prevmargin); *IF indentsymbol IN dindentsymbols THEN currmargin := prevmargin (UNTIL NOT (indentsymbol IN dindentsymbols) OR stackempty; (IF NOT (indersym^.spacesbefore := 0 &END $ELSE IF currsym^.crsbefore = 1 &THEN IF currlinepos > 0 THEN Writecrs (once, currlinepos)  END (*Insertblankline*);    PROCEDURE Lshifton (dindentsymbols: keysymset);  VAR indentsymbol: keysymbol; 0 $END  END;    PROCEDURE Insertblankline (VAR currsym: symbolinfo);  CONST once = 1; twice = 2;  BEGIN "IF currsym^.crsbefore = 0 $THEN &BEGIN (IF currlinepos = 0 *THEN Writecrs (once, currlinepos) *ELSE Writecrs (twice, currlinepos); (cur := 1 TO numberofcrs DO WRITELN (outfile); &currlinepos := 0 $END  END;    PROCEDURE Insertcr (VAR currsym: symbolinfo);  CONST once = 1;  BEGIN "IF currsym^.crsbefore = 0 $THEN BEGIN &writecrs (once, currlinepos); &currsym^.spacesbefore :=  BEGIN "top := top+1; "stack[top].indentsymbol := indentsymbol; "stack[top].prevmargin := prevmargin  END;    PROCEDURE Writecrs (numberofcrs: integer; VAR currlinepos: integer);  VAR i: integer;  BEGIN "IF numberofcrs > 0 $THEN BEGIN &FOR Iol := stack[top].indentsymbol; &prevmargin := stack[top].prevmargin; &top := top-1 $END ELSE BEGIN &indentsymbol := othersym; &prevmargin := 0 $END  END (*Popstack*);    PROCEDURE Pushstack (indentsymbol: keysymbol; prevmargin: integer); ll: boolean;  BEGIN "IF top = maxstacksize $THEN stackfull := true $ELSE stackfull := false  END;  PROCEDURE Popstack ( (*returning*) VAR indentsymbol: keysymbol; CVAR prevmargin : integer);  BEGIN "IF NOT stackempty $THEN BEGIN &indentsymbetchar (nextchar, currchar); "new (currsym); "new (nextsym); "Getsymbol (nextsym, currsym)  END (*Initfiles*);  "  FUNCTION Stackempty: boolean;  BEGIN "IF top = 0 $THEN stackempty := true $ELSE stackempty := false  END;   FUNCTION Stackfu"WRITELN('Now the filename to which you want the output sent.'); "WRITELN (' (NOTE: if you simply want to print it out,'); "WRITE (' type "PRINTER:") -->'); "READLN (outfilename); "REWRITE (outfile, outfilename); "Gol *);    PROCEDURE Initfiles;  BEGIN "WRITELN ('Welcome to the Pascal prettyprinter. Please type the name of'); "WRITE ('the textfile you wish as input --> '); "READLN (infilename); "RESET (infile, infilename); s (currchar, nextchar, spacesbefore, crsbefore); &lngth := 0; &IF currsym^.name = opencomment  THEN Getcomment (currchar, nextchar, name, valu, lngth) ELSE Getnextsymbol (currchar, nextchar, name, valu, lngth) END  END (* GetsymbPROCEDURE Getsymbol ( (*from input*) ((* updating *) VAR nextsym: symbolinfo; ((* returning*) VAR currsym: symbolinfo);  VAR dummy: symbolinfo;  BEGIN "dummy := currsym; "currsym := nextsym; "nextsym := dummy; "WITH nextsym^ DO $BEGIN &skipspace1Getspecialchar (currchar, nextchar, name, valu, lngth); 1IF (name = opencomment) OR (name = openbracket) 3THEN Getcomment (currchar, nextchar, name, valu, lngth) /END; $filemark : name := endoffile "END (* case *)  END (* Getnextsymbol *);    etidentifier (currchar, nextchar, name, valu, lngth); $digit : Getnumber (currchar, nextchar, name, valu, lngth); $quote : Getcharliteral(currchar, nextchar, name, valu, lngth); $otherchar: BEGIN ntsymbol IN dindentsymbols) *THEN Pushstack (indentsymbol, prevmargin) &END  END (*Lshifton*);    PROCEDURE Lshift;  VAR indentsymbol: keysymbol; prevmargin: integer;  BEGIN "IF NOT stackempty $THEN BEGIN &Popstack (indentsymbol, prevmargin); &currmargin := prevmargin $END  END;    PROCEDURE Insertspace (VAR symbol: symbolinfo);  BEGIN "IF currlinepos < maxlinesize $THEN BEGIN &WRITE (outfile, space); &currlinepos := succ (currlinepos); &WITH symbol^ DO IF (crsbefore = 0) AND (sp*IF indenttoclp IN optionsselected THEN Rshifttoclp (currsym^.name); *IF gobblesymbols IN optionsselected ,THEN Gobble (gobbleterminators, currsym, nextsym); *IF crafter IN optionsselected THEN crpending := true (END (*with*) $END (*while*); "IF crpefore IN optionsselected THEN Insertspace (currsym); *Ppsymbol (currsym); *IF spaceafter IN optionsselected THEN Insertspace (nextsym); *IF indentbytab IN optionsselected THEN Rshift (currsym^.name); := false ,END; ( IF blankliebefore IN optionsselected THEN ,BEGIN .Insertblankline (currsym); .crpending := false ,END; *IF dindentonkeys IN optionsselected ,THEN Lshifton (dindentsymbols); *IF dindent IN optionsselected THEN Lshift; *IF spacebE (nextsym^.name <> endoffile) DO $BEGIN &Getsymbol (nextsym, currsym); &WITH ppoption [currsym^.name] DO (BEGIN *IF (crpending AND NOT (crsuppress IN optionsselected)) ,OR (crbefore IN optionsselected) ,THEN BEGIN .Insertcr (currsym); .crpending  BEGIN (* main program, at last *); "Initvar1 (top, currlinepos, currmargin, keyword, dblchars, dblchar, ,sglchar, recordseen, currchar, nextchar, currsym, nextsym); "Initvar2 (ppoption); "Initvar3 (ppoption); "Initfiles; "crpending := false; "WHILent1 $ELSE IF currmargin < slofail2 THEN currmargin := currmargin + indent2  END (*Rshift*);    PROCEDURE Rshifttoclp;  BEGIN "IF NOT stackfull THEN Pushstack (currsym, currmargin); "currmargin := currlinepos  END (*Rshifttoclp*);   : keysymbol);  BEGIN "IF NOT stackfull THEN Pushstack (currsym, currmargin); " "(* If extra indentation was used, update margin.*) "IF startpos > currmargin THEN currmargin := startpos; "IF currmargin < slofail1 $THEN currmargin := currmargin + indsym, nextsym: symbolinfo);  BEGIN "Rshifttoclp (currsym^.name); "WHILE NOT (nextsym^.name IN (terminators + [endoffile])) DO $BEGIN &Getsymbol (nextsym, currsym); &Ppsymbol (currsym) $END; "Lshift  END (*Gobble*);    PROCEDURE Rshift (currsym&Movelinepos (newlinepos, currlinepos); &Printsymbol (currsym, currlinepos) $END (*with*)  END (*Ppsymbol*);   PROCEDURE Rshifttoclp (currsym:keysymbol); "FORWARD; " "  PROCEDURE Gobble ( (*up to*) terminators: keysymset; 3(*updating*) VAR curr> maxlinesize (THEN BEGIN *Writecrs (once, currlinepos); *IF currmargin + lngth <= maxlinesize ,THEN newlinepos := currmargin ,ELSE IF lngth < maxlinesize .THEN newlinepos := maxlinesize - lngth .ELSE newlinepos := 0 (END; ritecrs (crsbefore, currlinepos); &IF (currlinepos + spacesbefore > currmargin) (OR (name IN [opencomment, closecomment, openbracket, closebracket]) (THEN newlinepos := currlinepos + spacesbefore (ELSE newlinepos := currmargin; &IF newlinepos + lngth DO write (outfile, valu[i]); $startpos := currlinepos; $currlinepos := currlinepos + lngth "END  END (*Printsymbol*);    PROCEDURE Ppsymbol (currsym: symbolinfo);  CONST once = 1;  VAR newlinepos: integer;  BEGIN "WITH currsym^ DO $BEGIN &W"FOR i := currlinepos+1 TO newlinepos DO $WRITE (outfile, space); "currlinepos := newlinepos  END;    PROCEDURE Printsymbol (currsym: symbolinfo; VAR currlinepos: integer);  VAR i: integer;  BEGIN "WITH currsym^ DO "BEGIN $FOR i := 1 TO lngthacesbefore > 0) (THEN spacesbefore := pred (spacesbefore) $END  END (*Insertspace*);    PROCEDURE Movelinepos ( (*to*) newlinepos: integer; 0(*from*) VAR currlinepos: integer);  VAR i: integer;  BEGIN ending THEN WRITELN (outfile); "CLOSE (outfile,lock)  END. * ( "  noted letters from irate users, who found bugs in certain areas, such as the  lack of inserted spaces before the ".." (range) symbol and "ugly breaking upon  wraparound of several expressions in assignment statements." Fixes are  promised in a forthcocopied from the Pascal News. Andy Mickel, then the editor of the Pascal News,  claims that FORMAT is especially clear-cut in its variable names and procedure  layout; I agree. There is a hidden gotcha, apparantly: Pascal News Number 15 autifying process. What PRETTY  does to your file is fixed at compile time; however, it respects line ends and  other spacing already present within the file to a degree.  %FORMAT.TEXT and subfiles is fully documented in FORMAT.DOC.TEXT, which I  hich pulls in INITVARS.TEXT as a subfile--this contains the  variable initializing portion of the program) is the simpler and more  forgiving of the Pascal formatters. Unlike FORMAT, programs which are  syntactically incorrect MAY get through the be the input and output files at run time. Finally, several PACK and UNPACK  statements in FORMAT (noted within the source file) were changed to their  equivalents, since the UCSD compiler does not support these standard  procedures.  %PRETTY.TEXT (wfile, this is noted below. Further, each program has been modified to run  under UCSD Pascal, usually by changing plain "Write (X)" statements to "Write  (Outfile, X)," and similarly with read. Initializing text was added to set up r to compile  both programs on my medium-sized (56K) system, I did not further split up the  files to fit within a smaller RAM space for editing, since they will not then  compile. If subfiles do not share the same name (plus a number) as the main  ow text longer than memory (10K  to 25K available depending on how much RAM there is in your system), each  program is provided in parts that are drawn into the compiler via the I(nclude  compiler option. Since I already had to partition the compile 2DOCUMENTATION FOR THE PASCAL PRETTYPRINTERS  There are two Pascal source formatting and beautifying programs on this  disk, both from the Pascal News Number 13 (December 1978). Because they were  prepared on the E6 editor, which does not allO^ming issue of Pascal News. Frankly, I think the thing  works fairly well and is a big improvement over manually breaking out the  structure of a program you plan to publish. And it has some VERY nice  features; I am particularly enamoured of being able to automatically add  comments after an "END" statement pointing out of which program statement it  is the end!  %If you have the UCSD system you will note that both programs run slowly,  victims of multiple procedure calls for each letter of the s0THEN DoComment 0ELSE IF SymbolName = Comment THEN SkipComment ,END; &'0', '1', '2', '3', '4', '5', '6', '7', '8', '9': ,BEGIN .SymbolIsNumber := true; CharNumber := 1; .REPEAT 0Symbol [CharNumber] := Character; ReadACharacter; 0CharNumber := Ch := PascSymbolName [I] $END (*letters*) "ELSE IF (Character IN ['0'..'9', ' ', '(', '.', ':', '''', '<', '>']) $THEN CASE Character OF &'(': BEGIN $ CheckFor ('*', Comment, ReadNextCh); .IF (SymbolName = Comment) AND PackerIsOff Symbol [I]; ,IF (TestSymbol [I] IN ['a'..'z']) .THEN TestSymbol [I] := CHR (ORD (TestSymbol [I]) + ORD ('A') - 0ORD ('a')) *END; &I := 1; &PascalSymbol [LastPascSymbol] := TestSymbol; &WHILE PascalSymbol [I] <> TestSymbol DO I := I + 1; &SymbolNameth := CharNumber - 1; &FOR CharNumber := CharNumber TO AlfaLeng DO (Symbol [CharNumber] := ' '; ((* PACK (Symbol, 1, TestSymbol); *) ((*EQUIVALENT (WITH ADDED UPPER/LOWER CASE TRANSPARENCY): *) (FOR I := 1 TO AlfaLeng DO *BEGIN ,TestSymbol [I] :=   BEGIN (*ReadSymbol*) "IF (Character IN Letters) $THEN BEGIN &CharNumber := 1; SymbolIsNumber := false; &REPEAT (Symbol [CharNumber] := Character; ReadACharacter; (CharNumber := CharNumber + 1 &UNTIL NOT (Character IN LettersAndDigits); &LengO^K  (particularly the M68000). If you rewrote the reading/writing parts to accept  UCSD-type strings, it would run faster but might not work on your next Pascal  system. ource file and  output file. This problem can be solved by 1) waiting, 2) getting a machine-  language compiler, or, preferably, 3) hanging on until the 16-bit  microprocessors are available, which handle procedure calls with applomb arNumber + 1 .UNTIL NOT (Character IN Digits + ['.']); .IF Character IN ['B', 'E'] 0THEN BEGIN 2Symbol [CharNumber] := Character; ReadACharacter; 2CharNumber := CharNumber + 1; 2IF Character IN Digits + ['+', '-'] 4THEN REPEAT 6Symbol [CharNumber] := Character; ReadACharacter; 6CharNumber := CharNumber + 1 4UNTIL NOT (Character IN Digits) 0END; .Length := CharNumber - 1; SymbolName := Identifier; ,END (*numbers*); &' ': BEGIN .REPEAT ReadACharacter UNTIL Character <> ' '; ReadSymbol ,EN&IF SymbolName <> OfSymbol THEN REPEAT WriteSymbol; ReadSymbol (UNTIL SymbolName = OfSymbol; &ChangeMarginTo (ActualLeftMargin + IndentIndex); &REPEAT (WriteSymbol; ReadSymbol; (IF SymbolName <> EndSymbol *THEN BEGIN ,StartNewLineAndIndent; ,REPgnColumn - 6WriteColumn; 2IF IndentAfterEOL < 0 THEN IndentAfterEOL := 0 0END; .WriteColumn := AlignColumn; .ChangeMarginTo (ActualLeftMargin + AlignColumn - WriteColumn) ,END (END (*then*); lignment > 0 (THEN BEGIN *REPEAT WriteSymbol; ReadSymbol *UNTIL SymbolName IN [ColonSymbol, OfSymbol]; *IF SymbolName = ColonSymbol ,THEN BEGIN .WriteSymbol; ReadSymbol; .WITH UnWritten [LastEOL] DO 0BEGIN 2IndentAfterEOL := IndentAfterEOL + AliewLineAndIndent; WriteSymbol; ReadSymbol; &ChangeMarginTo (SavedLeftMargin); $END (*DoRecord*); $ $ $PROCEDURE DoVariantRecordPart; $ $VAR SavedLeftMargin, OtherSavedMargin: Margins; $ $BEGIN &OtherSavedMargin := ActualLeftMargin; &IF DeclarA$BEGIN &SavedLeftMargin := ActualLeftMargin; WriteSymbol; ReadSymbol; &ChangeMarginTo (WriteColumn - 6 + IndentIndex - WriteLeftCol); &StartNewLineAndIndent; DoFieldListUntil ([EndSymbol]); &ChangeMarginTo (ActualLeftMargin - IndentIndex); &StartNntIndex); &END; $LongLineIndent := SavedLgLnId "END (*DoParentheses*); " " "PROCEDURE DoFieldListUntil (EndFieldList: SymbolSet); " "VAR LastEOL: Margins; AlignColumn: Width; " " $PROCEDURE DoRecord; $ $VAR SavedLeftMargin: Width; $ &END &ELSE BEGIN (LongLineIndent := 1; (ChangeMarginTo (ActualLeftMargin + IndentIndex); (StartNewLineAndIndent; (REPEAT WriteSymbol; ReadSymbol (UNTIL SymbolName = RightParenth; (WriteSymbol; ReadSymbol; (ChangeMarginTo (ActualLeftMargin - Inde" "BEGIN $SavedLgLnId := LongLineIndent; $IF DeclarAlignment > 0 &THEN BEGIN (LongLineIndent := WriteColumn + SymbolGap + 1 - LeftMargin - ,WriteLeftCol; (REPEAT WriteSymbol; ReadSymbol (UNTIL SymbolName = RightParenth; (WriteSymbol; ReadSymbol&IF LeftMargin > IndentedLeftMargin THEN LeftMargin := IndentedLeftMargin $END  END (*ChangeMarginTo*);       PROCEDURE DoDeclarationUntil (EndDeclaration: SymbolSet);     "PROCEDURE DoParentheses; " "VAR SavedLgLnId: OptionSize; eftMargin: Margins);   VAR IndentedLeftMargin: Margins;   BEGIN "ActualLeftMargin := NewLeftMargin; LeftMargin := NewLeftMargin; "IF LeftMargin < 0 $THEN LeftMargin := 0 $ELSE BEGIN &IndentedLeftMargin := WriteRightCol - 9 - LongLineIndent; ** STRING TOO LONG.'); 2EXIT (Program) 0END; ,END (*string*) $END (*then case*) $ELSE BEGIN &Symbol [1] := Character; SymbolName := NameOf [Character]; &Length := 1; ReadACharacter $END  END (*ReadSymbol*);    PROCEDURE ChangeMarginTo (NewLr] := Character; 0CharNumber := CharNumber + 1; ReadACharacter .UNTIL Character <> ''''; .Length := CharNumber - 1; SymbolName := OtherSymbol; .IF Length > WriteRightCol - WriteLeftCol + 1 0THEN BEGIN 2FlushUnwrittenBuffer; WriteLn; 2Writeln (' *.THEN CheckFor ('.', Range, ReadNextCh) .ELSE SymbolName := PeriodSymbol; &'''': BEGIN .CharNumber := 1; .REPEAT 0REPEAT 2Symbol [CharNumber] := Character; 2CharNumber := CharNumber + 1; ReadACharacter 0UNTIL Character = ''''; 0Symbol [CharNumbeD; &'>', ':': ,CheckFor ('=', OtherSymbol, ReadNextCh); &'<': BEGIN .CheckFor ('=', OtherSymbol, ReadNextCh); .IF SymbolName <> OtherSymbol 0THEN CheckFor ('>', OtherSymbol, DontReadNextCh) ,END; &'.': IF LastSymbol <> EndSymbol EAT WriteSymbol; ReadSymbol ,UNTIL SymbolName IN [LeftParenth, SemiColon, EndSymbol]; ,IF SymbolName = LeftParenth .THEN BEGIN 0WriteSymbol; ReadSymbol; SavedLeftMargin := ActualLeftMargin; 0ChangeMarginTo (WriteColumn - WriteLeftCol); 0DoFieldListUntil ([RightParenth]); WriteSymbol; 0ReadSymbol; ChangeMarginTo (SavedLeftMargin) .END *END; &UNTIL SymbolName <> Semicolon; &ChangeMarginTo (OtherSavedMargin) $END (*DoVariantRecordPart*); $ $ "BEGIN (*DoFieldListUntil*) $LastEOL := Oldest; ,UnWritten [Beginning MOD BufferSize].IndentAfterEOL) | ,WriteRightCol) AND (CharCount - Beginning < BufferSize); *IF Successful ,THEN BEGIN .BlksAddedByThisStmt := BlksAddedByThisStmt + 0StatmtSeparation - 1; .UnWritten [Breakpt MOD BufferSize].Ind; & $BEGIN &IF BunchWanted OR IfThenBunchNeeded (THEN BEGIN *IF StatmtSeparation < 1 THEN StatmtSeparation := 1; *BlksOnCurrntLine := BlksOnCurrntLine + StatmtSeparation - 1; *Successful := ((Ending - Beginning + BlksOnCurrntLine + : Width); $ "VAR I: Width; 'StatmtBeginning, BlksOnCurrntLine, BlksAddedByThisStmt: integer; 'StatmtPart: ARRAY [1..4] OF integer; 'Successful: boolean; ' ' ' $PROCEDURE Bunch (Beginning, Breakpt, Ending: integer; &StatmtSeparation: OptionSize); LastProgPartWasBody := true; $ChangeMarginTo (ActualLeftMargin - IndentIndex); WriteSymbol; $ReadSymbol; StartNewLineAndIndent "END (*DoProcedures*); " " "PROCEDURE DoStatement (VAR AddedBlanks: Width; StatmtSymbol: $CommentText; StmtSymLength(UNTIL SymbolName = RightParenth; (ReadSymbol &END; $IF SymbolName = ColonSymbol THEN &REPEAT WriteSymbol; ReadSymbol UNTIL SymbolName = Semicolon; $WriteSymbol; ReadSymbol; $ChangeMarginTo (ActualLeftMargin + IndentIndex); $StartNewLineAndIndentfaLeng DO FOR J := 1 TO AlfaLeng DO &ProcName [I + 1, J] := Symbol [J + I*AlfaLeng]; $ProcNmLength := Length; WriteSymbol; ReadSymbol; $IF SymbolName = LeftParenth &THEN BEGIN (WriteSymbol; (REPEAT ReadSymbol; WriteSymbol 2 TO ProcSeparation DO StartNewLineAndIndent; $StartNewLineAndIndent; WriteSymbol; ReadSymbol; !(* FOR I := 0 TO (Length - 1) DIV AlfaLeng DO &Pack (Symbol, I * AlfaLeng + 1, ProcName [I + 1]; *) $(* Equivalent: *) $FOR I := 0 TO (Length - 1) DIV Al DoBlock (BlockName: CommentText; BlockNmLength: Width);   VAR I: Width; IfThenBunchNeeded, AtProcBeginning: boolean;    "PROCEDURE DoProcedures; " "VAR I: 0..20;  ProcName: CommentText; 'ProcNmLenght: Width; ' "BEGIN $FOR I := "ChangeMarginTo (ActualLeftMargin + IndentIndex); "StartNewLineAndIndent; ReadSymbol; "DoFieldListUntil (EndDeclaration); StartNewLineAndIndent; "ChangeMarginTo (ActualLeftMargin - IndentIndex)  END (*DoDeclarationUntil*);       PROCEDURE= Oldest EEND AEND (*then*); =ReadSymbol ;END (* , : = *) *END (*case*) *ELSE BEGIN WriteSymbol; ReadSymbol END; &END (*while*) "END (*DoFieldListUntil*); " " "  BEGIN (*DoDeclarationUntil*) "StartNewLineAndIndent; WriteSymbol; en [LastEOL] DO EBEGIN GIndentAfterEOL := IndentAfterEOL + IAlignColumn - WriteColumn; GIF IndentAfterEOL < 0 ITHEN IndentAfterEOL := 0; GWriteColumn := AlignColumn EEND; CIF SymbolName = CommaSymbol ETHEN BEGIN GStartNewLineAndIndent; LastEOL :F ,RecordSymbol: DoRecord; ,CaseSymbol: DoVariantRecordPart; ,LeftParenth: DoParentheses; ,CommaSymbol, ColonSymbol, EqualSymbol: ;BEGIN =WriteSymbol; =IF DeclarAlignment > 0 ?THEN IF NOT (EndLabel <= EndFieldList) ATHEN BEGIN CWITH UnWritt(IF LastSymbol IN [Semicolon, Comment] THEN IF SymbolName <> Semicolon *THEN BEGIN StartNewLineAndIndent; LastEOL := Oldest END; (IF SymbolName IN [RecordSymbol, CaseSymbol, LeftParenth, ,CommaSymbol, ColonSymbol, EqualSymbol] *THEN CASE SymbolName O$IF LastSymbol = LeftParenth $THEN FOR I := 1 TO DeclarAlignment - Length DO WriteA (' '); $AlignColumn := LeftMargin + WriteLeftCol + DeclarAlignment + 1; $WHILE NOT (SymbolName IN EndFieldList) DO &BEGIN entAfterEOL := 0- StatmtSeparation; ,END (END $END (*bunch*); $ $ $PROCEDURE WriteComment; $ $VAR I, SavedLength: Width; & SavedSymbolName: Symbols; )SavedChars: SymbolString; ) $BEGIN &SavedSymbolName := SymbolName; &FOR I := 1 TO Length DO SavedChars [I] := Symbol [I]; &SavedLength := Length; SymbolName := OtherSymbol; &Symbol [1] := '('; Symbol [2] := '*'; Length := 2; WriteSymbol; #(* FOR I := 0 TO (StmtSymLength - 1) DIV AlfaLeng DO (Unpack (StatmtSymbol [I + 1], Symbol, (I *2 1 3 > U ?^윻(THEN IF EndList = EndSymbol THEN IF LastSymbol = EndSymbol THEN *IF AtProcEnd AND ProcNamesWanted THEN WriteComment $END (*DoStmtList*); " st = UntilSymbol ,THEN StatmtPart [4] := StatmtSeparation ,ELSE StatmtPart [4] := SymbolGap; *Bunch (StatmtBeginning, StatmtPart [1], CharCount, StatmtPart [4]); (END; &IF NOT (Successful AND BunchWanted) StatmtPart [1], CharCount, SymbolGap); &StartNewLineAndIndent; StatmtPart [1] := CharCount; &REPEAT WriteSymbol; ReadSymbol &UNTIL SymbolName IN [Semicolon, UntilSymbol, EndSymbol, ElseSymbol, *PeriodSymbol]; &IF Successful (THEN BEGIN ( IF EndLissful 4THEN BEGIN 6BlksAfterPrt2 := AddedBlanks; 6StatmtPart [2] := StatmtPart [3]; 4END 4ELSE BlksAfterPrt2 := BlksOnCurrntLine; 0END (*then*) ,END (*while*) (END (*main then*); &BlksOnCurrntLine := BlksAddedByThisStmt; &Bunch (StatmtBeginning, 2DoStatement (AddedBlanks, StatmtSymbol, StmtSymLength); 2BlksOnCurrntLine := AddedBlanks + BlksAfterPrt2; 2BlksAddedByThisStmt := BlksAddedByThisStmt + AddedBlanks; 2Bunch (StatmtPart [2], StatmtPart [3], CharCount, 4StatmtSeparation); 2IF NOT SucceddedBlanks; *BlksAddedByThisStmt := BlksAddedByThisStmt + AddedBlanks; *WHILE SymbolName <> EndList DO ,BEGIN , WriteSymbol; ReadSymbol; .IF SymbolName <> EndList 0THEN BEGIN 2StatmtPart [3] := CharCount + 1; EndList (THEN BEGIN *IF ProcNamesWanted THEN IF AtProcBeginning THEN IF ,LastProgPartWasBody THEN IF LastSymbol = BeginSymbol .THEN WriteComment; *AtProcBeginning := false; *DoStatement (AddedBlanks, StatmtSymbol, StmtSymLength); *BlksAfterPrt2 := APROCEDURE DoStmtList (EndList: Symbols); $ $VAR BlksAfterPrt2: Width; )AtProcEnd: boolean; $ $BEGIN &AtProcEnd := AtProcBeginning; WriteSymbol; ReadSymbol; &StatmtPart [1] := CharCount + 1; StatmtPart [2] := StatmtPart [1]; $ IF SymbolName <> &LastSymbol := PeriodSymbol; WriteSymbol; Symbol [1] := '*'; &Symbol[2] := ')'; Length := 2; WriteSymbol; &SymbolName := SavedSymbolName; Length := SavedLength; &FOR I := 1 TO Length DO Symbol [I] := SavedChars [I] $END (*WriteComment*); $ $ $ AlfaLeng + 1));*) &(* EQUIVALENT: *) &FOR I := 0 TO (StmtSymLength - 1) DIV AlfaLeng DO FOR J := 1 TO AlfaLeng (DO Symbol [J + I * AlfaLeng] := StatmtSymbol [I + 1, J]; &Length := StmtSymLength; SymbolName := PeriodSymbol; # HANDSIZE[I]:=0; #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; 13 + 1; ! END; {RANSUIT} "  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; $1:NAMSUIT:='CLUBS '; $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) DIVR(RANK+48); {SO THIS 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 " FOR I:=1 TO 52 DO $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]:=CH2585*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; "WRITE(CHR(11)); {CLEAR TO END OF SCREEN} !END; {CLERBOT}   PROCEDURE SHUFMES; !BEGIN "CLEARTOP; "GOTOXY(0,0); "WRITE('SHUFFLING- HAVE A DRINK ON THE HOUSE.'); !END; {SHUFMES} "  FUNCTION RND:REAL; !BEGIN "RND:=SEED/32767; "SEED:=(1OTOXY(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; !BEGIN  GOTOXY(0,YPLYR);"CHOICE :SET OF CHAR; "XHOLE,YHOLE :INTEGER; "HOLSUIT,HOLRANK :STRING; "DBLDOWN :BOOLEAN; " "  PROCEDURE NEWSCREEN; !BEGIN "WRITE(CHR(1),CHR(12)); !END; {NEWSCREEN} !  PROCEDURE CLEARTOP; !BEGIN "G :INTEGER; "BUST,BJACK,PUSH,WIN :BOOLEAN; "XPLYR,YPLYR :INTEGER; "XDELR,YDELR :INTEGER; "I,J :INTEGER; {GENERAL PURPOSE INDICES} "CARDVAL :INTEGER; "REPLY :CHAR; T :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 0; "YOVER = 18; ! YHAND0= 6; {LEVEL-1 OF CARDS PLAYED} " !TYPE "VEGAS = (PLAYER,DEALER); " !VAR "DECK :ARRAY[1..52] OF INTEGER; "RANK,SUIT :INTEGER; "NAMRANK,NAMSUIT :STRING; "CARDSLEFPROGRAM BLACKJK; ! !{GAME OF BLACKJACK WRITTEN IN PASCAL BY T.R. STOKES} ! !CONST "XINST = 0; {VARIOUS X-Y COORDS FOR SCREEN MESSAGES} "YINST = 4; "XWIN = 0; "YWIN = 0; "XBET = 0; "YBET = 2; "XOVER = "END; {CASE} ! NAMECARD; #GOTOXY(X,Y); #CN:=Y-YHAND0; #WRITE(CN:1,')',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>10 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; %HANDVA"PERSON:=DEALER; "SHOHOLE;  WHILE (HANDVAL[2]<17) OR ((HANDVAL[2]=17) AND (NACES[2]>0)) DO " BEGIN # DEAL; $SHOWHAND; $SCORE; #END; {WHILE} ! HSCORE; !END; {DEALHOUSE} !  PROCEDURE EVALUATE; !VAR HV,YPRINT:INTEGER; !BEGIN #IF YPLYR>YDELR THERE; %END #UNTIL BUST OR (REPLY<>'H') OR (REPLY='D'); "IF BUST THEN #BEGIN $CLEREOL(XOVER,YOVER); $WRITE('YOU BUSTED WITH ',HANDVAL[1]:3); #END; {IF BUST} "IF REPLY='D' THEN DBLDOWN:=TRUE; !END; {DEALPLAYER} "  PROCEDURE DEALHOUSE; !BEGIN ITE('* * DEALER HAS A BLACKJACK !!'); $END; #END; {BJACK:=TRUE} "END; {TEST21 - NO BLACKJACK} "  PROCEDURE DEALPLAYER; !BEGIN ! PERSON:=PLAYER; "REPEAT #INSTRUCTIONS; #DOWHAT; $IF (REPLY='H') OR (REPLY='D') THEN %BEGIN &DEAL; &SHOWHAND; &SCOLACKJACK !!! - PUSH -'); $END {PUSH} #ELSE IF HANDVAL[1]=21 THEN $BEGIN $ WIN:=TRUE; %BET:=BET+BET DIV 2; %CLEREOL(XOVER,YOVER); %WRITE('* * * BLACKJACK !! - PAY 1.5 TIMES BET '); $END {PLAYERS BLACKJACK} #ELSE $BEGIN %CLEREOL(XOVER,YOVER); %WR%END; {PERSON} #END; {FOR} !END; {DEAL2} !  PROCEDURE TEST21; !BEGIN "IF (HANDVAL[1]=21) OR (HANDVAL[2]=21) THEN  BEGIN $BJACK:=TRUE; $SHOHOLE; $IF HANDVAL[1]=HANDVAL[2] THEN %BEGIN &PUSH:=TRUE; &CLEREOL(XOVER,YOVER); &WRITE('* * DOUBLE BSIZE[1]+1 ! ELSE HANDSIZE[2]:=HANDSIZE[2]+1; !END; {DEAL}   PROCEDURE DEAL2; !VAR #C:INTEGER; !BEGIN "FOR C:=1 TO 2 DO #BEGIN $FOR PERSON:=PLAYER TO DEALER DO %BEGIN &DEAL; &SCORE; &IF (PERSON=DEALER) AND (C=1) THEN NOSHOW &ELSE SHOWHAND RANK:6,' OF ',HOLSUIT); !END; {SHOHOLE} "  PROCEDURE DEAL; !VAR "K,CARD:INTEGER; !BEGIN "K:=CARDSLEFT; "CARD:=DECK[K]; "RANSUIT(CARD); "NAMECARD; "CARDSLEFT:=CARDSLEFT-1; "IF CARDSLEFT=0 THEN SHUFFLE; ! IF PERSON=PLAYER THEN HANDSIZE[1]:=HAND BET PLEASE ? '); #READLN(BET); #IF BET<0 THEN $BEGIN %NEWSCREEN; %EXIT(BLACKJK) $END; "UNTIL BET<201 !END; {REPEAT}  END; {PLAYERIN}   PROCEDURE SHOHOLE; !VAR CN:INTEGER; !BEGIN "GOTOXY(XHOLE,YHOLE); "CN:=YHOLE-YHAND0; "WRITE(CN:1,')',HOL!END; {INSTRUCTIONS} !  PROCEDURE PLAYERIN; !VAR B:CHAR;  BEGIN !CLEREOL(XBET,YBET); !WRITE('HOUSE LIMIT IS $200.. BET LIMIT ? (Y/N) '); !READ(B); !IF B='Y' THEN BET:=200 !ELSE "BEGIN #REPEAT #CLEREOL(XBET,YBET); #WRITE('HOUSE LIMIT IS $200.."CN:=YDELR-YHAND0; "WRITE(CN:1,') ?????????'); ! XHOLE:=XDELR; "YHOLE:=YDELR; ! HOLSUIT:=NAMSUIT; "HOLRANK:=NAMRANK; !END; {NOSHOW} !  PROCEDURE INSTRUCTIONS; !BEGIN "GOTOXY(XINST,YINST); "WRITE('H)it, G)ood, D)oubledown'); N CHOICE; ! IF (REPLY='D') AND (HANDSIZE[1]>2) THEN " BEGIN ! CLEREOL(XINST,YINST+1); $WRITE('NO-NO, NOT AFTER 3 OR MORE!!'); $DOWHAT; #END; !END; {DOWHAT} !  PROCEDURE NOSHOW; !VAR CN:INTEGER; !BEGIN "YDELR:=YDELR+1; "GOTOXY(XDELR,YDELR);  U.S. of A. Dollars you have $',DOLLARS); "CLEREOL(XINST,YINST); "CLEREOL(XINST,YINST+1); !END; {WINNINGS} !  PROCEDURE DOWHAT; !BEGIN "CLEREOL(XINST,YINST+1); "REPEAT #GOTOXY(XINST,YINST+1); #WRITE('YOUR MOVE ? '); #READ(REPLY); "UNTIL REPLY I"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('InL[I]:=HANDVAL[I]-10; $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+2,YDELR+1); N YPRINT:=YPLYR+3 #ELSE YPRINT:=YDELR+3; "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 "ELSE IF HANDVAL[1]>HANDVAL[2] THEN WIN:=TRUE; ! IF PUSH THEN BEGIN #CLEREOL(XDELR-2,YPRINT); ! WRITE(' - PUSH -'); "END; ! HV:=HANDVAL[2]; "IF (NOT PUSH) AND (NOT BUST) THEN ! BEGIN $CLEREOL(XDELR-8,YPRINT); $IF HV=21 THEN $ WRITE('PAY HOUSE - DEALER HAS 21!!') %ELSE WRITE('THE HOUSE PAYS ',HV+NOT AFTER 3 OR MORE!!~  ) ?????????ݥ9PbP^צH)it, G)ood, D)oubledown?2(HOUSE LIMIT IS $200.. BET LIMIT ? (Y/N)  >*  In U.S. of A. Dollars you have $ ~צ YOUR MOVE ? Dåń0NO-NO, ؂ ڏń> šm צTOTAL =  >צTOTAL =  t ( /  )bצ OF 9   88 š 8á8á?3'7D9צCLUBS PC9DIAMONDSתP29צHEARTS P!9SPADES תPL=.  88á 8 7 ȡ7A#244ȡK44444ٚW l bצ Pb808ábACE תPQ8 šK88b10 תP9bJACK תP+bQUEENתPbKING תP   צ&SHUFFLING- HAVE A DRINK ON THE HOUSE.B)1?R(4ȡ4"> BLACKJK RAM}  1; " IF NOT BJACK THEN %BEGIN &DEALPLAYER; &PSCORE; &IF NOT BUST THEN 'BEGIN (DEALHOUSE; (EVALUATE; " END; {IF NOT BUST} &END; {NOT BJACK} $END; {BET>0} #WINNINGS; #PLAYERIN; " SETUP; #CLERBOT; "UNTIL BET<0;NEWSCREEN !END. {MAIN PROG"WRITE(' AND PRESS RETURN - ') !END; " !BEGIN {MAIN PROGRAM} "CHOICE:=['H','G','D']; "NEWSCREEN; "INTRO; "READLN(SEED); "NEWSCREEN; "FRESHDECK; "SHUFFLE; "SETUP; "PLAYERIN; "DOLLARS:=0; "REPEAT #IF BET>0 THEN BEGIN $DEAL2; $TEST21); #END; {NOT PUSH} !END; {EVALUATE} ! !PROCEDURE INTRO; !VAR XX:INTEGER; !BEGIN "WRITELN('WHEN READY TO QUIT,'); "WRITELN(' ENTER ANY NEGATIVE BET'); "WRITELN; "WRITELN; "WRITELN(' TO START, PLEASE ENTER A RANDOM NUMBER '); Yá\צ#HOUSE LIMIT IS $200.. BET PLEASE ?  ɡɡ_  ) OF T4 á á nȡ4ȡÄ <2 LåÍá7!* * DOUBLE BLACKJACK !!! - -BlksAddedByThisStmt := BlksAddedByThisStmt + AddedBlanks; -Bunch (StatmtBeginning, StatmtPart [1], CharCount, SymbolGap) +END; &RepeatStatemtnt: +DoStmtList (UntilSymbol); &IfStatement: +BEGIN -(* PACK (Symbol, 1, StatmtSymbol [1]); EQUIVALENT: := Length; -REPEAT WriteSymbol; ReadSymbol -UNTIL SymbolName = DoSymbol; -WriteSymbol; ReadSymbol; StatmtPart [1] := CharCount + 1; -DoStatement (AddedBlanks, StatmtSymbol, StmtSymLength); -BlksOnCurrntLine := BlksOnCurrntLine + AddedBlanks; riteSymbol; (ReadSymbol (*Write COLON*) &END; $CASE StatementTypeOf [SymbolName] OF &ForWithWhileStatement: +BEGIN -(* PACK (Symbol, 1, StatmtSymbol [1]); EQUIVALENT: *) -FOR I := 1 TO AlfaLeng DO StatmtSymbol [1, I] := Symbol [I]; -StmtSymLength eginning := CharCount; $IF SymbolIsNumber &THEN BEGIN (WITH UnWritten [Oldest] DO *BEGIN ,IndentAfterEOL := IndentAfterEOL - 1 - Length - SymbolGap; ,IF IndentAfterEOL < 0 THEN IndentAfterEOL := 0 *END; (WriteSymbol; ReadSymbol (*Write LABEL*); W (* PROGRAM Format *)   (*$IFORMAT1.TEXT*)  (*$IFORMAT2.TEXT*)  $ "BEGIN (*DoStatment*) $BlksOnCurrntLine := 0; Successful := false; $BlksAddedByThisStmt := 0; $ChangeMarginTo (ActualLeftMargin + IndentIndex); $StartNewLineAndIndent; StatmtBO^K |Pfv<RH   H v  :]á)צPAY HOUSE - DEALER HAS 21!!'THE HOUSE PAYS  @WHEN READY TO QUIT,צ ENTER ANY NEGATIVE BET) TO START, PLEASE ENTER A RANDOM NUMBER צ AND PRESS RETURN - ץE  š ɡ2vš - PUSH -]á)צPAY HOUSE - DEALER HAS 21!!'THE HOUSE PAYS  @WHEN READY TO QUIT,צ ENTER ANY NEGATIVE BET Dáp |ɥåń :Hš ATHE HOUSE BUSTED WITH  @áPUSH -áIצ'* * * BLACKJACK !! - PAY 1.5 TIMES BET -* * DEALER HAS A BLACKJACK !! HéDÍ HˍDÍ5צYOU BUSTED WITH *) -FOR I := 1 TO AlfaLeng DO StatmtSymbol [1, I] := Symbol [I]; -StmtSymLength := Length; -REPEAT WriteSymbol; ReadSymbol -UNTIL SymbolName = ThenSymbol;  StartNewLineAndIndent; StatmtPart [1] := CharCount; -WriteSymbol; ReadSymbol; StatmtPart [2] := CharCount + 1; -DoStatement (AddedBlanks, StatmtSymbol, StmtSymLength); -BlksOnCurrntLine := AddedBlanks; -BlksAddedByThisStmt := AddedBlanks; -Bunch (StatmtPart [1], StatmtPart [2], CharCount, SymbolGap); -IF Successful /THEN Bunc"WHILE SymbolName IN [FuncSymbol, ProcSymbol] DO DoProcedures; "IF SymbolName = BeginSymbol $THEN BEGIN &IF LastProgPartWasBody (THEN FOR I := 2 TO ProcSeparation DO StartNewLineAndIndent; &IfThenBunchNeeded := false; AtProcBeginning := true; &ChanN DoDeclarationUntil (EndLabel); "IF SymbolName = ConstSymbol THEN DoDeclarationUntil (EndConst); "IF SymbolName = TypeSymbol THEN DoDeclarationUntil (EndType ); "IF SymbolName = VarSymbol THEN DoDeclarationUntil (EndVar ); x); "END (*DoStatement*); "   BEGIN (*DoBlock*) "IF CharCount > BufferSize * 2 $THEN CharCount := (CharCount MOD BufferSize) + BufferSize; "LastProgPartWasBody := LastProgPartWasBody AND (SymbolName = BeginSymbol); "IF SymbolName = LabelSymbol THElName IN [Semicolon, UntilSymbol, EndSymbol, /ElseSymbol]) DO -BEGIN WriteSymbol; ReadSymbol END; &CompoundStatement: +DoStmtList (EndSymbol) $END (*main case *); $AddedBlanks := BlksAddedByThisStmt; $ChangeMarginTo (ActualLeftMargin - IndentInde-StartNewLineAndIndent; WriteSymbol; ReadSymbol; -IF EndCommentsWanted AND (LastSymbol = EndSymbol) /THEN BEGIN 1StatmtSymbol [1] := 'CASE '; StmtSymLength := 4; 1WriteComment /END +END (*CaseStatement*); &OtherStatement: +WHILE NOT (SymboAddedBlanks; 5Bunch (StatmtPart [1], StatmtPart [2], CharCount, SymbolGap); 3END; 1IF SymbolName = Semicolon 3THEN BEGIN WriteSymbol; ReadSymbol END /END (*while*); -ChangeMarginTo (ActualLeftMargin - IndentIndex); mbol; ReadSymbol; 1IF NOT (SymbolName IN [Semicolon, EndSymbol]) 2 THEN BEGIN 5StatmtPart [2] := CharCount + 1; 5DoStatement (AddedBlanks, StatmtSymbol, StmtSymLength); 5BlksOnCurrntLine := AddedBlanks; 5BlksAddedByThisStmt := BlksAddedByThisStmt + ) 1(* EQUIVALENT: *) 1FOR I := 0 TO (Length - 1) DIV AlfaLeng DO 3FOR J := 1 TO AlfaLeng DO 3StatmtSymbol [I + 1, J] := Symbol [J + I * AlfaLeng]; 1StmtSymLength := Length; 1REPEAT WriteSymbol; ReadSymbol 1UNTIL SymbolName = ColonSymbol; 1WriteSy-ChangeMarginTo (ActualLeftMargin + IndentIndex); -WHILE SymbolName <> EndSymbol DO /BEGIN 1StartNewLineAndIndent; StatmtPart [1] := CharCount; 1(* FOR I := 0 TO (Length - 1) DIV AlfaLeng DO 3PACK (Symbol, (I + AlfaLeng + 1), StatmtSymbol [I + 1]);*tPart [2], 3 SymbolGap); 3BunchWanted := NOT BunchWanted; 1END; -IfThenBunchNeeded := false +END (*IfStatement*); &CaseStatement: +BEGIN -REPEAT WriteSymbol; ReadSymbol -UNTIL SymbolName = OfSymbol; -WriteSymbol; ReadSymbol; 3THEN Bunch (StatmtBeginning, StatmtPart [3], CharCount, 5StatmtSeparation) /END /ELSE IF (CharCount - StatmtBeginning) < BufferSize 1THEN BEGIN 3BunchWanted := NOT BunchWanted; 3BlksOnCurrntLine := 0; 3Bunch (StatmtBeginning, StatmtPart [1], StatmBlanks, StatmtSymbol, StmtSymLength); 1BlksOnCurrntLine := AddedBlanks; 1BlksAddedByThisStmt := BlksAddedByThisStmt + AddedBlanks; 1Bunch (StatmtPart [3], StatmtPart [4], CharCount, SymbolGap); 1BlksOnCurrntLine := BlksAddedByThisStmt; 1IF Successful 1FOR I := 1 TO AlfaLeng DO StatmtSymbol [1, I] := Symbol [I]; 1StmtSymLength := Length; IfThenBunchNeeded := false; 1StartNewLineAndIndent; StatmtPart [3] := CharCount; 1WriteSymbol; ReadSymbol; StatmtPart [4] := CharCount + 1; 1DoStatement (Addedh (StatmtBeginning, StatmtPart [1], CharCount, 1StatmtSeparation) /ELSE IfThenBunchNeeded := true; -If SymbolName = ElseSymbol /THEN BEGIN 1(* PACK (Symbol, 1, StatmtSymbol [1]); EQUIVALENT: *) geMarginTo (ActualLeftMargin - IndentIndex); &DoStatement (I, BlockName, BlockNmLength) (*I is dummy param*); &LastProgPartWasBody := true; &ChangeMarginTo (ActualLeftMargin + IndentIndex) $END $ELSE BEGIN WriteSymbol; ReadSymbol (*Write FORWARD *) END  END (*DoBlock*);    PROCEDURE Initialize;   VAR I: Width;  InfileName, OutfileName: string [25];   BEGIN (*Constants:*) "Digits := ['0'..'9']; Letters := ['A'..'Z', 'a'..'z']; "LettersAndDigits := Letters + Digits; "AlphaSymbols O^B"Symbol; ReadSymbol; StartNewLineAndIndent; *DoBlock (Main, MainNmLength); WriteA ('.'); *FlushUnwrittenBuffer; *Close (Outfile, lock) (END $END  END (*main program *). $ , Main [I + 1]); *) *(*EQUIVALENT:*) *FOR I := 0 TO (Length - 1) DIV AlfaLeng DO FOR J := 1 TO AlfaLeng ,DO Main [I + 1, J] := Symbol [J + I * AlfaLeng]; *MainNmLength := Length; *REPEAT WriteSymbol; ReadSymbol UNTIL SymbolName = Semicolon; *Write!* * !********************************************************) ! *StartNewLineAndIndent; WriteSymbol; ReadSymbol; *(* FOR I := 0 TO (Length - 1) DIV AlfaLeng DO ,PACK (Symbol, (I * AlfaLeng + 1)(ELSE BEGIN ( (  (******************************************************** !* * !* F O R M A T T H E P R O G R A M * !* - - - - - - - - - - - - - - - - * OGRAM !!!*) "ConstantsInitialization; Initialize; "IF eof(Input) $THEN Writeln (' *** No Program Found To Format') $ELSE BEGIN  ReadACharacter; ReadSymbol; &IF SymbolName <> ProgSymbol (THEN Writeln (' *** "PROGRAM" EXPECTED.') teln ('To exit the program, just type .'); &END "UNTIL I = 0; "Write ('Now the output filename ("PRINTER:" if you wish to print): '); "Readln (Outfilename); "Rewrite (Outfile, outfilename);  END (*Initialize *);      BEGIN (*MAIN PR'Please type input file name --> '); $Readln (Infilename); $IF Infilename = '' THEN EXIT (Program); $(*$I-*) $Reset (Infile, Infilename); $(*$I+*) $I := IORESULT; $IF I > 0 &THEN BEGIN (Writeln ('Oops, something''s wrong. IORESULT = ', I); (Wri"FOR I := 0 TO BufferSize DO Symbol [I] := ' '; "LastSymbol := PeriodSymbol; LastProgPartWasBody := false;  (* Now get filenames *) "Writeln; "Writeln ('Welcome to the P a s c a l F O R M A T T E R.':60); "I := 1; "REPEAT $Writeln; $Write (ers: *) "IndentIndex := 3; LongLineIndent := 3; ProcSeparation := 2; "SymbolGap := 1; StatmtSeparation := 3; DeclarAlignment := 0;  (* Initialize Input Context Data: *) "ReadColumn := 1; ChIsEOL := false; NextChIsEOL := false; ; LineNumber := 0; Increment := 0;  (* Initialize Boolean Parameters: *) "PackerIsOff := true; BunchWanted := false; DisplayIsOn := true; "ProcNamesWanted := true; EndCommentsWanted := false; "NoFormatting := false;  (* Initialize Numeric Parametl];  (* Initialize Column Data: *) "WriteColumn := 0; LeftMargin := 0; ActualLeftMargin := 0; "OutputCol := 1; ReadLeftCol := 1; ReadRightCol := MaxReadRightCol; "WriteLeftCol := 1; WriteRightCol := MaxWriteRightCol; Oldest := 1; "CharCount := 1&ProcSymbol, FuncSymbol, LabelSymbol, AlphaOperator]; "EndLabel := [ConstSymbol, TypeSymbol, VarSymbol, ProcSymbol, &FuncSymbol, BeginSymbol]; "EndConst := EndLabel - [ConstSymbol]; "EndType := EndConst - [TypeSymbol]; "EndVar := EndConst - [VarSymbo:= [ProgSymbol, BeginSymbol, EndSymbol, ConstSymbol, &TypeSymbol, RecordSymbol, CaseSymbol, IfSymbol, ThenSymbol, &ElseSymbol, DoSymbol, OfSymbol, ForSymbol, WithSymbol, &WhileSymbol, RepeatSymbol, UntilSymbol, Identifier, VarSymbol, +Range = "="UnsignedInteger "-" UnsignedInteger ["<" | ">"]. & !UnsignedInteger = Digit(Digit).  %CommentText = (Any character except "]" or close-comment).   Note: As defined above, a Directive may be within a comment specifying a  Pascal Comp CommentText.  'Directive = Letter Setting.  *Letter = "A"| "B"| "C"| "D"| "E"| "F"| "G"| "H"| 3"I"| "L"| "N"| "P"| "R"| "S"| "W".  )Setting = Switch | Value | Range.  *Switch = "+" | "-".  +Value = "=" Unsigned Integer. & NF"--Extended Backus-Naur Form--see Communications  ACM, November, 1977, page 822.):   DirectiveComment = "(*" DirectiveList "*)" | 7"(*$" CompilerOptionList CommentText DirectiveList"*)".  # #DirectiveList = "[" Directive {"," Directive} "]" pot for a comment containing directives. Subsequent use of embedded  directives allows you to change the kind of formatting for different sections  of your program. The syntax of these special comments is given below (The  syntax is given using "EB [NOTE to UCSD users: I did not implement this feature, though it should be  easy to do.]  %Directives to Format may always be specified in the program itself inside  comments with a special syntax. Thus the first line of a program is an ideal  sntaining a Pascal program and one output  file for the reformatted program. Additionally it may be possible to supply  the initial values of directives to Format when it begins execution. can find a set of values for the directives which produce satisfactory  results. The default values are typical.  % How To Use Format  %The use of Format will vary from implementation to implementation, but  will involve one major input file coability to control how formatting is done, not only  prior to execution, but also during execution through the use of prettyprinter  directives embedded in your program.  %Experience with Format over the last three years has shown that most  users%The flexibility of Format is accomplished by allowing you to supply  various directives (options) which override the default values. Rather than  being a rigid prettyprinter which decides for you how your program is to be  formatted, you have the l of statements and declarations, and more. Miscellaneous  features, such as supplying line numbers and automatic comments or deleting  all unnecessary blanks to save space, are described below.  ut they are rearranged with  respect to line boundaries and columns for readability. %Format maintains consistent spacing between symbols, breaks control and  data structures onto new lines if necessary, indents lines to reflect the  syntactic leverettyprinter for Pascal programs. It takes as  input a syntactically correct Pascal program and produces as output an  equivalent but reformatted Pascal program. The resulting program consists of  the same sequence of Pascal symbols and comments, b % >FORMAT DOCUMENTATION  %The following text accompanied the program listing in Pascal News, No. 13  (December 1978). For further comments, see "PRETTY.DOC.TEXT" elsewhere on  this disk.  %  What Format Does  %Format is a flexible pilerOptionList. On most implementations this is a "$" followed by  a series of letters and values ("+", "-", or digits), separated by commas.  See your local manual.   Examples of DirectiveComments:  %(*[A=15, E=3, N=1,1<]*) - good for publication quality. %(*[G-0, W=1-100, C+]*) - good for compact storage. %(*$U+ [R=1-72, I=2]*) - an example of a DirectiveList with a =CompilerOptionList.  %  Directives to Format.   A=n Align declarations. (The A directive forces the alignment of ":"(number of columns. Using I=2 or I=1 helps prevent excessively- (narrow lines within the specified write margins (W directive) where (there are heavily-nested constructs. (Default: I=3. (  L=n Specify Line-wraparound indent tab. (L determiserved words. The symbols [] () , and : are handled (independently of G. (Default: G=1. (  I=n Specify Indent tab. (I indents each nesting level of statements and declarations a given erly formatted (such as comments). (Default: F+ (of course!). (  G=n Specify symbol Gap. (The G directive determines the number of spaces placed between Pascal (symbols during formatting. G=O still places one space between two (identifiers and relected portions of your program. F- causes (Format to copy the input program directly with no changes. Therefore (by switching F on and off with directives which are appropriately (placed in your program, you can preserve text which is already (prop(after the "BEGIN" and "END" symbols constituting procedure and func- (tion bodies only. E=O creates no comments at all. E=3 means E=1 (and E=2. See example below. (Default: E=2. (  F+ or F- Turn Formatting on or off. (F allows you to format sein structured statements, as well as those (constituting procedure and function bodies. The comments take the (form: (*StatementPart*) or (*ProcedureName*). E=2 creates comments upply END comments. (The E directive generates comments after "END" symbols if none are (already there. Common Pascal coding styles frequently employ these (comments. E=1 creates comments after the "END" symbol in compound (statements which are withched on and off with directives (which are appropriately placed in your program. D is perhaps useful (to obtain program fragments for publication (such as one or more pro- (cedures) without having to print the whole program. (Default: D+. (  E=n S(store a program in compressed form and expand it later by reformatting (with C-. (Default: C-.   D+ or D- Turn Display on or off. D allows you to selectively display portions of your program during (formatting. Therefore, D must be swite margins (W directive). The number of spaces specified (by the G directive will still be written between symbols. C+ might (save some space on long-term storage media such as disk; you might ault: B- (one statement or statement part per line).   C+ or C- Fully Compress program. (C+ removes all non-essential blanks, end-of-lines, and comments from (your program. A compilable, packed program will be written within the (specified writct to read- (ability constraints. Bunching (B+) when the display is off (D-) has  no effect. In general, B+ saves paper and prevents your program from (becoming overly stretched in the vertical direction. See example  below. (Def(See example below. (Default: A=O (no alignment).  !B+ or B- Bunch statements and declarations reasonably. (B+ will place as many statements or declarations onto one line as will  fit within the specified write margins (W directive) subje and "=" in declarations. (If A is set to a value greater than O, then n should be equal to the ! maximum identifier length for that section of your program. The A  directive visually clarifies the declaration part of your program. nes the indentation of the remainder of statements or (declarations which are too long to fit on one line. (Default: L=3. (  N=x-y< or N=x-y> Generate line-numbers on the left or right. (The N directive indicates the starting line-number (x) and the incre- (ment (y) for each succeeding line-number. If y > O then line-numbers (are written outside the specified write margins for the formatted pro- (gram in sequential order starting at x; y = O shuts off line-number- (ing. "<" writes up to 4-digi Suppose that a Pascal program fragment looked like:  %PROCEDURE SAMPLE; 'PROCEDURE INNER; 'BEGIN END; %BEGIN 'IF X=3 THEN 1BEGIN X := 1; I := I+1 1END .ELSE 0BEGIN X := X+I; I := 0 0END; 'WHILE (CH <> 'X') AND FLAG1 DO )BEGIN I := I+3; INNE= 5; & %VAR (I,J,N:INTEGER; % %BEGIN (N:=0; J:=3; I:=SQR(N); N:=N + INCREMENT; (IF N>73 THEN BEGIN DOTHIS; DOTHAT END; %(*[B-] UNBUNCH. *) (IF N>5 THEN +IF J>6 THEN .DOSOMETHINGELSE; %END (*T*). %   The E Directive.  ENT; (IF N>73 THEN +BEGIN .DOTHIS; .DOTHAT +END; (IF N>5 THEN +IF J>6 THEN .DOSOMETHINGELSE; %END (*T*). %  and the output from Format with B directives embedded is:  %(*[B+] BUNCH STATEMENTS. *) %PROGRAM T(OUTPUT); % %CONST (INCREMENT AT END ; %IF N>5 THEN IF J>6 THEN DOSOMETHINGELSE; %END. %  then the output from Format (using the default, B-) is:  %PROGRAM T(OUTPUT); % %CONST (INCREMENT = 5; & %VAR (I,J,N:INTEGER; % %BEGIN (N:=0; (J:=3; (I:=SQR(N); (N:=N + INCREM)MAYBE: BOOLEAN; ( %BEGIN %END (*SAMPLE*). % %  The B Directive.   If the input to Format is:  %PROGRAM T(OUTPUT); %CONST INCREMENT = 5; %VAR I,J,N:INTEGER; %BEGIN %N:=0; %J:=3; I:=SQR(N); N:=N+INCREMENT; %IF N>73 THEN BEGIN DOTHIS; DOTHirective:  %(*[A=5] ALIGN DECLARATIONS. *) %PROGRAM SAMPLE(OUTPUT); %CONST ,A = 6; *ABC = 'LETTERS'; (THREE = 3; % %TYPE (RANGE = 1 .. 6; (COLOR = (RED, BLUE); + %VAR -I, ,I2, +I33, *I444, )I5555: RANGE; +YES, ,NO, %CONST (A = 6; (ABC = 'LETTERS'; (THREE = 3; % %TYPE (RANGE = 1 .. 6; (COLOR = +(RED, BLUE); + %VAR (I, I2, I33, I444, I5555: RANGE; (YES, NO, MAYBE: BOOLEAN; ( %BEGIN %END (*SAMPLE*). %  Here is the output from Format with an added A=5 dM SAMPLE(OUTPUT); %CONST A=6; ABC='LETTERS'; THREE=3; %TYPE RANGE=1..6; %COLOR=(RED,BLUE); %VAR %I,I2,I33,I444,I555:RANGE; %YES,NO,MAYBE:BOOLEAN; %BEGIN END. %  Here is the output from Format with all defaults set: % %PROGRAM SAMPLE(OUTPUT); % (reformatted program on the output file. Any line numbers generated (N (directive) are written outside these margins. (Default: N=1-72. (   EXAMPLES (   The A directive. (  Here is a sample program fragment before using Format: % %PROGRAse of the B+ directive. Note that (this directive is in effect only if B+ is used. (Default: S=3. (  W=x-y Specify Write margins. (The W directive indicates which columns are used for writing the t (x-1) columns or after the y~h column. (Default: R=1-999 (large enough to read end-of-line in most cases). (  S=n Specify Statement separation. (The S directive determines the number of spaces between statements (bunched on the same line by the unctions visually stand out. (Default: P=2. (  R=x-y Specify Read margins. The R directive indicates which columns are significant when Format (reads from the input file. R allows Format to accept files which have (line numbers in the firs(Default: N=0-0> (no line numbers). (  P=n Specify spacing between Procedure and function declarations. (The P directive determines the number of blank lines to be placed (between procedure and function declarations. n>2 makes procedures and (fut, right-justified line numbers together (with a trailing space ot the left of each line. ">" writes 6-digit, (zero-filled line numbers to the right of each line. Use the N (directive along with the W directive. R END; END; ) !then using Format with E=3 produces: ! %PROCEDURE SAMPLE; ' ' 'PROCEDURE INNER; ' ' *BEGIN *END (*INNER*); % % %BEGIN (*SAMPLE*) (IF X=3 (THEN +BEGIN .X := 1; .I := I+1 +END (*IF*) (ELSE +BEGIN .X := X+I; .I := 0 +END (*ELSE*); (WHILE Я̨ϹDžƅڨ̨E*); %END (*SAMPLE*); ) ) !How Format Works. ! %Format parses your program by performing syntax analysis similar to the  Pascal compiler: recursive descentE  IF E  THEN E  ELSE E  DO E  OF E FOR E WHILE E WITH E REPEAT E UNTIL < > ;E PROGRAM E BEGIN E END E CONST E TYPE E VAR E RECORD E CASE  MAIN ǠW] רX 0000000000רǟȡ)bǠA٢٢dǠȡ  ( )!= ,. []:"X% FORMAT string (including both the quotes)  which is wider than the specified write margins (W directive).   4. " *** NO PROGRAM FOUND TO FORMAT." %The input file is empty. text from your input file. The cause could be any  syntactic error, most commonly unmatched "BEGIN-END" pairs or the lack of  semicolons, string quotation marks, or the final period.   3. " *** STRING TOO LONG." %Your program contains a character! The Pascal program you fed to Format did not contain a Standard Pascal  program declaration.   2. " *** ERRORS FOUND IN PASCAL PROGRAM." %Your program is syntactically incorrect. The output from Format probably  does not contain all of the %(*LINESIZE*)  %Proper treatment of comments is certainly an area of future development  for Format.  %  Error Messages.  %Format issues the following error messages:   1. " *** 'PROGRAM' EXPECTED." ments, however, receive rough treatment from Format. The  first line of such comments is always left justified and placed on a separate  line. See the F directive. Thus:  %CONST LS=6; (*LINESIZE*)   will be reformatted as:  %CONST (LS = 6;ion or statement. Therefore  using comments like:  %CONST LS=6 (*LINESIZE*);   is a good idea because Format will carry the comment along with the  declaration. Similarly:  %BEGIN (* 'Z' < CH <= ' ' *)   is also okay.  %Stand-alone com%Format has limited error-recovery facilities, and no results are  guaranteed if a syntactically incorrect program is input.  %The bane of most Pascal prettyprinters is the treatment of comments.  Format considers them in the context of a declarat within nested declarations and statements.  It gathers characters into a buffer in which the indenting count of each  character is maintained. The characters are being continually emptied from  the buffer as new ones are added.  E PROCEDURE E FUNCTION E LABEL E IN E MOD E DIV E AND E OR E NOT E ARRAY E NOSYMBOL  ,     Ǡ $š7צ *** STRING TOO LONG.F >>  8<$6Ǡ$Ǡ (,tAu P'"D dǠdǠɡ d@$P6ǠǠ(#6ǠǠǠ $ ˡ = = $ ˡ> %ˡ.  $Ǡ6ǠǠ'á6ǠǠ'ˡǠ ǠȡP 6Ǡ   AaǠEE Ǡ$WA*$é$á #Ǡ6ǠǠ$á[á *ˡ )á %  Rء$Ǡ 6Ǡ$á+6ǠǠ ٫$$ÄǠ `Ǡ#6ǠǠ׼Ǡ Ǡ Ǡȡ6Ǡ -BF qhc36AW."(*,  ]á G $\%RFHw*z *ˡ)á%  $   %dǠdǠϫ`>˄ >áNWL  ( (~ڹi+ëp-ëi+ëܩ*)ܓ (*5-ë۩ۓcc-AS& |k\O"$@ ˡڹǠɄń*dǠ dǠ ń'dǠrCq  Rڹ  PÍڹccɡūcccc!lcc WccBǠȡ6Ǡ$%"CU^8š 듄듡dǠdǠ6H ȡj ) 0 ̍$%Ä cc($3%3ȡ ccقš bǠڢ< š Ǡ ڢ dǠ dǠ/š Ǡ ڢdǠdǠǠǠȡ Ǡ 2á-ɡ(C   CH  1 bǠآآdǠdǠ@C /C C Ccc%$`dǠۢdǠؚdǠ"/8` bǠآآdǠdǠǟȡ N6  %bǠآآdǠdǠFšɡ CbǠ&ǡšɡ ] dǠɡzǠš ] Ǡ ǠáXٕ  'š'*š  š] ȡ"$"$ȡ$"$$" """"""i &&&ǠǠ Ǡ dǠš dǠP ccš#cc  $!á 5cc !dǠ $!á !dǠcc (S ~Ǡ !dǠ!dǠ dǠNdǠšq $$áZ bǠڢdǠɡ ڢdǠdǠdǠ$ˡ  $á!dǠ $ˡT $$ á: dǠdǠ dǠ  %"צ3Welcome to the P a s c a l F O R M A T T E R.<Ǡ Please type input file name --> ׯC"Ǡš%Oops, something's wrong. IORESULT *-@'-dǠdǠdǠdǠdǠdǠ HdǠ Ǡ &cc!cc cccccccc ǠǠǠȡ6*$á'$ $áY""ǠSǠVSVȡ SSUT!dǠSǠ"!dǠ Kx ץ30$d-0 $á !dǠ %Ä# CASE Ǡ.$ ޹a <9f,UǠ!dǠN0LrMB,c%٨P&Ǡš &ǠǠ&"$Ä"$á0$á-$ccU $á !dǠ$ˡX&ǠT Ǡ]T]ȡ? ^^ȡ+T 6T ǠTTǠ $á $GX&ǠVUUXX&ccU$áǠT Ǡ]T]ȡ&T 6TǠTTǠUX& X&ǠVUUXX&ccUV\WX&cc:&WǠɡ/VWXX&ǠVVUUWX&ccǠT Ǡ]T]ȡ&T 6TǠTTǠ $áX& X&ǠVUXX&cc\WX&ccá%áک|R٨PV\U!dǠ&W#AbǠ]]]dǠ]ɡ]dǠ  $"ǠT Ǡ]T]ȡ&T 6TǠTTǠ $á XقVUUXX&cc\%ǠXX VǠUVWX&ccX& $\HáXXWX&Xcc\ ګ$Ǡ ǠǠ̀ʀȡ6ǠǠ'+LHT X&XX$ˡT "%áTǠǠUU$ˡ $ˡX&Ǡz$ǠǠ̀ʀȡǠ6ǠǠ $6Ǡ(6Ǡ*Ǡ Ǡ Ǡ̀ʀȡ? ̀ʀȡ*6 Ǡ Ǡ $ %6Ǡ*6Ǡ)Ǡ ǠǠR $ á $!á $á  $á !dǠ"!dǠ 8LUiɡ ccV؂VەVbǠǠɩ&ەǠɄ\\&U؂UbǠǠؑdǠ$á dǠ < 4vx  "$&(*,.2  >!dǠ !dǠ4SSȡ   SSȡ< TTȡ) 6Ǡ$ˡdǠ$rh dǠ% áȡ Ǡ$%$ˡ dǠ$@$xš`0QbǠݢ܂dǠɡ ݢdǠdǠ=  צ(To exit the program, just type .á 0 THEN Write (Outfile, Blanks: I); 6TestNo := LineNumber; I := 0; 6REPEAT TestNo := TestNo DIV 10; I := I + 1; 6UNTIL TestNo = 0; 6Write (Outfile, Zeroes: (6 - I), LineNumTH UnWritten [Oldest] DO $BEGIN &IF CharCount > BuffSzP1 (THEN BEGIN *IF ChIsEndLine ,THEN BEGIN .IF IndentAfterEOL < 0 0THEN BEGIN 2Write (Outfile, Blanks: - IndentAfterEOL); 2OutputCol := OutputCol - IndentAfterEOL; 0END 0ELSE BEGIN t; "StatementTypeOf [RepeatSymbol] := RepeatStatement;  END (*ConstantsInitialization*);    PROCEDURE WriteA (Character: char);  VAR I: Width; %TestNo: Integer;  BEGIN "CharCount := CharCount + 1; Oldest := CharCount MOD BufferSize; "WI CaseStatement; "StatementTypeOf [ IfSymbol] := IfStatement; "StatementTypeOf [ ForSymbol] := ForWithWhileStatement; "StatementTypeOf [ WhileSymbol] := ForWithWhileStatement; "StatementTypeOf [ WithSymbol] := ForWithWhileStatemen"FOR I := 22 TO 28 DO PascSymbolName [I] := AlphaOperator; "FOR SymbolName := ProgSymbol TO AlphaOperator DO $StatementTypeOf [SymbolName] := OtherStatement; "StatementTypeOf [ BeginSymbol] := CompoundStatement; "StatementTypeOf [ CaseSymbol] := ame [16] := WithSymbol; PascSymbolName [17] := RepeatSymbol; "PascSymbolName [18] := UntilSymbol; PascSymbolName [19] := ProcSymbol; "PascSymbolName [20] := FuncSymbol; PascSymbolName [21] := LabelSymbol; "PascSymbolName [29] := Identifier; IfSymbol; "PascSymbolName [10] := ThenSymbol; PascSymbolName [11] := ElseSymbol; "PascSymbolName [12] := DoSymbol; PascSymbolName [13] := OfSymbol; "PascSymbolName [14] := ForSymbol; PascSymbolName [15] := WhileSymbol; "PascSymbolNbol; PascSymbolName [ 3] := EndSymbol; "PascSymbolName [ 4] := ConstSymbol; PascSymbolName [ 5] := TypeSymbol; "PascSymbolName [ 6] := VarSymbol; PascSymbolName [ 7] := RecordSymbol; "PascSymbolName [ 8] := CaseSymbol; PascSymbolName [ 9] :="PascalSymbol [27] := 'NOT '; PascalSymbol [28] := 'ARRAY '; "PascalSymbol [29] := 'NOSYMBOL ';  END;    PROCEDURE ConstantsInitialization;  BEGIN "Const1Init; "PascSymbolName [ 1] := ProgSymbol; "PascSymbolName [ 2] := BeginSym[20] := 'FUNCTION '; "PascalSymbol [21] := 'LABEL '; PascalSymbol [22] := 'IN '; "PascalSymbol [23] := 'MOD '; PascalSymbol [24] := 'DIV '; "PascalSymbol [25] := 'AND '; PascalSymbol [26] := 'OR '; [13] := 'OF '; PascalSymbol [14] := 'FOR '; "PascalSymbol [15] := 'WHILE '; PascalSymbol [16] := 'WITH '; "PascalSymbol [17] := 'REPEAT '; PascalSymbol [18] := 'UNTIL '; "PascalSymbol [19] := 'PROCEDURE '; PascalSymbol [ 6] := 'VAR '; "PascalSymbol [ 7] := 'RECORD '; PascalSymbol [ 8] := 'CASE '; "PascalSymbol [ 9] := 'IF '; PascalSymbol [10] := 'THEN '; "PascalSymbol [11] := 'ELSE '; PascalSymbol [12] := 'DO '; "PascalSymbol"NameOf ['>'] := EqualSymbol; NameOf [';'] := Semicolon; "PascalSymbol [ 1] := 'PROGRAM '; PascalSymbol [ 2] := 'BEGIN '; "PascalSymbol [ 3] := 'END '; PascalSymbol [ 4] := 'CONST '; "PascalSymbol [ 5] := 'TYPE '; PascalSymbolh; "NameOf [')'] := RightParenth; NameOf ['='] := EqualSymbol; "NameOf [','] := CommaSymbol; NameOf ['.'] := PeriodSymbol; "NameOf ['['] := LeftBracket; NameOf [']'] := RightBracket; "NameOf [':'] := ColonSymbol; NameOf ['<'] := EqualSymbol; ber: I); 6LineNumber := LineNumber + Increment; 6IF LineNumber > 9999 6THEN LineNumber := LineNumber - 10000; 6Writeln (Outfile); 4END 4ELSE BEGIN 6Writeln (Outfile); 6IF Increment > 0 8THEN BEGIN :Write (Outfile, LineNumber: 4,' '); :LineNumber := LineNumber + Increment; 8END 4END; 2IF IndentAfterEOL > 0 2THEN Write (Outfile, Blanks: IndentAfterEOL); 2OutputCol := IndentAfterEOL + 1; 0END; .ChIsEndLine := false; ,END (*IF ChIsEndLine*) ,ELSE BEGIN Write (Outfile, ch); OutputCol := Outp*WHILE (Character = ' ') AND NOT ChIsEOL DO ,ReadACharacter; *IF NOT ChIsEOL THEN StartNewLineAndIndent (END; &IF ChIsEOL (THEN BEGIN *LeftMargin := 0; StartNewLineAndIndent; *LeftMargin := ActualLeftMargin (END (ELSE WriteA (Character) $END; R I := 1 TO Length DO WriteA (Symbol [I]); $END (*IF DisplayIsOn*); "LastSymbol := SymbolName  END (*WriteSymbol*);    PROCEDURE CopyACharacter;   BEGIN "IF DisplayIsOn $THEN BEGIN &IF WriteColumn > WriteRightCol (THEN BEGIN h > WriteRightCol - WriteLeftCol + 1 4THEN Length := WriteRightCol - WriteLeftCol + 1; 2IndentAfterEOL := WriteLeftCol - 1; 2WriteColumn := WriteLeftCol 0END; ,END (*with*); (END (*then*) (ELSE FOR I := 1 TO NumberBlanksToWrite DO WriteA (' '); &FOWriteLeftCol + LeftMargin + LongLineIndent + 6Length - 1 > WriteRightCol 4THEN Length := 10; 2IndentAfterEOL := WriteLeftCol - 1 + LeftMargin + 4LongLineIndent; 2WriteColumn := WriteLeftCol + LeftMargin + 4LongLineIndent 0END 0ELSE BEGIN 2IF Lengt.WriteA (' '); NumberBlanksToWrite := SymbolGap - 1; ,END; &IF WriteColumn + Length + NumberBlanksToWrite - 1 > *WriteRightCol (THEN BEGIN *WriteA (' '); *WITH UnWritten [Oldest] DO ,BEGIN .ChIsEndLine := true; .IF PackerIsOff 0THEN BEGIN 2IF acket, LeftParenth]) AND (LastSymbol = Identifier) (THEN NumberBlanksToWrite := 0 (ELSE IF (SymbolName IN AlphaSymbols) AND (LastSymbol IN 0AlphaSymbols) *THEN IF WriteColumn <= WriteRightCol ,THEN BEGIN IF DisplayIsOn $THEN BEGIN &NumberBlanksToWrite := SymbolGap; &IF (LastSymbol IN [LeftParenth, LeftBracket, PeriodSymbol]) OR *(SymbolName IN [Semicolon, RightParenth, RightBracket, *CommaSymbol, PeriodSymbol, ColonSymbol]) OR (SymbolName IN *[LeftBr(Infile); ChIsEOL := false; (IF NoFormatting THEN WriteA (Character) &END &ELSE BEGIN FlushUnwrittenBuffer; EXIT (Program) END  END (*ReadACharacter*); s   PROCEDURE WriteSymbol;   VAR I: Width; %NumberBlanksToWrite: OptionSize;   BEGIN ",BEGIN .ChIsEndLine := true; .IndentAfterEOL := WriteLeftCol - 1; ,END; *WriteColumn := WriteLeftCol - 1; (END; $END $ELSE IF NOT eof (Infile) &THEN BEGIN (Character := Infile^; ReadColumn := ReadColumn + 1; (NextChIsEOL := EOLN (Infile); Get 1 ,ELSE BEGIN ReadColumn := ReadColumn + 1; Get (Infile) END (END; "IF NextChIsEOL $THEN BEGIN &Character := ' '; NextChIsEOL := false; ChIsEOL := true; &ReadColumn := 1; &IF NoFormatting (THEN BEGIN *WriteA (' '); *WITH UnWritten [Oldest] DO ghtCol $THEN BEGIN &IF ReadRightCol < MaxReadRightCol (THEN BEGIN NextChIsEOL := true; Readln (Infile) END (ELSE ReadColumn := 2 $END $ELSE IF ReadColumn = 1 THEN &WHILE ReadColumn < ReadLeftCol DO (BEGIN *IF EOLN (Infile) ,THEN ReadColumn := riodSymbol; &WITH UnWritten [Oldest] DO (BEGIN *ChIsEndLine := true; *IndentAfterEOL := WriteLeftCol + LeftMargin - 1; (END; &WriteColumn := WriteLeftCol + LeftMargin; $END  END;    PROCEDURE ReadACharacter;   BEGIN "IF ReadColumn > ReadRi$BEGIN ChIsEndLine := true; IndentAfterEOL := 0; END; "WriteColumn := 0; FOR I := 0 TO BuffSzM1 DO WriteA (' ');  END;    PROCEDURE StartNewLineAndIndent;   BEGIN "IF PackerIsOff AND DisplayIsOn $THEN BEGIN &WriteA (' '); LastSymbol := PeutCol + 1; END; (END (*IF CharCount > *); &Ch := Character; WriteColumn := WriteColumn + 1; $END (*with*)  END (*WriteA*);    PROCEDURE FlushUnwrittenBuffer;   BEGIN "WriteA (' '); "WITH UnWritten [Oldest] DO "ReadACharacter  END (*CopyACharacter*);      PROCEDURE DoFormatterDirectives;   CONST Invalid = -1;  TYPE ParamCount = 1..2; &Params = ARRAY [ParamCount] OF integer;  VAR Specification: Params; %FormatOption: char; %PrevDisplay, PrevNoFormatting: boolean; %EndDirectiv: CharSet;    PROCEDURE ReadIn (N: ParamCount; VAR Specification: Params);   VAR I: ParamCount;   BEGIN  FOR I := 1 TO N DO $BEGIN &WHILE NOT (Character IN (Digits + EndDirectv)) DO CopyACharacter; &Speci"REPEAT WHILE Character <> '*' DO ReadACharacter; ReadACharacter "UNTIL Character = ')'; "ReadACharacter; LastSymbol := comment; ReadSymbol  END;     PROCEDURE DoComment;   VAR I: OptionSize;   PROCEDURE CompilerDirectives;  BEGIN REPEAT  END (*DoFormatterDirectives*);      PROCEDURE ReadSymbol;   CONST ReadNextCh = true; 'DontReadNextCh = false;  VAR TestSymbol: Alfa; %CharNumber, I: Width;     PROCEDURE SkipComment;  BEGIN tting :THEN WriteA ('-'); 6END .END (*case*) *END (*boolean parameters*) &END (*main case statement*); $END (*then*) $ELSE IF NOT (Character IN EndDirectv) THEN CopyACharacter "UNTIL Character IN EndDirectv; "IF Character = ']' THEN CopyACharacteranted := SavedBunch StartNewLineAndIndent; WriteA ('('); >WriteA ('*'); BunchWirectv); ,IF Character IN ['+', '-'] .THEN CASE FormatOption OF 0'B': IF DisplayIsOn THEN BunchWanted := Character = '+'; 0'C': PackerIsOff := Character = '-'; 0'D': BEGIN 8PrevDisplay := DisplayIsOn; 8DisplayIsOn := Character = '+'; '] + EndDirectv))  '>') DO :CopyACharacter; 8IF Character = '>' THEN Increment := - Increment 6END .END (*case*); *END (*Next 2 letters*); ('B', 'C', 'D', 'F': *BEGIN ,REPEAT CopyACharacter ,UNTIL Character IN (['+', '-'] + EndD AND (Specification [2] - :Specification [1] > 8) 8THEN BEGIN :ReadLeftCol := Specification [1]; :ReadRightCol := Specification [2] 8END; 0'N': BEGIN 8LineNumber := Specification [1]; 8Increment := Specification [2]; 8WHILE NOT (Character IN (['<0'W': IF (Specification [1] > 0) AND (Specification [2] < :BufferSize - 2) AND (Specification [2] - :Specification [1] > 8) 8THEN BEGIN :WriteLeftCol := Specification [1]; :WriteRightCol := Specification [2] 8END; 0'R': IF (Specification [1] > 0) [1]; 0'S': StatmtSeparation := Specification [1] .END (*case*) *END (*1st 7 letters*); ('W', 'R', 'N': *BEGIN ,ReadIn (2, Specification); ,IF Specification [2] <> Invalid .THEN CASE FormatOption OF amesWanted := Specification [1] > 1; :EndCommentsWanted := Odd(Specification [1]) 8END; 0'G': SymbolGap := Specification [1]; 0'I': IndentIndex := Specification [1]; 0'L': LongLineIndent := Specification [1]; 0'P': ProcSeparation := Specification 'S': *BEGIN ,ReadIn (1, Specification); ,IF (Specification [1] < WriteRightCol - WriteLeftCol - 9) 0OR (FormatOption = 'P') .THEN CASE FormatOption OF 0'A': DeclarAlignment := Specification [1]; 0'E': IF Specification [1] < 4 8THEN BEGIN :ProcN END (*ReadIn*);    BEGIN (*DoFormatterDirectives*); "EndDirective := ['*', ']']; "REPEAT IF Character IN ['A'..'G', 'I', 'L', 'N', 'P', 'R', 'S', 'W'] $THEN BEGIN &FormatOption := Character; &CASE FormatOption OF ('A', 'E', 'I', 'G', 'P', 'L',fication [I] := 0; &IF NOT (Character IN EndDirectiv) (THEN *REPEAT ,Specification [I] := 10 * Specification [I] + ORD (Character) .- ORD ('0'); ,CopyACharacter *UNTIL NOT (Character IN Digits) (ELSE Specification [I] :