home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / EASYBUFF.IQC / EASYBUFF.INC
Text File  |  2000-06-30  |  6KB  |  148 lines
  1. {EASYBUFF.PAS ----Easy buffered text output for CP/M Turbo Pascal v.2.00
  2.  By Benjamin Ho
  3.  Evanston, IL
  4.  4/11/86
  5.  
  6.  Did you ever try to process a text file using this traditional,
  7.  straightforward method of text processing ?
  8.  
  9.    while not eof(input) do begin
  10.      read (input, ch) ;
  11.      process (ch) ;
  12.      write (output, ch) ;
  13.    end ;
  14.  
  15.   If so, you've undoubtly heard your disk heads jumping madly between the
  16.   input and output files.  This activity, which is very bad for your drives,
  17.   is caused by Turbo's use of a pitifully small buffer (128 bytes) for
  18.   text output.
  19.  
  20.   These routines provide a larger, user-selectable buffer for the standard
  21.   procedures write and writeln.  Eliminate fussing with user-written buffering
  22.   procedures which have to be tailored for each program and save your disk
  23.   drives from excessive wear and tear by using these routines.
  24.  
  25.   Caveats : If your program uses the USR standard device, these routines
  26.             are NOT for you.
  27.  
  28.   Useage:
  29.     include this file at the beginning of your program.  Set the constant
  30.     ZSIZE to a multiple of 128, and then
  31.  
  32.   1) Instead of opening your output file with
  33.  
  34.      var output: text ;
  35.      assign (output, 'filename.ext') ;
  36.      reset (output),
  37.  
  38.      just call initwrite ('filename.ext').
  39.  
  40.   2) When output is desired, use writeln (usr,var1,var2...) ;
  41.   3) Instead of close(f), use endwrite.
  42.  
  43.   Make sure to use endwrite! If you don't, data will be lost!
  44.  
  45.   These routines work by re-directing USR output to a buffer
  46.   which is automatically written to disk when full.  }
  47.  
  48. {   Date         : May 8, 1986                                           }
  49. {   Update By    : Ken Isacson                                           }
  50. {   Instructions : Set Max to the maximum nuumber of buffers to be       }
  51. {                  open at one time.  When you call either InitWrite     }
  52. {                  or EndWrite or Writeln(Usr, Var) be sure you have     }
  53. {                  BufferNumber set to the correct buffer number.        }
  54. {                  I.e. File number one gets BufferNumber := 1.          }
  55. {                       File number two gets BufferNumber := 2.          }
  56. {                       etc...                                           }
  57. {   Reason       :  Allows you to have more than just one buffer!        }
  58. {. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . }
  59.  
  60. const zsize = 4096 ; {default 4K buffer}
  61.       Max   = 1    ; {Maximum number of buffers to be opened at one time}
  62.  
  63. type outfilename = string [14] ;
  64. var zbuff        : array [1..zsize] of char ;
  65.     zcount,zi    : integer ;
  66.     zf           : file ;
  67.     BufferNumber : Integer; {You need to be setting this accordingly in your
  68.                              Program }
  69.  
  70. {----------------------------------------------------------}
  71. procedure diskoff ;
  72. {The disk drive motors on Kaypro machines don't always know when to stop
  73.  spinning, so this routine is included to turn them off.}
  74.  
  75. var i : integer ;
  76.     junk : boolean ;
  77.  
  78. begin
  79.   for i := 1 to 256 do
  80.     junk := keypressed ;
  81. end ;
  82.  
  83. {----------------------------------------------------------}
  84. procedure bwrite (ch : char) ;
  85. {This replaces the USROUT routine called by write/ln.  Instead of going
  86.  to the USR device, characters go into a buffer.  When the buffer is
  87.  full, it is automatically written to disk.  Direct bdos calls are
  88.  used to write the buffer because using Blockwrite can't be used.
  89.  Evidently, Turbo has problems when its i/o procedures call each other.}
  90.  
  91. var i : integer ;
  92.  
  93. begin
  94.   if zcount[BufferNumber] < zsize then begin  {put char into buffer}
  95.     zcount[BufferNumber] := zcount[BufferNumber] + 1 ;
  96.     zbuff [BufferNumber, zcount[BufferNumber]] := ch ;
  97.   end
  98.   else begin                                             {handle full buffer}
  99.     for i := 1 to zsize div 128 do begin                 {Flush buffer      }
  100.       bdos (26, addr(zbuff[BufferNumber,1])+128*(i-1)) ; {Set dma addr      }
  101.       bdos (21, addr(zf[BufferNumber])+12);              {write 128 bytes   }
  102.     end ;
  103.     DiskOff ;
  104.     for i := 1 to zsize do                               {re-init buffer    }
  105.       zbuff [BufferNumber, i] := #26 ;
  106.     zcount[BufferNumber] := 1 ;                         {reset buffer pointer}
  107.     zbuff [BufferNumber, zcount[BufferNumber]] := ch ;
  108.   end ;
  109. end ;
  110.  
  111.  
  112.  
  113. {----------------------------------------------------------}
  114. procedure initwrite (name: outfilename) ;
  115. {sets up buffer, redirects USR output to buffer, opens output file}
  116.  
  117. var i :integer ;
  118.  
  119. begin {initwrite}
  120.   zcount[BufferNumber] := 0 ;        {initialize buffer ptr}
  121.   usroutptr := addr(bwrite) ;        {make our routine the usr routine}
  122.   for i := 1 to zsize do             {initialize buffer}
  123.     zbuff [BufferNumber, i] := #26 ;
  124.   assign (zf[BufferNumber], name) ;  {connect to proper file}
  125.   rewrite (zf[BufferNumber]) ;
  126. end ; {initwrite}
  127.  
  128. {----------------------------------------------------------}
  129. procedure endwrite ;
  130. {Flushes out any remaining characters in buffer, closes file}
  131.  
  132. var even : boolean ;
  133.     sec,i : integer ;
  134.  
  135. begin {endwrite}
  136.   if zcount[BufferNumber] <> 0 then begin    {flush out unwritten buffer}
  137.     even := (zcount[BufferNumber] mod 128 = 0) ;
  138.     if even then sec := zcount[BufferNumber] div 128
  139.       else sec := zcount[BufferNumber] div 128 + 1 ;
  140.     for i := 1 to sec do begin               {flush buffer}
  141.       bdos (26, addr(zbuff[BufferNumber, 1])+128*(i-1)) ;  {set dma addr}
  142.       bdos (21, addr(zf[BufferNumber])+12)                 {write 128 bytes}
  143.     end ;
  144.     DiskOff ;
  145.   end ;
  146.   close (zf[BufferNumber]) ;
  147. end ;   {endwrite}
  148.