\\              *** Show Forth Status ***              21may93py                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ display stack in a window                            05dec99py                                                                MINOS also memory also forth                                    terminal class intstack         cell var saddr                          cell var sdepth         cell var app                            method .line0           method .line                            cell var base#          static width                            method draw-it                                          how:    &15 width !                                                     : init  ( base app -- )                                           ^ over ! app !  base# ! 0 0 super init  curoff ;              : assign ( addr n -- )  dup sdepth ! cells                        saddr  dup @  IF  dup HandleOff  THEN  Handle!                  saddr @ sdepth @ cells move                                     width @ sdepth @ 1+ super assign ;                                                                    -->             \ display stack in a window                            07aug10py                                                                        : .type ( addr u -- )  width @ 1- min                             width @ 1-  over - pos +!  type ;                             : .line0 ( -- addr u )                                            sdepth @ 0 <<# '> hold #S '< hold #> #>> ;                    : .line ( n -- addr u )                                           extend tuck dabs <<# #S rot sign #> #>> ;                     : draw-it  ( -- )                                                 base push base# @ base !                                        page .line0 .type                                               sdepth @ 0 ?DO  cr saddr @ Ith  .line .type                     LOOP  0. at  draw ;                                   class;                                          -->                                                                                                                                             \ search order                                         05dec99py                                                                intstack class vocstack                                         how:    : .voc   ?dup 0= IF  s" ???"  EXIT  THEN                          body>  >name  ?dup 0= IF  " ???" THEN                           count $1F and ;                                               : .line0 base# @ .voc ;                                         : .line  .voc ;                                                 : assign  ( addr n addr -- )                                      base# ! super assign ;                                        : init  ( dpy app -- )  0 -rot super init ;             class;                                                                                                                                                                                                                                                                                                          -->             \ open stack window                                    05dec99py                                                                User stackw     stackw off                                      User orderw     orderw off                                      : stack-window ( -- )  screen self window new window with             1 1 vviewport new                                                   DS[ base @    stackw intstack new                                   0 1 *fill 0 1 *fil rule new    2 vabox new ]DS          s" Stack"  assign 1 8 geometry show  endwith ;            : order-window ( -- )  screen self window new window with             1 1 vviewport new                                                   DS[ current @ orderw vocstack new                                   0 1 *fill 0 1 *fil rule new    2 vabox new ]DS          s" Order"  assign 1 8 geometry show  endwith ;                                                                                                                            -->             \ open stack window                                    01jan00py                                                                : display-stack ( n1 .. nx -- n1 .. nx )                          .blk  blk @ ?EXIT                                               stackw @ IF  sp@ depth 1- stackw @                                           intstack with assign draw-it endwith  THEN         orderw @ IF  vp cell+ context over - cell/ 1+ current @                      orderw @                                                        vocstack with assign draw-it endwith  THEN  ;    ' display-stack IS .status                                      onlyforth