\ file: WINDOW.BLK       Block: 0           cl 11/10/85         window program                                                  by                                                              Craig A. Lindley                                                Manitou Springs                                                 Colorado                                                        November 1985                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   \ file: WINDOW.BLK       Block: 1                               \ window routines                                    cl 11/10/85\ window load screen                                            warning off                                                     dark                                                            .( Compiling window package and demo program )                  cr                                                              2 32 thru                                                       warning on                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      \ file: WINDOW.BLK       Block: 2                               \ case statement                                     cl 11/10/85\ Dr. Charles Eakers Forth Dimensions Vol 2, Num 3              : ?comp   state @ not abort" Compilation only" ;                : ?pairs  <>         abort" Bad CASE statement"  ;              : case    ?comp csp @ !csp 4 ; immediate                        : of      4 ?pairs                                                        compile over compile = compile ?branch                          here 0 , compile drop 5 ; immediate                   : endof   5 ?pairs compile branch here 0 ,                                swap   >resolve 4 ; immediate                         : endcase 4 ?pairs compile drop                                           begin sp@ csp @ <>                                              while >resolve repeat                                           csp ! ; immediate                                                                                                     \ file: WINDOW.BLK       Block: 3                               \ window routines                                    cl 11/10/85\ write count # of chars with attrib at cursor position         code chra                       \ char/attrib count --           cx pop ax pop ah bl mov        \ get count in cx, attrib in bl  bh bh xor 9 # ah mov           \ char in al, func. code in ah   si push 16 int si pop          \ do video interrupt             next end-code                                                  \ write 1 char with attrib at cursor - update cursor position   code chra+                      \ char/attrib --                 ax pop ah bl mov bh bh xor     \ char in al, attrib in bl       1 # cx mov 9 # ah mov          \ char in al, func. code in ah   si push 16 int                 \ count=1, write char/attrib     3 # ah mov 16 int dl inc 2 # ah mov 16 int                      si pop next                    \ inc cursor position           end-code                                                        \ file: WINDOW.BLK       Block: 4                               \ window routines                                    cl 11/10/85\ read char and attrib at cursor position                       code rdchra                     \ -- char/attrib                 0 # bh mov 8 # ah mov          \ pg =0  func. code = 8          si push 16 int si pop          \ do video interrupt             1push                          \ char/attrib to stk            end-code                                                        \ put char with attrib at x,y                                   : putch                         \ x y char/attrib --              >r at r> 1 chra ;                                             \ get char with attrib at x,y                                   : getch                         \ x y -- char/attrib              at rdchra ;                                                                                                                                                                                   \ file: WINDOW.BLK       Block: 5                               \ window routines                                    cl 11/10/85\ draw count # of chars/attrib starting at x,y                  : draw_row                      \ x y char/attrib count --        >r >r at r> r> chra ;                                         \ scroll specified window up n lines                            code scrlup                     \ xul yul xlr ylr cnt attrib --  bx pop bl bh mov di pop        \ bh attrib si # of lines        dx pop dl dh mov ax pop al dl mov \ dx has lr x y               cx pop cl ch mov ax pop al cl mov \ cx has ul x y               di ax mov si push bp push      \ save regs                      6 # ah mov 16 int              \ ax # of lines func. code ah    bp pop si pop next             \ restore forth's regs          end-code                                                                                                                                                                                        \ file: WINDOW.BLK       Block: 6                               \ window routines                                    cl 11/10/85\ memory management support                                     \ tell DOS to allociate memory bytes                            code calloc                     \ # bytes -- seg T               bx pop 4 # cl mov bx cl shr    \         -- maxp error code F   bx inc 72 # ah mov 33 int      \ int 21h func. code 48h         u< if   bx push ax push ax ax xor \ if C then error                else ax push -1 # ax mov then 1push end-code                \ tell DOS to free memory segment                               code free                       \ seg -- T                       ax pop ax es mov               \     -- error code F            73 # ah mov 33 int             \ int 21h func. code 49h         u< if   ax push ax ax xor      \ if C then error                   else -1 # ax mov then 1push                                 end-code                                                        \ file: WINDOW.BLK       Block: 7                               \ window routines                                    cl 11/10/85\ memory management support                                                                                                     \ tell DOS to shrink or expand allociated memory segment        code setblock                   \ # bytes -- T                   cs ax mov ax es mov            \         -- maxp error code F   bx pop 4 # cl mov bx cl shr    \ bx has # of paragraphs         bx inc 74 # ah mov 33 int      \ int 21h func. code 4Ah         u< if   bx push ax push ax ax xor \ if C then error                else -1 # ax mov                                                then 1push                                                  end-code                                                                                                                                                                                                                                                        \ file: WINDOW.BLK       Block: 8                               \ window routines                                    cl 11/10/85\ extended word fetch and store words                           \ fetch word from extended memory                               code e@                         \ seg addr -- n                  bx pop es pop                  \ seg in es addr in bx           es: 0 [bx] ax mov              \ get the data on stk            1push                                                          end-code                                                        \ store word in extended memory                                 code e!                         \ n seg addr --                  bx pop es pop ax pop                                            ax es: 0 [bx] mov              \ store the data                 next                                                           end-code                                                                                                                        \ file: WINDOW.BLK       Block: 9                               \ window routines                                    cl 11/10/85\ read current cursor location                                  code rdcur                      \ -- x y                         si push 0 # bh mov 3 # ah mov  \ int 10h func. code 3           16 int  si pop ah ah xor                                        dl al mov ax push dh al mov                                     1push                                                          end-code                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        \ file: WINDOW.BLK       Block: 10                              \ window routines                                    cl 11/10/85\ window control block (wcb) record layout                       0 constant ulx     2 constant uly       \ upper left corner     4 constant width   6 constant height    \ width and height      8 constant curx   10 constant cury      \ current cursor pos   12 constant oldx   14 constant oldy      \ old cursor pos.      16 constant bufseg 18 constant oldwcbseg \ seg storage          20 constant attrib                       \ window attrib.       22 constant record_size                  \ size of record       15 constant boarder                      \ boarder attribute    hex                                                             b800 constant v_seg                      \ video memory start      variable wcbseg                       \ current wcb seg      decimal                                  \ storage                                                                              \ file: WINDOW.BLK       Block: 11                              \ window routines                                    cl 11/10/85\ extended memory fetch and store words                         \ store word n at addr in current wcb                           : wcbseg!                       \ n addr --                       wcbseg @ swap e! ;            \ store at addr in wcb seg      \ fetch word from addr in current wcb                           : wcbseg@                       \ addr -- n                       wcbseg @ swap e@ ;            \ fetch from addr in wcb seg                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ file: WINDOW.BLK       Block: 12                              \ window routines                                    cl 11/10/85\ window frame drawing routines                                 : top                                                             ulx wcbseg@ uly wcbseg@ [ 201 boarder 256 * + ] literal putch   ulx wcbseg@ 1+ uly wcbseg@ [ 205 boarder 256 * + ] literal      width wcbseg@ draw_row                                          ulx wcbseg@ width wcbseg@ + 1+ uly wcbseg@                      [ 187 boarder 256 * + ] literal putch ;                       : bottom                                                          ulx wcbseg@ uly wcbseg@ height wcbseg@ + 1+                     [ 200 boarder 256 * + ] literal putch                           ulx wcbseg@ 1+ uly wcbseg@ height wcbseg@ + 1+                  [ 205 boarder 256 * + ] literal width wcbseg@ draw_row          ulx wcbseg@ width wcbseg@ + 1+ uly wcbseg@ height wcbseg@ + 1+  [ 188 boarder 256 * + ] literal putch ;                       \ file: WINDOW.BLK       Block: 13                              \ window routines                                    cl 11/10/85\ window frame drawing routines                                 : sides                                                           uly wcbseg@ height wcbseg@ + 1+ uly wcbseg@ 1+                  do ulx wcbseg@ i [ 186 boarder 256 * + ] literal putch             ulx wcbseg@ width wcbseg@ + 1+ i                                [ 186 boarder 256 * + ] literal putch                        loop ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        \ file: WINDOW.BLK       Block: 14                              \ window routines                                    cl 11/10/85\ temporary data storage areas                                  \ used by scn->buf and buf->scn                                 label save_h   nop nop          \ storage for height parameter  label save_w   nop nop          \ storage for width  parameter  label save_ptr nop nop          \ storage for start pointer     label save_si  nop nop          \ storage for forths IP reg     label save_ds  nop nop          \ storage for current ds reg                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ file: WINDOW.BLK       Block: 15                              \ window routines                                    cl 11/10/85\ move data from screen to memory buffer                        hex                                                             code scn->buf                   \ x y width height seg --        cld es pop 0 # di mov save_h #) pop  save_w #) pop ax pop       a0 # bl mov bl mul bx pop bx shl bx ax add ax save_ptr #) mov   si save_si #) mov ds ax mov ax save_ds #) mov v_seg # ax mov    ax ds mov cs: save_ptr #) si mov cs: save_h #) cx mov           here cx push cs: save_w #) cx mov  rep movs                          cs: save_ptr #) si mov a0 # si add si cs: save_ptr #) mov       cx pop                                                     loop                                                            cs: save_ds #) ax mov  ax ds mov                                save_si #) si mov                                               next  end-code                                                 \ file: WINDOW.BLK       Block: 16                              \ window routines                                    cl 11/10/85\ move data from memory buffer to screen                        code buf->scn                   \ seg x y width height --        cld  save_h #) pop  save_w #) pop ax pop  a0 # bl mov           bl mul bx pop bx shl bx ax add ax save_ptr #) mov               si save_si #) mov ds ax mov ax save_ds #) mov ax pop ax ds mov  v_seg # ax mov ax es mov 0 # si mov cs: save_ptr #) di mov      cs: save_h #) cx mov                                            here cx push cs: save_w #) cx mov  rep movs                          cs: save_ptr #) di mov a0 # di add di cs: save_ptr #) mov       cx pop                                                     loop                                                            cs: save_ds #) ax mov  ax ds mov   save_si #) si mov            next                                                           end-code                                                        \ file: WINDOW.BLK       Block: 17                              \ window routines                                    cl 11/10/85\ lowest level window routine                                   \ moves screen data to memory buffer                            \ and then draws the actual window frame                        : ((window))                    \ move data scn->buf              ulx wcbseg@ uly wcbseg@       \ x y coordinates                 width wcbseg@ 2+ height wcbseg@ 2+ \ width height               bufseg wcbseg@ scn->buf       \ get buf seg addr                top sides bottom ;                                                                                                                                                                                                                                                                                                                                                                                                                                            \ file: WINDOW.BLK       Block: 18                              \ window routines                                    cl 11/10/85\ clear window routine                                          : clr_window                    \ --                              ulx wcbseg@ 1+                \ upper left  corner x            uly wcbseg@ 1+                \ upper right corner y            ulx wcbseg@ width wcbseg@ +   \ lower left  corner x            uly wcbseg@ height wcbseg@ +  \ lower right corner y            0 attrib wcbseg@ scrlup       \ scroll entire window            0 curx wcbseg!                \ home window cursor              0 cury wcbseg! ;                                                                                                                                                                                                                                                                                                                                                                              \ file: WINDOW.BLK       Block: 19                              \ window routines                                    cl 11/10/85: (window)                      \ x y width height attrib -- f    record_size calloc            \ try to allociate space for wcb  if wcbseg @ >r wcbseg ! r>    \ if successful store seg var        oldwcbseg wcbseg! attrib wcbseg!   \ save attrib in wcb         2dup 2+ swap 2+ * 2* calloc \ alloc space for screen buf        if bufseg wcbseg!           \ save buffer seg                      height wcbseg! width wcbseg!    \ save parameters in            uly    wcbseg! ulx   wcbseg!    \ new wcb                       rdcur oldy wcbseg! oldx wcbseg! \ get old cursor pos.           ((window)) clr_window true      \ move data draw frame       else ." buffer alloc. failure" cr  \ if no memory                 wcbseg @ free drop drop 0 \ free wcb memory                   then                                                         else ." wcb alloc. failure" drop drop 0  then ; \ return flag \ file: WINDOW.BLK       Block: 20                              \ window routines                                    cl 11/10/85\ window parameter checking                                     : wfit cr                                                         abort" Window won't fit on crt" ;                             : open_window                   \ x y width height attrib -- f    depth 5 >=                                                       if >r 4dup rot + 2+ 24 <=                                         if + 2+ 79 <=                                                     if r> (window)                                                  else cr ." ULX and/or WIDTH incorrect" wfit                     then                                                          else   cr ." ULY and/or HEIGHT incorrect" wfit                  then                                                          else cr ." Incorrect # of parameters specified" quit            then ;                                                       \ file: WINDOW.BLK       Block: 21                              \ window routines                                    cl 11/10/85\ close the current window (defined by wcbseg data)             \ free wcb and buffer memory then unlink window                 : close_window                  \ --                              wcbseg @ 0 <>                 \ if window exists                if bufseg wcbseg@             \ get buffer seg addr                ulx wcbseg@ uly wcbseg@    \ get x,y corner                     width wcbseg@ 2+ height wcbseg@ 2+                              buf->scn                   \ mov data back to screen            oldx wcbseg@ oldy wcbseg@ at                                    bufseg wcbseg@ free drop   \ free buffer seg memory             wcbseg @ free drop         \ free wcb seg memory                oldwcbseg wcbseg@ wcbseg ! \ unlink this window              else                          \ if no current window               cr ." No open windows !" cr  then ;                        \ file: WINDOW.BLK       Block: 22                              \ window routines                                    cl 11/10/85\ position cursor in window                                     \ if parameters out of range do the best we can and still       \ stay in the window                                            : wat                            \ x y --                         swap dup abs width wcbseg@     \ req. x in window ?             1- >                           \ if not then                    if drop width wcbseg@ 1- then  \ set x to max in window         curx wcbseg!                   \ save new cursor x position     dup abs height wcbseg@         \ req y in window ?              1- >                           \ if not then                    if drop height wcbseg@ 1- then \ set y to max in window         cury wcbseg!                   \ save new cursor y position     curx wcbseg@ ulx wcbseg@ + 1+  \ actual cursor position         cury wcbseg@ uly wcbseg@ + 1+  at ; \ calculation             \ file: WINDOW.BLK       Block: 23                              \ window routines                                    cl 11/10/85\ read window cursor position                                   : rdwcur                        \ -- x y                          curx wcbseg@ cury wcbseg@ ;                                   \ read char/attrib of character at cursor in window             : rdwcha                        \ x y -- char/attrib              wat rdchra ;                                                  \ scroll window up for blank line at bottom                     : scroll_window                 \ --                              ulx wcbseg@ 1+ uly wcbseg@ 1+ \ upper left corner to scroll     ulx wcbseg@  width wcbseg@ +  \ lower right x coordinate        uly wcbseg@ height wcbseg@ +  \ lower right y coordinate        1 attrib wcbseg@ scrlup ;     \ up 1 line                                                                                                                                                     \ file: WINDOW.BLK       Block: 24                              \ window routines                                    cl 11/10/85\ do carrage return in the current window                       : crout rdwcur nip 0 swap wat ; \ carrage ret in window         \ do a line feed in the current window                          : lfout rdwcur 1+ dup                                             height wcbseg@ 1- >           \ cursor out of window            if 1- scroll_window then      \ if so scroll the window up      wat ;                         \ place the cursor in window    \ do a back space in the current window                         : bsout rdwcur over 0<>         \ backspace cursor in window      if swap 1- swap wat then ;                                    \ ring the bell                                                 : bell 7 (emit) ;               \ sound the horn                                                                                                                                                \ file: WINDOW.BLK       Block: 25                              \ window routines                                    cl 11/10/85: wemit dup 32 <                \ char --                         if case                       \ if control char process it           7 of bell  endof         \ if bell then                         8 of bsout endof         \ if backspace then                   10 of lfout endof         \ if linefeed then                    13 of crout endof         \ if carrage ret then                endcase                                                      else                          \ else its a display char            attrib wcbseg@ 256 * +     \ char now char/attrib               rdwcur rot chra+           \ output char adv. cursor            drop dup width wcbseg@ 1- =   \ if at end of window line        if drop lfout crout        \ do lfcr to next line               else 1+ curx wcbseg!       \ store new x coordinate             then  then ;                                               \ file: WINDOW.BLK       Block: 26                              \ window routines                                    cl 11/10/85: wcr 13 wemit 10 wemit ;       \ window carrage return         : wtype 0                       \ window equiv. of type           ?do count wemit loop drop ;                                   \ use memory manager to give forth a full 64k segment           : initialize                    \ --                              cr ." Memory management "     \ output 1/2 msg                  -1 setblock                   \ request FFFF bytes              if                            \ if successful                     ." initialized"             \ output message and                0 wcbseg !                  \ initialize link variable        else                                                              ." error" quit              \ abort program                   then cr ;                                                                                                                     \ file: WINDOW.BLK       Block: 27                              \ window demo                                        cl 11/10/85\ window equivalents of standard Forth words                    : wlist block 16 0                                                do dup i c/l * + c/l          \ window equiv. of list              -trailing wtype wcr                                          loop drop ;                                                   : wtriad 3 / 3 * 3 bounds       \ window equiv. of triad          do i wlist                    \ list screen in window              wcr wcr                    \ add a couple of cr's            loop ;                                                                                                                                                                                                                                                                                                                                                                                        \ file: WINDOW.BLK       Block: 28                              \ window demo                                        cl 11/10/85\ window canned messages                                        : msg1                                                            " This could be your application program! " wtype ;           : msg2 " Ain't this window package something! " wtype ;         : msg3 "  ** Window 4 ** " wtype ;                              : msg1out 0 0 wat               \ output msg1 20 times            20 0 do msg1 loop ;                                           : msg2out 0 0 wat               \ output msg2 10 times            10 0 do msg2 loop ;                                           : msg3out 0 0 wat               \ output msg3 80 times            80 0 do msg3 loop ;                                           \ file: WINDOW.BLK       Block: 29                              \ window demo                                        cl 11/10/85\ video attribute constants                                     \ file: WINDOW.BLK       Block: 29                              \ window demo                                        cl 11/10/85\ video attribute constants                                     7   constant normal         15 constant high_int                112 constant reverse       128 constant blink                   : fill_crt 0 0                  \ fill crt with rev video A's     [ ascii A reverse 256 * + ]   \ calculate char/attrib code      literal 2048 draw_row ;                                       : wait 10000 0 do noop loop ;   \ timing loop                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   \ file: WINDOW.BLK       Block: 30                              \ window demo                                        cl 11/10/85\ define the four windows used in the demo program              : window1                       \ define window #1                0 0 20 10 reverse open_window ;                               : window2                       \ define window #2                2 1 70 8 normal open_window ;                                 : window3                       \ define window #3                7 6 69 10 reverse open_window ;                               : window4                       \ define window #4                10 9 59 4 high_int open_window ;                                                                                                                                                                                                                                                                                                                                                              \ file: WINDOW.BLK       Block: 31                              \ window demo                                        cl 11/10/85: demo                                                            fill_crt window1                                                if 0 0 wat msg2 wait wcr wait 7 emit wcr                           wait " It sure is" wtype wait 8 wemit 8 wemit                   wait 10 5 wat wait window2                                      if msg1out wait window3                                            if 0 10 wat 24 wtriad wait window4                                 if msg3out wait close_window wait close_window                     wait clr_window msg2out wait close_window                       0 wlist wait wait wait wait close_window                  then then                                                    then                                                         then                                                            wait ;                                                        \ file: WINDOW.BLK       Block: 32                              \ window demo                                        cl 11/10/85only forth also dos also        \ search dos and forth          : test empty-buffers            \ dummy program name              initialize                    \ initialize memory manager       " window.blk"  fcb1 (!fcb)    \ parse filename to fcb           fcb1 !files open-file         \ open the file to list           2 0                                                             do                            \ run the demo 2 times              demo wait wait wait dark wait                                 loop                                                            ." What did you think of that Huh?" cr bye ;                  only forth also                 \ power up search order         ' test is boot                  \ make demo run automatically   save-system window.com          \ create .COM demo                                      \End Listing                            ;S                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ;S                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ;S