home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / winstack.seq < prev    next >
Encoding:
Text File  |  1990-07-06  |  2.7 KB  |  57 lines
  1. \ WINSTACK.SEQ          Pull Down WINDOW Stack Display     by Tom Zimmer
  2.  
  3. \ Idea from Chuck Gibson
  4.  
  5. comment:
  6.  
  7.   Display the stack vertically on the screen below the stack depth
  8. entry in the status line.  Enabled as long as you hold down the RIGHT and
  9. LEFT SHIFT keys together.
  10.  
  11. comment;
  12.  
  13. only forth also definitions hidden also
  14.  
  15. defined ?showstack nip                  \ if ?SHOWSTACK is already defined
  16. #if ' noop is bgstuff #endif            \ then clear bgstuff to NOOP
  17.  
  18. 3 value smask   \  1 = right shift,  2 = left shift, 4 = Ctrl,  8 = Alt
  19.                 \ 10 = Scroll Lock, 20 = Num Lock,  40 = Caps Lock
  20.  
  21. : ?showstack    ( --- )         \ display a pulldown stack picture
  22.                 defers bgstuff                  \ on the defered chain
  23.                 depth 0< ?exit                 \ don't bother if less than 1
  24.                 $40 $17 c@L smask and smask =   \ check for ENABLE shift key
  25.                 if                              \ if pressed THEN doit
  26.                         savecursor              \ save current screen pos
  27.                         savescr                 \ save the screen
  28.                         cursor-off              \ turn off the cursor
  29.                         depth dup>r             \ save depth for later
  30.                         if                      \ if depth non-zero
  31.                                 18 0 at >rev
  32.                                 ."  Depth " r@ (.) dup>r type 4 r> - spaces
  33.                                 >norm
  34.                                 18 1 28 r@ rows 2- min
  35.                                 1+ >menu true <box>
  36.                                                 \ the draw a box for stack
  37.                                 28 1 at ." \r Top of stack "
  38.                                 0 r@ 1- rows 3 - min  \ up to ROWS elements
  39.                                 do      19 i 1+ at
  40.                                                 \ position cursor for each
  41.                                         i pick 7 u.r 2 spaces
  42.                                                 \ print stack value & space
  43.                             -1 +loop            \ loop till done
  44.                         else    17 0 at         \ else display EMPTY
  45.                                 >rev ."  Stack Empty " >norm
  46.                         then    r>drop          \ discard copy of depth
  47.                         begin   $40 $17 c@L smask and smask = 0=
  48.                         until                   \ loop till SHIFT released
  49.                         restscr                 \ restore screen
  50.                         restcursor              \ restore cursor position
  51.                 then    ;
  52.  
  53. ' ?showstack is bgstuff
  54.  
  55. only forth also definitions
  56.  
  57.