( contools DAY )

needs FreeBytes toolkit2
needs ekey os_events

: VOC-NAME. ( wid -- )
  DUP FORTH-WORDLIST = IF DROP S" forth" TYPE EXIT THEN
  DUP CELL+ @ DUP IF N> COUNT TYPE DROP ELSE DROP S" unk:" TYPE . THEN
;

: ORDER
  GET-ORDER S" context: " TYPE
  0 ?DO VOC-NAME. SPACE LOOP CR
  S" current: " TYPE GET-CURRENT VOC-NAME. CR
;

: vocs
\ print DF vocabularies
  cr voc-list
  begin @ dup while
          dup cell+ voc-name.
          dup 3 cells + @ 
          ?dup 
          if ."  defined in "  voc-name.
          else ."  is the main vocabulary"
          then cr
  repeat
  drop
;

: info
   S" Data space: " TYPE HERE ABS . CR
   S" Threaded code space: " TYPE MAX_THREADED THERE - . CR
   S" Name space: " TYPE  MAX_NAMES NHERE - . CR
   FreeBytes
   S" Free heap space: " TYPE . CR
   S" Max chunk size: " TYPE .  CR
;

: Advanced-OK
     STATE @ 0=                         
     IF
        S"  ok" TYPE BASE @ 10 <> 
        IF [CHAR] : EMIT BASE @ DUP>R DECIMAL 0 <# #S #> TYPE R> BASE ! THEN
        DEPTH ABS 40 MIN 0 ?DO [CHAR] . EMIT LOOP CR 
     THEN 
;

: ID. ( nfa -- )
   ?DUP IF N> COUNT 31 AND TYPE THEN
;


: NLIST ( wid -- )
  @ ?DUP 0= IF EXIT THEN
  0 >R
  BEGIN
    DUP 
    CELL+ ID. SPACE
    RP@ 1+!
    CDR DUP 0=
    0 (ekey) ekey>char if
      bl = or
    else
      drop
    then
  UNTIL DROP CR
  S" words: " TYPE R> . CR
;

: WORDS
   CONTEXT @ NLIST
;

: .s
  depth 0 <# [char] ] hold
    #s [char] [ hold
  #> type space
  depth 10 > if s" ... " type then
  depth 10 min 0 ?do depth 10 min i - 1-
    pick . loop
;

: ? @ . ;