home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / prtctrl.seq < prev    next >
Text File  |  1991-03-06  |  4KB  |  107 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 pr-reset$
  18. null$ value compresson$
  19. null$ value compressoff$
  20. null$ value boldon$
  21. null$ value boldoff$
  22. null$ value ulon$
  23. null$ value uloff$
  24. null$ value 1on$
  25. null$ value 1off$
  26. null$ value 2on$
  27. null$ value 2off$
  28. null$ value 3on$
  29. null$ value 3off$
  30.  
  31. forth definitions
  32.  
  33. : teletype      ( --- )
  34.                 null$ =: pr-init$       null$ =: pr-reset$
  35.                 null$ =: compresson$    null$ =: compressoff$
  36.                 null$ =: boldon$        null$ =: boldoff$
  37.                 null$ =: ulon$          null$ =: uloff$
  38.                 null$ =: 1on$           null$ =: 1off$
  39.                 null$ =: 2on$           null$ =: 2off$
  40.                 null$ =: 3on$           null$ =: 3off$ ;
  41.  
  42. editor definitions
  43.  
  44. : p$write       ( a1 --- )
  45.                 count prnhndl hwrite drop ;
  46.  
  47. : ?compressed   ( --- )
  48.                 compressvar @
  49.                 if      compresson$
  50.                 else    compressoff$
  51.                 then    p$write ;
  52.  
  53. : printer-init  ( -- )
  54.                 pr-init$ p$write
  55.                 ?compressed ;
  56.  
  57. : printer-reset ( -- )
  58.                 pr-reset$ p$write ;
  59.  
  60. : boldon        ( --- ) boldon$  p$write  on> bldvar ;
  61. : boldoff       ( --- ) boldoff$ p$write off> bldvar ;
  62. : ulon          ( --- ) ulon$    p$write  on> ulvar  ;
  63. : uloff         ( --- ) uloff$   p$write off> ulvar  ;
  64. : 1on           ( --- ) 1on$     p$write  on> 1onvar ;
  65. : 1off          ( --- ) 1off$    p$write off> 1onvar ;
  66. : 2on           ( --- ) 2on$     p$write  on> 2onvar ;
  67. : 2off          ( --- ) 2off$    p$write off> 2onvar ;
  68. : 3on           ( --- ) 3on$     p$write  on> 3onvar ;
  69. : 3off          ( --- ) 3off$    p$write off> 3onvar ;
  70.  
  71. : lineendoff    ( --- )
  72.                 bldvar if boldoff then
  73.                 ulvar  if uloff   then
  74.                 1onvar if 1off    then
  75.                 2onvar if 2off    then
  76.                 3onvar if 3off    then ;
  77.  
  78. : prtfunc       ( c1 --- )      \ builds printer attribute control functions
  79.                 create c,
  80.                 does>   dup>r c@ over =
  81.                 if      drop false
  82.                         r@ 1+ perform abs 1+ 2* r@ + 1+ perform
  83.                 then    r>drop ;
  84.  
  85. '1' prtfunc ?1on       ' 1onvar , ' 1on  ,    ' 1off ,
  86. '2' prtfunc ?2on       ' 2onvar , ' 2on  ,    ' 2off ,
  87. '3' prtfunc ?3on       ' 3onvar , ' 3on  ,    ' 3off ,
  88. 'b' prtfunc ?bold      ' bldvar , ' boldon  , ' boldoff ,
  89. 'u' prtfunc ?underline ' ulvar ,  ' ulon ,    ' uloff ,
  90.  
  91. : ptype         ( a1 n1 --- )           \ type a string to the printer
  92.                 bounds
  93.                 ?do     i c@ '%' =
  94.                         if      i 1+ c@ bl or
  95.                                 ?underline ?bold ?1on ?2on ?3on
  96.                                 if      i c@ pemit
  97.                                         1       \ skip to next character
  98.                                 else    2       \ skip an extra character
  99.                                 then
  100.                         else i c@ pemit 1       \ skip to next character
  101.                         then
  102.                +loop    ;
  103.  
  104. forth definitions
  105.  
  106.  
  107.