stack.f

   1 \\r
   2 \ STACK.F\r
   3 \ Displaying data stack on screen for Forth beginners.\r
   4 \ HIOMULTI.F or HIOMULT2.F must be loaded first.\r
   5 \\r
   6 \ 1996. 2. 9.\r
   7 \ Wonyong Koh\r
   8 \r
   9 BASE @\r
  10 GET-ORDER  GET-CURRENT\r
  11 �e\8bi���\89\9db-WORDLIST GET-ORDER 1+ SET-ORDER\r
  12 \r
  13 DECIMAL\r
  14 \r
  15 �e\8bi���\89\9db-WORDLIST SET-CURRENT\r
  16 \r
  17 7 CONSTANT SWIDTH\r
  18 CREATE BLANKS SWIDTH CHARS ALLOT  BLANKS SWIDTH CHARS BL FILL\r
  19 \r
  20 : #!R  ( column row x width )\r
  21     >R BASE @ 10 = IF S>D ELSE 0 THEN   \ col row d  R: width\r
  22     SWAP OVER DUP 0< IF DNEGATE THEN\r
  23     <#  #S ROT SIGN  #>\r
  24     2OVER 2OVER NIP R@ SWAP - BLANKS SWAP xySTR!\r
  25     DUP R> SWAP - >R 2SWAP SWAP R> + SWAP 2SWAP xySTR! ;\r
  26 \r
  27 NONSTANDARD-WORDLIST SET-CURRENT\r
  28 \r
  29 0 60 CELLS 60 CELLS HAT \94ᣡ����\88\81  \94ᣡ����\88\81 BUILD\r
  30 \ 0 60 CELLS 60 CELLS HAT StackDisplayer  StackDisplayer BUILD\r
  31 \r
  32 :NONAME \94ᣡ����\88\81 ACTIVATE\r
  33         BEGIN\r
  34           \8cq�b�� @ 0 DO PAUSE LOOP\r
  35           GRAPHIC? SCREEN-UPDATED? AND                  IF\r
  36             BASE @ DUP 10 <> IF HEX THEN\r
  37             MAX-X 8 - 0 S" \8b���:" xySTR!\r
  38             SystemTask                  \ system task's userP\r
  39             @ CELL+ @\r
  40             SystemTask stackTop 's @    \ sp0 sp@\r
  41             4 CELLS +                   \ PAUSE pushes 4\r
  42             2DUP - 2/ ( 1 CELLS / ) DUP\r
  43             MAX-X 3 - 0 ROT 3 #!R\r
  44             10 MIN\r
  45             DUP 1+ MAX-X 8 - SWAP S"         " xySTR!\r
  46             0 ?DO\r
  47                 DUP @ MAX-X SWIDTH - I 1+ ROT SWIDTH #!R CELL+\r
  48             LOOP 2DROP\r
  49             BASE !\r
  50           THEN\r
  51         AGAIN\r
  52 ; EXECUTE\r
  53 \r
  54 SET-CURRENT  SET-ORDER\r
  55 BASE !\r