`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JO^ӡӡz OTHELL2.TEXT^ozOTHELLINIT.TEXTBLACKJACK.TEXTo DEBTS.TEXTE^o STORE.DATAE^oPPSCAL20*PROSE.DOC1.TEXTӡ*NPROSE.DOC2.TEXTNp PROSE.CODEE^op|UNIVERSAL.TEXTo|POLICY.DOC.TEXT㡎CATALOG.3.TEXTo CHASE.TEXTE^o OTHELLO.TEXT^oz OTHELL1.TEXT^o&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&A General Look at Directives  %In its default mode, Prose automotically fills and justifies output  lines, and formats the output in pages. Directives are needed to instruct  Prose to do anything more fancy. There are directives to change the marg rest o the miscellaneous options that affect the  text formatting process.   Of these six groups, the INPUT, MARGIN, OPTION, and PARAGRAPH settings are  likely to be changed oten throughout the text. There will probably be a small  numbe running text will (be inserted. This includes where to print titles, footers, and the (like. %4) MARGIN sets the left and right margins %5) PARAGRAPH describes special actions for the beginning of each  paragraph. %6) OPTION conrols the %1) INPUT controls the meaning and treatment of characters on the input  file. %2) OUTPUT describes the type of output device for which the formatted  result is intended. %3) FORM specifies the format of the page into which thel the options and  specifications that direct Prose as it produces formatted otuput from  unformatted input. The concepts that make up the formatting environment can  be loosely grouped into six areas, and there are directives to control each  one: set to 10 and the right margin to 70. Then, the margins are squeezed together  by 5 characters on both sides. " *.MARGIN( L10 R70 ) *.MARGIN( L+5 R-5 )  %  Controlling the Formatting Environment  %The formatting environment is defined to be alny directives, a  relative value may be used. This is indicated by a plus or minus sign before  the integer, and indicates that the old value should be incremented or  decremented by a certain amount. In the following example, the left margin is  %4) A specification enclosed in parentheses, which consists of descriptors  defined by the directive itself.  %When a numeric value is required (for a parameter or as part of a  descriptor), an explicit positive integer may be given. In maparameter, default values are used.  There are four forms for the parameter:  %1) The absence of any parameter. %2) A single numeric value. %3) The remainder of the directive line. e begins with the name of the command, for instance  "MARGIN". The name can always be abbreviated to three letters, and in fact,  only the first three letters are examined by Prose. The name may be followed  by a parameter, but in the absence of a  *.FORM( [ /// L58 // #73 `PAGE' P /// ] *+ [ /// L58 // `PAGE' P /// ] )  Although the examples in this writeup will usually show directives typed  entirely in upper case, upper and lower case letters may be intermixed.  %Every directiv and so no other directives can follow these. Long directives may extend to  several lines. Continuation lines are indicated by a plus sign ( + ) typed in  column one. The continuation may be made anywhere that a blank is allowed.  For example: on the same line, provided that they are  separated by the directive escape character. For example:  *.BREAK.SKIP 2.MARGIN( L5 R65)  Some directives, however, take the remainder of the line as their parameter, ve escape character (although you can change it if you wish)  because it seems very unlikely that anyone would want to type a period in the  first column of a line of test. The entire line is scanned for directives.  Several directives can be typedins,  to control options, and to define the type of output device you intend to use.  %A line of directives is indicated by typing the directive escape  character in the first column of an input line. The period was chosen as the  default directir of different settings, and it will be convenient to be able to resume  old settings. To accomodate these needs, a simple device is available fo  these four directives.  %When setting the options controlled by these directives, the following  syntax is used:  *.directivename( parameters )   where the parameters consist of a key letter followed by option settings. For  instance:  *.MARGIN( L5 R60 )   sets the left margin to 5 and the right to 60. Each time one of these four  ds the page format, including titles, footers, date/time, and the top  and bottom of the page. The argument consists of parameters, followed by (if  appropriate) an optional field width. For example "T:30" prints the title in a  field of 30 characte  %Sets the page counter. The numeric parameter can be relative. For  example, ".COUNT +1" increments the page number by one. In the absence of a  parameter the default is to set the page number to one.   FORM ( parameters )  FORM  %Define%Prose treats the remainder of the directive line as a comment, i.e. it  is ignored. The COMMENT directive allows you to include in the source of your  document information that will not be printed on the formatted copy.  %  COUNT number  COUNTtifying  environment.  %( ... ) indicates that the parameter is enclosed in parentheses and is  described in detail along with the description of the directive itself.   BREAK  %Causes a justification break.  %  COMMENT  line  UNDENT undent following line * numeric  WEOS write end of section * -none-  %The directives marked with an asterisk ( * ) cause a justification break  before they are processed, since they affect the filling and juso print * ( ... )  SKIP skip output lines * numeric  SORTINDEX sort and print index * ( ... )  SUBTITLE set the subtitle remainder of line  TITLE set the main title remainder of OUTPUT set output parameters ( ... )  PAGE eject to top of page * numeric  PARAGRAPH set paragraphing params ( ... ) or numeric  RESET reset directive defaults * ( ... )  SELECT select pages t remainder of line  LITERAL print literal text remainder of line  MARGIN set margins * ( ... ) or numeric  OPTION set options * ( ... ) or numeric et page count numeric  FORM define page format * ( ... )  INDENT indent following line * numeric  INPUT set input parameters * ( ... ) or numeric  INX store index entry evious values: left 0 and right 70.   Short Directive Table   Directive Meaning (action) Break Parameter type  BREAK break justification * -none-  COMMENT no action remainder of line  COUNT s decremented when no parameter is given, the kep buffers can be used as a  stack.  *.MARGIN( L0 R70 )  -...  *.MARGIN( L10 R60 )  -...  *.MARGIN   In the previous example, the last MARGIN directive resets the margins to their  prmeter is specified, the values are set to those that were  stored in the numerically previous keep buffer. Since the keep number is  automatically incremented when the parenthesis form is used and automatically values are saved in the numerically next buffer.  %Old values may be recalled by using the following form:  *.directivename number   For example:  *.MARGIN 5   sets the margins to the values that were stored in keep buffer 5.  %If no parairectives is processed, Prose saves the new values in a keep buffer. There  are ten keep buffers (numbered 0 through 9) associated with each of these  directives. A keep parameter may be used to specify which buffer to use, but  if not specified, the rs. Text lines are built by the FORM directive from left  to right, starting in the first printable column, although the tabbing  specification may be used to alter that. The following table describes the  FORM specifications that are available.   key char meaning default field width #C 24 hour clock as hh.mm.ss (15.37.58) 8 #D raw date as yy/mm/dd (78/02/13) 8 #E nice date as dd Mmm yy (13 Feb 78) nul $K keep number next no $U underline character character nul $W input width number 150 no  %If a specification is not given, its value is n default relative $B explicit blank character character nul $C case shift character character nul $D directive escape character character . $H hyphenation character character  interpretation of characters on the input file. The parameters can be given  in any order, and consist of a key letter followed by a value. The following  table summarizes the parameters.   key letter meaning type n number of spaces. In the absence  of a parameter, the default is 5.  %  INPUT ( parameters )  INPUT number  INPUT  %The INPUT directive is used to define the input environment; that is, the FORM consisting of a single L specification defining an  infinite number of lines per page. In this mode, the PAGE directive acts as  though there are 5 lines left on the page.  %  INDENT number  INDENT  %Indents the following line by a certaihat defines two pages with two "["s and two "]"s:  %.FORM( [ // T #62 E /// L56 // #63 'PAGE' P /// ] %+ [ // T #62 E /// L56 // 'PAGE' P /// ] )  %In the absence of a parameter, no special page formatting is done. This  is similar to a %It is easy (once you understand the FORM directive) to produce fancy page  formats. For example, you can design a FORM that will print the page number  at the right of odd numbered pages, and at the left of even pages. This is  done with a FORM t until it reaches the top of page.  %The bottom of page specification is where Prose increments the page  number, so of you print the page number both before and after the bottom of  page definition, you will get two different numbers.  t to the output  device when it reaches the top of a page. You can also request Prose to pause  at the top of each page to allow you to change paper. At the end of the  document, Prose does one last page eject, interpreting the FORM specification ne of  the title buffers with the TITLE or SUBTITLE directives will change the title  or subtitle on the next page.  %The top of page definition is used for several things. By using the  OUTPUT directive, you can request Prose to send a page ejec#] define bottom of page # #default form: '.FORM( [ // T #62 E /// L56 // #33 '- ' PN:1 ' -' /// ]) # %The FORM directive is processed interpretively. This means that the  format is re-scanned as each page of output is producwd, so changing oas hh:mm AM ( 3:37 PM) 8 7or hh:mm PM ##n tab forward or backward to absolute column n #"..." print literal text #`...' print literal text #/ print an end of line #/n print -n- ends of lines #[ define top of page be expanded +R upper case roman numerals if needed] +r lower case roman numerals #S subtitle its length #T main title its length #W wall clock 9 #Ln fill in n lines of running text #Pf current page number, f selects the form 3 +N or n arabic numerals (default) [the field +L upper case letter width will +I lower case letter ot changed. The default  value is the one that will be set if the key letter is given by itself, and is  also the value that is assigned when Prose begins processing.  B: The explicit blank character indicates that Prose should not tamper with. #Thus, if the cross hatch ( # ) is specified as the explicit blank: # (.INPUT( B# ) # #then two words that are separated by an explicit blank: # (Mr.#Smith #will neverre. #   W: The input width is used to specify how many characters will be read from #each input line. If your input lines have sequencing information at the #right of each line, you will need to set the width to an appropriate value. #    INcifies which keep buffer should be used to #store the new input options. The default is to use the numerically next #buffer. #   U: Text surrounded by the underline character will be underlined. Blanks are #not underlined, but explicit blanks a#adding a superfluous hyphen. If Prose is forced to insert more blanks than #a certain threshold (set with the OPTION directive), it will issue a #message suggesting that you insert hyphenation characters. #   K: The keep parameter explicitly speion" as "syn/co/pa/tion". Prose #will insert a hyphen ( - ) only when the characters on both sides of the #hyphenation point are letters. You might type "hyper-active" as #"hyper-/active", and Prose will split the word, if necessary, without le boundries within that word. Of course, not all the #syllable boundries need by specified, only those where you want Prose to be #able to split a word. For example, if the hyphenation character is set to #the shash ( / ), you might type "syncopate. #   H: The hyphenating character is used to define hyphenation points within #words. Sometimes a long word will cause many blanks to be inserted to #justify the preceding line. Prose will hyphenate such a word if you have #defined the syllab#upper-case-only input. It is recommended that if possible, you use mixed- #case input to create mixed-case output. #   D: The directive escape character is the character you type in the first #column of an input line to flag it as a directive lin the word with two case shift characters, causing a shift-up/shift- #down (^^LLAMA and ^^OOPS). Keep in mind that the case shift character does #not need to be used unless you want to create a mixed-case output from roud as all that. # #At first glance, the stuttering method may seem clumsy, but experience #shows that it is reasonably easy to get used to. To enter wrods that #already have a double letter at the beginning (like llama and oops), merely #preceedID AALICE. "^Y^OU (NEEDN'T BE SO PROUD AS ALL THAT." 0 #Output from Prose: # (The Mock Turtle went on. 0"We had the best of educations--in fact, we went to school (every day--" 0"I'VE been to a day-school, too," said Alice. "You needn't (be so p#production of mixed-case output from upper-case only input. # #Input to Prose: # .INPUT ( C^ ) (TTHE MMOCK TTURTLE WENT ON. 0"^W^E HAD THE BEST OF EDUCATIONS--IN FACT, WE WENT TO SCHOOL (EVERY DAY--" 0^"I'VE^ BEEN TO A DAY-SCHOOL, TOO," SAn. Since most upper case letters are at the beginning of a word #(following a blank), the second method, called stuttering, is to double the #first character of the word. The following example demonstrates the cifiec, Prose #automatically shifts all upper case letters to lower case. To specify an #upper case letter, one of two methods may be used. The first method is to #surroung letters with the case shift characters, causing a shift-up and #shift-dow be split from one line to the next, and Prose will never fill #blanks in between the words to justify a line. #   C: The case shift character must be used to create mixed-case output from #upper-case-only input. When a case shift character is speX text %Enters the remainder of the line together with the current page number as  an index entry. This means that as the formatted text migrates from page to  page, the resulting index will always be correct.  % %  LITERAL text  %Prints the remainder of the line on the output file. The special  processing for upper/lower case, underlining, and literal blanks is performed  on the text of the parameter, and then it is printed as a single output line.  The output line is prioff. key letter meaning type default relative allowed $E print error messages switch + F fill output lines switch + $J justification limit numeric 3 no $K s )  OPTION number  OPTION  %All the miscellaneous options that affect the text formatting process are  gathered together in the OPTION directive. These options are summarized in  the following table. For switch options, "+" means on and "-" is  also the value that is assigned when Prose begins processing.  %The Keep parameter explicitly specifies which keep buffer should be used  to store the new margins. The default is to use the numerically next buffer.   OPTION ( parameter right margin number 70 yes  %If a specification is not given, its value is not changed. The default  value is the one that will be set if the key letter is given by itself, and is lowing  table lists the parameters.  key letter meaning type default relative allowed $K keep number next no $L left margin number 0 yes $R in is the column number  of the last printed character. Thus, subtracting the left margin from the  right margin gives the number of printed columns. The parameters may be given  in any order, and consist of a key letter followed by a value. The fol  MARGIN ( parameters )  MARGIN number  MARGIN  %The MARGIN directive is used to set the left and right margins for  filling and justifying. The left margin is the number of leading spaces  before the first printed character, and the right margO^㡓or example,  %.LITERAL T   sets a print density of 8 characters per inch on some CDC line printers.  nted independently of filling and justifying and page  formatting processes; it is transparent to the usual Prose formatting and is  not counted as an output line. The LITERAL directive is useful for producing  special printer control characters. F keep numeric next no $L left justify switch + $M multiple blanks switch + $P 2 blanks after periods switch + $R right justify switch + $S spacing numeric 1 no $U shift to upper case switch - $ %If a specification is not given, its value is not changed. The default  value is handy for printing large #sections, such as sample programs, all in upper case. #   OUTPUT ( terminal-type parameters ) %The OUTPUT directive defines important aspects of the output device that  is the destination of the formatted text.all lower case letters to upper case by selecting the #Shift to Upper Case option. This is of particular interest to CDC users, #for whom lower case letters are interpreted as two characters when sent to #certain output devices. This option is also S: By setting the Spacing option, you can easily produce single, double, or #triple spaced output. Simply set the Spacing option to 1, 2, or 3. #  U: Since some output devices are not able to handle mixed-case files, you can #cause Prose to shift separated by #two blanks without requiring you to be extremely careful about typing the #original text. [NOTE: what we REALLY need is the option to have two blanks #after colons, too, which the UCSD editor removes if in the filling mode.] # n is selected, then Prose will make sure #that each period which is followed by at least one blank will be followed #by at least two blanks. Prose will not add blanks before justifying if #there are already two. This makes it easy to have sentencese input file, there will be at least that many on #the output file, but Prose may add more blanks during the justification #process. If the switch is off, multiple blanks will be changed into a #single blank. #  P: If the 2 Blanks After Periods optio#is one straight margin (either left or right) and one ragged margin. #  M: If the Multiple Blanks Switch is on, multiple blanks on the input file are #considered to be significant. In other words, if there are several blanks #between two words on thdone. If both switches are on, output lines are justified #to both the left and right margins. If both switches are off, lines are #centered between the two margins. If one is on and one is off, the result p parameter explicitly specifies which keep beffer should be used to #store the new options. The default is to use the numerically next buffer. #  L:  R: The Left and Right Justify Switches work together to determine what kind of #justification is ed when Prose inserts enough blanks to bring the #number between any adjacent words to three. If hyphenation is not #possible, or Prose is not able to bring the number of inserted blanks below #the limit, an error message is printed. #  K: The Kee#insert blanks that are not explicitly on the input file. The Justification #Limit controls the point at which Prose will attempt to hyphenate a word. #If, for instance, the justification limit is three, then the hyphenation #process will be invoke input lines as they are, #without reformatting to fill up the output lines. In effect, a #justification break is done after each input line. #  J: In justifying the left and right margins of an output line, Prose has to suppressed by setting the E option #to "E-". #  F: Output lines are automatically filled and justified as described in the #section "Basic Units of Text" [NOTE: not present in this abstract]. If the #Fill Switch is turned off, Prose will print ththe one that will be set if the key letter is given by itself, and  is also the value that is assinged when Prose begins processing. #  E: Error messages are printed on the main output file, interspersed in the #formatted text. These may be entirely The OUTPUT directive may be used  only once, and must appear before any lines are printed on the output device  or immediately following the directive ".RESET( OUTPUT )".   "Terminal-type" may be one of the following; the default is ASC:  ASC ASCII terminal, using carriage return for overprinting and form feed  for page eject. A teletype is called an ASC terminal although the  form feed will not cause a page eject. This is not a problem if the  ej automatic indent number 0 no $K keep number next no $N number generator none $P automatic page eject number 0 no $S ic skip and/or automatic page eject can be specified, and  you can even have Prose automatically number the paragraphs. key letter meaning type default relative allowed $F paragraph character character nul $I %The PARAGRAPH directive specifies what is done when a new paragraph is  aignalled by typing a special character (called the paragraph flag character)  in the first column of an input line. An automatic indent or undent can be  selected, an automat of the following methods: one or  more blank lines, leading blanks at the beginning of an input line (ie,  indentation), or by the .BREAK directive. The PARAGRAPH directive provides a  more versatile method of creating paragraphs.  re fewer than the specified number of lines  remaining on the current page. If no parameter is given, PAGE does an  unconditional page eject.  %  PARAGRAPH ( parameters )  PARAGRAPH number  PARAGRAPH  %Paragraphs can be indicated by any not have underlining ability and your #input does underlining, the Underlining Available option should be turned #off to prevent Prose from trying to generate overprinted underlines. #   PAGE number  PAGE  %Causes a page eject if there a#wait for a carriage return to be entered. #  S: All output that Prose produces can be Shifted to the Right by any number of #spaces up to 50. This makes it easy to center the output on a wide printer #page. #  U: If the destination terminal doesse option is selected, every time the "[" is encountered in the #FORM specification, Prose will stop printing and wait for some operator #acknowledgement. On an ASC or AJ terminal, Prose will sound the bell, and the right numeric 0 $U Underlining is available switch + $  E: If the Page Eject option is selected, a form feed or "1" will be printed #every time the "[" is encountered in the FORM specification. #  P: If the Pauletter meaning type default $E Page eject at top of page switch - 1("[" in FORM description) $P Pause at top of page switch - $S Shift output lines to*pitch (in characters per inch), e.g., "AJ 10".  %The parameters define further characteristics of the output device, and  several global output options. The parameters may be given in any order, and  are selected from the following table.  key  the output will be printed more slowly. For this reason, it is *recommended that ASC be used for drafts, and AJ only for the final *version. The AJ may be followed by a number specifying the desired ro users, *forget about LPT.]  %AJ Anderson/Jacobson terminal, using 1/60th of an inch increments for *justification. ASC may be specified for an AJ terminal, but the  result will not have as high quality. If AJ is selected, however, ect option (see below) is not selected.  %LPT Line printer, using "+" for overprinting and "1" for page eject. Carriage control is supplied automatically by Prose, and so like any *other terminal, column 1 is the first printing column. [Micautomatic skip number 0 no $U automatic undent number 0 no $ %If a specification is not given, its value is not changed. The default  value is the one that will be set if the key letter is given by itself, and is  also the value that is assigned when Prose begins processing.  F: The Paragraph Flag Character is used to invoke this collection of #paragraphing actions by typing it iinted result, resetting either  of these directives also causes a page eject.  %  SELECT ( parameters )  As documentation is revised, not every page changes. The SELECT  directive may be used to print only certain pages. The entire t the action is different. Resetting COUNT sets the page  counter to 1; resetting INX deletes all index entries that have been  accumulated; and resetting PAGE causes a page eject. In addition, since  resetting FORM or OUTPUT directly affects the pr%The values of parameters for most directives are set to their defaults  (which are listed with the description of each directive) with the exception  of the keep parameters, which are set to "K0". For the COUNT, INX, and PAGE  directives, however, are selected from the following list of directive  names:  COUNT FORM INPUT INX (MARGIN OPTION OUTPUT PAGE (PARAGRAPH SELECT SUBTITLE TITLE  (.RESET( MARGIN OPTION )  only resets the MARGIN and OPTION directives. Directives may also be excluded  selectively, e.g.:  .RESET( EXCEPT FORM OUTPUT )  resets all directives with the exception of FORM and OUTPUT.  %Parameters for RESEThanged the values of many directives (such as FORM, MARGIN, or  OPTION), the single command: (.RESET  resets the values of all directives to their defaults. Directives may be  reset selectively by using the second form of the command. For example: #store the new paragraph options. The default is to use the numerically #next buffer. #   RESET  RESET ( parameters )  RESET ( EXCEPT parameters )  %The RESET directive is used to set directives to their default values.  If you have c#  S: The Automatic Skip is done before the first line of the paragraph, and #functions the same as a SKIP directive. #  K: The Keep parameter explicitly specifies which keep buffer should be used to the first line of the paragraph. If this parameter is set to 4, for #instance, it will ensure that at least four lines are left on the page. If #there are fewer lines that specified, a page eject is done. The is applied #after the automatic skip. &l lower case letter &R upper case Roman &r lower case Roman  #N is the field width, which will be expanded if needed.   P: The Automatic Page Eject is used to simulate the effect of the directive: (.PAGE number #before #The number replaces the paragraph flag character when the line is #formatted. The number generator parameter has the form: Nfn . # #f selects the numeric form: # -blank- no numbering &N or n arabic numerals L upper case letterrance of the paragraph flag character. The number #generator is initialized to 1 each time new PARAGRAPH settings go into #effect, but resuming an old setting will also resume the old numbering. ph (see the description of INDENT and UNDENT). If the number #generator is used, the indent or undent is applied after the number is #generated. #  N: If the Number Generator is specified, a new number (or letter) will be #generated for each occurn the first column of an input line. #Note that this character should be set in at least one PARAGRAPH directive, #or none of these actions will work. #  I:  U: The Automatic Indent or Automatic Undent is applied to the first line of #the paragraext will be  formatted, but only selected pages will be printed. Thus, the central  processor time used will not be reduced very much, but printing time will be.  The descriptor consists simply of page numbers separated by spaces. To select  a span of pages, two numbers are typed together, separated by a colon ( : ).  The second page number may be specified relative to the first. The following  example selects pages 3, 5, 10 through 15, and 20 through 25 to be printed: (.SELECT( 3 5K ڤaġ aA(ڤZȡ aA(ۤ۹ r   "$&(*,.02468:<>@BDFHJLNPRTVXx\`bdz"*A PROSE rites a  CDC end-of-record-mark. Specifically, this directive is used to create  indexed writeups at the University of Minnesota. ble column.  %  WEOS  %Write an end-of-section to the output file, This directive is useful for  creating multiple section writeups under systems with utilities that  manipulate multiple section files. In the CDC version of Prose, WEOS we name "outdent" or "hanging indent". A line can never  be undented past the leftmost column of the printer page, and so a large  number is adjusted to a smaller value. In the absence of a parameter, the  default is to undent to the leftmost printa%Enters the remainder of the directive line into the title buffer. The  title buffer is used by the FORM directive.  %  UNDENT number  UNDENT  %Undents the following line a certain number of spaces. The undent is  sometimes known by th are used.  %  SUBTITLE text  %Enters the remainder of the directive line into the subtitle buffer. The  subtitle buffer is used by the FORM directive.  %  TITLE text  (blanks printed after) $S 1 sorting option. If this is numeric, it is the first 8significant column for alphabetical sorting. If it is 8the letter "P", it selects sorting by page number.   In the absence of parameters, the defaultsaning $L 2 left width of page number (field width for number) $M 0 margin (left margin before index line) $P 0 column (in index entry) to insert page number $R 2 right width of page number leading blanks to print at the left of each index line, where to insert the  page number in each line, and how to format the page number. The parameters  may be given in any order, and are selected from the following.   key letter default me can be sorted  either alphabetically or by page number, and then printed in a fairly flexible  manner. The SORTINDEX directive allows you to specify what column is to be  considered the first significant column for alphabetical sorting, how many the top  of a page, at least one actual blank line must preceed the SKIP directive. In  the absence of a parameter, 5 lines are skipped.  SORTINDEX ( parameters )  SORTINDEX  %The index entries that are accumulated by INX directives 10:15 20:+5 )  The default is to select all pages to be printed.   SKIP number  SKIP  %Skips a certain number of output lines, i.e., prints blank lines. SKIP  will never print blank lines at the top of a page, so to skip lines athjlnprtvxz|~ ۫c  ɡؚ$ ع  0 áA áġ M DŽġD M DŽ'ġ D ǐġ C D ǐdġ C dZġ X C Z2ġ L 2(ġ X L ( ġ X  ġ I X ġ V ġ I V ġ I   $ قšȡ%  áA áܫ@ &צkצ,&&P&&&ؕPPצ.TEXTUq.s` @šn ] ZSArP[áXáɡI@M \ ܩOɄAښA ȡA A á  ] A+Ä ˡ A] A\ šA ńP0XةPÄXȡ X; TةXšXȡ *Ʃxˡxť WW1RXɡ5XšrP[˩XȄȡ ˡáˡ ]| - 7a"$&(*,.02468:<>@BDF NPRTVX\^`dflnZrtv@zثc rXȡ?P0٩0ˡ `ܤ8ەȡ ȡ`ܤ䥏"^ɡ ݫ^䩍_š7)\á1  ˡ0š rRީ0QP[á0䩍_šǀ6M \rPؤ ؤع楊䥊䥇 䩍_šX: ÍN^ ^_š^_TtÍܤɡ'ڕȋvš^^ؚ^ ^_š^_Rڨ خɡ$ٶȡ5ٕȡ ȡ0T x__^ˡ-ǀʁ   v  oKz9xXPQPrP"0 0ġ3 Jٸ:á ɡظ(^^^́ʁȡá́ʁȡ́ʁ ˡ[ˡKܩܩɄ́ʁȡ Xd0 0 0ʁ ʁŢ Ḿʁȡ?́ʁ á!ʁŢ ́ʁȡ )_ ʁʁ  ʁŢ ˩:ޫ ǀ+ !  váoˡ8́ʁȡ*́ʁoáʁ ʁŢ w'XˡXX8á.ġ)70XˡXXšXˡXX"R d7 ń á Ä쓡ˡ́ʁȡ`́ʁݚL ^ Vf_  ?rġ8܊ƥ1ܤޢ ޢ ڂڕ9ƥ1ݢ ݢ ۂݢ ݢ  7 ȡádá@ åۤ ۚ  ۚ ߚ  ȡA۩á# ۚšTġDáaA  RȡDáaA  M$9{0L2 Z   ġá7YY A0YAYY@ūnn An A!@n!V  $""W؂ɡ 2#R Rآoآآ آآ OR$R REآoآˡآ˫\آ آآ OQj%S ǗɩSآ W ;-)á-ǒء[;Xp :̀ƀ2ƀ?ʀ<š<̀ʀ̀ʀ<ʀߚʀ=̀ʀ̀ʀʀȡʀʀʀʀ̀ʀ̀<̀ʀʀȡʀʀʀ̀PáʀેP Q>ʀʀેQ?u <(áJLPRVZ\`dfj ثc-)á-.*-P _0U+ UU+/ETX900R0ؚ;0(ái-)˩nC;ة[˄ %-R0ٮ2á-Ǔع0/ c0[ _0U /3d00de00[vt Ul   "$&(*,.02468:<>@BDF   "$&(*,.02468:<>@BDFHJNPRTVXZ\^`dfjn ثc)á-vvX +:>}8U (á-UU)˩n-ؤ1ȡ 3á U`1[ á-0  < W \\Y)˩n쩄-ؤعF.\.2(0v.0zx Wpx.wus Ul   "$&(*,.02468:<>@BDFHJPRT^`dj} ثc)á-(' 0TTT))?eNR7Xɡ詄(á- ˩n&' Ǘ0SSS'W CoE|b6(á-TT)˩n-ؤع..p 0 0T.V..^. 0SS)˩n-ؤع7 Ǘ0SW0WF0pn Rf   "$&(*,.02468:<>@BDFHJLNPRTV\^`bdثce)á-f ǘWǙ(*,.02468:<>@BDLNPTVZ\^`bdfhjn ثcM)á-N$' 0RRR%)?QNRn42̀ʀȡ ةoá 1J5(á-ˍ ܤ ˍRh3(á-RR)˩n-ؤعg/o/ˡ ث˫\./ / 0R/ǖ ǂ0Ozx Wp   "$& - ȡ ȡ  : 1!˩nEá !!/ɡ'! -T `2 ڤ  ܤ ˥ ܤ  +-". ˡ -/ Ą  -+ - 0ġ-+á߂ߕɡR0: ȡ'ȡxwl)U _U آآ[آآ آآ V*U _U3 [آآ آ 1Z+n+Ä -0&S ǗɩSآ W i6'T ݩTpآ V^آ xwb(T ݩTDpآ V^آ -)ˡ~ á-qX13سl_ؗ-áڡǻd áǶǼ cDZ-١n- Xɡ1A =(á-ȡ7)˩noM0:á+-0ȡ7 7 ˡ c)á-ȡ7!o>(á-) JbSHIFTHUJUSTIFICATION LIMIT J9 SPACING I'3B G<"t\Q7 OF H_ɡ- H___ IS TOO Ib SMALLH LARGEH, H`  USEDH KKEEP HRIGHT MARGIN JLEFT MARGIN JWIDTHH INDENT INUMBER WIDTH JSKIP H LEFT WIDTH I MARGIN IPAGE COLUMN JRIGHT WIDTH J~SORT COLUMN GROUP J"EXCEPT" MUST BE FIRJST HDIRECTIVE NOT ALLOWEJD: H ȡ7٥d٢ HAJ PITCH MUST BE 10 JOR 12H! iY?%% F%uȡ7٥d٢ BAD NUMERIC FORM JHYPHENATION NEEDED: Jȡ4ɡ,BAD TERMINAL TYPE JMUST BE IN INITIAL DJIRECTIVEȡ0  7JJةcآ  MISSING ) IUNMATCHED QUOTE JPAGENUMBER TOO LARGEJUNDEFINED KEEP BUFFEJR HUNKNOWN DIRECTIVE: J š  GG٩ȡF٩ġ ٩šGF٩ġ 4E٨ȡ0ߢ 7 JH٨ ȡ0  7JI٨   FK@ ^Ʃ.ÄɄWĄ肸šꩇššlšby٢ ȡ4٢ n٢ ٢ ,-٢ ٢ "襏,٩٢  DƩ٢ ٢ ȡ#ťƩ,ťƩ ٢ Wġ1Ś 1Śxš[#ˡ,詊 ]á á ,ũp"ˡA@ ń ˡárɡiy٩蚩š9٢ AA2q`ޥ2W0#DBd 6.gO>>@ ˩n ˡ c-nd,.f=b"v,n]kn]"W á,JáA"šظ>+HB@AB?-13 én-س"عn-0:X0#4<567809=>dǽ0?`ޥɡڢ>ؚآ>ٚPm_T AťƩؚ٢ (Cضˡȡ Cȡڣ<š C Cƥڣ= ȡ Cڣ<ȡC ثcY)á-Z)$(R@??ܢ<ܢ><ȡܢ<ܢ><ȡɡQ>>PPwPQ>؟ˡfأ>Pڣ><Än-ؤ عqǒ0Ǔ0< ǔ0Ǖ0PépÍ -< ǖ0rp Sh   "$&(*,.02468:<>@BDFHJLNPRTVX^`dLa  ---- HɡFORM ERROR: JعLINE TOO LONG J́ʁcʁ fPAGENUMBER TOO LARGEJJBAD NUMERIC FORM J.NO "L" FOUND J $B`ꩁqlY . H́@́ʁʁȡ!ʁAʁʁ́٩@q d MARGIN I OPTION I PARAGRAPH IFORM H SELECT I SORTINDEX IzCOUNTHm INDENT I[aFצ" ***** Prose errors detected *****!T4l"x V $ RzFD8|hvp ! .!"$b&'())b*+++++^,,,---.v../0/*0N/12n22256666 7 ǀ\UXYZ ]na1 ǖ@PQYNZť  E@T?TD]ED"Xɡ7P,ץ&&,,P&&,&ؕ,P,,P,צ.TEXTU,צ$output file, for console ? PáCONSOLE:K,,P,.TEXTU,צPRINTER:0u0u^ؚ[6]Jan]Feb]Mar]Apr]May]Jun]Jul]Aug] Sep] Oct] Nov] Dec]P\'input file(s), for workfile ? &P&צצ*SYSTEM.WRK.TEXT}&,,&P,,Q,Y2Y ۤښ ۤٚ ؚۤ0[BRE[COM[COU[FOR[IND[INP[INX[LIT[MAR[ OPT[ OUT[ PAG[ PAR[ RES[SEL[SKI[SOR[SUB[TIT[UND[WEO[EXC[ASC[LPT[AJ [Z^ښ^ٚ0/  0  0/  0  0      ȡ$^    " ' NnLlRr UNO CLOCK   " tX  0  RSU EPSUW WVWCFIKNPSU L M P R S   + - TW#[]/"' BCDHKUW KLR EFJKLMP   ȡAZȡazȡ09ȡDiVCDELPSHSȡڹmMNOPQR}{Swuȡ7VTRH><:86.uuuqoomkkigeeccFFF>6666Jȡؤ &*DPTpV^xw ȡؤ( PQ X\v4RU[ ȡؤ* ר(ȡr(Q0P_^  S, M\]! Ro. ǖO ȡؤ$ TNPˡPP>PQ$OSWF SKIP HN OUTPUT I<INPUTH/RESETH" ~ncSH8- ERROR: Id2ɡKLR.Rf_ɫbb ښ`š ٚ`8([//T#62E///L56//#33"- "PN:1" -"///] :7737l::;0; L ]1 ǖ@PQYNZť  E@T?TD]ED"Xɡ7O^UNIT UNIVERSAL_IO;   INTERFACE   TYPE BYTE = 0..255;    FUNCTION KeyPress: BOOLEAN;  FUNCTION InPort (PORTNO: BYTE): CHAR;  PROCEDURE OutPort (PORTNO: BYTE; CH: CHAR);  PROCEDURE ClearScreen;  PROCEDURE ClrToScreenEnd;  PROCEDURE ClrToLin  %If we all implemented a UNIT UNIVERSAL_IO, all your application program  would have to say is "USES UNIVERSAL_IO", and you've included all the  necessary functions.  %Here is a partial example of the way someone may implement such a UNIT:    minimal series of functions, which we would all include in our SYSTEM.LIBRARY.  You would be free to add more, but at least you would be able to link the  standard functions into your applications programs without having to fiddle  with source code. available directly from  the hardware, so we don't always have to "Type a number" to begin a game.  %It seems elementary for the UCSD Pascal user community to agree on a program until someone types something.  This allows optional user interaction with an ongoing program. Other programs,  such as modem controllers, read and write data to specific hardware ports.  Finally, it would be nice to have a random-number seedional problem: many programs rely on hardware-specific functions  not implemented in SYSCOM. For example, quite a number of authors have  included routines to test if a console key has been pressed without having to  READ a character and thus hang up a routine recently published in Dr. Dobb's to read in the SYSTEM.MISCINFO file.  Programmers writing proprietary software will have to do something like this  during initialization if their productions are to use the CRT efficiently. But  there is addit what SYSCOM^ refers to. This is clumsy, and it  is not easy to debug software with all the checking turned off (the U- option  disables i/o checking and rangechecking).  %There are alternate ways to get at the information in SYSCOM, such as the lementors of UCSD Pascal did not see fit to allow us to get at it easily.  Direct reference to the SYSCOM variables requires you to compile in the  variable declarations in GLOBALS.TEXT, then switch to the (*$U-*) compiler  option, so the compiler knowsication that  manipulates data on the CRT screen. It means you always have to diddle with  a new program before you can use it. Although this information should be  readily available in SYSCOM, where the system functions have access to it, the  imp 5A SUGGESTION FOR A UNIVERSAL I/O UNIT  %Most of the UCSD Pascal programs that I have seen have a monotonous  beginning consisting of hardware-specific procedures like CLEARSCREEN,  EraseToEndOfLine, EraseToEndOfScreen, etc., required for any appleEnd;    IMPLEMENTATION   FUNCTION READY: BOOLEAN; EXTERNAL;  {an assembly language routine that returns a "1" if a console key !has been pressed}   FUNCTION GetPort (PORTNO: BYTE): CHAR; EXTERNAL;  {this assy-language routine reads a character from a specific port}   PROCEDURE SendPort (PORTNO: BYTE; CH: CHAR); EXTERNAL;  {this assy-language routine puts out a chararacter to a specific port}    FUNCTION KeyPress;  BEGIN "KeyPress := READional disk to cover air mail) from Jim Gagne, Datamed  Research, 1433 Roscomare Road, Los Angeles CA 90024. Both UCSD Pascal and CP/M-  compatible Pascals are supported, though UCSD programs will require  modification to run under other systems.  %5-re $10  each postpaid (California residents MUST add 6% sales tax; Canadian and  Mexican recipients should add $3 per order for the extra hassle involved;  other out-of-country sales must add $8 for the first disk of an order and  $1.50 per each addit %INTERIM POLICY OF THE UCSD PASCAL USERS' GROUP LIBRARY   Obtaining Library Software.  %Floppy disks full of donated Pascal programs are available from the  Library as follows:  %8-inch, single-sided, single-density UCSD- or CP/M-format disks aO^áparameters to assembly language routines or anything else. %Let me know what you think....  %Sincerely,  %Jim Gagne, DATAMED RESEARCH. every time you do something; or the contents of an  address in RAM that is not used by the system but is different every time you  turn on your machine).  % %I specifically do NOT want to implement PEEK and POKE, since we do not  need them to pass %In addition to the procedures and functions listed above, we should  include FUNCTION RandomByte, which would return a random value from 0 to 255  (e.g., the contents of the Z-80 R register; the lowest byte of the system  clock if you don't reset it would have to write and debug before you  could use UCSD Pascal Library software. But you have to alter the procedures  other authors have included in their programs already!!  E (1, Chrbuf, 1)  END;   PROCEDURE ClrToScreenEnd;  BEGIN  . . .  END;   PROCEDURE ClrToLineEnd;  BEGIN  . . .  END;   END.  %Of course, the implementation would vary from system to system. And this  would be one more thing that youY;  END;   FUNCTION InPort;  BEGIN "InPort := GetPort (PORTNO);  END;   PROCEDURE OutPort;  BEGIN "SendPort (PORTNO, CH);  END;   PROCEDURE ClearScreen;  VAR Chrbuf: PACKED ARRAY [0..1] OF CHAR;  BEGIN "Chrbuf [0] := CHR (12); "UNITWRIT1/4 inch diskettes of UCSD software (2 or 3 are required to hold an 8-  inch volume) are available from Bruce Sherman, SofTech Microsystems, 9494  Black Mountain Road, San Diego CA 92126. Pricing is not yet established, but  will probably exceed $20 per volume due to order processing costs. (We are  looking for volunteers to distribute the various 5-1/4 inch formats so we can  offer them at lower cost.) Software of interest only to users of certain  systems will as a rudergoing development that you eventually  wish to sell, we would be willing to pilot it for you if it is of sufficient  interest to the group at large and works moderately well. I am certain many  members would enjoy writing you with their comments, any from someone else. If you have an especially long program  or one that is for some reason tricky to compile, you may wish to submit  object code as well as source. Certain items may be submitted in object form  only: if you have a quality program un free of bugs, 3) be reasonably clearly written and documented so that it may  be easily modified, 4) come with sufficient instructions so that we can use  it, 5) be capable of being placed in the public domain, and 6) not have been  received previousldevelop the habit of donating particularly useful  tools to the Users' Group, a broad base of software support will quickly  develop which will benefit us all enormously.  %To be accepted, software must: 1) be in source form, 2) be relatively precision integer packages, business math routines, generic input/output  processing, program timers and debuggers, system utilities, and reports of  specific techniques to speed UCSD programs are particularly desired. It is  clear that if we can all are particularly eager  to receive donations of software tools: those procedures and programs you  have developed to make your programming simpler and more productive, and  which may be of broad interest to the Pascal community. Such items as double-  programs obtained from the Users' Group Library will be suitable for your  intended purpose.  %  Submitting Software.  %We are interested in receiving software from anyone who may wish to  contribute. Every type of program is welcomed, and we OT be copied without continuing to carry whatever statements of  authorship it may now contain. Finally, despite hard work to maintain the  highest standards possible, we of course cannot guarantee in any way that be paid to Datamed Research  at the above address, within a month's time of the sale.  %All software is furnished with the understanding that no one may sell it  for profit without the written consent of the author. In addition, the  software MAY Nroup must be reimbursed $2 per disk volume sold. (A  disk volume is the contents of one 8-inch, single-sided, single-density  diskette.) These charges apply no matter how indirectly the seller obtains  Users' Group software. These editing fees should  for nothing. This includes OEM's and retailers. However, if any charge  whatsoever is made to the recipient of the software, then: 1) the maximum  charge is limited to a $5 fee per volume plus the retail cost of each floppy  disk and 2) the Users' Ge disk volume of your choice by donating software to  the group if the software is accepted (see below).  %Any user may copy Users' Group software and give it away to others FREE le because of differences in disk sectoring). In addition, they can  provide Microengine users with software that will enable them to convert UCSD  standard disks on their machines. Contact them directly for more information.  %You can obtain a frele not be distributed to incompatible systems. Contact  Bruce for further information.  %Western Digital has indicated an interest in distributing Users' Group  software on 8-inch disks compatible with the Microengine (these are NOT UCSD  compatibd you should wind up  with a product of much higher quality in a much shorter time than is the rule.  %We are also interested in reports of bugs in the system or user software  (preferably with fixes or kludges to get around them) and documentation of the  more obscure aspects of UCSD Pascal. %  Editors.  %Many people have written to UCSD and SofTech wishing to assist in the  organization of a users group library. We tO^persuasions. So the $1 payment per disk is intended to  reimburse you in part for the very real effort required to create a disk with  truly useful contents.  warning: most of the Pascal disks now floating around have much less work put  into them than we feel is required for them to be generally useful. I, in  particular, am a FANATIC about making our products helpful and/or fun to  programmers of various brary, so we can coordinate our efforts.  (I reserve the right not to send you ALL the Users' Group volumes if this  thing gets too big and you haven't contributed for a while.) A word of as editor of that volume, 2) receive $1 for each disk SOLD  (remember, many will be given to friends), and 3) be placed on the official  UCSD Pascal Users' Group Library Roster of Editors, and receive all past and  future volumes of the Users' Group lirograms if they solve a pressing need. (I would prefer to  put most of the hardware-specific material on a special disk, which users can  ignore if they wish.)  If you submit a disk that is reasonably well put together, you will: 1)  be listed any remaining documentation required for use. Note that we are specifically  committed to full and complete documentation ON THE DISK whenever possible.  Programs should be of general interest, although it is all right to include  hardware-specific phecked out the programs and organized them in some way. You  should have a catalog of the files on the disk, and a separate file  containing: 1) descriptions of each program, 2) what you think of it, and 3) l of  software may submit it to the Users' Group (send them to Datamed Research; 8-  inch diskettes preferred). Fundamentally, the requirements for the acceptance  for the software are those stated previously; in addition, the disk editor  must have chink this is grand. Because it  makes little sense for the collection and distribution of programs to be  scattered all around the country, we plan to set up the following structure  for now and see how it works: Anyone who wishes to collect a disk ful /VOLUME 3 CATALOG, UCSD PASCAL USERS' GROUP LIBRARY H 9Prose, games, and some ideas.*    BLACKJACK.TEXT.....Now you can play it in Pascal. Appropriate for 1980: allows 3negative money.   CHASE.TEXT.........A good implementation of an old favo PROB P P1 P2 MAP MOVE M C A B n ~pmO^ ware-specific procedures in the game programs (see UNIVERSAL.TEXT for a discus-  sion of this subject); as a rule, any code your system does not support (e.g.,  KeyPress or a system clock) can just be deleted.  ts of the University of  California. Please read the file POLICY.DOC.TEXT regarding the software on this  disk. All programs should be self-documenting, though you'll have to fix hard- ORE.DATA.........Sample data file for DEBTS.TEXT.   UNIVERSAL.TEXT.....Suggestion for a UNIT that will let us use each other's pro- 3grams without having to edit in hardware-specific routines.    * NOTE: UCSD Pascal is a trademark of the Regenn for those without sufficient memory to com- 3pile; will run under UCSD versions I.4 and I.5.   REQUESTS.TEXT......Some ideas for some very needed programs and routines.   SNOOPY.TEXT........Snoopy calendar, featuring the W.W. I flying ace.   ST3Strait, of the University of Minnesota. Requires most of 364K of memory to compile.  PROSE.0.TEXT  PROSE.A.TEXT  PROSE.B.TEXT  PROSE.C.TEXT  PROSE.D.TEXT  PROSE.E.TEXT  PROSE.F.TEXT.......Subfiles of Prose.   PROSE.I.5.CODE.....Object versioews No. 15. What you really need to know to use it.   PROSE.TEXT.........A copy of the fancy text-formatting program from the Pascal 3News, No. 15, adapted for UCSD Pascal by its author, J. P. st I've seen.  OTHELL1.TEXT  OTHELL2.TEXT  OTHELLINIT.TEXT....Subfiles of OTHELLO.   POLICY.DOC.TEXT....How the Users' Group Library works.   PROSE.DOC1.TEXT  PROSE.DOC2.TEXT....A subset of the documentation of Prose, copied from the Pas- 3cal Nrite. Get away from the 3robots, but don't get zapped by the electric fence! 3  DEBTS.TEXT.........Home finance program, keeps track of your bills. Nicely menu 3driven, easy to use.   OTHELLO.TEXT.......VERY nice implementation of OTHELLO, the be  PROGRAM CHASE;  CONST MAN = 'O'; {SYMBOL FOR THE MAN} (EDGE = 'I'; {SYMBOL FOR THE FENCE} (OBST = '*'; {SYMBOL FOR AN OBSTRUCTION} (ROBOT = 'R'; YOU ?'); "WRITELN; "WRITELN(' BEGINNER - B'); "WRITELN(' INTERMEDIATE - I'); "WRITELN(' EXPERT - E'); "WRITELN(' OLD PRO - P');  WRITELN; "WRITE(' TYPE IN YOUR SKILL '); "READ (SK);  WRITURE STARTGAME;  VAR SK: CHAR;  BEGIN  WRITELN;WRITELN;WRITELN; "WRITE('ENTER A NUMBER FOLLOWED BY RETURN ');READLN(RNUM);  IF RNUM=0 THEN RNUM:=12.345; "WHILE RNUM > 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: *) #(* 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^Rz(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 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 *) #(* 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&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; 4okm6FALSE: (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;  OF 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 ); ong 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 lA O^Rz 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; )  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: ces[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]; /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].adjcentpieces[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;#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;  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 :=...*) 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 + [A O^Rz&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,b  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,moveteTHEN 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 ,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 N ['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)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 +w,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); IT(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 2EXA O^R); #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  (* 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 stELN('Score'); #WRITELN('-----------'); #WRITELN(CHR(whiteascii),'/White:'); #WRITELN(CHR(blackascii),'/Black:'); #END; (*showemptyboard*) "  PROCEDURE instructions; #VAR &i: INTEGER; #PROCEDURE page1; &BEGIN &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 ')] := '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".&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 ') '); &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('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-2 1 3 9 P ?^윖'; $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; "CARDSLEPROGRAM 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 =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; #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} ! 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 "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; $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); 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[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; #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 RRY:REAL; "END; !  VAR !LAST,INDEX :INTEGER; !EXISTS,DONE :BOOLEAN;  TODAY :DATE; !THISPAYMENT :REAL; !STORE :STORECARD; !STORES :ARRAY[1..30] OF STORECARD; !STO..31; !CHOICESET=SET OF CHAR; !DATE= "RECORD #YY:INTEGER; #MM:INTEGER; #DD:INTEGER; "END;  STORECARD= "RECORD #NAME:STRING; #LASTPAID:DATE; #BALANCE:REAL; #LASTPAYMENT:REAL; #MINPAYMENT:REAL; #CARRYCHARGE:REAL; #MONTHLYCOST:REAL; #TOTALCAPROGRAM DEBTS;  {KEEPS TRACK OF ALL REVOLVING DEBTS ON DISK FILE}  {DISK FILE NAME IS STORE.DATA}   CONST (*CHANGED FOR APPLE PASCAL*) !CLERSCRN=12; !CLEREOL=29; !CLEREOS=11; !FIRSTLINE=3; !FIRSTYR=70; !LASTYR=99; !  TYPE !MNTH=1..12; !DAY=11 2 G M E R C L Xc$2)?^#INSTRUCTIONS; #WINNINGS; #PLAYERIN; " SETUP; #CLERBOT; "UNTIL BET<0 !END. {MAIN PROGRAM}  "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} ) %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 THE