home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / WIMPFO.ZIP / !WimpForth / words < prev    next >
Text File  |  1996-03-21  |  3KB  |  83 lines
  1. \ $Id: words.f $
  2.  
  3. cr .( Loading WORDS...)
  4.  
  5. \ display words from one or two patterns
  6. \ use: words
  7. \  or: words +!
  8. \  or: words ! 2
  9.  
  10. : horizontal-line ( -- )
  11.                 getcolrow drop getxy drop - 1- 0max 8 /mod 0
  12.                 ?do     ." --------"
  13.                 loop    s" --------" drop swap type
  14.                 cr ;
  15.  
  16. only forth also hidden also definitions
  17.  
  18.   variable vocsave
  19.  
  20. create words-pad    260 allot
  21. create words-pocket 260 allot
  22.  
  23. : .voc-once     ( -- )
  24.                 vocsave @ ?dup
  25.                 if      cr ." ----------- " >name .id
  26.                         horizontal-line
  27.                         vocsave off
  28.                 then    ;
  29.  
  30. : match?        ( addr len -- f )
  31.                 2dup >r >r words-pocket count search nip nip
  32.                 pocket  c@
  33.                 if      r> r>    pocket count search nip nip and
  34.                 else    r> r> 2drop
  35.                 then       words-pocket c@ 0= or ;
  36.  
  37. 0 value w#threads
  38.  
  39. : (words)       ( voc -- )
  40.                 dup voc#threads to w#threads
  41.                 dup voc>vcfa call@
  42.                 dup   doClass =         \ don't look through classes
  43.                 swap do|Class = or 0=   \ don't look through classes
  44.         if      dup here 500 + w#threads cells move     \ copy vocabulary up
  45.                 voc>vcfa vocsave !
  46.                 begin   here 500 + w#threads largest dup
  47.                 while   dup l>name nfa-count 2dup 255 min words-pad place
  48.                         words-pad ?uppercase count match?
  49.                         if      .voc-once
  50.                                 type 20 #tab space 20 ?cr
  51.                                 1 +to words-cnt
  52.                         else    2drop
  53.                         then
  54.                         @ swap !
  55.                         start/stop
  56.                 repeat  2drop
  57.         else    drop
  58.         then    vocsave off ;
  59.  
  60. forth definitions
  61.  
  62. : words         ( -<optional-name>- )
  63.                 0 to words-cnt
  64.                 words-pocket off
  65.                 bl word ?uppercase c@
  66.                 if      pocket count words-pocket place
  67.                         bl word ?uppercase drop
  68.                         voc-link @
  69.                         begin   dup vlink>voc
  70.                                 (words) @ dup 0=
  71.                         until   drop
  72.                 else    context @ (words)
  73.                 then
  74.                 base @ >r decimal
  75.                 cr horizontal-line
  76.                 ." Displayed " words-cnt . ." of the "
  77.                 count-words . ." words in the system."
  78.                 r> base ! ;
  79.  
  80. only forth also
  81.  
  82.  
  83.