home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / games / vmsnet.sources.games / chase / part01 next >
Internet Message Format  |  1992-02-11  |  39KB
  1. Path: uunet!wupost!waikato.ac.nz!ccc_spt
  2. From: ccc_spt@waikato.ac.nz (Simon Travaglia)
  3. Newsgroups: vmsnet.sources.games
  4. Subject: CHASE_GAME.COM - Basic car game
  5. Message-ID: <1992Jan28.172522.6341@waikato.ac.nz>
  6. Date: 28 Jan 92 17:25:22 +1300
  7. Organization: University of Waikato Computer Centre
  8. Lines: 1189
  9.  
  10.  
  11. Ok, this is a simple car game to run on a vax machine.  I wrote it about 2
  12. years ago or so, but seeing as how there's stuff all games being posted, I
  13. thought I might put it on for laughs. 
  14.  
  15. Basically the game involves you driving round a track avoiding various
  16. obstacles etc.
  17.  
  18. Nothing fantastic, but I think it works.
  19.  
  20. The file below is a self-extracting command file - just chuck it in a
  21. directory somewhere called CHASE_GAME.COM then simply @CHASE_GAME.  This
  22. will extract the game into about 7 files or so from memory...
  23.  
  24. Once the extract has taken place, you can compile the source code by hand
  25. or by:
  26.  
  27. $ @CHASE
  28.  
  29. which is one of the files that was sent along with the distribution.
  30.  
  31. Now - caveats:
  32.     Don't execute this command procedure in SYSTEM or any other account
  33.     that  has  privilege.   (It won't do any harm,  but it's just a bad
  34.     habit to get into)
  35.  
  36.     It's a cheap, nasty game, don't expect bells and whistles.
  37.  
  38. Have some fun.
  39.  
  40.                     - Simon
  41.  
  42. $!--CUT-HERE----------------------------------------------------------
  43. $ Copy SYS$INPUT: CHASE.COM
  44. $ Deck
  45. $
  46. $ PASC/ENV TOPTENMDL              ! The File with high_score routine
  47. $ PAS CHASE                       ! The Game Source
  48. $ LINK CHASE,TOPTENMDL            ! Link it and bob's your aunty!
  49. $ EOD
  50. $ Write Sys$output "Extracted CHASE.COM..."
  51. $ Copy SYS$INPUT: CHASE.CRS
  52. $ Deck
  53. +++++------------------------------+++++
  54. +++/        a              #        \+++
  55. ++/  #      a                        \++
  56. +/          a                   #     \+
  57. +           a              #           +
  58. ]         +------------------+         [
  59. ]         [[----------------]]         [
  60. ]         [[__VAX_SPEEDWAY__]]         [
  61. ]         [[__S._TRAVAGLIA__]]      #  [
  62. ]         [[__WAIKATO_UNIV__]]     #   [
  63. ]   #     [[__22-23/8/1988__]]         [
  64. ]     #   [[____Q_=_QUIT____]]         [
  65. ]      #  [[----------------]]         [
  66. ]         +------------------+         [
  67. +               #     a                +
  68. +\                    a          #    /+
  69. ++\          #        a              /++
  70. +++\                  a             /+++
  71. +++++------------------------------+++++
  72. $ EOD
  73. $ Write Sys$output "Extracted CHASE.CRS..."
  74. $ Copy SYS$INPUT: CHASE.DRN
  75. $ Deck
  76.     +------------------------------+    
  77.    /Vvvv v                    <<<<<<\   
  78.   /Vvv  v                      ,,,,,<\  
  79.  /Vvv    v                       , ,,<\ 
  80. +Vv   v v                       ,    ,<+
  81. |         +------------------+         |
  82. |         |                  |         |
  83. |         |                  |         |
  84. |         |                  |         |
  85. |         |                  |         |
  86. |         |                  |         |
  87. |         |                  |         |
  88. |         |                  |         |
  89. |         +------------------+         |
  90. +>..  . .                       6    6^+
  91.  \>...  .                     6    66^/ 
  92.   \>.....                       6 66^/ 
  93.    \>>>>>>                    6 666^/   
  94.     +------------------------------+    
  95. $ EOD
  96. $ Write Sys$output "Extracted CHASE.DRN..."
  97. $ Copy SYS$INPUT: CHASE.HLP
  98. $ Deck
  99. HWelcome to Vax Speedway.
  100.  
  101. You are the owner of a fully reworked Fiat Bambina with optional body extras,
  102. making you quite a mean force on the race track.   Unfortunately,  the other
  103. drivers are also mean forces and also a little on the dozy side.
  104.  
  105. Here, at the race of the century, you are to do battle with the other drivers
  106. and,  using your extra special keypad controls,  win.   (Sounds pretty simple
  107. really)
  108. #3        Your Keypad
  109. #4        Your Keypad
  110.               Up
  111.             +---+
  112.             | 8 |            Q = Quit
  113.         +---+    +---+    +---+           ^W = Rewrite the screen
  114.        Left | 4 |        | 6 | Right
  115.         +---+    +---+    +---+
  116.             | 2 |
  117.             +---+
  118.              Down
  119.  
  120. Hit Return for more info...
  121. [RET]
  122. What means what:
  123.  
  124.         * - You
  125.         # - Oil spot        (You lose control temporarily)
  126.         
  127.         0 - Pothole         (Causes fatal steering failure)
  128.     1, 2, 3, 4, 5 - The other maniacs    (Drivers)
  129.  ], [, -, +, /, \ - The barriers    (You guessed it, deadly as well)
  130.     
  131.         (0a(B - Track halfway lines
  132.         (0`(B - Raceway Official.
  133.  
  134.      As you may have guessed,  Oil spots aren't too bad, but running into any
  135. of the other cars,  potholes,  barriers or Raceway Officials is Bad News.  In
  136. fact, it puts you out of the race.   The worst thing about oil spots and pot-
  137. holes is that they multiply with time,  and of course,  Raceway Officials are
  138. notorious for popping up all over the place when you least expect them......
  139.  
  140.  
  141. [Hit Return to Play]
  142. $ EOD
  143. $ Write Sys$output "Extracted CHASE.HLP..."
  144. $ Copy SYS$INPUT: CHASE.PAS
  145. $ Deck
  146.     {
  147.         Always make sure a copy of toptenmdl.pas goes with this
  148.         program, as it requires it for the top ten routine.
  149.  
  150. @@@     @@@                    @@                          @@@  @@@@@@@  @@@
  151. @@@@   @@@@                    @@                           @@       @@   @@
  152. @@ @@ @@ @@   @@@@@   @@   @@  @@   @@@@@   @@ @@@@         @@      @@    @@
  153. @@  @@@  @@  @@   @@  @@   @@  @@  @@   @@  @@@@            @@    @@@     @@
  154. @@   @   @@       @@  @@   @@  @@  @@   @@  @@       @@@@   @@      @@    @@
  155. @@       @@   @@@@@@  @@   @@  @@  @@@@@@   @@              @@       @@   @@
  156. @@       @@  @@   @@  @@   @@  @@  @@       @@              @@       @@   @@
  157. @@       @@  @@   @@  @@   @@  @@  @@   @@  @@              @@  @@   @@   @@
  158. @@       @@   @@@@@    @@@@@   @@   @@@@@   @@              @@   @@@@@    @@
  159.  
  160.  
  161.      @@@@  @@@@   @@@  @@@@  @   @  @@@  @@@@@ @  @@@  @   @  @@@
  162.         @   @ @   @ @   @ @   @ @   @ @   @   @   @ @   @ @@  @ @   
  163.         @@@@  @@@@  @   @ @   @ @   @ @       @   @ @   @ @ @ @ @@@@@
  164.         @     @  @  @   @ @   @ @   @ @   @   @   @ @   @ @  @@     @
  165.         @     @   @  @@@  @@@@   @@@   @@@    @   @  @@@  @   @  @@@
  166.  
  167.  
  168.         @@@@  @@@@  @@@@@  @@@  @@@@@ @   @ @@@@@  @@@
  169.         @   @ @   @ @     @     @     @@  @   @   @      @
  170.         @@@@  @@@@  @@@@  @@@@@ @@@@  @ @ @   @   @@@@@ 
  171.         @     @  @  @         @ @     @  @@   @       @  @
  172.         @     @   @ @@@@@  @@@  @@@@@ @   @   @    @@@
  173.  
  174.  
  175.          *****  *     *   *****    *****   ******
  176.         *       *     *  *     *  *     *  *
  177.         *       *     *  *     *  *        *
  178.         *       *******  *******   *****   ****
  179.         *       *     *  *     *        *  *
  180.         *       *     *  *     *  *     *  *
  181.          *****  *     *  *     *   *****   ******
  182.  
  183.     PASC/ENV TOPTENMDL        The File with high_score routine
  184.     PAS CHASE            The Game Source
  185.     LINK CHASE,TOPTENMDL        Link it and bob's your aunty!
  186.  
  187.     }
  188.  
  189. [inherit ('sys$library:starlet',
  190.         'toptenmdl' ) ]
  191.  
  192. Program game_name( Input, output, infile, help_file, outfile, screen_file );
  193.  
  194. CONST    clear_screen    = ''(27)'[2J';
  195.     home        = ''(27)'[H';
  196.     esc        = chr(27);
  197.     wide        = ''(27)'#6';        {double width vt100 chars}
  198.     bell        = chr(7);
  199.     bright        = ''(27)'[1m';
  200.     flash        = ''(27)'[5m';
  201.     clear_eol    = ''(27)'[K';
  202.     dull        = ''(27)'[m';
  203.     grafix_on    = ''(27)'(0';
  204.     grafix_off    = ''(27)'(B';
  205.     errorplace    = ''(27)'[23;1H'+grafix_off;
  206.     bs        = chr(8);
  207.     nullit        = chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0);
  208.     line_22        = ''(27)'[22;1H';
  209.     line_23        = ''(27)'[23;1H';
  210.     cursor_off    = ''(27)'[?25l';
  211.     cursor_on    = ''(27)'[?25h';
  212.  
  213.     official_char    = '`';            {What an official looks like.  Remember to change in the HELP}
  214.     Dead_chars    = official_char+'[]/\-+12345';        {Characters you die if you touch}
  215.     max_officials    = 3;            {Maximum number of officials allowed on the track}
  216.  
  217.     Screen_width    = 40;            {How many columns the game screen takes up}
  218.     screen_depth    = 20;            {How many rows the game screen takes up}
  219.     filename_length    = 256;            {Length of VMS filename (max) }
  220.     input_line_length    = 132;        { max length of line input from a file }
  221.  
  222.  
  223. TYPE    Screen_lines    = packed array [1..screen_width] of char;
  224.     filename_type    = varying [filename_length] of char;
  225.     five_str    = varying [5] of char;
  226.     ten_str        = varying [10] of char;
  227.     $uword = [WORD] 0..65535;
  228.     $deftyp = [UNSAFE] INTEGER;
  229.     $defptr = [UNSAFE] ^$DEFTYP;
  230.     quad_word    = [quad, unsafe] record                { Defn for the schedule wakeup time vars }
  231.                         long1 : unsigned;
  232.                         long2 : integer;
  233.                       end;
  234.     object_rec        = record
  235.                 x : integer;    {x_pos}
  236.                 y : integer;    {y_pos}
  237.                 xi : integer;    {X increment        By using the x increment and the Y increment, I can}
  238.                 yi : integer;    {Y increment        tell which way the car is going. Should only be H or V}
  239.                 c : char;    {character the car is on}
  240.               end; {record}
  241.     moves        = array ['2'..'8'] of integer;
  242.  
  243. VAR    infile, outfile, help_file, screen_file : text;
  244.     Screen        : array [0..screen_depth] of screen_lines;
  245.     dir_Screen        : array [0..screen_depth] of screen_lines;
  246.     Game_over    : boolean := false;
  247.     seed        : real;
  248.     Io_chan        : [volatile] integer;
  249.     sleep_time    : quad_word;        { Sleep Time}
  250.  
  251.     car        : array [1..5] of object_rec;
  252.     my_car        : object_rec;
  253.     official    : array [1..max_officials] of object_rec;
  254.  
  255.     x_i        : moves := ( 0, 2, -1, 2, 1, 2, 0 );        {These arrays are which way the car will move with a}
  256.     y_i        : moves := ( 1, 2, 0, 2, 0, 2, -1 );        {give key press (x and y increment values)}
  257.  
  258.     move_text    : varying [512] of char;            {The text that is passed to QIO_Write for each move cycle}
  259.     old_y        : integer := 3;                    {Used to stop back and forward over finish line to inc laps}
  260.     laps        : real := 0;                    {Number of laps the car has done}
  261.     time_out    : packed array [1..11] of char;        {The current system time}
  262.     pothole        : boolean := false;                {Have I hit a pothole?}
  263.     score        : integer :=0;
  264.  
  265.     officials_out    : boolean := false;                {are officials allowed on the track yet?}
  266.     potholes_out    : boolean := false;                {has the track developed potholes}
  267.  
  268.     image_dir    : varying [250] of char;
  269.     begin_clock    : integer;
  270.     end_clock    : integer;
  271.     safe_dist    : integer := 10;
  272.     crash_char    : char := ' ';
  273.     message        : varying [80] of char;                {what happened death message}
  274.  
  275.         Iosb :                {I/O Status Block}
  276.             [volatile, Quad] Record
  277.                 Status : $uword;
  278.                 Nrbytes : $uword;
  279.                 Devdepend : $deftyp
  280.             End {Record};
  281.  
  282.     char_in : integer;
  283.     car_num : integer;
  284.     call_status : integer;
  285.     num_of_cars    : integer := 3;
  286.     num_of_officials    : integer := 2;
  287.  
  288. [ASYNCHRONOUS, EXTERNAL(lib$signal)] PROCEDURE lib$signal
  289.   (
  290.     %IMMED condition_value    : [LIST] $deftyp
  291.   );
  292.       EXTERNAL;
  293.  
  294.     {*****************************************************************}
  295. procedure check_status( input_status : integer );
  296.     begin
  297.     if not odd( input_status ) then lib$signal( input_status );
  298.     end;
  299.  
  300.     {*****************************************************************}
  301.  
  302. function within( num, lower, upper : integer): boolean;
  303.     begin
  304.     within := (num >= lower) and (num <= upper);
  305.     end;
  306.  
  307.     {*****************************************************************}
  308.  
  309. Procedure image_dr;
  310.  
  311. VAR    image_out : varying [256] of char;
  312.     brac_place : integer;
  313.     rev_index  : integer;
  314.         Itemlist :
  315.             Record
  316.                 Item : [Long(3)] Record
  317.                         Bufsize : $uword;
  318.                         Code : $uword;
  319.                         Bufadr : integer;
  320.                         Lenadr : integer
  321.                     End {Record};
  322.                 No_more : integer        {set to zero to mark end of list}
  323.             End {Record};
  324.  
  325. BEGIN
  326.     With itemlist do
  327.         Begin
  328.         With item do
  329.             Begin
  330.             Bufsize := 256;
  331.             Code := jpi$_imagname;
  332.             Bufadr := iaddress(image_out.body);
  333.             Lenadr := iaddress(image_out.length);
  334.             End {With};
  335.         No_more := 0        { indicates end of list }
  336.     End {With};
  337.     $Getjpi( itmlst := itemlist);
  338.     brac_place := image_out.length;
  339.     While image_out[brac_place] <> ']' do brac_place := brac_place -1;
  340.     image_dir := substr( image_out, 1, brac_place );
  341. END;
  342.  
  343.     {*****************************************************************}
  344. [asynchronous] function qio_write( x_in, y_in : integer; op_text: varying [l1] of char := chr(0) ) : integer;
  345. var x, y : varying [20] of char;
  346.     out_text : varying [512] of char;
  347.     begin
  348.     $fao( ctrstr :=  '!UL', outbuf := y.body, outlen := y.length, p1 := y_in );
  349.     $fao( ctrstr :=  '!UL', outbuf := x.body, outlen := x.length, p1 := x_in );
  350.     out_text := esc + '[' + y + ';' + x + 'H' + op_text;
  351.     qio_write := $qiow( chan := io_chan, func := Io$_writevblk , 
  352.               p1 := %ref out_text.body, p2 := out_text.length );
  353.     end;
  354.  
  355.     {*****************************************************************}
  356.  
  357. Function get_1_char_now : integer;    {Get one character IMMEDIATELY from keyboard.  No char, return -1 }
  358. VAR    char_read : char;
  359.     begin
  360.     call_status :=  $qiow( chan := IO_chan,
  361.             iosb := iosb,
  362.             func := io$_readvblk + io$m_noecho + io$m_nofiltr + io$m_timed,
  363.             p1 := char_read, p2 := 1, p3 := 0 );
  364.     check_status( call_status );
  365.     get_1_char_now := ord(char_read);
  366.     if iosb.status = ss$_timeout then get_1_char_now := -1
  367.         else check_status( iosb.status );
  368.     end; {get_1_char_now}
  369.  
  370.     {*****************************************************************}
  371.  
  372. Function get_1_char : integer;        {Get one character from the keyboard.  Wait if neccessary }
  373. VAR    char_read : char;
  374.     begin
  375.     call_status :=  $qiow( chan := IO_chan,
  376.             iosb := iosb,
  377.             func := io$_readvblk + io$m_noecho + io$m_nofiltr,
  378.             p1 := char_read, p2 := 1 );
  379.     check_status( call_status );
  380.     check_status( iosb.status );
  381.     get_1_char := ord(char_read);
  382.     end; {get_1_char_now}
  383.  
  384.     {*****************************************************************}
  385. procedure sleep;    { Do sleep of current sleep length }
  386.     begin
  387.     $schdwk( daytim := sleep_time );
  388.     $hiber;
  389.     end;
  390.  
  391.     {*****************************************************************}
  392.  
  393. procedure explode( x, y : integer );
  394.     begin
  395.     qio_write( x, y, '@'+nullit+bs+bs+bs+'---' );
  396.     sleep;
  397.     qio_write( x, y, bs+'=*=' );
  398.     sleep;
  399.     qio_write( x, y, bs+'***' );
  400.     sleep;
  401.     if within( y, 1, 18) then
  402.         begin
  403.         qio_write( x, y-1, bs+ '\ /' );
  404.         qio_write( x, y+1, bs+ '/ \' );
  405.         qio_write( x, y, bs+'   ' );
  406.         sleep;
  407.         qio_write( x, y-1, bs+ '` ~' );
  408.         qio_write( x, y+1, bs+ ', .' );
  409.         sleep;
  410.         qio_write( x, y-1, bs+ '   ' );
  411.         qio_write( x, y+1, bs+ '   ' );
  412.         end;
  413.     sleep;
  414.     qio_write( x, y, bs+'   ' );
  415.     end;
  416.  
  417.     {************************************************************}
  418.  
  419. Function random( number    : integer):integer;            {Give random number between 1 and number}
  420.    {sub}function mth$random( var seed:real):real;extern;
  421.     BEGIN
  422.     Random := trunc(mth$random(seed)*number)+1;
  423.     END; {random}
  424.  
  425.  
  426.     {*****************************************************************}
  427.  
  428. Function ok_to_put( x, y : integer ): boolean;
  429.     begin
  430.     ok_to_put := ( (abs(x-my_car.x) > safe_dist) and 
  431.             (abs(y-my_car.y) > safe_dist ) and
  432.                 (screen[y, x] = ' ') )
  433.     end;
  434.  
  435.     {*****************************************************************}
  436.  
  437. function cvt_to_chars( num :integer ): five_str;    {Converts a number to a string (for concatenation}
  438.     var chars_out : five_str;
  439.     begin
  440.     $fao( ctrstr :=  '!UL', outbuf := chars_out.body, outlen := chars_out.length, p1 := num );
  441.     cvt_to_chars := chars_out;
  442.     end;
  443.  
  444.     {*****************************************************************}
  445. function watton( x, y : integer): char;
  446.     begin
  447.     watton := dir_screen[y, x];
  448.     end;
  449.  
  450.     {*****************************************************************}
  451. function wattons( x, y : integer): char;
  452.     begin
  453.     wattons := screen[y, x];
  454.     end;
  455.  
  456.     {******************************************************************}
  457. function dead:boolean;
  458.     begin
  459.     dead := (index( '  '+dead_chars, screen[my_car.y, my_car.x]) > 2 );
  460.     end;
  461.  
  462.     {*****************************************************************}
  463.  
  464. function Put_Character( x, y :integer; 
  465.             what : char ): ten_str;        {Place character}
  466.     begin
  467.     put_character := esc+'['+cvt_to_chars(y)+';'+cvt_to_chars(x)+'H'+what;
  468.     end;
  469.  
  470.     {*****************************************************************}
  471.  
  472. Function Unput_Character( x, y : integer):ten_str;        {Erase character and put screen}
  473.     begin
  474.     unput_character := esc+'['+cvt_to_chars(y)+';'+cvt_to_chars(x)+'H'+screen[y, x];
  475.     end;
  476.  
  477.     {*****************************************************************}
  478.  
  479. procedure Type_file( file_to_type : filename_type);                {Put help text on the terminal }
  480. VAR    Input_line : varying [input_line_length] of char;
  481.     waste : integer;
  482. BEGIN
  483.     open( infile, file_to_type, history := readonly);
  484.     reset(infile);
  485.     while not eof( infile ) do
  486.         Begin
  487.         readln( infile, input_line );
  488.         if input_line = '[RET]' then 
  489.                 begin
  490.                 waste := get_1_char;
  491.                 writeln( Clear_screen, Home );
  492.                 end
  493.         else writeln( Input_line ); {if input line <> RET}
  494.         End;
  495.     close( infile );
  496. END;  {type_file }
  497.  
  498.     {*****************************************************************}
  499.  
  500. Procedure do_screen_and_help;                    {Type startup screen and inquire if user wants help}
  501. VAR    Yes_or_no : varying [10] of char;
  502.     nothing : integer;
  503. begin
  504.     Type_file( Image_dir+'Chase.SCN' );
  505.     readln( yes_or_no );                                {if person wants help/instructions }
  506.     if yes_or_no.length > 0 then                                {default to not wanting help }
  507.         begin
  508.         if yes_or_no[1] in ['Y', 'T', 't', 'y'] then type_file( image_dir+'CHASE.HLP' );    {unless they ask for it}
  509.         nothing := get_1_char;
  510.         end;
  511. end; {do_screen_and_help}
  512.  
  513.     {*****************************************************************}
  514.  
  515. Procedure setup_screen;                { Setup the screen }
  516. VAR    line_num : integer;
  517. Begin
  518.     line_num := 0;
  519.     Open( screen_file, image_dir+'Chase.crs', history := readonly );        {read in the screen layout file}
  520.     reset( screen_file );
  521.     while not eof( screen_file) do
  522.         begin
  523.         Line_num := line_num + 1;
  524.         readln( screen_file, screen[line_num]);
  525.         end;
  526.     close( screen_file );
  527.  
  528.     line_num := 0;
  529.     open( screen_file, image_dir+'Chase.drn', history := readonly );        {read in the directions file}
  530.     reset( screen_file );
  531.     while not eof( screen_file) do
  532.         begin
  533.         Line_num := line_num + 1;
  534.         readln( screen_file, dir_screen[line_num]);
  535.         end;
  536.     close( screen_file );
  537.     
  538. end;
  539.  
  540.     {*****************************************************************}
  541.  
  542. Procedure Initialise_Game;
  543.     begin
  544.     seed := clock;
  545.     Call_status := $assign(devnam := 'SYS$COMMAND:', chan := %ref IO_chan);
  546.     if not odd( call_status) then
  547.         begin
  548.         writeln( errorplace, 'Error in assigning a channel to SYS$COMMAND...');
  549.         lib$signal( call_status );
  550.         end;
  551.     end;
  552.  
  553.     {*****************************************************************}
  554.  
  555. Procedure Rewrite_Screen;
  556. VAR    line_num : integer;
  557.     begin
  558.     writeln( clear_screen, home, grafix_on, wide, screen[1] );
  559.     for line_num := 2 to screen_depth do
  560.         writeln( wide, screen[ line_num ] );
  561.     writeln( grafix_off + esc + '[22;1HLaps: ', laps:3:1, '          Time: ', time_out, ',  Score: ', score:5,grafix_on);
  562.     writeln( home);
  563.     end;
  564.  
  565.     {************************************************************}
  566. procedure move_my_car;
  567. VAR    kb_char : char;
  568.     ran_x, ran_y : integer;
  569.     begin
  570.     char_in := get_1_char_now;
  571.     kb_char := ' ';
  572.     if (char_in <> -1) and not pothole then kb_char := chr( char_in );
  573.     move_text := move_text + unput_character( my_car.x, my_car.y );
  574.     case kb_char of
  575.         '2', '4', '6', '8' : begin                            {if a direction key}
  576.                     if my_car.xi <> -x_i[kb_char] then        {so you can't reverse immediately}
  577.                         my_car.xi := x_i[kb_char];
  578.                     if my_car.yi <> -y_i[kb_char] then        {so you can't reverse immediately}
  579.                         my_car.yi := y_i[kb_char];
  580.                      end;
  581.         'q', 'Q', chr(27)  : begin                            {else if quit}
  582.                     game_over := true;
  583.                     crash_char := ' ';                    {so it says they quit}
  584.                      end;
  585.         chr( 23 )    : rewrite_screen;                        {else if rewrite}
  586.         otherwise;
  587.         end; {case};
  588.     my_car.x := my_car.x + my_car.xi;                            {change my increments (dirn)}
  589.     my_car.y := my_car.y + my_car.yi;
  590.     move_text := move_text + put_character( my_car.x, my_car.y, my_car.c );            {add it all to output string}
  591.     case screen[my_car.y, my_car.x] of
  592.       Official_char, '[', ']', '/', '\', '-', '+', '1', '2', '3', '4', '5' : begin
  593.                                     game_over := true;
  594.                                     crash_char := screen[ my_car.y, my_car.x];
  595.                                     end; {deaded}
  596.         'a' : begin
  597.             laps := laps + 0.5;
  598.             if abs( old_y - my_car.y) < 8 then laps := laps - 0.5    {cheat - back and forward over finish line}
  599.             else     begin
  600.                 score := score + random( round( laps*random(40))  );
  601.                 time( time_out );
  602.                 writeln( grafix_off + esc + '[22;1HLaps: ', laps:3:1, '          Time: ', time_out, ',  Score: ', score:5,grafix_on);
  603.                 ran_x := random( 38 ) + 1;
  604.                 ran_y := random(18) + 1;
  605.                 if ok_to_put(ran_x, ran_y)  then                 {drop an oil spot}
  606.                     begin
  607.                     screen[ ran_y, ran_x] := '#';                {Update array}
  608.                     qio_write( ran_x, ran_y, '#' );                {Draw on screen}
  609.                     end;
  610.                 if potholes_out then
  611.                     begin
  612.                     ran_x := random( 38 ) + 1;
  613.                     ran_y := random(18) + 1;
  614.                     if ok_to_put( ran_x, ran_y) then                 {drop an oil spot}
  615.                         begin
  616.                         screen[ ran_y, ran_x] := '0';                {Update array}
  617.                         qio_write( ran_x, ran_y, '0' );                {Draw on screen}
  618.                         end;
  619.                     end; {if potholes out}
  620.                 end; {else}
  621.             old_y := my_car.y;                    {So someone can't go back and forward on one spot}
  622.             case round(laps*2) of
  623.                 8 :    begin                    {After the fifth lap, add another car}    
  624.                     potholes_out := true;            {Yes there are potholes}
  625.                     car[4].x := 17;    
  626.                     car[4].y := 4;
  627.                     car[4].xi := -1;
  628.                     car[4].yi := 0;
  629.                     car[4].c := ' ';
  630.                     num_of_cars := 4;
  631.                     sleep_time.long1 := -1400000;        {a little faster}
  632.                     end;
  633.                 18 :    begin                    {After the ninth lap, add another car}    
  634.                     officials_out := true;            {Officials are out and about}
  635.                     num_of_cars := 5;            {All the cars are now out}
  636.                     car[5].x := 19;
  637.                     car[5].y := 5;
  638.                     car[5].xi := -1;
  639.                     car[5].yi := 0;
  640.                     car[5].c := ' ';
  641.                     sleep_time.long1 := -1200000;        {A bit faster}
  642.                     end;
  643.                 26 :    begin
  644.                      sleep_time.long1 := -1000000;    {A bit faster}
  645.                     safe_dist := 6;            {Objects may appear this near to me}
  646.                     end;
  647.                 34 :    begin
  648.                     sleep_time.long1 := -800000;    {up with the speed}
  649.                     safe_dist := 3;            {Objects may appear THIS near to me}
  650.                          end;
  651.                 48 :    begin
  652.                     sleep_time.long1 := -600000;    {Chopping along nicely now}
  653.                     safe_dist := 2;            {If object appears, I'v got stuff all chance of missing}
  654.                     end;
  655.                 otherwise; {case laps}
  656.                 end;
  657.               end;
  658.         '#'  : begin
  659.             with my_car do
  660.                 begin
  661.                 if xi <> 0 then xi := (random(2)-1)*round(xi+2/abs(xi))
  662.                     else xi := (random(2)-1);
  663.                 if yi <> 0 then yi := (random(2)-1)*round(yi/abs(yi))
  664.                     else yi := (random(2)-1);
  665.                 end;
  666.                end;
  667.         '0'    : begin
  668.               pothole := true;        {Player has had it}
  669.               qio_write( 1, 22, bright+wide+grafix_off+flash+'Steering''s gone!!!'+bell+dull+clear_eol+grafix_on );
  670.               end;
  671.         ' ' :;
  672.         otherwise writeln( errorplace, 'Huh?  Ran over: ', screen[my_car.y, my_car.x] );
  673.         end; {case}
  674.     end;
  675.  
  676.     {************************************************************}
  677.  
  678. procedure move_car( which_one : integer );
  679. VAR    lucky_dip : integer;
  680.     putchar : char;
  681.     Begin
  682.     with car[which_one] do
  683.         begin
  684.         move_text := move_text + Put_character( x, y, c);
  685.         screen[y, x] := c;
  686.         x := x + xi;
  687.         y := y + yi;
  688.         if wattons(x, y) in ['1', '2', '3', '4', '5'] then
  689.                 begin        {cars never collide}
  690.                 x := x - xi;
  691.                 y := y - yi;
  692.                 end;
  693.         case watton( x, y) of
  694.             'V' : begin
  695.                 xi := 0;
  696.                 yi := 1;
  697.                   end;
  698.             'v' : begin
  699.                 lucky_dip := random( 10 );
  700.                 if lucky_dip > 7 then 
  701.                     begin
  702.                     xi := 0;
  703.                     yi := 1;
  704.                     end;
  705.                   end;
  706.  
  707.             '>' : begin
  708.                 xi := 1;
  709.                 yi := 0;
  710.                   end;
  711.             '.' : begin
  712.                 lucky_dip := random( 10 );
  713.                 if lucky_dip > 7 then 
  714.                     begin
  715.                     xi := 0;
  716.                     yi := 1;
  717.                     end;
  718.                 end;
  719.  
  720.             '6' : begin
  721.                 lucky_dip := random( 10 );
  722.                 if lucky_dip > 7 then 
  723.                     begin
  724.                     xi := 0;
  725.                     yi :=-1;
  726.                     end;
  727.                 end;
  728.  
  729.             '^' : begin
  730.                 xi := 0;
  731.                 yi := -1;
  732.                   end;
  733.  
  734.             ',' : begin
  735.                 lucky_dip := random( 10 );
  736.                 if lucky_dip > 7 then 
  737.                     begin
  738.                     xi := -1;
  739.                     yi := 0;
  740.                     end;
  741.                   end;
  742.  
  743.             '<' : begin
  744.                 xi := -1;
  745.                 yi := 0;
  746.                   end;
  747.             ' '  : begin
  748.                    end;
  749.             otherwise writeln( errorplace, grafix_off, 'Unexpected watton =', watton(x,y), '=, at [',x:0,';',y:0,'].',grafix_on );
  750.             end; {case}
  751.         c := wattons(x,y);
  752.         screen[y, x] := chr(which_one+48);
  753.         putchar := screen[y, x];
  754.         move_text := move_text + put_character( x, y, putchar );
  755.         end;
  756.     end;
  757.  
  758.     {************************************************************}
  759.  
  760. procedure move_officials;
  761. VAR     off_num : integer;
  762.     ran_x, ran_y : integer;
  763. begin
  764. IF random(100) > 80 then
  765.     for off_num := 1 to num_of_officials do            {These move rarely}
  766.     with official[off_num] do
  767.         begin
  768.         if (x > 0) then                {if it's been defined}
  769.             begin
  770.             qio_write( x, y, c);        {if on screen then unput_character}
  771.             screen[ y, x ] := c;
  772.             end;
  773.         ran_x := random(38) + 1;            {work out new random x}
  774.         ran_y := random(18) + 1;            { and Y }
  775.         if ok_to_put( ran_x, ran_y ) then        { Check that the spot is not too near to my car and a blank place}
  776.             begin
  777.             x := ran_x;                {If so, do the assignments}
  778.             y := ran_Y;
  779.             c := screen[y, x];
  780.             screen[y, x] := official_char;
  781.             qio_write( x, y, official_char );    {put_character}
  782.             end;
  783.         end;
  784. end;
  785.  
  786. [asynchronous] function bugger_an_error( a, b : [unsafe] integer ):integer;
  787.     begin
  788.     qio_write( 1,1, clear_screen+home+grafix_off+'AAAAAAAAAAAAAAAAGGGGGGGGGH!!!!' );
  789.     bugger_an_error := 0;                            {Make it die when it returns}
  790.     qio_write( 1, 2, 'And here is your error message ...');            {after it returns, it will spill error msg}
  791.     end;
  792.  
  793. BEGIN { Game_Name }
  794.     Initialise_Game;
  795.     image_dr;
  796.     Do_screen_and_help;
  797.     Setup_screen;
  798.     rewrite_screen;
  799.  
  800.     sleep_time.long1 := -1500000;    { Set this up for correct delay = .15s}
  801.     sleep_time.long2 := -1;
  802.  
  803.     official[1].x := 0;
  804.     official[2].x := 0;
  805.     official[3].x := 0;
  806.     
  807.     car[1].x := 10;
  808.     car[1].y := 3;
  809.     car[1].xi := -1;
  810.     car[1].yi := 0;
  811.     car[1].c := ' ';
  812.  
  813.     car[2].x := 18;
  814.     car[2].y := 18;
  815.     car[2].xi := 1;
  816.     car[2].yi := 0;
  817.     car[2].c := ' ';
  818.  
  819.     car[3].x := 37;
  820.     car[3].y := 12;
  821.     car[3].xi := 0;
  822.     car[3].yi := -1;
  823.     car[3].c := ' ';
  824.  
  825.     my_car.x := 22;
  826.     my_car.y := 3;
  827.     my_car.xi := -1;
  828.     my_car.yi := 0;
  829.     my_car.c := '*';
  830.  
  831.  
  832.     begin_clock := clock;
  833.     establish( bugger_an_error );                { Establish error handler }
  834.     writeln( cursor_off );
  835.  
  836.     While not game_over do
  837.         begin
  838.         Move_text := '';
  839.         for car_num := 1 to num_of_cars do
  840.             if car[ car_num ].x <> 0 then
  841.                 move_car( car_num );
  842.         if officials_out then move_officials;
  843.         if dead then game_over := true;        {Check}
  844.         move_my_car;
  845.         qio_write( 1, 1, move_text );
  846.         sleep;
  847.         end;
  848.     explode( my_car.x, my_car.y );
  849.  
  850.     writeln( line_22, grafix_off );
  851.  
  852.     end_clock := clock;
  853.     case crash_char of
  854.         Official_char : message := 'You hit an Official!!!!';
  855.         '[', ']', '/', '\', '-', '+' : Message := 'You hit a barrier!!';
  856.         '1', '2', '3', '4', '5' : message := 'You hit another car!!!';
  857.         ' ' : Message := 'Oh no!' ;
  858.         otherwise;    
  859.         end; {case}
  860.     writeln( cursor_on, message );
  861.     sleep_time.long1 := -20000000;    { So they can read the message }
  862.     sleep;
  863.     high_score( score, 'Chase', image_dir+'Chase.top' );
  864. END. { Game_Name }
  865. $ EOD
  866. $ Write Sys$output "Extracted CHASE.PAS..."
  867. $ Copy SYS$INPUT: CHASE.SCN
  868. $ Deck
  869. H(B
  870. H#33HVax Speedway!H#43HVax Speedway!HAnother Mauler 131 / Overlord Software Production 
  871. 9H- 19882H(0sqqqqqqqwqqqqqqs1Hq        x       pr1Hrrss    so0Hx0H
  872. 0Hoqsssssss1Hlqvqqqqq0Hx ssss9Hoooooppqqrs11Hx30Hx ooo48Hss60H
  873. 60Hoqs11Hx        rqpoopqr   (B\45H(0qpo  opqs63Hr11Hx      ros      sor 
  874. 31Hx43Hro s      sr    ssssp 12Hoooooo  s      s  oooooooooooooo  s      s oooo>
  875. 21Hqrssrq47Hqrssrq20H(B[Do you want Instructions? Y/N]
  876. 1H                  Simon Travaglia - Waikato University - 1988
  877.  
  878. $ EOD
  879. $ Write Sys$output "Extracted CHASE.SCN..."
  880. $ Copy SYS$INPUT: TOPTENMDL.PAS
  881. $ Deck
  882. [ inherit ('sys$library:starlet') ]
  883.  
  884. MODULE TOP_SCORE;
  885.  
  886. [global] procedure high_score( my_score : integer;
  887.             Game_name : varying [game_name_length] of char;
  888.             Score_file : varying [Score_file_length] of char );
  889.  
  890. Const    Username_size    = 12;
  891.     text_length    = 15;
  892.     number_of_scores    = 12;
  893.     number_of_months    = 12;
  894.     home    = ''(27)'[H';
  895.     Clear_screen    = ''(27)'[2J';
  896.     esc    = chr(27);
  897.  
  898.     done_better_msg        = 'You''re not doing any better in ';
  899.     Not_on_score        = 'You''re not doing too good at ';
  900.     Well_done        = 'Hooray!  You''re now entered in the high scores for ';
  901.     good_stuff        = 'Congratulations, you have increased your score in ';
  902.  
  903. Type    player_rec = record
  904.             Score        : integer;
  905.             Month        : packed array [1..3] of char;
  906.             Username     : packed array [1..username_size] of char;
  907.             Text        : varying [text_length] of char;
  908.             games_played    : integer;
  909.               end; {rec}
  910.     $uword = [WORD] 0..65535;
  911.     quad_word    = [quad, unsafe] record                { Defn for the schedule wakeup time vars }
  912.                         long1 : unsigned;
  913.                         long2 : integer;
  914.                       end;
  915.  
  916. VAR    outfile    : file of player_rec;
  917.     screen_in, screen_out    : text;
  918.     Year_scores    : array [1..number_of_months] of player_rec;
  919.     Month_scores    : array [1..number_of_scores] of player_rec;
  920.     totals        : player_rec;
  921.     opened        : boolean;    {have I opened the score file}
  922.     message        : varying [80] of char;
  923.     my_Username    : packed array [1..12] of char;
  924.     text_input    : varying [256] of char;
  925.     Date_String : packed array [1..11] of char;
  926.     Null_rec    : player_rec;
  927.     current_rec    : player_rec;
  928.     ask_for_text    : boolean;
  929.     score_place    : integer;
  930.     wait_time    : integer;
  931.     sleep_time    : quad_word;        { Sleep Time}
  932.     bombed_out    : boolean;
  933.  
  934. procedure get_username;
  935. VAR        Itemlist :
  936.             Record
  937.                 Item : [Long(3)] Record
  938.                         Bufsize : $uword;
  939.                         Code : $uword;
  940.                         Bufadr : integer;
  941.                         Lenadr : integer
  942.                     End {Record};
  943.                 No_more : integer        {set to zero to mark end of list}
  944.             End {Record};
  945.  
  946. BEGIN
  947.     With itemlist do
  948.         Begin
  949.         With item do
  950.             Begin
  951.             Bufsize := username_size;
  952.             Code := jpi$_username;
  953.             Bufadr := iaddress(my_username);
  954.             Lenadr := 0;                {Don't need a length returned}
  955.             End {With};
  956.         No_more := 0        { indicates end of list }
  957.     End {With};
  958.     $Getjpi( itmlst := itemlist);
  959. END;
  960.  
  961. procedure write_new_file;
  962. VAR    Rec_num : integer;
  963.     start_date    : packed array [1..11] of char;
  964.     begin
  965.     Writeln( Screen_out, 'Creating new score file...');
  966.     open( outfile, Score_file, history := NEW, sharing := none );
  967.     rewrite( outfile );
  968.     get_username;
  969.  
  970.     totals.games_played := 1;                        {TOTAL NUMBER OF GAMES PLAYED}
  971.     totals.username := my_username;                        {Put username in totals username field}
  972.     date( start_date );
  973.     totals.text := pad( start_date, ' ', text_length );            {Put initialisation date in date field}
  974.     write( outfile, totals );                        {Put it to the file then do the rest}
  975.  
  976.     for rec_num := 1 to number_of_months + number_of_scores do
  977.         write( outfile, null_rec );                 {write empty records}
  978.     close( outfile );
  979.     end;
  980.  
  981. procedure read_scores;
  982. VAR    Rec_num : integer;
  983.     begin
  984.     while not opened do
  985.         begin
  986.         open( outfile, Score_file, history := readonly, sharing := none, error := continue );
  987.         case status( outfile ) of
  988.             3 : write_new_file;
  989.             0 : begin
  990.                 reset( outfile );
  991.                 read( outfile, totals );
  992.                 for rec_num := 1 to number_of_months do
  993.                     read( outfile, year_scores[ rec_num ] );
  994.                 for rec_num := 1 to number_of_scores do
  995.                     read( outfile, month_scores[ rec_num ] );
  996.                 opened := true;
  997.                 end; {0}
  998.             2 : begin
  999.                 Writeln( screen_out, Clear_screen, home, 'Please wait...');
  1000.                 $schdwk( daytim := sleep_time );
  1001.                 $hiber;
  1002.                 Wait_time := Wait_time + 1;
  1003.                 if wait_time > 15 then                 {Stuff it, we timed out, die horribly}
  1004.                     begin
  1005.                     Writeln( Screen_out,  'Sorry, cannot access the score file...');
  1006.                     opened := true;
  1007.                     bombed_out := true;
  1008.                     end;
  1009.                 end;
  1010.             otherwise
  1011.                 begin
  1012.                 writeln( Screen_out, clear_screen, home, 'Failed to open Score File, Please inform Games Supervisor' );
  1013.                 opened := true;
  1014.                 bombed_out := true;
  1015.                 end;
  1016.             end; {case}
  1017.         end; {while not opened}
  1018.     end; {Read Scores}
  1019.  
  1020. Procedure write_scores;
  1021. VAR    Rec_num : integer;
  1022.     Begin
  1023.     opened := false;
  1024.     close( outfile );        { do the close from read - Locks file from start of score to finish}
  1025.     while not opened do
  1026.         begin
  1027.         open( outfile, Score_file, history := old, sharing := none, error := continue );
  1028.         case status( outfile ) of
  1029.             0 : begin
  1030.                 rewrite( outfile);
  1031.                 totals.games_played := totals.games_played + 1;
  1032.                 write( outfile, totals );
  1033.                 for rec_num := 1 to number_of_months do
  1034.                     write( outfile, year_scores[ rec_num ] );
  1035.                 for rec_num := 1 to number_of_scores do
  1036.                     write( outfile, month_scores[ rec_num ] );
  1037.                 opened := true;
  1038.                 end; {status = 0}
  1039.             2 : opened := true;
  1040.             otherwise 
  1041.                 begin
  1042.                 writeln( Screen_out, 'Turd in a sock, there''s a problem with the score file ->', status(outfile) );
  1043.                 opened := true; {so we don't loop on it all the time}
  1044.                 end;
  1045.             end; {case}
  1046.         end; {while not opened}
  1047.     end; {write_scores}
  1048.  
  1049. Procedure check_month;
  1050. Var    Month_string : packed array [1..3] of char;
  1051.     month_num : integer;
  1052.     score_num : integer;
  1053. begin
  1054.     date( date_string );
  1055.     month_string := substr( date_string, 4, 3);
  1056.     month_string[2] := chr( ord(month_string[2]) + 32 );
  1057.     month_string[3] := chr( ord(month_string[3]) + 32 );
  1058.     current_rec.month := month_string;
  1059.     if (month_scores[1].games_played <> 0) and         {if record is defined, not just blank}
  1060.         (month_scores[1].month <> month_string) then    {if new month}
  1061.         begin
  1062.         for month_num := number_of_months-1 downto 1 do
  1063.             year_scores[ month_num +1 ] := year_scores[month_num];        {Move the monthly scores down one}
  1064.         year_scores[1] := month_scores[1];                    {Put high score of last month in top}
  1065.         for score_num := 1 to number_of_scores do
  1066.             month_scores[score_num] := null_rec;                    {Clear previous month's high scores}
  1067.         end;
  1068. end; {check month}
  1069.  
  1070.  
  1071. Procedure Check_score;
  1072. VAR     Rec_num    : integer;
  1073.     check_place : integer;
  1074. begin
  1075.     Score_place := 0;
  1076.     check_place := 0;
  1077.     { Checks -     1.  Is my score in the region of high scorers 
  1078.             2.  Is my username somewhere else in the list?
  1079.                 If above - ignore my score - tell me I've done better
  1080.                 If below - push scores down over the top of my previous one and insert
  1081.     }
  1082.     For rec_num := number_of_scores downto 1 do
  1083.         if (my_score > month_scores[rec_num].score) then score_place := rec_num;
  1084.     if score_place <> 0 then
  1085.         begin
  1086.         get_username;                {No point in doing this unless I fit in}
  1087.         for rec_num := score_place-1 downto 1 do
  1088.             if month_scores[rec_num].username = my_username then 
  1089.                 begin
  1090.                 message := done_better_msg;  {done better - no update}
  1091.                 month_scores[rec_num].games_played := month_scores[rec_num].games_played + 1;
  1092.                 end;
  1093.         if message.length = 0 then                                    {if no higher score}
  1094.             begin
  1095.             current_rec.games_played := 1;
  1096.             current_rec.username := my_username;
  1097.             current_rec.score := my_score;
  1098.             current_rec.text := pad( current_rec.text, ' ', text_length );
  1099.  
  1100.             for rec_num := score_place to number_of_scores do
  1101.                 if month_scores[rec_num].username = my_username then check_place := rec_num;    {make c_p = my last score}
  1102.  
  1103.             if check_place = 0 then 
  1104.                 begin
  1105.                 check_place := 12;                        {if no previous score}
  1106.                 message := well_done;
  1107.                 end
  1108.                 else begin
  1109.                     current_rec.games_played := month_scores[check_place].games_played + 1;        {incr games played}
  1110.                     current_rec.text := month_scores[check_place].text;
  1111.                     current_rec.text := month_scores[check_place].text;                {copy text}
  1112.                     message := good_stuff;
  1113.                      end;
  1114.  
  1115.             for rec_num := check_place-1 downto score_place do
  1116.                 month_scores[rec_num+1] := month_scores[rec_num];            {move down old records}
  1117.             month_scores[score_place] := current_rec;                    {insert this curr_rec}
  1118.             Ask_for_text := true;
  1119.             end; {if message.length}
  1120.         end {if score_place <> 0}
  1121.     else Message := not_on_score;                                     {if score_place DOES = 0}
  1122. end; {check_score}
  1123.  
  1124. Procedure display_scores;
  1125. VAR    Rec_num : integer;
  1126.     begin
  1127.     Writeln( screen_out, Clear_screen, Home, 
  1128.          '  Long time winners of the past           High scores of ', substr( date_string, 4, 8),' Tot: ', totals.games_played:0);
  1129.     writeln( screen_out, '  -----------------------------           -----------------------');
  1130.     Writeln( screen_out, ' ');
  1131.     Writeln( screen_out, 'Mth  Score  Username    Name            Score  Username      Name        Games');
  1132.     Writeln( screen_out, ' ');
  1133.  
  1134.     for Rec_num := 1 to number_of_months do                {write the MONTH scores}
  1135.         with year_scores[rec_num] do
  1136.             if score <> 0 then 
  1137.                 writeln( screen_out, esc, '[', rec_num+5:0, ';1H', month, ' ', score:5, ' ', username, ' ', text );
  1138.  
  1139.     for Rec_num := 1 to number_of_scores do                {write this month's scores}
  1140.         with month_scores[rec_num] do
  1141.             if score <> 0 then 
  1142.                 writeln( screen_out, esc, '[', rec_num+5:0, ';40H', score:5, ' ', username, ' ', text,  ' ', games_played:0 );
  1143.         
  1144.     writeln( screen_out, esc, '[20;1H', 'Current Score: ',my_Score:0 );
  1145.     Writeln( screen_out, message, game_name );
  1146.  
  1147.     if ask_for_text then
  1148.         begin
  1149.         if current_rec.text <> pad( '', ' ', text_length) then                {If there's an old text field}
  1150.             Write( Screen_out, 'Enter your name and press <Return> [',current_rec.text,']: ' )    {prompt with old text default}
  1151.             else Write( screen_out, 'Enter your name and press <Return>: ' );            {Or just prompt}
  1152.         Readln( screen_in, Text_input, error := continue );                                {Read my text}
  1153.         if text_input.length = 0 then text_input := current_rec.text;            {Save old text}
  1154.         if text_input.length >= text_length then text_input.length := text_length    {so no overflow}
  1155.             else text_input := pad( text_input, ' ', text_length );            {Pad to text_length}
  1156.         if text_input.length <> 0 then month_scores[score_place].text := text_input;    {if any input change .text}
  1157.         end;
  1158.     end;
  1159.  
  1160. BEGIN
  1161.     Open( screen_in, 'SYS$INPUT', history := readonly );
  1162.     Reset( screen_in );
  1163.     Open( screen_out, 'SYS$OUTPUT', history := new );
  1164.     Rewrite( Screen_out );
  1165.     sleep_time.long1 := -50000000;    { Set this up to delay 5 secs}
  1166.     sleep_time.long2 := -1;
  1167.  
  1168.     opened := false;
  1169.     bombed_out := false;
  1170.     Null_rec    := zero;
  1171.     current_rec    := zero;
  1172.     ask_for_text    := false;
  1173.     score_place    := 0;
  1174.     wait_time    := 0;
  1175.     Read_scores;
  1176.     if not bombed_out then         {If i succeeded in opening the file}
  1177.         begin
  1178.         Check_month;
  1179.         Check_score;
  1180.         display_scores;
  1181.         Write_scores;
  1182.         end;
  1183. END; {Procedure High_Score}
  1184.  
  1185. END. {Module}
  1186. $ EOD
  1187. $ Write Sys$output "Extracted TOPTENMDL.PAS..."
  1188. $ exit
  1189. $!-CUT-HERE--------------------------------------------------------
  1190.  
  1191.    ______________________________________________________________________
  1192.  The Sturgeon General has  determined that reading signatures can cause gross
  1193.  deformities in  fish,  carrots,  turnips, politicians and other dumb animals
  1194.     DO NOT LOOK AT THIS SIGNATURE THROUGH A MAGNIFYING GLASS
  1195. spt@waikato.ac.nz - Simon Travaglia, Computer Services, University of Waikato
  1196. Fax: 064-7-838-4066  Ph: 064-7-838-4008  SM: Priv. Bag, Hamilton, New Zealand
  1197.    ----------------------------------------------------------------------
  1198. You are only young once, but you can stay immature indefinitely.
  1199.