SPACE 2/SPACE - Library 2 - Volume 1.iso/program/177/pascal/fastread.inc

Text File | 1987-09-15 | 24.4 KB | 670 lines

{*************************************************************}
{*               Eric's FASTREAD Routines                    *}
{*                                                           *}
{*   Written by:                                             *}
{*      Eric W. Wedaa                                        *}
{*      4620 East 17th Street                                *}
{*      Tucson AZ, 85711                                     *}
{*                                                           *}
{*   Copyrighted 1987 by Eric W. Wedaa                       *}
{*                                                           *}
{*      BIX: EWEDAA                                          *}
{*      CIS: 76515,2274                                      *}
{*                                                           *}
{*   Release Date: August 27, 1987.                          *}
{*                                                           *}
{*************************************************************}
{*                                                           *}
{*   Written for OSS Pascal Version 1.14                     *}
{*               GEM/TOS in ROM Version 1.00                 *}
{*                                                           *}
{*       Released in the Public Domain!                      *}
{*                                                           *}
{*************************************************************}
{*                                                           *}
{*   Design Tools included:                                  *}
{*        Eric's Pascal Utilities,                           *}
{*        Eric's Pascal Editor,                              *}
{*        1st Word ver 1.03, by GST,                         *}
{*        Alt, By Michtron,                                  *}
{*        OSS Pascal, By O.S.S. and C.C.D.                   *}
{*   and, Eric's Library Disk for OSS Pascal.                *}
{*                                                           *}
{*************************************************************}


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{++    The following files are needed to use these routines ++}
{++       --Fastread.inc                                    ++}
{++       --Fastread.con                                    ++}
{++       --Fastread.typ                                    ++}
{++       --Fastread.doc                                    ++}
{++       --Read.Me                                         ++}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{Copyright 1987 by Eric W. Wedaa}

{Don't forget to include the FASTREAD constants and types.    }


{1111111111111111111111111111111111111111111111111111111111111}
{1111  Gemdos File Create Command.    111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION f_create (VAR
     a_file_name : path_chars ; {  File name in "C" format.   }
     mode : INTEGER) {             Mode to open the file.     }
: INTEGER ; {                     Error Number.               }

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!   }

{    For this application, mode is always set to 0 for writing}
{ the file only.                                              }

GEMDOS ($3C) ;

{1111111111111111111111111111111111111111111111111111111111111}
{1111  Gemdos File Open Command.    11111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION f_open (VAR
     a_file_name : path_chars ; {  File name in "C" format.   }
     mode : INTEGER) {             Mode to open the file.     }
: INTEGER ; {                     Error Number.              }

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!   }

{    For this application, mode is always set to 0 for reading}
{ the file only.                                              }

GEMDOS ($3d) ;

{1111111111111111111111111111111111111111111111111111111111111}
{1111   Gemdos File Close Command.    111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION file_close (HANDLE : INTEGER) {File handle.          }
: INTEGER ; {                        Error Number.            }

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!   }

GEMDOS ($3e) ;

{1111111111111111111111111111111111111111111111111111111111111}
{1111   Gemdos File Read Command.    1111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION f_read (HANDLE : INTEGER ; {File Handle.             }
     count : LONG_INTEGER ; {        Bytes to be read in.     }
     VAR
        buf : contents) {            Where to store the file. }
   : LONG_INTEGER ;

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!   }

GEMDOS ($3f) ;

{1111111111111111111111111111111111111111111111111111111111111}
{1111   Gemdos File Write Command.     11111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION fast_write (HANDLE : INTEGER ; {File Handle.            }
     count : LONG_INTEGER ; {        Bytes to be read in.     }
     VAR
        buf : contents) {            Where to store the file. }
   : LONG_INTEGER ;

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!   }

GEMDOS ($40) ;

{1111111111111111111111111111111111111111111111111111111111111}
{1111   Loads the buffer after reset and readln.  111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_read_file (VAR
     txt_buffer : buffer) ;

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!   }

 BEGIN ;
   txt_buffer.buffer_len :=  f_read (txt_buffer.file_handle,
        contents_size, txt_buffer.buffer_contents) ;
   txt_buffer.buffer_contents[ contents_size + 1 ] :=  CHR (1) ;
   IF txt_buffer.buffer_len >=  0
      THEN
       BEGIN ; { No error occured.}
         txt_buffer.eof_buffer :=  FALSE ;
         txt_buffer.buffer_pos :=  1 ;
         txt_buffer.no_error :=  TRUE ;
         IF txt_buffer.buffer_len = contents_size
            THEN txt_buffer.last_buffer :=  FALSE
            ELSE
               BEGIN ; { Less than full buffer was loaded. }
                  txt_buffer.last_buffer :=  TRUE ;
                  IF txt_buffer.buffer_len = 0
                     THEN txt_buffer.eof_buffer :=  TRUE ;
               END ;
       END{ Of No error occured.}

      ELSE
         BEGIN ; {error occured.}
            txt_buffer.buffer_pos :=  1 ;
            txt_buffer.error_number :=  INT (txt_buffer.buffer_len) ;
            txt_buffer.no_error :=  FALSE ;
            txt_buffer.buffer_len :=  0 ;
            txt_buffer.last_buffer :=  TRUE ;
            txt_buffer.eof_buffer :=  TRUE ;
         END ; {of error occured.  }
 END ; {of procedure f_read_file. }

{1111111111111111111111111111111111111111111111111111111111111}
{1111  writes and sets up the file here.   1111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_write_file (VAR
     a_buffer : buffer) ;
VAR
   bytes_written : LONG_INTEGER ;

 BEGIN ;
   WITH a_buffer DO
      BEGIN ;
bytes_written :=  fast_write (file_handle, buffer_len, buffer_contents) ;
         IF bytes_written < 0
            THEN
             BEGIN ; {Error occured. }
               no_error :=  FALSE ;
               error_number :=  INT (bytes_written) ;
               buffer_pos :=  1 ;
               buffer_len :=  0 ;
             END{Of error occurred. }
            ELSE
               BEGIN ; {No error. }
                  no_error :=  TRUE ;
                  error_number :=  0 ;
                  buffer_pos :=  1 ;
                  buffer_len :=  0 ;
               END ; {Of no error. }


      END ; {Of with A_Buffer do Begin. }
 END ; {Of procedure F_Write_File. }

{1111111111111111111111111111111111111111111111111111111111111}
{1111  Close the file here.   11111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_close (VAR
     txt_buffer : buffer) ;

{     This routine is allowed to be called by the programmer. }

 BEGIN ;
   WITH txt_buffer DO
      BEGIN ;
         IF reading_file
            THEN
             BEGIN ;
               buffer_pos :=  1 ;
               buffer_len :=  0 ;
               last_buffer :=  TRUE ;
               eof_buffer :=  TRUE ;
               error_number :=  file_close (file_handle) ;
               IF (error_number < 0)
                  THEN no_error :=  FALSE
                  ELSE no_error :=  TRUE ;
             END

            ELSE
               BEGIN ; {We're writing to this file. }
buffer_pos :=  fast_write (file_handle, buffer_len, buffer_contents) ;
                  IF buffer_pos <>  buffer_len
                     THEN
                      BEGIN ; {Errror occured}
                        error_number :=  file_close (file_handle) ;
                        error_number :=  INT (buffer_pos) ;
                        no_error :=  FALSE ;
                      END

                     ELSE
                        BEGIN ;
                           last_buffer :=  TRUE ;
                           eof_buffer :=  TRUE ;
                           error_number :=  file_close (file_handle) ;
                           IF (error_number < 0)
                              THEN no_error :=  FALSE
                              ELSE no_error :=  TRUE ;
                        END ;
               END ;
      END ; {of with txt_Buffer do. }
 END ; {of procedure F_Close);}


{1111111111111111111111111111111111111111111111111111111111111}
{1111  Checks for the End Of File.  11111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION f_eof (VAR
     txt_buffer : buffer)
: BOOLEAN ;

{Returns True if EOF has been reached/else returns false. }


{     This routine is allowed to be called by the programmer  }

 BEGIN ;
   IF txt_buffer.eof_buffer
      THEN f_eof :=  TRUE
      ELSE f_eof :=  FALSE ;
 END ; {Of function F_EOF.}


{1111111111111111111111111111111111111111111111111111111111111}
{1111  Checks to see if an error has occured.   11111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION f_error (VAR
     txt_buffer : buffer)
: BOOLEAN ;

{     This routine is allowed to be called by the programmer. }
{    Returns True if error occured, else returns false.       }

 BEGIN ;
   IF txt_buffer.no_error
      THEN f_error :=  FALSE
      ELSE f_error :=  TRUE ;
 END ; {Of function F_Error.}


{1111111111111111111111111111111111111111111111111111111111111}
{1111  Returns the error number if an error has occurred.  111}
{1111111111111111111111111111111111111111111111111111111111111}

FUNCTION f_io_result (VAR
     txt_buffer : buffer)
: INTEGER ; { Error number returned here.                       }

{     This routine is allowed to be called by the programmer. }

 BEGIN ;
   IF NOT txt_buffer.no_error
      THEN f_io_result :=  txt_buffer.error_number
      ELSE f_io_result :=  0 ;
 END ; {Of function F_error_number.}


{1111111111111111111111111111111111111111111111111111111111111}
{11111  Converts A_File_Name to Fast Read format.  11111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE make_path (VAR
     a_file_name : STRING ;
     VAR
        f_file_name : path_chars) ;
VAR
   x, len : INTEGER ;
 BEGIN ;
   len :=  LENGTH (a_file_name) ;
   FOR x :=  1 TO len DO
      f_file_name[ x ] :=  a_file_name[ x ] ;
   f_file_name[ len + 1 ] :=  CHR (0) ;
 END ;


{1111111111111111111111111111111111111111111111111111111111111}
{11111  Resets the file for reading.  111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_reset (VAR
     txt_buffer : buffer ;
     a_file_name : STRING ) ; {file name to be opened.        }

{     This routine is allowed to be called by the programmer. }

VAR
{    Used to convert file_name to C format.                   }
   f_file_name : path_chars ;

 BEGIN ;

{  Convert to "C" format. }
   make_path (a_file_name, f_file_name) ;

{Set constants.}
   txt_buffer.fast_return :=  CHR (13) ;
   txt_buffer.fast_line_feed :=  CHR (10) ;


{ Open it.}
   txt_buffer.file_handle :=  f_open (f_file_name, 0) ; {file name, mode of}
{read.}
   IF txt_buffer.file_handle >=  0
      THEN
       BEGIN ;
         f_read_file (txt_buffer) ; {load the buffer.}
         txt_buffer.reading_file :=  TRUE ;
       END

      ELSE
         BEGIN ; {error occured in opening it.}
            WITH txt_buffer DO
               BEGIN ;
                  buffer_pos :=  1 ;
                  buffer_len :=  0 ;
                  last_buffer :=  TRUE ;
                  eof_buffer :=  TRUE ;
                  error_number :=  HANDLE ;
                  no_error :=  FALSE
               END ; {of with txt_Buffer do. }
         END ; {of error occured in opening it. }
 END ; {of procedure F_Reset. }


{1111111111111111111111111111111111111111111111111111111111111}
{11111  Sets up the file for writing.  11111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_rewrite (VAR
     txt_buffer : buffer ;
     a_file_name : STRING ) ; {file name to be opened.        }

{     This routine is allowed to be called by the programmer. }

VAR
{    Used to convert file_name to C format.                   }
   f_file_name : path_chars ;

 BEGIN ;

{  Convert to "C" format. }
   make_path (a_file_name, f_file_name) ;

{Set constants.}
   txt_buffer.fast_return :=  CHR (13) ;
   txt_buffer.fast_line_feed :=  CHR (10) ;


{ Open it.}
   txt_buffer.file_handle :=  f_create (f_file_name, 0) ; {file name, mode of}
{   if txt_buffer.file_Handle>=0}
{ then Txt_Buffer.File_Handle :=  F_Open (F_File_Name, 1) ;}{file name, mode of}
{read.}
   IF txt_buffer.file_handle >=  0
      THEN
       BEGIN ;
         WITH txt_buffer DO
            BEGIN ;
               buffer_pos :=  1 ;
               buffer_len :=  0 ;
               last_buffer :=  FALSE ;
               eof_buffer :=  FALSE ;
               error_number :=  0 ;
               no_error :=  TRUE ;
               reading_file :=  FALSE ;
            END ; {of with txt_Buffer do. }
       END

      ELSE
         BEGIN ; {error occured in opening it.}
            WITH txt_buffer DO
               BEGIN ;
                  buffer_pos :=  1 ;
                  buffer_len :=  0 ;
                  last_buffer :=  TRUE ;
                  eof_buffer :=  TRUE ;
                  error_number :=  HANDLE ;
                  no_error :=  FALSE
               END ; {of with txt_Buffer do. }
         END ; {of error occured in opening it. }
 END ; {of procedure F_Rewrite. }

{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_readln (VAR
     a_buffer : buffer ;
     VAR
        txt_line : max_string) ; {Text line returned.   }

{     This routine is allowed to be called by the programmer. }

VAR
   counter : INTEGER ; {the length of the line returned. }

{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}

   PROCEDURE f_read_it ;

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!        }

    BEGIN ;
      WITH a_buffer DO
         BEGIN ;
            IF (NOT eof_buffer)
               THEN
                BEGIN ; {           Load the string.                }
                  WHILE (buffer_contents[ INT (buffer_pos) ] <>  fast_return)
                  AND (counter < string_size)
                  AND (buffer_pos <=  buffer_len ) DO
                     BEGIN ;
                        counter :=  counter + 1 ;
txt_line[ counter ] :=  buffer_contents[ INT (buffer_pos) ] ;
                        buffer_pos :=  buffer_pos + 1 ;
                     END ;

                  IF (buffer_pos <=  buffer_len)
                     AND (buffer_contents[ INT (buffer_pos) ] = fast_return )
                     THEN
                      BEGIN ; {   Normal end of line hit.          }
                        txt_line[ 0 ] :=  CHR (counter) ;
                        buffer_pos :=  buffer_pos + 2 ;
                        IF (buffer_pos > buffer_len)
                           AND (NOT last_buffer)
                           THEN
                            BEGIN ; {Load the buffer again. }
                              f_read_file (a_buffer) ;
                              IF buffer_contents [ 1 ] = fast_line_feed
                                 THEN buffer_pos :=  2
                                 ELSE buffer_pos :=  1 ;
                            END ; {of load the buffer again.}
                      END{of buffer_pos = chr(12). }

{                  Is the string full?                            }
                     ELSE IF (counter >=  string_size)
                        THEN txt_line[ 0 ] :=  CHR (counter)

                        ELSE IF (buffer_pos > buffer_len)
                           AND (NOT last_buffer)
                           THEN
                            BEGIN ; {Have to load and read again. }
{                         Load it here. }
                              f_read_file (a_buffer) ; {load the buffer.}
{                         Finish reading the line here.}
                              IF no_error
                                 THEN f_read_it
                                 ELSE txt_line[ 0 ] :=  CHR (counter) ;
                            END{ of have to load it again.}

{         Did we hit the last char in the file?             }
                           ELSE IF (buffer_pos >=  buffer_len)
                              AND ( last_buffer)
                              THEN
                               BEGIN ; {set length to counter and eof to true. }
                                 txt_line[ 0 ] :=  CHR (counter) ;
                                 eof_buffer :=  TRUE ;
                               END ;
                END ; {of not eof buffer.}
         END ; {of with buffer do begin. }
    END ; {of f_Read_it. }

{------------------------------------------------------------------}
 BEGIN ;
   txt_line[ 0 ] :=  CHR (0) ;
   counter :=  0 ;
   f_read_it ;
 END ; {of f_readln. }

{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_writeln (VAR
     a_buffer : buffer ;
     VAR
        txt_line : max_string) ; {Text line returned.   }

{     This routine is allowed to be called by the programmer. }

VAR
   string_size, {       The size of the string.          }
   counter : INTEGER ; {the length of the line returned. }

{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}

   PROCEDURE f_write_it ;

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!        }

    BEGIN ;
      WITH a_buffer DO
         BEGIN ;
            WHILE (counter < string_size)
            AND (buffer_pos <=  contents_size ) DO
               BEGIN ;
                  counter :=  counter + 1 ;
                  buffer_contents[ INT (buffer_pos) ] :=  txt_line[ counter ] ;
                  buffer_pos :=  buffer_pos + 1 ;
               END ;

            buffer_len :=  buffer_pos - 1 ;

            IF (buffer_pos <=  contents_size - 1)
               THEN
                BEGIN ; {   Normal end of line hit.          }
                  buffer_contents[ INT (buffer_pos) ] :=  fast_return ;
                  buffer_pos :=  buffer_pos + 1 ;
                  buffer_contents[ INT (buffer_pos) ] :=  fast_line_feed ;
                  buffer_pos :=  buffer_pos + 1 ;
                  buffer_len :=  buffer_len + 2 ;
                  IF (buffer_len = contents_size)
                     THEN f_write_file (a_buffer) ;
                END{of buffer_pos  <=  Contents_Size. }

               ELSE IF (buffer_pos > contents_size)
                  THEN
                   BEGIN ; {Have to write it and finsh the line. }
{                         Write it here. }
                     f_write_file (a_buffer) ; {load the buffer.}
{                         Finish writing the line here.}
                     IF no_error
                        THEN f_write_it ;
                   END

                  ELSE
                     BEGIN ;
{The end of the line occurs at the buffer boudary.}
                        IF buffer_pos = contents_size
                           THEN
                            BEGIN ;
buffer_contents[ INT (buffer_pos) ] :=  fast_return ;
                              buffer_len :=  buffer_len + 1 ;
                              f_write_file (a_buffer) ;
buffer_contents[ INT (buffer_pos) ] :=  fast_line_feed ;
                              buffer_pos :=  buffer_pos + 1 ;
                              buffer_len :=  buffer_len + 1 ;
                            END

                           ELSE
                              BEGIN ; {Buffer_Pos > Contents_Size. }
                                 f_write_file (a_buffer) ;
buffer_contents[ INT (buffer_pos) ] :=  fast_return ;
                                 buffer_pos :=  buffer_pos + 1 ;
buffer_contents[ INT (buffer_pos) ] :=  fast_line_feed ;
                                 buffer_pos :=  buffer_pos + 1 ;
                                 buffer_len :=  buffer_len + 2 ;
                              END ;
                     END ; {The end of the line occurs at the buffer boudary.}

         END ; {of with A_Buffer do begin. }
    END ; {of F_Write_It. }

{------------------------------------------------------------------}
 BEGIN ;
   string_size :=  LENGTH (txt_line) ;
   counter :=  0 ;
   f_write_it ;
 END ; {of F_Writeln. }


{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}

PROCEDURE f_write (VAR
     a_buffer : buffer ;
     VAR
        txt_line : max_string) ; {Text line returned.   }

{     This routine is allowed to be called by the programmer. }

VAR
   string_size, {       The size of the string.          }
   counter : INTEGER ; {the length of the line returned. }

{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}

   PROCEDURE f_write_2it ;

{     This routine is NOT TO BE CALLED BY THE PROGRAMMER!!!        }

    BEGIN ;
      WITH a_buffer DO
         BEGIN ;
            WHILE (counter < string_size)
            AND (buffer_pos <=  contents_size ) DO
               BEGIN ;
                  counter :=  counter + 1 ;
                  buffer_contents[ INT (buffer_pos) ] :=  txt_line[ counter ] ;
                  buffer_pos :=  buffer_pos + 1 ;
               END ;

            buffer_len :=  buffer_pos - 1 ;

            IF (buffer_pos <=  contents_size )
               THEN
                BEGIN ; {   Normal end of line hit.          }
{                   Don't do anything.}
                END

               ELSE IF (buffer_pos > contents_size)
                  THEN
                   BEGIN ; {Have to write it and finsh the line. }
{                         Write it here. }
                     f_write_file (a_buffer) ; {load the buffer.}
{                         Finish writing the line here.}
                     IF no_error
                        THEN f_write_2it ;
                   END ;

         END ; {of with A_Buffer do begin. }
    END ; {of F_Write_It. }

{------------------------------------------------------------------}
 BEGIN ;
   string_size :=  LENGTH (txt_line) ;
   counter :=  0 ;
   f_write_2it ;
 END ; {of F_Write. }