The start of quick FORTH 4/18/87 7 /11/88 This is an early version of the menu system that uses some create/does> constructions to simplify the task of pull down window creation. Screen 20 adds a graphics pull down to the pull down menus defined on screen 13. <FILE> and <EDIT> need only be defined once (on SCR 13). The menu [MAIN] uses them and the new item <GRAPH>. Have fun. \ STARTUP SCREEN 2 /18/1988NEED >ATTRIB NEED CAPS? NEED QUE: NEED (.S) NEED THE NEED SPLIT NEED (ORDER) NEED 0/ NEED COMMAND.COM \ NEED >HIRES VISA QUICK4.BLK VOCABULARY QUICK ONLY FORTH ALSO ALSO QUICK DEFINITIONS ALSO 2 21 THRU ' (INTRO) IS INTRO ONLY FORTH DEFINITIONS ALSO SAVE-SYSTEM QHEADS.DAT QF.COM CR .( System saved as QF.COM ) \ WINDOW STATUS LINE VARIABLE OLD-CAPS VARIABLE OLD-BASE BASE CONSTANT FORTH-BASE CODE ATT-EMIT ( char attrib -- ) AX POP 9 # AH MOV 1 # CX MOV $10 INT BX POP NEXT END-CODE : T.EMIT ( char addr -) IBM-AT? >R >R >R THE WINDOW >BRACES THE WINDOW EGA? IF 9 ELSE 56 THEN R> 0 IBM-AT ATT-EMIT R> R> IBM-AT ; : .TOP ( addr count loc -- ) SWAP BOUNDS ?DO COUNT I T.EMIT LOOP DROP ; : .CAPS OLD-CAPS @ IF " CAPS" ELSE " " THEN 76 .TOP ; : .BASE " BASE= " 67 .TOP DECIMAL OLD-BASE @ (.) 72 .TOP ; \ WINDOW STATUS LINE DEFER UPDATE.FILES BACKGROUND: ?CAPS BEGIN CAPS? OLD-CAPS @ OVER <> IF OLD-CAPS ! SINGLE .CAPS MULTI ELSE DROP THEN FORTH-BASE @ OLD-BASE @ OVER <> IF OLD-BASE ! SINGLE .BASE MULTI ELSE DROP THEN UPDATE.FILES PAUSE AGAIN ; \ NEWER QUICK FORTH 6 /21/88FORTH DEFINITIONS : DONE [ WINDOW ] CLOSE DSEG @ 0= IF ?CAPS SLEEP THEN ; : SETUP TEXT/CURSOR CAPS? OLD-CAPS ! ; QUICK DEFINITIONS CREATE TBUF 80 ALLOT : TOP-LINE TBUF 80 BLANK TBUF 80 0 .TOP .CAPS OLD-BASE OFF ; : (HELP) 6 11 20 1 $600 $200 OW ." HELP IS NOT DONE" KEY DROP DONE ; ' (HELP) 187 HOT.KEY ! ( INSTALL "HELP" ) EXIT DO I NEED THIS?? : BLANK.CURSOR [ WINDOW ] RDCHRA FLIP DUP $F0 AND 16 / 17 * SWAP $FF00 AND + FLIP 1 CHRA ; \ INTRO MESSAGE 6 /11/88: (INTRO) [ WINDOW ] 12 5 55 17 $7900 $7C00 OW NOSCROLL ." FORTH-83 with windows Ver " .VERSION cr ." (C)opyright 1987,1988 by Gary Bergstrom" cr cr ." KEY COMMAND" cr ." *** *******" cr ." ESC leave this screen" cr ." F1 HELP" cr ." Alt <letter> First letter of a menu" cr cr ." --while in a menu--" cr ." UP/DOWN move item selection" cr ." <cr> select item" cr ." ESC leave current menu" cr cr ." or use the left button of a mouse for selections" BEGIN (KEY?) IF (KEY) 27 = ELSE FALSE THEN LEFT? OR UNTIL DONE ; \ print files and path at top of screen 6 /21/88VARIABLE OLD-FILE VARIABLE OLD-INFILE IN-FILE CONSTANT IN-FIL FILE CONSTANT FIL : (.FILE) ( file addr -- ) >R @ 8 + COUNT 20 MIN R> TBUF + SWAP MOVE ; : .FILES TBUF 80 BLANK [ DOS ] GET-DRIVE TBUF C! " :\" TBUF 1+ SWAP MOVE (.PATH) TBUF 3 + SWAP MOVE " FROM:" TBUF 20 + SWAP MOVE IN-FIL DUP @ OLD-INFILE ! 25 (.FILE) " TO:" TBUF 45 + SWAP MOVE FIL DUP @ OLD-FILE ! 48 (.FILE) TBUF 66 0 .TOP ; : (FILE?) OLD-FILE @ FIL @ <> OLD-INFILE @ IN-FIL @ <> OR THE DOS 'PATH @ OR IF .FILES THE DOS 'PATH OFF THEN ; ' (FILE?) IS UPDATE.FILES \ FILE AND EDIT WINDOWS ONLY FORTH ALSO QUICK DEFINITIONS ALSO variable MODIFIER : \CHARS ( line# col.end col.start --) HIDE.CURSOR \ invert chr DO I OVER [ WINDOW ] RDWCHA [ QUICK ] MODIFIER @ XOR SPLIT ATT-EMIT LOOP DROP SHOW.CURSOR ; : DO.LINE ( line# -- ) [ WINDOW ] AT? >R >R HEIGHT DSEG@ 1- MIN width dseg@ 0 \chars r> r> at ; : INVERSE.LINE ( line# -- ) $2F00 MODIFIER ! DO.LINE ; : RESTORE.LINE ( line# -- ) [ WINDOW ] EGA? IF ATTRIB DSEG@ ELSE $2F00 THEN MODIFIER ! DO.LINE ; VARIABLE OLD-LINE# : MOVE-LINE ( new# -- ) [ WINDOW ] OLD-LINE# @ OVER = IF DROP ELSE OLD-LINE# @ DUP 0< IF DROP ELSE RESTORE.LINE THEN DUP 0< NOT IF DUP INVERSE.LINE THEN OLD-LINE# ! THEN ; \ COURSE: 1 /12/89FORTH DEFINITIONS : COURSE: CREATE INPUT , ( pass key # for keyboard usage ) HERE >R 0 , ( HOW MANY ) BL PARSE-WORD TUCK 'WORD PLACE 1+ ALLOT 0 BEGIN ' ['] " = WHILE (,") ' , 1+ REPEAT R> ! ( HOW MANY ) DOES> 2DUP 2+ @ >= ABORT" ???" 4 + COUNT + SWAP 1+ 0 ?DO COUNT + 2+ LOOP 2- @ ( next is stack dependent ) SWAP >R SWAP >R SWAP >R EXECUTE R> R> R> ; QUICK DEFINITIONS : COURSE? ( x y addr -- f ) >BODY SWAP -1 <> IF 2DROP EXIT THEN DUP @ SWAP 6 + C@ OVER + BETWEEN ; \ print menu : @COURSE-NAME ( pfa.addr -- addr len ) 4 + COUNT ; : .MENU ( pfa.addr -- ) AT? >R >R DUP 2+ SWAP @ 0 ?DO DUP DUP @ @COURSE-NAME ROT 2+ @ 1+ ( fudge ) -ROT THE WINDOW >TOP 4 + LOOP DROP R> R> AT ; : COURSE-LEN ( pfa.addr -- len ) 2+ C@ ; : COURSE-WIDTH ( pfa.addr -- width ) 4 + COUNT + C@ ; : .COURSE ( cfa.addr col -- ) SWAP >BODY DUP >R [ WINDOW ] ULY DSEG@ SWAP DUP COURSE-WIDTH SWAP COURSE-LEN $1700 EATTRIB DSEG@ OW NOSCROLL R> DUP 4 + COUNT + SWAP COURSE-LEN 0 DO DUP COUNT TYPE CR COUNT + 2+ LOOP DROP SINGLE ; \ don't allow background tasks to overwrite \ NEW WARM 2VARIABLE ZDIV 2VARIABLE MOUSEINT 0. MOUSEINT 2! : QUICK.BYE [ WINDOW ] 1 >WINDOW# (DONE) HIDE.CURSOR ZDIV 2@ 0 !INT MOUSEINT 2@ 2DUP D0= IF 2DROP ELSE 51 !INT THEN MULTI.BYE ; ' QUICK.BYE IS BYE : NEW-WARM [ WINDOW ] 1 >WINDOW# SETUP MULTI (WARM) ; ' NEW-WARM IS WARM : T-DIR 3 5 65 15 $600 $600 OW SINGLE RMARGIN @ >R 55 RMARGIN ! DIR/W CR ." Hit any key to continue" KEY DROP R> RMARGIN ! DONE ; \ SCREEN EDITIING : (UP) [ WINDOW ] AT? 1- 0 MAX AT ; : (RIGHT) [ WINDOW ] RDCHRA 255 AND LAST-KEY ! CHAR ; : (DOWN) [ WINDOW ] AT? 1+ HEIGHT DSEG@ 1- MIN AT ; : (LEFT) [ WINDOW ] AT? SWAP 1- 0 MAX SWAP AT ; ' (UP) 200 HOT.KEY ! ' (RIGHT) 205 HOT.KEY ! ' (DOWN) 208 HOT.KEY ! ' (LEFT) 203 HOT.KEY ! \ MENU 7 /14/88FORTH DEFINITIONS : MENU: CREATE HERE >R 0 , 2 ( START AT COL 2 ) BEGIN ' DUP ['] ; <> WHILE >BODY DUP , OVER , 4 + C@ + 2+ 1 R@ +! REPEAT \ /\ how many blanks between R> 3DROP DOES> ( x y -- ??-addr f) >R 2DUP -999 = SWAP -999 = AND ( print menu if -999,-999 ) IF 2DROP R> .MENU ELSE ( x y -- R: list of courses ) -1 = IF R> DUP 2+ SWAP @ 0 ?DO 2DUP DUP 2+ @ SWAP @ 4 + C@ ( title len) OVER + WITHIN IF NIP R> R> R> 3DROP TRUE EXIT THEN 4 + LOOP ELSE R> THEN DROP FALSE THEN ; \ FILE AND EDIT WINDOWS 7 /14/88DOS ALSO DEFINE NUL : CLOSE-EM CLOSE-BOTH NUL ; \ FILE AND EDIT WINDOWS 7 /14/88COURSE: <FILE> 161 {FILE} " Close BOTH " CLOSE-EM " BYE " BYE " 1 LOAD " OK " DOS gateway " COMMAND.COM " DIR " T-DIR ; : (EDIT) 1 ED ; COURSE: <EDIT> 146 {EDIT} " Previous" RED " SCR #1 " (EDIT) " at Error" EED ; MENU: [MAIN] <FILE> <EDIT> ; ' [MAIN] IS MENU PREVIOUS quick definitions \ MAIN WINDOW 6 /21/88: MAIN-WINDOW [ WINDOW ] 1 2 78 22 $600 $200 OW .FILES AT? 5 " {F1 is HELP}" >BOTTOM 22 " {F2 is STACK}" >BOTTOM 40 " {F3 is ORDER}" >BOTTOM ( from above ) AT 1 WINDOW# DSEG! ['] [MAIN] IS MENU -999 -999 MENU VIDEO-MODE? VIDEO.MODE DSEG! ; FORTH DEFINITIONS defer intro : (INSTALL) ( addr --) IS MENU THE WINDOW TOP -999 -999 MENU ; : INSTALL ( -- ) ' STATE @ IF [COMPILE] LITERAL COMPILE (INSTALL) ELSE (INSTALL) THEN ; IMMEDIATE quick definitions \ more testing 6 /21/88: SET-VIDEO VIDEO-MODE? 7 = IF $B000 ELSE $B800 THEN [ WINDOW ] DUP ['] V.SEG >BODY ! [ EDITOR ] SCR-SEG ! ; : NEW-BOOT [ WINDOW ] START.DSEG 16 / 1+ CSEG + DSEG ! THE WINDOW SAVE-CONFIG VIDEO-MODE? VIDEO.MODE DSEG! 51 @INT MOUSEINT 2! M.RESET SET-VIDEO HELLO 0 @INT ZDIV 2! ['] (0/) CSEG 0 !INT [ WINDOW ] WINDOW.EMIT SINGLE SETUP TOP-LINE MAIN-WINDOW INTRO ?CAPS WAKE MULTI REOPEN ; ' NEW-BOOT IS BOOT FORTH DEFINITIONS : COLD 1 >WINDOW# (DONE) COLD ; \ NEW VERSION THAT CLOSES AND REOPENS WINDOWS QUICK DEFINITIONS \ DO MENU 3 /9 /88DEFER ACTION : DO-MENU 0 INVERSE.LINE [ WINDOW ] 0 OLD-LINE# ! BEGIN KEY CASE 200 OF OLD-LINE# @ 1- DUP 0< IF DROP HEIGHT DSEG@ 1- THEN MOVE-LINE ENDOF 208 OF OLD-LINE# @ 1+ HEIGHT DSEG@ OVER <= IF DROP 0 THEN MOVE-LINE ENDOF 27 OF DONE EXIT ENDOF $0D OF DONE OLD-LINE# @ ACTION EXIT ENDOF ENDCASE AGAIN ; \ PICK UP WORD AT MOUSE 3 /11/8864 QUE: MBUFF MBUFF QINIT \ space for keystrokes : bl? ( chra -- f ) dup bl = swap 0= or ; : FIND-START ( -- ) [ WINDOW ] BEGIN AT? OVER 0= IF 2DROP EXIT THEN 2DUP SWAP 1- SWAP RDWCHA 255 AND bl? IF W-AT EXIT THEN 2DROP AGAIN ; : GET-WORD MBUFF QINIT [ WINDOW ] RDCHRA 255 AND BL? IF EXIT THEN BEGIN RDCHRA 255 AND bl max DUP MBUFF NQ BL? IF EXIT THEN [ EDITOR ] MY.WINDOW AT? SWAP 1+ SWAP INSIDE? NOT IF BL MBUFF NQ EXIT THEN [ WINDOW ] AT? SWAP 1+ SWAP W-AT AGAIN ; : @WORD hide.cursor AT? THE EDITOR MOUSE.LOC [ WINDOW ] W-AT FIND-START GET-WORD W-AT show.cursor ; \ MOUSE INTERFACE FOR MENUS 3 /9 /88: DO-MMENU [ EDITOR ] -1 OLD-LINE# ! BEGIN LEFT? WHILE MY.WINDOW MOUSE.LOC DUP >R INSIDE? IF R> MOVE-LINE ELSE R> DROP -1 MOVE-LINE THEN REPEAT DONE OLD-LINE# @ DUP 0< IF DROP ELSE ACTION THEN ; QUICK : START-MENU ( addr -- ) DUP @ BODY> DUP IS ACTION SWAP 2+ @ [ WINDOW ] ULX DSEG@ + 2+ .COURSE ; : MOUSE-MENU [ EDITOR ] MOUSE.LOC MENU IF START-MENU DO-MMENU ELSE DROP MY.WINDOW MOUSE.LOC INSIDE? IF @WORD THEN THEN ; \ MOUSE INTERFACE FOR MENUS 6 /21/88: MENU-KEY? ( key -- ???-addr true / key false ) FALSE SWAP [ ' MENU >IS ] LITERAL @ >BODY DUP 2+ SWAP @ 0 ?DO 2DUP @ @ = IF NIP NIP TRUE SWAP 0 LEAVE THEN 4 + LOOP DROP SWAP ; : MENU-KEY ( -- c ) BEGIN PAUSE (KEY?) IF (KEY) MENU-KEY? IF START-MENU DO-MENU ELSE MBUFF NQ THEN THEN MBUFF DQ? IF EXIT THEN LEFT? IF MOUSE-MENU BEGIN PAUSE LEFT? 0= UNTIL THEN RIGHT? IF 13 MBUFF NQ BEGIN PAUSE RIGHT? 0= UNTIL THEN AGAIN ; ' MENU-KEY IS KEY \ EDIT 1 /13/89: KEY: CREATE , DOES> @ MBUFF NQ ; 209 KEY: ed-next 201 KEY: ED-PREV 188 KEY: >SHADOW : END-EDIT 27 ( ESC ) MBUFF NQ ; COURSE: <EDITFILE> 161 {FILE} " NEXT SCR" ED-NEXT " PREV SCR" ED-PREV " SHADOW " >SHADOW " EXIT " END-EDIT ; MENU: [EDIT-MENU] <EDITFILE> ; : (EDIT-INIT) INSTALL [EDIT-MENU] ; EDITOR ALSO ' (EDIT-INIT) IS ED-INIT \ FILE AND EDIT WINDOWS 3 /16/88ALSO QUICK COURSE: <GRAPH> 162 {GRAPHICS} " EGA " >EGA " CGA B/W " >HIRES " CGA COLOR " >COLOR ; MENU: [MINE] <FILE> <EDIT> <GRAPH> ; INSTALL [MINE] PREVIOUS \ FILE AND EDIT WINDOWS 2 /18/1988 SPLIT split makes two bytes out of a word \CHARS ( line# col.end col.start -- ) \ invert chars on screen for "moving bar" effect INVERSE.LINE ( line# -- ) given a line # invert it \ FILE AND EDIT WINDOWS .FW open and print File window .EW open and print Edit window COMMAND.COM allows going to DOS shell (EDIT) default editing screen DO-EW what to do in edit window DO-FW what to do in file window \ DO MENU 2 /18/1988MOVE-LINE ( new# old# -- new#' ) move "moving bar" ACTION vector for what will be done when slecting from menu DO-MENU "moving bar" menu driver \ SOME MENUS 2 /18/1988EW edit menu and install it in ALT-E FW file menu and install it in ALT-F \ MOUSE INTERFACE FOR MENUS 3 /9 /88DO-MMENU do a mouse menu \ PICK UP WORD AT MOUSE 3 /11/88NEED QUE: MBUFF space for keystrokes to allow the mouse to type to the key queue FIND-START ( -- ) find the start of the word that the mouse is currently on GET-WORD get the current word into the key queue @WORD find start then get a word and finally retore cursor \ MOUSE INTERFACE FOR MENUS 3 /11/88 MOUSE-MENU do the two currently defined mouse windows MOUSE-KEY ( -- c ) new key routine to allow pushing mouse buttons
