home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_2.ZIP / FPCSRC.ZIP / BOXTEXT.SEQ < prev    next >
Encoding:
Text File  |  1990-07-13  |  4.0 KB  |  120 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. only forth also hidden also definitions
  43.  
  44. \ anew boxer
  45.  
  46. 0 value tx   0 value ty
  47. 0 value bx   0 value by
  48.  
  49. 0 value fbx
  50. 0 value tlc  0 value tln
  51. 0 value trc
  52. 0 value bline                   \ box line where text will go next
  53.  
  54. : <box>         ( left top right bottom filled --- )
  55.                 =: fbx
  56.                 rows 1- min =: by
  57.                 cols 1- min =: bx
  58.                 =: ty =: tx
  59.                 tx ty at tlc FEMIT              \ top left corner
  60.                 tln 0>
  61.                 if      bx tx - 1- 0MAX 0
  62.                        ?do       tln FEMIT      \ top side of box
  63.                         loop     trc FEMIT
  64.                 else    bx ty at trc FEMIT      \ top right corner
  65.                 then
  66.                 tx by at ." └"                  \ bottom left corner
  67.                 bx tx - 1- 0MAX 0
  68.                ?do       ." ▄"                  \ bottom side of box
  69.                 loop     ." █"                  \ bottom right corner
  70.                 by ty 1+
  71.                ?do      tx i at ." │"           \ left side of box
  72.                         fbx                     \ fill the box?
  73.                         if      bx tx - 1- spaces
  74.                         then
  75.                         bx i at ." █"           \ right side of box
  76.                 loop    tx 1+ ty 1+ dup =: bline at ;
  77.  
  78. forth definitions
  79.  
  80. : >box          ( --- )
  81.                 218 =: tlc  196 =: tln  220 =: trc ;
  82.  
  83. : >menu         ( --- )
  84.                 179 =: tlc    0 =: tln  219 =: trc ;
  85.  
  86. : bcr           ( --- )         \ box carraige return, to start of next line
  87.                 incr> bline
  88.                 tx 1+ bline at ;
  89.  
  90. : box           ( left top right bottom --- )
  91.                 >box false <box> ;
  92.  
  93. : box&fill      ( left top right bottom --- )
  94.                 >box true <box> ;
  95.  
  96. : (.box)        ( x y --- )
  97.                 >box X>"BUF
  98.                 >r over r@ c@ + 3 + over 2+ box
  99.                 space r> count type space
  100.                 bx by 1+ at ;
  101.  
  102. : .box"         ( x y | text --- )
  103.                 compile (.box) X," ; immediate
  104.  
  105. : menubox       ( left top right bottom --- )
  106.                 >menu false <box> ;
  107.  
  108. only forth also definitions
  109.  
  110. \s
  111. : boxsample     ( --- )
  112.                 20 2
  113.                 do      i 2* i .box" Ziping along!"
  114.                 loop
  115.                 10 10 .box" hello this is a sample of BOXED TEXT"
  116.                 20 15 .box" Here is even more text!!" ;
  117.  
  118. boxsample
  119.  
  120.