home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / STATUS.SEQ < prev    next >
Encoding:
Text File  |  1989-07-11  |  2.3 KB  |  65 lines
  1. \ STATUS.SEQ    Display a status line at screen top.    by Tom Zimmer
  2.  
  3. 0 value vocv    \ show vocabulary stack value flag
  4.  
  5. : <.STAT>       ( --- )
  6.                 printing @ ?exit        \ NO status if printing
  7.                 savecursor
  8.                 base @ >r decimal
  9.                 0 0 at >attrib1
  10.                 ."  C - " sp@ here - 0 1000 um/mod nip (u.) type ." k : - "
  11.                 #listsegs xhere drop xseg @ - - 16 *d
  12.                 1000 um/mod nip (u.) type ." k"
  13.                 2 spaces depth
  14.                 if      >attrib4 ."  Depth " depth (u.) dup>r type
  15.                         4 r> - spaces >attrib1
  16.                 else    ." Stack Empty"
  17.                 then    2 spaces seqhandle >hndle @ -1 =
  18.                 if      seqhandle dup clr-hcb pathset drop
  19.                         -2 seqhandle >hndle !
  20.                 then    .seqhandle cols #out @ - spaces
  21.                 vocv                            \ if vocabulary showing is on
  22.                 if      cols 11 - 1 at >attrib3
  23.                         current @ body> >name space %.id eeol
  24.                         >attrib1
  25.                         #vocs context over 0
  26.                         do      dup @ ?dup 0= if nip i swap leave then
  27.                                 cols 11 - i 2+ at
  28.                                 body> >name space %.id eeol 2+
  29.                         loop    drop
  30.                         cols 11 - swap 2+ at space
  31.                         ['] root >name %.id eeol
  32.                 then
  33.                 cols 7 - 0 at space
  34.                 dtbuf off
  35.                 gettime drop build-hm dtbuf count type space >norm
  36.                 r> base !
  37.                 restcursor ;
  38.  
  39. : .STATUS       ( -- )
  40.                 defers status
  41.                 ?stack
  42.                 statv @
  43.                 if      <.stat>
  44.                 then    ;
  45.  
  46. ' .STATUS IS STATUS             \ Status printed for command lines.
  47. ' <.STAT> IS LOADSTAT           \ Status printed while loading.
  48.  
  49. : STATON        ( --- )
  50.                 STATV ON ;
  51.  
  52. : STATOFF       ( --- )
  53.                 STATV OFF ;
  54.  
  55. STATON          \ default to displaying status line
  56.  
  57. : VOCON         ( -- )
  58.                 ON> VOCV ;
  59.  
  60. : VOCOFF        ( -- )
  61.                 OFF> VOCV ;
  62.  
  63. VOCON           \ default to displaying the vocabulary stack
  64.  
  65.