home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_GEN / FORTH_86.ZIP / FRENCH.4TH < prev    next >
Text File  |  1994-01-01  |  3KB  |  84 lines
  1. off printload
  2.  
  3. ( forget strt 
  4. : strt ; )
  5. unsplit
  6.  
  7.  
  8. ( This is an illustration of how special characters -- provided they are part 
  9. of the IBM-PC character set -- can be inserted in text messages )
  10.  
  11. ( *************************** )
  12. ( first define some constants )
  13. ( *************************** )
  14.  
  15. 128 const ccedilla  130 const eacute
  16. 201 const tleft     205 const horiz    187 const tright
  17. 186 const vert      200 const bleft    188 const bright
  18.  
  19. ( **************************** )
  20. ( now define some higher level )
  21. ( words that use them          )
  22. ( **************************** )
  23.  
  24. : middle     24 0 do horiz .c loop  ;
  25. : top        tleft .c middle tright .c crlf ;
  26. : bottom     bleft .c middle bright .c crlf ;
  27.  
  28. : prtced     ccedilla .c ;
  29. : prtacu     eacute   .c ;
  30.  
  31. ( *************************** )
  32. ( Now the final words that    )
  33. ( create the screen output    )
  34. ( *************************** )
  35.  
  36. : test1      " this is a test " ." prtacu "  of an acute ^0dh^^0ah^" ." ;
  37. : test2      crlf " this is an alternative ^128^ m^130^thod " ." 
  38.                                " of doing it ^13 10 ^  " ." ;
  39.  
  40.  
  41. : ctest      254 0                ( all ascii graphics characters )
  42.            do i dup 
  43.            │    if[ 7 thru 10 13 27 ]        ( omit screen control codes )
  44.            │    │    20h dup .c .c drop  (  because .c executes them )
  45.            │    else
  46.            │    │    dup 1fh and 0=         
  47.            │    │      if             ( start fresh display line )
  48.            │    │      │  crlf crlf
  49.            │    │      then 
  50.            │    │         .c 20h .c         ( otherwise print char + space ) 
  51.            │    then
  52.            loop ;
  53.  
  54. ( ******************************** )
  55. ( we have finished all definitions )
  56. ( what follows is "immediate"      )
  57. ( output that uses the definitions )
  58. ( ******************************** )
  59.  
  60. cls                ( clear screen )
  61.  
  62. 22 spcs top             ( draw the top of the box )
  63.        22 spcs vert .c        ( draw the left vertical of the box )
  64.                 128 20h .c .c
  65.                 144 20h .c .c    ( write             )
  66.                 160 20h .c .c
  67.                 144 20h .c .c    (      the            )
  68.                 130 20h .c .c
  69.                 131 20h .c .c    (          required        )
  70.                 147 20h .c .c
  71.                 133 20h .c .c    (           characters    )
  72.                 135 20h .c .c
  73.                 136 20h .c .c    (             in the box    )
  74.                 138 20h .c .c
  75.                 150 20h .c .c  
  76.        20h .c vert .c crlf    ( draw the right vertical of the box )
  77. 22 spcs bottom            ( draw the bottom of the box ) 
  78.              crlf
  79.  
  80. test1                 ( execute test1 )
  81. test2                 ( execute test2 )
  82. ctest                 ( execute ctest )
  83.  
  84.