home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFB.ZIP / FFUTILS.ARC / ZIMMER.ARC / TDISK.SEQ < prev    next >
Encoding:
Text File  |  1988-01-11  |  2.3 KB  |  62 lines
  1. \ TDISK.SEQ     Text to disk write routines.            by Tom Zimmer
  2.  
  3. ?dark
  4. .comment:
  5.  
  6.   Routines to allow printing to a disk file.
  7.  
  8.   Just enter PRTON to create a print file on disk called TEXT.PRN. After
  9. using PRTON, any printed output performed with PRINT, or PRINTING ON/OFF
  10. will go to this file.  Finish up text file output by entering PRTOFF.
  11. This closes the print file.
  12.  
  13.   The filename used for printing, can be specified with the PRTSET command.
  14. Enter:
  15.         PRTSET <filename> <enter>
  16.  
  17.   To specify a print file other than TEXT.PRN. The extension ".PRN" will
  18. always be applied to your print filename.
  19.  
  20.  
  21. comment;
  22.  
  23. create aline    128 allot       \ 128 character line buffer
  24. variable len    len off         \ current line buffer character position.
  25. handle prtfile                  \ Print file handle
  26.  
  27. : c>file        ( c1 --- )     \ Character to file
  28.                 dup     aline len @ + c! len incr 10 =  \ write on linefeed
  29.                 len @ 127 > or                          \ or on long line.
  30.                 if      aline len @ prtfile hwrite drop
  31.                         len off
  32.                 then    #out incr ;
  33.  
  34. : prtset        ( name --- )
  35.                 bl word                 \ specify a filename
  36.                 prtfile $>handle          \ move it to the handle
  37.                 " PRN" ">$ prtfile $>ext ;  \ make file extension always .TXT
  38.  
  39. prtset TEXT                             \ default to "TEXT.PRN"
  40.  
  41. : prtoff        ( --- )                 \ Terminate printing, and close file.
  42.                 prtfile >hndle @ 0<     \ Leave if already closed.
  43.                 if      exit
  44.                 then
  45.                 13 c>file 10 c>file
  46.                 ['] (print) is pemit
  47.                 prtfile hclose drop
  48.                 fast staton ;
  49.  
  50. : prton         ( --- )                 \ Enable printing and create file.
  51.                 prtfile >hndle @ -1 >   \ Leave if file is already open.
  52.                 if      exit
  53.                 then
  54.                 prtfile >hndle @ 0<
  55.                 if      prtfile hcreate             \ make the file
  56.                         abort" Couldn't create file"  \ abort if error
  57.                         len off                         \ newline
  58.                 then    slow statoff
  59.                 ['] c>file is pemit ;
  60.  
  61. 60 tillkey
  62.