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 / MAPSTATF.LBR / TRANSBUF.LZB / TRANSBUF.ÌIB
Text File  |  2000-06-30  |  3KB  |  77 lines
  1. {Modified version of
  2.  EASYBUFF.PAS ----Easy buffered text output for CP/M Turbo Pascal v.2.00
  3.  -sorry, I have long since lost the proper credits for these routines but
  4.   they are in my files as public domain material-
  5.   These routines work by re-directing USR output to a
  6.   buffer which is automatically written to disk when full.  }
  7.  
  8. const zsize = 8192 ; {default 8K buffer}
  9.  
  10. type outfilename = String[12] ;
  11. var zbuff        : array [1..zsize] of char ;
  12.     zcount       : integer ;
  13.     zf           : file ;
  14.  
  15. {------}
  16. procedure bwrite (ch : char) ;
  17. {This replaces the USROUT routine called by write/ln.  Instead of going
  18.  to the USR device, characters go into a buffer.  When the buffer is
  19.  full, it is automatically written to disk.  Direct bdos calls are
  20.  used to write the buffer because using Blockwrite can't be used.
  21.  Evidently, Turbo has problems when its i/o procedures call each other.}
  22.  
  23. var i : integer ;
  24.  
  25. begin
  26.   if zcount < zsize then begin  {put char into buffer}
  27.     zcount := zcount + 1 ;
  28.     zbuff [zcount] := ch ;
  29.   end
  30.   else begin                                             {handle full buffer}
  31.     for i := 1 to zsize div 128 do begin                 {Flush buffer      }
  32.       bdos (26, addr(zbuff[1])+128*(i-1)) ;              {Set dma addr      }
  33.       bdos (21, addr(zf)+12);                            {write 128 bytes   }
  34.     end ;
  35.     for i := 1 to zsize do                               {re-init buffer    }
  36.       zbuff [i] := #26 ;
  37.     zcount := 1 ;                                      {reset buffer pointer}
  38.     zbuff [zcount] := ch ;
  39.   end ;
  40. end ;
  41.  
  42.  
  43. {------}
  44. procedure initwrite (name: outfilename) ;
  45. {sets up buffer, redirects USR output to buffer, opens output file}
  46.  
  47. var i :integer ;
  48.  
  49. begin {initwrite}
  50.   zcount := 0 ;        {initialize buffer ptr}
  51.   usroutptr := addr(bwrite) ;        {make our routine the usr routine}
  52.   for i := 1 to zsize do             {initialize buffer}
  53.     zbuff [i] := #26 ;
  54.   assign (zf, name) ;  {connect to proper file}
  55.   rewrite (zf) ;
  56. end ; {initwrite}
  57.  
  58. {------}
  59. procedure endwrite ;
  60. {Flushes out any remaining characters in buffer, closes file}
  61.  
  62. var even : boolean ;
  63.     sec,i : integer ;
  64.  
  65. begin {endwrite}
  66.   if zcount <> 0 then begin    {flush out unwritten buffer}
  67.     even := (zcount mod 128 = 0) ;
  68.     if even then sec := zcount div 128
  69.       else sec := zcount div 128 + 1 ;
  70.     for i := 1 to sec do begin               {flush buffer}
  71.       bdos (26, addr(zbuff[1])+128*(i-1)) ;  {set dma addr}
  72.       bdos (21, addr(zf)+12)                 {write 128 bytes}
  73.     end ;
  74.   end ;
  75.   close (zf) ;
  76. end ;   {endwrite}
  77. ocedure initwrite (name: