home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / PRTCTRL.SEQ < prev    next >
Encoding:
Text File  |  1989-07-03  |  3.4 KB  |  103 lines
  1. \ PRTCTRL.SEQ   Print control file                      by Tom Zimmer
  2.  
  3. \ Allows the editor to do BOLD, UNDERLINE, ect.
  4.  
  5. editor definitions
  6.  
  7. 0 value bldvar                  \ Bold state variable
  8. 0 value ulvar                   \ Underline state variable
  9. variable compressvar          \ Compressed print variable
  10. 0 value 1onvar                  \ first of three user definable printer strings
  11. 0 value 2onvar
  12. 0 value 3onvar
  13.  
  14. variable null$  null$ off
  15.  
  16. null$ value pr-init$
  17. null$ value compresson$
  18. null$ value compressoff$
  19. null$ value boldon$
  20. null$ value boldoff$
  21. null$ value ulon$
  22. null$ value uloff$
  23. null$ value 1on$
  24. null$ value 1off$
  25. null$ value 2on$
  26. null$ value 2off$
  27. null$ value 3on$
  28. null$ value 3off$
  29.  
  30. forth definitions
  31.  
  32. : teletype      ( --- )
  33.                 null$ =: pr-init$
  34.                 null$ =: compresson$    null$ =: compressoff$
  35.                 null$ =: boldon$        null$ =: boldoff$
  36.                 null$ =: ulon$          null$ =: uloff$
  37.                 null$ =: 1on$           null$ =: 1off$
  38.                 null$ =: 2on$           null$ =: 2off$
  39.                 null$ =: 3on$           null$ =: 3off$ ;
  40.  
  41. editor definitions
  42.  
  43. : p$write       ( a1 --- )
  44.                 count prnhndl hwrite drop ;
  45.  
  46. : ?compressed   ( --- )
  47.                 compressvar @
  48.                 if      compresson$
  49.                 else    compressoff$
  50.                 then    p$write ;
  51.  
  52. : printer-init  ( --- )
  53.                 pr-init$ p$write
  54.                 ?compressed ;
  55.  
  56. : boldon        ( --- ) boldon$  p$write  on> bldvar ;
  57. : boldoff       ( --- ) boldoff$ p$write off> bldvar ;
  58. : ulon          ( --- ) ulon$    p$write  on> ulvar  ;
  59. : uloff         ( --- ) uloff$   p$write off> ulvar  ;
  60. : 1on           ( --- ) 1on$     p$write  on> 1onvar ;
  61. : 1off          ( --- ) 1off$    p$write off> 1onvar ;
  62. : 2on           ( --- ) 2on$     p$write  on> 2onvar ;
  63. : 2off          ( --- ) 2off$    p$write off> 2onvar ;
  64. : 3on           ( --- ) 3on$     p$write  on> 3onvar ;
  65. : 3off          ( --- ) 3off$    p$write off> 3onvar ;
  66.  
  67. : lineendoff    ( --- )
  68.                 bldvar if boldoff then
  69.                 ulvar  if uloff   then
  70.                 1onvar if 1off    then
  71.                 2onvar if 2off    then
  72.                 3onvar if 3off    then ;
  73.  
  74. : prtfunc       ( c1 --- )      \ builds printer attribute control functions
  75.                 create c,
  76.                 does>   dup>r c@ over =
  77.                 if      drop false
  78.                         r@ 1+ perform abs 1+ 2* r@ + 1+ perform
  79.                 then    r>drop ;
  80.  
  81. '1' prtfunc ?1on       ' 1onvar , ' 1on  ,    ' 1off ,
  82. '2' prtfunc ?2on       ' 2onvar , ' 2on  ,    ' 2off ,
  83. '3' prtfunc ?3on       ' 3onvar , ' 3on  ,    ' 3off ,
  84. 'b' prtfunc ?bold      ' bldvar , ' boldon  , ' boldoff ,
  85. 'u' prtfunc ?underline ' ulvar ,  ' ulon ,    ' uloff ,
  86.  
  87. : ptype         ( a1 n1 --- )           \ type a string to the printer
  88.                 bounds
  89.                 ?do     i c@ '%' =
  90.                         if      i 1+ c@ bl or
  91.                                 ?underline ?bold ?1on ?2on ?3on
  92.                                 if      i c@ pemit
  93.                                         1       \ skip to next character
  94.                                 else    2       \ skip an extra character
  95.                                 then
  96.                         else i c@ pemit 1       \ skip to next character
  97.                         then
  98.                +loop    ;
  99.  
  100. forth definitions
  101.  
  102.  
  103.