home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / armforth / !ARMforth / Support / Windefs < prev    next >
Encoding:
Text File  |  1989-12-24  |  19.2 KB  |  830 lines
  1. ( WINDOW IMPLEMENTATION  21/9/89
  2.                          24/12/89 )
  3.  
  4. : COND-LOAD
  5.    -FIND
  6.    0= IF ( NOT LOADED )
  7.       FLOAD
  8.    ELSE
  9.       2DROP
  10.       BL WORD
  11.    THEN
  12.    ;
  13.  
  14. FORTH DEFINITIONS
  15. COND-LOAD OS OSDEFS
  16. VOCABULARY WIN_MAN IMMEDIATE
  17. WIN_MAN DEFINITIONS DECIMAL
  18.  
  19. : W_HANDLE ;
  20. : W_XPOS 4 + ;
  21. : W_YPOS 8 + ;
  22. : W_OLDXPOS 12 + ;
  23. : W_OLDYPOS 16 + ;
  24. : W_TYPEX 20 + ;
  25. : W_TYPEY 24 + ;
  26. : W_WIDTH 28 + ;
  27. : W_HEIGHT 32 + ;
  28. : W_WAEX_MAXX 36 + ;
  29. : W_WAEX_MINY 40 + ;
  30. : W_DIDSCROLL 44 + ;
  31. : W_PRINTSPACE 48 + ;
  32. : W_TYPESCROLLED 52 + ;
  33. : W_CREATE 56 + ;
  34. : W_ROWPTRS 144 + ;
  35.  
  36. 144 CONSTANT W_DYN_AREA
  37.  
  38. 0 VARIABLE W_BUF 256 ALLOT
  39.  
  40. : LS! ( ADDR / OFFSET / VALUE ... ADDR )
  41.      SWAP 3 PICK + ! ;
  42. : LSC! ( ADDR / OFFSET / VALUE ... ADDR )
  43.      SWAP 3 PICK + C! ;
  44.  
  45. : L! ( VALUE / ADDR / OFFSET ... ADDR )
  46.      OVER >R + ! R> ;
  47. : LC! ( VALUE / ADDR / OFFSET ... ADDR )
  48.      OVER >R + C! R> ;
  49.  
  50. : PARAM_START LATEST PFA 12 + ;
  51.  
  52. HEX
  53. 83 CONSTANT WIN_FLAGS
  54. 139 CONSTANT TIT_BAR_FLAGS
  55. DECIMAL
  56.  
  57. 32 CONSTANT PIX_CHAR_HGHT
  58. PIX_CHAR_HGHT NEGATE CONSTANT NEG_PIX_CHAR_HGHT
  59. 16 CONSTANT PIX_CHAR_WDTH
  60. PIX_CHAR_WDTH NEGATE CONSTANT NEG_PIX_CHAR_WDTH
  61.  
  62. : PR_WIN
  63.       CR
  64.       DUP
  65.       W_CREATE
  66.       ." VIS MIN X " DUP @ . CR
  67.       ." VIS MIN Y " DUP 4 + @ . CR
  68.       ." VIS MAX X " DUP 8 + @ . CR
  69.       ." VIS MAX Y " DUP 12 + @ . CR
  70.       ." SCROLL X " DUP 16 + @ . CR
  71.       ." SCROLL Y " DUP 20 + @ . CR
  72.       ." WINDOW BEHIND " DUP 24 + @ . CR
  73.       ." FLAGS/STATUS " DUP 28 + @ . CR
  74.       ." TITLE FOREGROUND " DUP 32 + C@ . CR
  75.       ." TITLE BACKGROUND " DUP 33 + C@ . CR
  76.       ." WA FOREGROUND " DUP 34 + C@ . CR
  77.       ." WA BACKGROUND " DUP 35 + C@ . CR
  78.       ." SCROLL OUTER COLOUR " DUP 36 + C@ . CR
  79.       ." SCROLL INNER COLOUR " DUP 37 + C@ . CR
  80.       ." HIGHLIGHTED TITLE " DUP 38 + C@ . CR
  81.       ." RESVD " DUP 39 + C@ . CR
  82.       ." WA EX MIN X " DUP 40 + @ . CR
  83.       ." WA EX MIN Y " DUP 44 + @ . CR
  84.       ." WA EX MAX X " DUP 48 + @ . CR
  85.       ." WA EX MAX Y " DUP 52 + @ . CR
  86.       ." TITLE BAR ICON FLAGS " DUP 56 + @ . CR
  87.       ." BUTTON TYPE " DUP 60 + @ . CR
  88.       ." SPRITE AREA CTRL BLOCK " DUP 64 + @ . CR
  89.       ." RESVD " DUP 68 + @ . CR
  90.       ." TITLE POINTER " DUP 72 + @ . CR
  91.       ." TITLE VALIDATION " DUP 76 + @ . CR
  92.       ." TITLE LENGTH " DUP 80 + @ . CR
  93.       ." NUMBER ICONS " 84 + @ . CR
  94.       ." HANDLE " DUP W_HANDLE @ . CR
  95.       ." X POS " DUP W_XPOS @ . CR
  96.       ." Y POS " DUP W_YPOS @ . CR
  97.       ." OLD X POS " DUP W_OLDXPOS @ . CR
  98.       ." OLD Y POS " DUP W_OLDYPOS @ . CR
  99.       ." TYPE X " DUP W_TYPEX @ . CR
  100.       ." TYPE Y " DUP W_TYPEY @ . CR
  101.       ." WIDTH " DUP W_WIDTH @ . CR
  102.       ." HEIGHT " W_HEIGHT @ . CR
  103.       ;
  104.  
  105. : WIN <BUILDS
  106.       PARAM_START W_CREATE
  107.             16 0 LS! ( SCROLL X )
  108.             20 0 LS! ( SCROLL Y )
  109.             24 -1 LS! ( ON TOP )
  110.             28 WIN_FLAGS LS! ( FLAGS / STATUS )
  111.             36 0 LSC! ( SCROLL OUTER COLOUR )
  112.             37 0 LSC! ( SCROLL INNER COLOUR )
  113.             39 0 LSC! ( RESVD )
  114.             40 0 LS! ( WA EX MIN X )
  115.             52 0 LS! ( WA EX MAX Y )
  116.             56 TIT_BAR_FLAGS LS!
  117.             64 0 LS! ( SPRITE AREA CTRL BLK )
  118.             68 0 LS! ( RESVD )
  119.             76 -1 LS! ( TITLE STRING VALIDATION )
  120.             84 0 LS! ( NUM ICONS )
  121.  
  122.             80 L! ( TITLE STRING LENGTH )
  123.             72 L! ( TITLE STRING PTR )
  124.             60 L! ( BUTTON TYPE )
  125.             38 LC! ( BACKGROUND HIGHLIGHTED )
  126.             35 LC! ( WORK AREA BACKGROUND )
  127.             34 LC! ( WORK AREA FOREGROUND )
  128.             33 LC! ( TITLE BACKGROUND )
  129.             32 LC! ( TITLE FOREGROUND )
  130.             DROP ( ADDRESS )
  131.  
  132.             DUP ( BOTTOM LEFT Y )
  133.             PARAM_START W_CREATE 4 L! DROP ( VIS MIN Y )
  134.             3 PICK ( CHAR HEIGHT )
  135.             PIX_CHAR_HGHT *
  136.             DUP ( HEIGHT IN PIXELS )
  137.             NEGATE
  138.             DUP  ( WDTH / HGHT / BLX / BLY / PIXHGHT / -PIXHGHT / -PIXHGHT )
  139.             PARAM_START W_WAEX_MINY !
  140.             PARAM_START W_CREATE 44 L! DROP ( WA EX MIN Y )
  141.  
  142.             ( WDTH / HGHT / BLX / BLY / PIXHGHT )
  143.  
  144.             + PARAM_START W_CREATE 12 L! DROP ( VIS MAX Y )
  145.             DUP ( BOTTOM LEFT X )
  146.             PARAM_START W_CREATE ! ( VIS MIN X )
  147.             3 PICK ( CHAR WIDTH )
  148.             PIX_CHAR_WDTH *
  149.             DUP ( WIDTH IN PIXELS )
  150.             DUP
  151.             PARAM_START W_WAEX_MAXX !
  152.             PARAM_START W_CREATE 48 L! DROP ( WA EX MAX X )
  153.             + PARAM_START W_CREATE 8 L! DROP ( VIS MAX X )
  154.  
  155.             ( STACK = X / Y )
  156.  
  157.             DUP 2 << W_DYN_AREA + ALLOT ( ALLOCATE SPACE FOR DYNAMIC DATA )
  158.             2DUP ( X / Y / X / Y )
  159.             0 DO
  160.                HERE OVER ( X / Y / X / HERE / X )
  161.                I * + ( ROW ADDRESS )
  162.                PARAM_START W_DYN_AREA + ( FIRST ROW PTR )
  163.                I 2 << + ! ( ROW ADDR INTO ROW PTR )
  164.             LOOP
  165.             DROP ( X )
  166.             2DUP
  167.             PARAM_START W_HEIGHT !
  168.             PARAM_START W_WIDTH !
  169.             * HERE SWAP DUP ALLOT ( SPACE FOR WINDOW TEXT )
  170.             ERASE
  171.             0 PARAM_START
  172.             2DUP W_XPOS !
  173.             2DUP W_YPOS !
  174.             2DUP W_OLDXPOS !
  175.             2DUP W_OLDYPOS !
  176.             2DUP W_TYPEX !
  177.                  W_TYPEY !
  178.  
  179.             DOES>
  180.             ;
  181.  
  182. -1 VARIABLE WIN_OP_STR
  183. -1 VARIABLE WIN_IP_STR
  184.  
  185. : SET_WIN_OP WIN_OP_STR ! ;
  186. : SET_WIN_IP WIN_IP_STR ! ;
  187.  
  188. : WIN_OP WIN_OP_STR @ ;
  189. : WIN_IP WIN_IP_STR @ ;
  190.  
  191. : WIN_HANDLE WIN_OP W_HANDLE ;
  192. : WIN_XPOS WIN_OP W_XPOS ;
  193. : WIN_YPOS WIN_OP W_YPOS ;
  194. : WIN_OLDXPOS WIN_OP W_OLDXPOS ;
  195. : WIN_OLDYPOS WIN_OP W_OLDYPOS ;
  196. : WIN_TYPEX WIN_OP W_TYPEX ;
  197. : WIN_TYPEY WIN_OP W_TYPEY ;
  198. : WIN_WIDTH WIN_OP W_WIDTH ;
  199. : WIN_HEIGHT WIN_OP W_HEIGHT ;
  200. : WIN_WAEX_MAXX WIN_OP W_WAEX_MAXX ;
  201. : WIN_WAEX_MINY WIN_OP W_WAEX_MINY ;
  202. : WIN_DIDSCROLL WIN_OP W_DIDSCROLL ;
  203. : WIN_PRINTSPACE WIN_OP W_PRINTSPACE ;
  204. : WIN_TYPESCROLLED WIN_OP W_TYPESCROLLED ;
  205. : WIN_ROWPTRS WIN_OP W_ROWPTRS ;
  206.  
  207. 8 CONSTANT MAX_WINDOWS
  208.  
  209. 0 VARIABLE WIN_HANDLE_LIST MAX_WINDOWS 4 << ALLOT
  210. 0 VARIABLE NUM_WINDOWS
  211.  
  212. : ADD_HANDLE ( PARAM AREA / NEW HANDLE ... )
  213.       WIN_HANDLE_LIST NUM_WINDOWS @ 4 << + DUP >R ! ( STORE HANDLE AT ADDR )
  214.       R> 4 + ! ( STORE PARAM AREA AT ADDR + 4 )
  215.       1 NUM_WINDOWS +!
  216.       ;
  217.  
  218. : FIND_PARAM_AREA ( HANDLE ... PARAM AREA [ -1 ON FAILURE ] )
  219.       -1 SWAP
  220.       NUM_WINDOWS @ 0 DO
  221.          DUP ( HANDLE TO FIND )
  222.          WIN_HANDLE_LIST I 4 << + DUP >R @ ( LIST HANDLE )
  223.          = IF ( HANDLES MATCH )
  224.             2DROP R> 4 + @ ( GET PARAM AREA )
  225.             0 LEAVE ( ZERO IS DUMMY BECAUSE DROP NEEDED AFTER LOOP )
  226.          ELSE
  227.             R> DROP
  228.          THEN
  229.       LOOP
  230.       DROP
  231.       ;
  232.  
  233. -1 VARIABLE SAVE_WIN_OP
  234.  
  235. : SET_TEMP_OP ( HANDLE )
  236.       WIN_OP SAVE_WIN_OP !
  237.       FIND_PARAM_AREA ( FAILURES SHOULD NOT OCCUR !!! )
  238.       DUP -1 = IF
  239.          ." BAD HANDLE "
  240.       THEN
  241.       SET_WIN_OP
  242.       ;
  243.  
  244. : RESTORE_OP
  245.       SAVE_WIN_OP @ SET_WIN_OP
  246.       ;
  247.  
  248. : WIN_CREATE
  249.       DUP
  250.       W_CREATE
  251.       Wimp CreateWindow
  252.       2DUP ADD_HANDLE
  253.       SWAP W_HANDLE !
  254.       ;
  255.  
  256. : WIN_OPEN
  257.       DUP W_HANDLE @ W_BUF !
  258.       DUP W_CREATE @ W_BUF 4 + !
  259.       DUP W_CREATE 4 + @ W_BUF 8 + !
  260.       DUP W_CREATE 8 + @ W_BUF 12 + !
  261.           W_CREATE 12 + @ W_BUF 16 + !
  262.       0 W_BUF 20 + !
  263.       0 W_BUF 24 + !
  264.       -1 W_BUF 28 + !
  265.       W_BUF Wimp OpenWindow
  266.       ;
  267.  
  268. : WIN_CLOSE
  269.       W_HANDLE @ W_BUF !
  270.       W_BUF Wimp CloseWindow
  271.       ;
  272.  
  273. : WIN_DELETE
  274.       W_HANDLE
  275.       Wimp DeleteWindow
  276.       ;
  277.  
  278. : WIN_SET_CARET_POS ( HANDLE )
  279.       -1
  280.       WIN_XPOS @ 1 + PIX_CHAR_WDTH * 12 -
  281.       WIN_YPOS @ 1 + PIX_CHAR_HGHT * NEGATE
  282.       32
  283.       0
  284.       Wimp SetCaretPosition
  285.       ;
  286.  
  287. : WIN_MOVE ( X / Y )
  288.       4 ROT ROT OS Plot
  289.       ;
  290.  
  291. : WIN_ORIGIN ( X / Y )
  292.       29 OS WriteC
  293.       SWAP
  294.       DUP
  295.       OS WriteC
  296.       8 >>
  297.       OS WriteC
  298.       DUP
  299.       OS WriteC
  300.       8 >>
  301.       OS WriteC
  302.       ;
  303.  
  304. : WIN_OUTPUT_LINE ( XOFFSET / ROW )
  305.       2 << WIN_ROWPTRS + @ ( XOFFSET / ROW ADDR )
  306.       SWAP
  307.       BEGIN
  308.          2DUP + ( ROW ADDR / XOFFSET / CHAR ADDR )
  309.          C@ DUP IF ( NON ZERO CHAR )
  310.             OS WriteC
  311.             1 + ( ROW ADDR / XOFFSET + 1 )
  312.             DUP
  313.             WIN_WIDTH @ =
  314.          ELSE
  315.             DROP 1
  316.          THEN
  317.       UNTIL
  318.       2DROP
  319.       ;
  320.  
  321. : WIN_PRINT_TEXT ( BUFFER ADDR ... )
  322.       >R R 28 + @
  323.       R 4 + @
  324.       - PIX_CHAR_WDTH / ( [GX0 - X0] / PIX_WDTH )
  325.       R 16 + @
  326.       R 40 + @
  327.       - PIX_CHAR_HGHT / ( [Y1 - GY1] / PIX_HGHT )
  328.       R 40 + @
  329.       R 32 + @
  330.       - PIX_CHAR_HGHT / 2 + ( NO. OF LINES TO PRINT )
  331.       R 28 + @ ( GX0 )
  332.       R 4 + @ PIX_CHAR_WDTH - ( X0 - PIX_WDTH )
  333.       BEGIN
  334.          PIX_CHAR_WDTH + 2DUP
  335.          < ( IS GX0 < X0 )
  336.       UNTIL
  337.       SWAP DROP PIX_CHAR_WDTH - ( XSTART / YSTART / LINES / ORIGX )
  338.       R 40 + @ ( GY1 )
  339.       R> 16 + @ PIX_CHAR_HGHT + ( Y1 + PIX_HGHT )
  340.       BEGIN
  341.          PIX_CHAR_HGHT - 2DUP
  342.          > ( IS GY1 > Y1 )
  343.       UNTIL
  344.       SWAP DROP PIX_CHAR_HGHT + 4 -
  345.       ( XSTART / YSTART / LINES / ORIGX / ORIGY )
  346.       WIN_ORIGIN
  347.       0 SWAP ( XSTART / YSTART / GRAPHY / LINES )
  348.       BEGIN
  349.          DUP
  350.       WHILE ( LINES != 0 )
  351.          0 3 PICK WIN_MOVE ( XSTART / YSTART / GRAPHY / LINES )
  352.          ROT DUP WIN_HEIGHT @ < IF ( XSTART / GRAPHY / LINES / YSTART )
  353.             DUP 5 PICK SWAP
  354.             ( XSTART / GRAPHY / LINES / YSTART / XSTART / YSTART )
  355.             WIN_OUTPUT_LINE
  356.          THEN
  357.          1 + ROT PIX_CHAR_HGHT -
  358.          ( XSTART / LINES / YSTART + 1 / GRAPHY - PIX_HGHT )
  359.          ROT 1 -
  360.          ( XSTART / YSTART + 1 / GRAPHY - PIX_HGHT / LINES - 1 )
  361.       REPEAT
  362.       2DROP 2DROP
  363.       0 0 WIN_ORIGIN
  364.       ;
  365.  
  366. : WIN_UPDATE_WINDOW ( REDRAW BUF ADDR )
  367.       DUP
  368.       Wimp UpdateWindow
  369.       IF
  370.          BEGIN
  371.             WIN_PRINTSPACE @ IF
  372.                16 OS WriteC
  373.             ELSE
  374.                DUP
  375.                WIN_PRINT_TEXT
  376.             THEN
  377.             DUP
  378.             Wimp GetRectangle
  379.             0=
  380.          UNTIL
  381.       THEN
  382.       DROP
  383.       ;
  384.  
  385. : WIN_DRAW_NEW_CHAR
  386.       W_BUF 0 WIN_HANDLE @ LS!
  387.             16 ROT PIX_CHAR_HGHT * NEGATE DUP >R LS!
  388.             8 R> PIX_CHAR_HGHT - LS!
  389.             4 ROT PIX_CHAR_WDTH * DUP >R LS!
  390.             12 R> PIX_CHAR_WDTH + LS!
  391.       WIN_UPDATE_WINDOW
  392.       ;
  393.  
  394. : WIN_CLEAR_LINE ( LINE NUMBER [ FROM 0 ]... )
  395.       2 << WIN_ROWPTRS + @ ( ADDR OF START OF LINE )
  396.       WIN_WIDTH @ 0 DO
  397.          DUP 0 SWAP C!
  398.          1 +
  399.       LOOP
  400.       DROP
  401.       ;
  402.  
  403. : WIN_SHIFT_ROW_POINTERS
  404.       WIN_ROWPTRS DUP @ SWAP ( SAVE 1ST LINE POINTER )
  405.       WIN_HEIGHT @ 1 - 0 DO
  406.          DUP I 2 << + ( OLD [WRP0] / WRP0 / WRP0 + I*4 )
  407.          DUP 4 + ( OLD [WRP0] / WRP0 / WRP0 + I*4 / WRP0 + I*4 + 4 )
  408.          @ SWAP ! ( OLD [WRP0] / WRP0 )
  409.       LOOP
  410.       WIN_HEIGHT @ 1 - 2 << + ! ( UPDATE LAST POINTER )
  411.       ;
  412.  
  413. : WIN_REDRAW_WINDOW ( BUFFER ADDR )
  414.                     ( ASSUMES BUFFER HAS HANDLE IN FIRST WORD )
  415.       DUP
  416.       Wimp RedrawWindow
  417.       IF
  418.          BEGIN
  419.             DUP
  420.             WIN_PRINT_TEXT
  421.             DUP
  422.             Wimp GetRectangle
  423.             0=
  424.          UNTIL
  425.       THEN
  426.       DROP
  427.       ;
  428.  
  429. : WIN_RFSH_WINDOW
  430.       BEGIN
  431.          0 W_BUF Wimp Poll
  432.          DUP 1 = IF
  433.             W_BUF WIN_REDRAW_WINDOW
  434.          THEN
  435.          0=
  436.       UNTIL
  437.       ;
  438.       
  439.  
  440. : WIN_SAME_LINE ( TYPEX / XPOS / YPOS )
  441.       W_BUF 0 WIN_HANDLE @ LS!
  442.       SWAP PIX_CHAR_HGHT * NEGATE DUP >R 16 SWAP LS!
  443.       8 R> PIX_CHAR_HGHT - LS!
  444.       SWAP PIX_CHAR_WDTH * 12 SWAP LS!
  445.       SWAP 4 SWAP LS!
  446.       0 WIN_PRINTSPACE !
  447.       WIN_UPDATE_WINDOW
  448.       ;
  449.  
  450. : WIN_TYPE_PRINT_SCROLLED ( XPOS / YPOS )
  451.       0 ROT ROT
  452.       WIN_SAME_LINE
  453.       ;
  454.  
  455. : WIN_LINE_SPLIT ( TYPEY / YPOS )
  456.       W_BUF 0 WIN_HANDLE @ LS!
  457.       4 0 LS!
  458.       12 WIN_WIDTH @ PIX_CHAR_WDTH * LS!
  459.       SWAP PIX_CHAR_HGHT * NEGATE PIX_CHAR_HGHT - 8 SWAP LS!
  460.       SWAP PIX_CHAR_HGHT * NEGATE 16 SWAP LS!
  461.       0 WIN_PRINTSPACE !
  462.       WIN_UPDATE_WINDOW
  463.       ;
  464.  
  465. : WIN_UPDATE_LAST_LINE
  466.       WIN_TYPEX @
  467.       WIN_WIDTH @
  468.       WIN_HEIGHT 1 -
  469.       WIN_SAME_LINE
  470.       ;
  471.  
  472. : WIN_REDRAW_ALL_WINDOW
  473.       WIN_HANDLE @ ( DUP -1 0 0 0 0 Wimp SetCaretPosition )
  474.       0 WIN_WAEX_MINY @ WIN_WAEX_MAXX @ NEG_PIX_CHAR_HGHT 0
  475.       4 PICK PIX_CHAR_HGHT +
  476.       Wimp BlockCopy
  477.       W_BUF 0 WIN_HANDLE @ LS!
  478.             4 0 LS!
  479.             8 WIN_WAEX_MINY @ DUP >R LS!
  480.             16 R> PIX_CHAR_HGHT + LS!
  481.             12 WIN_WAEX_MAXX @ LS!
  482.       Wimp UpdateWindow
  483.       IF
  484.          BEGIN
  485.             16 OS WriteC ( CLEAR GRAPHICS WINDOW )
  486.             W_BUF Wimp GetRectangle
  487.             0=
  488.          UNTIL
  489.       THEN
  490.       WIN_RFSH_WINDOW
  491.       ;
  492.  
  493. : WIN_UPDATE_CURSOR_NEW_LINE
  494.       WIN_YPOS @ DUP WIN_OLDYPOS !
  495.       DUP 1 + DUP WIN_YPOS !
  496.       WIN_HEIGHT @ - IF ( IS YPOS != HEIGHT )
  497.          DROP ( PREVIOUS YPOS )
  498.          EXIT
  499.       THEN
  500.       WIN_YPOS !
  501.       WIN_TYPEX @ 0< IF
  502.          ( NOTHING )
  503.       ELSE ( >= 0 )
  504.          WIN_UPDATE_LAST_LINE
  505.       THEN
  506.       0 WIN_CLEAR_LINE
  507.       WIN_SHIFT_ROW_POINTERS
  508.       WIN_REDRAW_ALL_WINDOW
  509.       1 WIN_DIDSCROLL !
  510.       ;
  511.  
  512. : WIN_UPDATE_CURSOR
  513.       0 WIN_DIDSCROLL !
  514.       WIN_XPOS @ DUP WIN_OLDXPOS !
  515.       1 + DUP WIN_XPOS !
  516.       WIN_WIDTH @ - IF ( IS XPOS != WIDTH )
  517.          EXIT
  518.       THEN
  519.       0 WIN_XPOS !
  520.       WIN_UPDATE_CURSOR_NEW_LINE
  521.       ;
  522.  
  523. : WIN_LF_CHAR
  524.       WIN_UPDATE_CURSOR_NEW_LINE
  525.       WIN_ROWPTRS WIN_YPOS @ 2 << + @ ( ADDR OF START OF NEW LINE )
  526.       WIN_XPOS @ 0 DO ( FILL NEW LINE WITH SPACES BEFORE CURSOR )
  527.          DUP 32 SWAP C! 1 +
  528.       LOOP
  529.       DROP
  530.       WIN_YPOS @ WIN_OLDYPOS !
  531.       ;
  532.  
  533. : WIN_CR_CHAR
  534.       0 WIN_XPOS !
  535.       ;
  536.  
  537. : WIN_CLEAR_WINDOW
  538.       WIN_HEIGHT @ 0 DO
  539.          I WIN_CLEAR_LINE
  540.       LOOP
  541.       W_BUF 0 WIN_HANDLE @ LS!
  542.             4 0 LS!
  543.             8 WIN_WAEX_MINY @ LS!
  544.             12 WIN_WAEX_MAXX @ LS!
  545.             16 0 LS!
  546.       1 WIN_PRINTSPACE !
  547.       WIN_UPDATE_WINDOW
  548.       0 WIN_XPOS !
  549.       0 WIN_YPOS !
  550.       0 WIN_OLDXPOS !
  551.       0 WIN_OLDYPOS !
  552.       ;
  553.  
  554. : WIN_CTRL_CHAR
  555.       DUP
  556.       7 = IF ( IS IT A BEEP )
  557.          OS WriteC
  558.       ELSE
  559.          12 = IF
  560.             WIN_CLEAR_WINDOW
  561.          THEN
  562.       THEN
  563.       ;
  564.  
  565. : WIN_DEL_CHAR
  566.       WIN_YPOS @ WIN_XPOS @ 2DUP OR 0= IF ( XPOS AND YPOS = 0 )
  567.          2DROP
  568.          EXIT
  569.       THEN
  570.       ( YPOS / XPOS )
  571.       1 - DUP 0< IF
  572.          DROP WIN_WIDTH @ 1 -
  573.          SWAP 1 - SWAP
  574.       THEN
  575.       2DUP WIN_XPOS ! DUP WIN_YPOS ! WIN_OLDYPOS !
  576.       ( YPOS / XPOS )
  577.       OVER 2 << WIN_ROWPTRS + @ OVER + ( YPOS / XPOS / CHAR ADDR )
  578.       0 SWAP C!
  579.       SWAP 1 WIN_PRINTSPACE !
  580.       WIN_DRAW_NEW_CHAR
  581.       ;
  582.  
  583. : WIN_PRINT_ALL_WORD
  584.       WIN_TYPESCROLLED @ IF
  585.          WIN_XPOS @ WIN_YPOS @
  586.          WIN_TYPE_PRINT_SCROLLED
  587.       ELSE
  588.          WIN_TYPEY @ WIN_YPOS @ - 0= IF ( IS TYPEY = YPOS )
  589.             WIN_TYPEX @ WIN_XPOS @ WIN_YPOS @
  590.             WIN_SAME_LINE
  591.          ELSE
  592.             WIN_TYPEY @ WIN_YPOS @
  593.             WIN_LINE_SPLIT
  594.          THEN
  595.       THEN
  596.       ;
  597.  
  598. HEX
  599.  
  600. : WIN_TYPE
  601.       DUP 0= IF ( IS COUNT = 0 )
  602.          2DROP
  603.          EXIT
  604.       THEN
  605.       0 WIN_TYPESCROLLED !
  606.       WIN_XPOS @ WIN_TYPEX !
  607.       WIN_YPOS @ WIN_TYPEY !
  608.       BEGIN
  609.          SWAP
  610.          ( COUNT / ADDR )
  611.          DUP 1 + SWAP C@ ( COUNT / ADDR+1 / [ADDR] )
  612.          7F AND
  613.          DUP
  614.          7F = IF
  615.             DROP
  616.             WIN_DEL_CHAR
  617.             1 ( USED AS BOOLEAN LATER )
  618.          ELSE
  619.             DUP
  620.             0D = IF
  621.                DROP
  622.                WIN_CR_CHAR
  623.                1
  624.             ELSE
  625.                DUP
  626.                0A = IF
  627.                   DROP
  628.                   WIN_LF_CHAR
  629.                   1
  630.                ELSE
  631.                   DUP
  632.                   20 < IF
  633.                      DROP
  634.                      WIN_CTRL_CHAR
  635.                      0
  636.                   ELSE ( PRINTABLE CHAR )
  637.                      WIN_ROWPTRS
  638.                      WIN_YPOS @ 2 << + @ ( CHAR / ROW ADDRESS )
  639.                      WIN_XPOS @ + C! ( STORE CHAR IN BUFFER )
  640.                      WIN_UPDATE_CURSOR
  641.                      WIN_XPOS @ 0= IF
  642.                         WIN_YPOS @ WIN_OLDYPOS !
  643.                      THEN
  644.                      1
  645.                   THEN
  646.                THEN
  647.             THEN
  648.          THEN
  649.          IF ( TEST BOOLEAN )
  650.             WIN_DIDSCROLL @ IF
  651.                1 WIN_TYPESCROLLED !
  652.             THEN
  653.          THEN
  654.          SWAP ( ADDR / COUNT )
  655.          1 - DUP 0=
  656.       UNTIL
  657.       2DROP
  658.       WIN_PRINT_ALL_WORD
  659.       ;
  660.  
  661. DECIMAL
  662.  
  663. : WIN_OPEN_WINDOW ( BUF ADDR )
  664.       Wimp OpenWindow
  665.       ;
  666.  
  667. : WIN_KEY ( ASSUMES Wimp_POLL HAS BEEN DONE )
  668.           ( POLL BUFF ADDR / POLL VAL )
  669.       DUP
  670.       1 - 0= IF
  671.          DROP
  672.          DUP @ ( HANDLE )
  673.          SET_TEMP_OP
  674.          WIN_REDRAW_WINDOW
  675.          RESTORE_OP
  676.       ELSE
  677.          DUP
  678.          2 - 0= IF
  679.             DROP
  680.             DUP @ ( HANDLE )
  681.             SET_TEMP_OP
  682.             WIN_OPEN_WINDOW
  683.             RESTORE_OP
  684.          ELSE
  685.             2DROP
  686.          THEN
  687.       THEN
  688.       ;
  689.  
  690. HEX
  691.  
  692. : WIN_EMIT
  693.       -1 WIN_TYPEX !
  694.       DUP
  695.       7F = IF ( DELETE CHAR )
  696.          DROP
  697.          WIN_DEL_CHAR
  698.       ELSE
  699.          DUP
  700.          0D = IF ( CARRIAGE RETURN )
  701.             DROP
  702.             WIN_CR_CHAR
  703.          ELSE
  704.             DUP
  705.             0A = IF ( LINEFEED )
  706.                DROP
  707.                WIN_LF_CHAR
  708.             ELSE
  709.                DUP
  710.                20 < IF ( CONTROL CHAR )
  711.                   WIN_CTRL_CHAR
  712.                   EXIT
  713.                ELSE ( PRINTABLE CHAR )
  714.                   WIN_ROWPTRS
  715.                   WIN_YPOS @ 2 << + @ ( CHAR / ROW ADDRESS )
  716.                   WIN_XPOS @ + C! ( STORE CHAR IN BUFFER )
  717.                   WIN_UPDATE_CURSOR
  718.                   0 WIN_PRINTSPACE !
  719.                   WIN_DIDSCROLL @ IF
  720.                      WIN_WIDTH @ 1 - WIN_HEIGHT @ 2 -
  721.                   ELSE
  722.                      WIN_OLDXPOS @ WIN_OLDYPOS @
  723.                   THEN
  724.                   WIN_DRAW_NEW_CHAR
  725.                   WIN_XPOS @ 0= IF
  726.                      WIN_YPOS @ WIN_OLDYPOS !
  727.                   THEN
  728.                THEN
  729.             THEN
  730.          THEN
  731.       THEN
  732.       ( WIN_HANDLE @ )
  733.       ( WIN_SET_CARET_POS )
  734.       ;
  735.  
  736. WIN_MAN
  737. HIDE W_HANDLE
  738. HIDE W_XPOS
  739. HIDE W_YPOS
  740. HIDE W_OLDXPOS
  741. HIDE W_OLDYPOS
  742. HIDE W_TYPEX
  743. HIDE W_TYPEY
  744. HIDE W_WIDTH
  745. HIDE W_HEIGHT
  746. HIDE W_WAEX_MAXX
  747. HIDE W_WAEX_MINY
  748. HIDE W_DIDSCROLL
  749. HIDE W_PRINTSPACE
  750. HIDE W_TYPESCROLLED
  751. HIDE W_CREATE
  752. HIDE W_ROWPTRS
  753. HIDE W_DYN_AREA
  754. HIDE W_BUF
  755. HIDE LS!
  756. HIDE LSC!
  757. HIDE L!
  758. HIDE LC!
  759. HIDE PARAM_START
  760. HIDE WIN_FLAGS
  761. HIDE TIT_BAR_FLAGS
  762. HIDE PIX_CHAR_HGHT
  763. HIDE NEG_PIX_CHAR_HGHT
  764. HIDE PIX_CHAR_WDTH
  765. HIDE NEG_PIX_CHAR_WDTH
  766. HIDE WIN_OP_STR
  767. HIDE WIN_IP_STR
  768. HIDE WIN_HANDLE
  769. HIDE WIN_XPOS
  770. HIDE WIN_YPOS
  771. HIDE WIN_OLDXPOS
  772. HIDE WIN_OLDYPOS
  773. HIDE WIN_TYPEX
  774. HIDE WIN_TYPEY
  775. HIDE WIN_WIDTH
  776. HIDE WIN_HEIGHT
  777. HIDE WIN_WAEX_MAXX
  778. HIDE WIN_WAEX_MINY
  779. HIDE WIN_DIDSCROLL
  780. HIDE WIN_PRINTSPACE
  781. HIDE WIN_TYPESCROLLED
  782. HIDE WIN_ROWPTRS
  783. HIDE WIN_SET_CARET_POS
  784. HIDE WIN_MOVE
  785. HIDE WIN_ORIGIN
  786. HIDE WIN_OUTPUT_LINE
  787. HIDE WIN_PRINT_TEXT
  788. HIDE WIN_DRAW_NEW_CHAR
  789. HIDE WIN_CLEAR_LINE
  790. HIDE WIN_SHIFT_ROW_POINTERS
  791. HIDE WIN_REDRAW_WINDOW
  792. HIDE WIN_RFSH_WINDOW
  793. HIDE WIN_UPDATE_WINDOW
  794. HIDE WIN_SAME_LINE
  795. HIDE WIN_TYPE_PRINT_SCROLLED
  796. HIDE WIN_LINE_SPLIT
  797. HIDE WIN_UPDATE_LAST_LINE
  798. HIDE WIN_REDRAW_ALL_WINDOW
  799. HIDE WIN_UPDATE_CURSOR_NEW_LINE
  800. HIDE WIN_UPDATE_CURSOR
  801. HIDE WIN_LF_CHAR
  802. HIDE WIN_CR_CHAR
  803. HIDE WIN_CLEAR_WINDOW
  804. HIDE WIN_CTRL_CHAR
  805. HIDE WIN_DEL_CHAR
  806. HIDE WIN_PRINT_ALL_WORD
  807. HIDE WIN_OPEN_WINDOW
  808. HIDE RESTORE_OP
  809. HIDE SET_TEMP_OP
  810. HIDE SAVE_WIN_OP
  811. HIDE FIND_PARAM_AREA
  812. HIDE ADD_HANDLE
  813. HIDE NUM_WINDOWS
  814. HIDE WIN_HANDLE_LIST
  815. HIDE MAX_WINDOWS
  816.  
  817.  
  818. WIN_MAN ASSIGN POLL-ESCAPE TO-DO WIN_KEY
  819.  
  820. FORTH DEFINITIONS DECIMAL
  821.  
  822. WIN_MAN
  823. 0 VARIABLE TITLE
  824. HEX 314E4957 TITLE ! DECIMAL
  825. 20 10 200 200 5 12 6 1 12 0 TITLE 4 WIN ROB
  826. ROB WIN_CREATE
  827. ROB WIN_OPEN
  828. ROB SET_WIN_OP
  829. : TEST 60 0 DO 68 WIN_MAN WIN_EMIT LOOP ;
  830.