home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / tbox.seq < prev    next >
Encoding:
Text File  |  1990-04-18  |  4.2 KB  |  126 lines
  1. \ BOXTEXT.SEQ   Some simple boxes around text.          by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.         BOXTEXT.SEQ
  6.  
  7.           A cute little routine that works like ." to print messages
  8.         to the screen.  The difference here is that .BOX" requires an
  9.         X and Y coordinate of where to start printing the message,
  10.         and it also prints a box around your text string, with
  11.         graphic line draw characters.  .BOX" is used as follows:
  12.  
  13.                 : boxtest       ( --- )
  14.                                 10 10 .box" hello there"
  15.                                 15 20 .box" This is a box test" ;
  16.  
  17.           As you can see it is used like ." .
  18.  
  19.         BOX  &  BOX&FILL
  20.  
  21.           These words have been generalized simewhat to automatically
  22.         position the cursor on their first empty line after drawing
  23.         the box. You can then simply use .", TYPE, or EMIT or SPACE
  24.         to display text on this first line. To get to the next line
  25.         of the box, use BCR for BOX CR which will position the cursor
  26.         on the first character position of the second boc line. Here
  27.         is an example:
  28.  
  29.  
  30.                 : example       ( --- )
  31.                                 10 10 35 15 box&fill
  32.                                     ." This is the first line"
  33.                                 bcr ." this is the second line"
  34.                                 bcr ." this is the third line"
  35.                                 bcr ." ect." cr ;   \s
  36.  
  37.         You can load this example by typing 29 LOAD <enter>. After
  38.         doing that type EXAMPLE <enter> to see the box and text.
  39.  
  40. comment;
  41.  
  42. FORTH DECIMAL TARGET >LIBRARY       \ A Library file
  43.  
  44. 0 value tx   0 value ty
  45. 0 value bx   0 value by
  46. 0 value bline                   \ box line where text will go next
  47.  
  48. ALSO HTARGET DEFINITIONS
  49.  
  50. 0 value fbx
  51. 0 value tlc  0 value tln
  52. 0 value trc
  53.  
  54. : bwidth        ( -- n1 )
  55.                 bx tx - 1- 0max ;
  56.  
  57. : .boxline      ( n1 -- )
  58.                 tx over at ." │"        \ left side of box
  59.                 fbx                     \ fill the box?
  60.                 if      bwidth spaces
  61.                 then
  62.                 bx swap at ." █" ;      \ right side of box
  63.  
  64. : <box>         ( left top right bottom filled --- )
  65.                 =: fbx
  66.                 rows 1- min =: by
  67.                 cols 1- min =: bx
  68.                 =: ty =: tx
  69.                 tx ty at tlc emit               \ top left corner
  70.                 tln 0>
  71.                 if      bwidth 0
  72.                        ?do       tln emit       \ top side of box
  73.                         loop     trc emit
  74.                 else    bx ty at trc emit       \ top right corner
  75.                 then
  76.                 tx by at ." └"                  \ bottom left corner
  77.                 bwidth 0
  78.                ?do       ." ▄"                  \ bottom side of box
  79.                 loop     ." █"                  \ bottom right corner
  80.                 by ty 1+
  81.                ?do      i .boxline
  82.                 loop    tx 1+ ty 1+ dup =: bline at ;
  83.  
  84. TARGET DEFINITIONS PREVIOUS
  85.  
  86. : >box          ( --- )
  87.                 218 =: tlc  196 =: tln  220 =: trc ;
  88.  
  89. : >menu         ( --- )
  90.                 179 =: tlc    0 =: tln  219 =: trc ;
  91.  
  92. : bcr           ( --- )         \ box carraige return, to start of next line
  93.                 bline 1+ =: bline
  94.                 tx 1+ bline at ;
  95.  
  96. : box           ( left top right bottom --- )
  97.                 >box false <box> ;
  98.  
  99. : box&fill      ( left top right bottom --- )
  100.                 >box true <box> ;
  101.  
  102. : menubox       ( left top right bottom --- )
  103.                 >menu false <box> ;
  104.  
  105. \ : (.box)        ( x y --- )
  106. \                 >box X>"BUF
  107. \                 >r over r@ c@ + 3 + over 2+ box
  108. \                 space r> count type space
  109. \                 bx by 1+ at ;
  110. \
  111. \ : .box"         ( x y text --- )
  112. \                 compile (.box) X," ; immediate
  113.  
  114. FORTH TARGET >TARGET
  115.  
  116. \s
  117. : boxsample     ( --- )
  118.                 20 2
  119.                 do      i 2* i .box" Ziping along!"
  120.                 loop
  121.                 10 10 .box" hello this is a sample of BOXED TEXT"
  122.                 20 15 .box" Here is even more text!!" ;
  123.  
  124. boxsample
  125.  
  126.