home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / STATUS.SEQ < prev    next >
Encoding:
Text File  |  1988-01-11  |  1.5 KB  |  46 lines
  1. \ STATUS.SEQ    Display a status line at screen top.    by Tom Zimmer
  2.  
  3. variable STATV
  4.  
  5. : <.STAT>       ( --- )
  6.                 #OUT @ #LINE @ >R >R
  7.                 ATTRIB C@ >R
  8.                 BASE @ >R DECIMAL
  9.                 0 0 AT >ATTRIB1
  10.                 ." C - " SP@ HERE - (U.) TYPE ."  : - "
  11.                 #LISTSEGS 16 * XHERE - (U.) TYPE
  12.                 2 qspaces DEPTH
  13.                 IF      >ATTRIB4 ."  Depth " DEPTH (U.) DUP >R TYPE
  14.                         4 R> - QSPACES >ATTRIB1
  15.                 ELSE    ." Stack Empty"
  16.                 THEN    2 qspaces SHNDL @ >HNDLE @ -1 =
  17.                 IF      shndl @ dup clr-hcb pathset drop
  18.                         -2 shndl @ >hndle !
  19.                 THEN    .FILE 80 #OUT @ DUP >R - 0 MAX QSPACES
  20.                 R> 57 <
  21.                 IF      57 0 AT
  22.                         CONTEXT @ BODY> >NAME .ID BL QEMIT
  23.                         CURRENT @ BODY> >NAME .ID
  24.                 THEN    74 0 AT BL QEMIT
  25.                         GETTIME <.HM> DROP >NORM
  26.                         R> BASE ! R> ATTRIB C! R> R> AT ;
  27.  
  28. : .STATUS       ( -- )
  29.                 DEFERS STATUS
  30.                 ?STACK
  31.                 STATV @
  32.                 IF      <.STAT>
  33.                 THEN    ;
  34.  
  35. ' .STATUS IS STATUS             \ Status printed for command lines.
  36. ' <.STAT> IS LOADSTAT           \ Status printed while loading.
  37.  
  38. : STATON        ( --- )
  39.                 STATV ON ;
  40.  
  41. : STATOFF       ( --- )
  42.                 STATV OFF ;
  43.  
  44. STATON          \ DEFAULT TO DISPLAYING STATUS LINE.
  45.  
  46.