home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / WINSTACK.SEQ < prev    next >
Encoding:
Text File  |  1989-07-15  |  2.6 KB  |  56 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.                                 0 r@ 1- rows 3 - min  \ up to ROWS elements
  38.                                 do      19 i 1+ at
  39.                                                 \ position cursor for each
  40.                                         i pick 7 u.r 2 spaces
  41.                                                 \ print stack value & space
  42.                             -1 +loop            \ loop till done
  43.                         else    17 0 at         \ else display EMPTY
  44.                                 >rev ."  Stack Empty " >norm
  45.                         then    r>drop          \ discard copy of depth
  46.                         begin   $40 $17 c@L smask and smask = 0=
  47.                         until                   \ loop till SHIFT released
  48.                         restscr                 \ restore screen
  49.                         restcursor              \ restore cursor position
  50.                 then    ;
  51.  
  52. ' ?showstack is bgstuff
  53.  
  54. only forth also definitions
  55.  
  56.