===Mode-less full feature text editor=== 0 list Screen 0 not modified 0 \ VEDIT - FORTHSTAR SCREEN EDITOR 22:23JWB11/11/85 1 \ Last change: Screen 068 21:11JWB11/13/85 2 Before loading the editor make the following changes to your 3 UTILITY.BLK Screen File. 4 5 DEFER EDIT ' LIST IS EDIT \ Screen 6 Line 14 : add this line 6 7 THEN EDIT ; \ Screen 7 Line 15 replace LIST with EDIT 8 9 ALSO !! The recompiled system will overwrite the file 10 FORTH83.COM on the disk in drive 1. 11 12 DO YOU HAVE A BACKUP INCASE SOMETHING GOES WRONG!! 13 14 PRESS C TO CONTINUE THE LOAD ANY OTHER TO ABORT!! 15 1 list Screen 1 not modified 0 \ EDITOR LOAD BLOCK 22:27JWB11/11/85 1 : ARE.YOU.SURE? 0 LIST KEY ASCII C <> ABORT" LOAD CANCELED" ; 2 ARE.YOU.SURE? 3 CR .( LOADING VEDIT EDITOR AND REBUILDING SYSTEM ) 4 ONLY FORTH DEFINITIONS ' NOOP IS WHERE 5 ' P! >NAME FENCE ! FORGET FUDGE 4 VIEW# ! 6 FROM UTILITY.BLK 2 LOAD CR .( UTL LOADED ) 7 FROM UTILITY.BLK 22 LOAD CR .( SHADOW LOADED ) CR 8 5 VIEWS EDITOR.BLK 5 VIEW# ! 9 4 124 THRU CR .( EDITOR LOADED ) 4 VIEW# ! 10 FROM UTILITY.BLK 28 LOAD CR .( DUMPING LOADED) 11 FROM UTILITY.BLK 31 LOAD CR .( SEEING LOADED) 12 FROM UTILITY.BLK 43 LOAD CR .( SHOWING LOADED) 13 FROM UTILITY.BLK 49 LOAD CR .( BUGGING LOADED) 14 FROM UTILITY.BLK 52 LOAD CR .( TASKING LOADED) 15 WARNING ON --> 2 list Screen 2 not modified 0 \ Load up the system 18:51jwb11/05/85 1 5 VIEW# ! 2 : HELLO (S -- ) 3 CR ." 8086 Forth 83 Model" 4 CR ." Version 2.1.0 01Jun84" 5 CR ." Recompiled 08Nov87" 6 CR ." VEDIT by JW Brown 13Nov85" CR 7 START ONLY FORTH ALSO DEFINITIONS ; ' HELLO IS BOOT 8 9 : MARK (S -- ) 10 CREATE DOES> (FORGET) FORTH DEFINITIONS ; 11 MARK EMPTY HERE FENCE ! 12 CR .( System has been loaded, Size = ) HERE U. 13 ( EXIT ) \ Remove brackets on EXIT when testing mods to EDITOR 14 15 SAVE-SYSTEM FORTH83.COM CR .( System saved as FORTH83.COM ) 4 list Screen 4 not modified 0 \ Define vocabularies, set up search order 23:16JWB11/04/85 1 2 ONLY FORTH DEFINITIONS VOCABULARY EDITOR 3 4 ONLY FORTH ALSO ROOT DEFINITIONS 5 6 : EDITOR EDITOR ; 7 8 ONLY FORTH ALSO EDITOR ALSO DEFINITIONS DECIMAL 9 10 ORDER 11 12 13 14 15 5 list Screen 5 not modified 0 \ VIDEO-IO 23:15JWB11/04/85 1 \ Call video-io BIOS routines with type $10=16 INTerupt. 2 CODE VIDEO-IO ( dx cx bx ax dx' cx' bx' ax') 3 AX POP \ Pop all registers. 4 BX POP 5 CX POP 6 DX POP 7 RP PUSH \ Save return stack pointer = BP 8 16 INT \ Call video io routines. 9 RP POP \ Restore return stack pointer. 10 DX PUSH \ Return all registers to user. 11 CX PUSH 12 BX PUSH 13 1PUSH \ Push AX and fall into NEXT 14 END-CODE 15 6 list Screen 6 not modified 0 1 VARIABLE $KBF 2 \ Leave true flag if KBF has changed. New value in $KBF . 3 CODE KBF? ( -- flag ) \ Was: $KBF @ KBF DUP $KBF ! <> 4 2 # AH MOV \ Function number 2 for kb flag 5 22 INT \ Call KBF is returned in AL 6 AH AH SUB \ Clear high byte of AX. 7 $KBF # DI MOV \ Address of old KBF to DI 8 0 [DI] BX MOV \ Fetch old value of KBF 9 AX BX CMP \ Compare new value with old. 10 0= IF AX AX SUB \ Leave false flag if the same 11 ELSE AX 0 [DI] MOV \ Update $KBF and 12 -1 # AX MOV \ return true if KBF has changed. 13 THEN 1PUSH \ Push AX and fall into NEXT 14 END-CODE 15 7 list Screen 7 not modified 0 \ INIT-WINDOW 23:28JWB11/04/85 1 \ Scroll active page up. 2 CODE INIT-WINDOW ( ulc ulr lrc lrr atrib -- ) 3 AX POP AL BH MOV \ ulc=upper left column 4 AX POP AL DH MOV \ ulr=upper left row 5 AX POP AL DL MOV \ lrc=lower right column 6 AX POP AL CH MOV \ lrr=lower right row 7 AX POP \ Attribute byte used. 8 AL CL MOV \ 07 is for normal text. 9 1536 # AX MOV \ 1536 = 600 hex 10 RP PUSH 11 16 INT 12 RP POP 13 NEXT END-CODE 14 15 8 list Screen 8 not modified 0 \ GOTOXY AT {KEY} 18:43jwb11/05/85 1 \ Move cursor to new location at (col,row). 2 CODE AT (S col row -- ) 3 AX POP \ Get cursor row. 4 DX POP \ Get cursor column. 5 AL DH MOV \ Pack into DX for function call. 6 BH BH XOR \ Set screen page number to zero. 7 2 # AH MOV \ Function 2 is set cursor position. 8 16 INT \ Call video io 9 NEXT \ Next word please. 10 END-CODE 11 : GOTOXY AT ; 12 \ Wait for key without checking break key!! 13 : {KEY} (S -- char ) 14 0 7 BDOS 255 AND ; 15 9 list Screen 9 not modified 0 \ KBF @DATE 18:43jwb11/05/85 1 \ Return the current state of the keybord flag KB_FLAG 2 CODE KBF ( -- kbf ) 3 2 # AH MOV \ Function number 2 for kb flag 4 22 INT \ Call routine. 5 AH AH SUB \ Clear high byte of AX. 6 1PUSH \ Push AX and fall into NEXT 7 END-CODE 8 \ Fetch date from DOS. Returned in packed form, see (.DATE) 9 CODE @DATE ( -- year mmdd ) 10 42 ( 2A) # AH MOV 11 33 ( 21) INT 12 CX PUSH 13 DX PUSH 14 NEXT END-CODE 15 10 list Screen 10 not modified 0 \ @TIME TSMH TT SS MM HH 18:49jwb11/05/85 1 \ Fetch time from DOS. Returned packed in TSMH . 2 CREATE TSMH 4 ALLOT 3 4 : TTT TSMH C@ ; : SSS TSMH 1+ C@ ; 5 : MMM TSMH 2+ C@ ; : HHH TSMH 3 + C@ ; 6 7 CODE @TIME ( -- -- ) 8 44 ( 2C) # AH MOV 9 33 ( 21) INT 10 TSMH # DI MOV 11 DX 0 [DI] MOV 12 CX 2 [DI] MOV 13 NEXT END-CODE 14 15 11 list Screen 11 not modified 0 \ ATRIB VEMIT 20:18JWB11/07/85 1 VARIABLE ATRIB \ Current character attribute. 2 3 \ Emit character according to current attribute in ATRIB 4 CODE VEMIT ( char -- ) 5 ATRIB # DI MOV \ First output a space with 6 0 [DI] BX MOV \ with the color attribute. 7 2336 # AX MOV \ 0920HEX 8 1 # CX MOV \ Number of spaces to output. 9 16 INT \ Bios function call. 10 AX POP \ Fetch character to output. 11 14 # AH MOV \ Now output actual character 12 16 INT \ this time cursor will advance 13 #OUT # DI MOV \ to the next legal position. 14 0 [DI] INC \ Increment FORTH's character count. 15 NEXT END-CODE 12 list Screen 12 not modified 0 \ (KEY?) 20:07 03/14/86 1 2 3 \ Skan for key press returning true if key is down. 4 CODE (KEY?) ( -- flag ) 5 1 # AH MOV 6 22 INT 7 0= IF 0 # AX MOV \ FALSE if no key press. 8 ELSE -1 # AX MOV \ TRUE if key pressed. 9 THEN 10 1PUSH END-CODE 11 12 13 14 15 13 list Screen 13 not modified 0 \ CUR@ CUR! 23:58JWB11/04/85 1 CODE CUR@ ( -- rc ) \ Fetch cursor position as 16-bit word. 2 3 # AH MOV 3 BH BH SUB 4 16 INT 5 DX PUSH 6 NEXT 7 END-CODE 8 \ Restore cursor position, row in hi byte col in low byte. 9 CODE CUR! ( rc -- ) 10 2 # AH MOV 11 BH BH SUB 12 DX POP 13 16 INT 14 NEXT 15 END-CODE 14 list Screen 14 not modified 0 \ MATCH 14:12JWB06/16/85 1 ASSEMBLER DEFINITIONS 2 3 LABEL MATCH2 \ Leaves flag & byte advance 4 SI AX MOV \ Current cursor address. 5 SI POP \ Original cursor address. 6 SI AX SUB \ Byte count to advance. 7 DI SI MOV \ Restore interpretive pointer. 8 ( dx ax ) 2PUSH \ Flag, 0 no match, non zero match. 9 \ Byte count to advance. 10 11 LABEL MATCH1 12 CX POP CX POP CX POP CX POP 13 MATCH2 #) JMP 14 EDITOR DEFINITIONS 15 15 list Screen 15 not modified 0 \ MATCH 14:12JWB06/16/85 1 2 CODE MATCH CLD \ Set for auto increment. 3 SI DI MOV \ Save interpretive pointer. 4 CX POP \ String length. 5 BX POP \ String address. 6 DX POP \ Byte count to end of screen. 7 SI POP \ Address of cursor on screen. 8 SI PUSH \ Save copy of cursor address. 9 BEGIN AL LODS \ Fetch byte from screen. 10 0 [BX] AL CMP \ Compare with string. 11 0= IF DX PUSH \ Possible match, save 12 BX PUSH \ current position. 13 CX PUSH 14 SI PUSH 15 16 list Screen 16 not modified 0 \ MATCH 14:12JWB06/16/85 1 2 BEGIN CX DEC \ Decrement string length. 3 MATCH1 JE \ If zero we have a match. 4 DX DEC \ Decrement bytes to end of screen. 5 MATCH1 JE \ If zero we are at end of screen. 6 BX INC \ Increment string address. 7 AL LODS \ Get next byte from screen. 8 0 [BX] AL CMP \ Compare with string byte. 9 0<> UNTIL SI POP \ Restore pointers and counts. 10 CX POP 11 BX POP 12 DX POP 13 THEN DX DEC \ Decrement byte to end of screen 14 0= UNTIL MATCH2 #) JMP 15 END-CODE 17 list Screen 17 not modified 0 \ (OF) 14:12JWB06/16/85 1 \ EQUIVALENT TO OVER = IF DROP 2 CODE (OF) 3 AX POP BX POP 4 BX AX CMP 5 0<> IF BX PUSH 6 0 [IP] IP MOV 7 NEXT 8 THEN IP INC 9 IP INC 10 NEXT END-CODE 11 12 13 14 15 18 list Screen 18 not modified 0 \ CASE OF ENDOF ENDCASE 14:12JWB11/08/87 1 ( see FORTH DIMENSIONS, II/3 page 37 ) 2 3 : CASE CSP @ !CSP TRUE ; IMMEDIATE 4 5 : OF ?CONDITION COMPILE (OF) ?>MARK ; IMMEDIATE 6 7 : ENDOF COMPILE BRANCH ?>MARK 8 2SWAP ?>RESOLVE TRUE ; IMMEDIATE 9 10 : ENDCASE ?CONDITION COMPILE DROP BEGIN SP@ 11 CSP @ = 0= WHILE ?>RESOLVE 12 REPEAT CSP ! ; IMMEDIATE 13 14 15 19 list Screen 19 not modified 0 \ FIRSTF NEXTF 14:50 11/10/85 1 \ Search for first match of file spec at adr. 2 CODE FIRSTF ( adr flag ) 3 DX POP \ Offset of ASCIIZ file specification. 4 CX CX XOR \ Set attribute to 0 for normal files. 5 78 # AH MOV \ Searh for first match. 6 33 INT 7 U>= IF AX AX XOR THEN \ Carry flag set if error. 8 1PUSH \ Push AX containing the error code. 9 END-CODE 10 \ Search for next file match. 11 CODE NEXTF ( -- flag ) 12 79 # AH MOV \ Search for next match. 13 33 INT 14 U>= IF AX AX XOR THEN \ Carry set if error. 15 1PUSH END-CODE \ Push error flag. 20 list Screen 20 not modified 0 \ DBUFF ADD*.* ADD*.*? 15:21JWB11/10/85 1 128 CONSTANT DBUFF 2 \ Add *.* to file spec at adr. 3 : ADD*.* ( adr adr ) 4 DUP " *.*" ROT COUNT + SWAP CMOVE 5 DUP C@ 3 + OVER C! ; 6 \ Add *.* if null spec or drive spec only. 7 : ADD*.*? ( adr adr ) 8 DUP C@ 0= \ Null spec? 9 IF ADD*.* \ Add *.* if so. 10 ELSE DUP C@ 2 = \ Maybe drive only. 11 IF DUP 2+ C@ ASCII : = \ Is it drive spec? 12 IF ADD*.* \ Add *.* if so. 13 THEN THEN THEN ; 14 15 21 list Screen 21 not modified 0 \ DISP-FNAME 15:35JWB11/10/85 1 \ Display a filename and size from DOS scratch area at HERE 2 : DISP-FNAME 3 #OUT @ IF 3 SPACES THEN DBUFF 42 + DBUFF 30 + 4 DO I C@ ?DUP 5 IF DUP BL > 6 IF DUP ASCII A >= 7 OVER ASCII Z <= AND 8 IF 32 OR THEN 9 THEN VEMIT 10 ELSE LEAVE 11 THEN 12 LOOP 12 #OUT @ 20 MOD - SPACES 13 DBUFF 26 + DUP @ SWAP 2+ @ 6 D.R ; 14 15 22 list Screen 22 not modified 0 \ (DIR) 15:35JWB11/10/85 1 \ Display directory based on file spec at adr. 2 : (DIR) ( adr -- ) 3 ADD*.*? DBUFF 4 26 BDOS DROP \ Set data transfer area scratch pad. 5 DUP DUP C@ + 1+ 0 SWAP C! 6 1+ FIRSTF 0= \ Any match? 7 IF 6 3 AT 6 3 #OUT OFF 8 BEGIN DISP-FNAME #OUT @ 50 > 9 IF 1+ 2DUP AT #OUT OFF THEN \ More files? 10 NEXTF UNTIL 2DROP 11 THEN ; 12 13 14 15 23 list Screen 23 not modified 0 \ 3DROP FUNCTION-KEYS 14:13JWB06/16/85 1 : 3DROP DROP 2DROP ; 2 3 27 CONSTANT ESC 4 13 CONSTANT RETURN 5 10 CONSTANT LF 6 82 CONSTANT INS 7 59 CONSTANT F1 8 83 CONSTANT DEL 9 60 CONSTANT F2 10 15 CONSTANT BACK-TAB 11 61 CONSTANT F3 12 75 CONSTANT LEFT-ARROW 13 14 15 24 list Screen 24 not modified 0 \ VIDEO MODES 20:37JWB11/06/85 1 2 BASE ! 2 : -BLINK ATRIB @ 01111111 AND ATRIB ! ; 3 : BLINK ATRIB @ 10000000 OR ATRIB ! ; 4 DECIMAL 5 \ Type n bytes of string at adr using current atribute byte. 6 : VTYPE ( adr n -- ) 7 0 ?DO COUNT VEMIT LOOP DROP ; 8 9 \ Set cursor type. Start line = sl End line = el 10 \ Function 1 of type $10 int. 11 : SET-CURSOR ( sl el -- ) 12 SWAP FLIP + 0 SWAP 0 256 13 VIDEO-IO 2DROP 2DROP ; 14 15 25 list Screen 25 not modified 0 \ BIG LITTLE AND NO CURSORS 20:39JWB11/06/85 1 \ Make a big cursor. 2 : BIG-CURSOR ( -- -- ) 3 0 6 SET-CURSOR ; 4 \ Make a little cursor. 5 : LITTLE-CURSOR ( -- -- ) 6 6 7 SET-CURSOR ; 7 \ Make no cursor. 8 : NO-CURSOR ( -- -- ) 9 8 8 SET-CURSOR ; 10 : -NO-CURSOR ( -- -- ) 11 0 8 SET-CURSOR ; 12 : SELECT-CURSOR ( -- -- ) 13 KBF 128 AND 14 IF BIG-CURSOR 15 ELSE LITTLE-CURSOR THEN ; 26 list Screen 26 not modified 0 \ CHK .INS .CAP .NUM .SRL .STAMP 22:57jwb11/06/85 1 VARIABLE $INS 5 , ," INS" VARIABLE $NUM 10 , ," NUM" 2 VARIABLE $CAP 15 , ," CAP" VARIABLE $SRL 20 , ," SRL" 3 VARIABLE $AUTO $AUTO OFF 4 : CHK \ nf ofaddr 5 2DUP @ = OVER 2+ @ CUR! 6 IF 4 + COUNT VTYPE DROP 7 ELSE 2DROP 3 SPACES THEN ; 8 : .STAMP ( -- -- ) CUR@ 25 CUR! $AUTO @ 9 IF ." STAMP" ELSE ." " THEN CUR! ; 10 HEX : .INS ( kbf -- ) 80 AND $INS CHK ; 11 : .CAP ( kbf -- ) 40 AND $CAP CHK ; 12 : .NUM ( kbf -- ) 20 AND $NUM CHK ; 13 : .SRL ( kbf -- ) 10 AND $SRL CHK ; 14 : $INIT 80 $INS ! 40 $CAP ! 20 $NUM ! 10 $SRL ! ; DECIMAL 15 27 list Screen 27 not modified 0 \ FUNCTION KEYS 14:13JWB06/16/85 1 62 CONSTANT F4 2 77 CONSTANT RIGHT-ARROW 3 63 CONSTANT F5 4 72 CONSTANT UP-ARROW 5 64 CONSTANT F6 6 80 CONSTANT DOWN-ARROW 7 65 CONSTANT F7 8 71 CONSTANT HOME 9 66 CONSTANT F8 10 79 CONSTANT END 11 67 CONSTANT F9 12 73 CONSTANT PG-UP 13 68 CONSTANT F10 14 81 CONSTANT PG-DN 15 115 CONSTANT ^LEFT-ARROW 28 list Screen 28 not modified 0 \ FUNCTION KEYS 14:13JWB06/16/85 1 94 CONSTANT ^F1 2 116 CONSTANT ^RIGHT-ARROW 3 95 CONSTANT ^F2 4 96 CONSTANT ^F3 5 97 CONSTANT ^F4 6 119 CONSTANT ^HOME 7 98 CONSTANT ^F5 8 117 CONSTANT ^END 9 99 CONSTANT ^F6 10 132 CONSTANT ^PG-UP 11 100 CONSTANT ^F7 12 118 CONSTANT ^PG-DN 13 14 15 29 list Screen 29 not modified 0 \ FUNCTION KEYS 08:31JWB06/22/85 1 101 CONSTANT ^F8 2 102 CONSTANT ^F9 48 CONSTANT ALTB 3 103 CONSTANT ^F10 50 CONSTANT ALTM 4 104 CONSTANT ALTF1 46 CONSTANT ALTC 5 22 CONSTANT ALTU 31 CONSTANT ALTS 6 105 CONSTANT ALTF2 30 CONSTANT ALTA 7 49 CONSTANT ALTN 34 CONSTANT ALTG 8 106 CONSTANT ALTF3 24 CONSTANT ALTO 9 107 CONSTANT ALTF4 32 CONSTANT ALTD 10 108 CONSTANT ALTF5 23 CONSTANT ALTI 11 109 CONSTANT ALTF6 20 CONSTANT ALTT 12 110 CONSTANT ALTF7 13 111 CONSTANT ALTF8 14 112 CONSTANT ALTF9 15 113 CONSTANT ALTF10 30 list Screen 30 not modified 0 \ VARIABLES 09:15JWB06/20/85 1 VARIABLE $SCRATCH 2 : HELD $SCRATCH @ + ; 3 : SCREEN $SCRATCH @ 1024 + + ; 4 : BACKBUF $SCRATCH @ 2048 + + ; 5 : SEARCHBUF $SCRATCH @ 3072 + + ; 6 : REPLACEBUF $SCRATCH @ 3136 + + ; 7 : INSBUF $SCRATCH @ 3392 + + ; 8 VARIABLE CURSOR 9 VARIABLE SCREEN# 10 VARIABLE $INSERT 11 VARIABLE TAB# 12 VARIABLE HOLD-DEPTH 13 VARIABLE 14 VARIABLE $TITLE 63 ALLOT 15 VARIABLE $SECONDS 31 list Screen 31 not modified 0 \ $REPLACE PREV-FILE $DIRECTORY 14:13JWB06/16/85 1 VARIABLE $INITIALS 3 ALLOT 2 VARIABLE $REPLACE 3 VARIABLE PREV-FILE B/FCB ( 42 ) ALLOT 4 VARIABLE CUR-FILE B/FCB ALLOT 5 VARIABLE OLD-FILE 6 VARIABLE $DIRECTORY 7 VARIABLE BROWSING 8 \ Open a new screen file give address of counted string. 9 : OPEN-SCR \ addr --- 10 COUNT CUR-FILE [ DOS ] (!FCB) [ EDITOR ] 11 CUR-FILE [ DOS ] !FILES 12 IN-FILE @ DUP 15 BDOS DOS-ERR? TUCK NOT 13 IF DUP FILE-SIZE 1- SWAP MAXREC# ! 14 THEN [ EDITOR ] ; 15 32 list Screen 32 not modified 0 \ SPLIT .DATE TIME@ (.TIME) .TIME 18:46jwb11/05/85 1 : SPLIT ( hilo hi lo ) 2 256 /MOD SWAP ; 3 4 : (.DATE) ( -- addr count ) 5 @DATE SWAP 1900 - 6 0 <# # # 2DROP ASCII / HOLD SPLIT 7 0 # # ASCII / HOLD 2DROP 0 # # #> ; 8 9 10 11 12 13 14 15 33 list Screen 33 not modified 0 \ .TIME .DATE 18:48jwb11/05/85 1 2 \ Format the time ready for typing. 3 : (.TIME) ( -- adr count ) 4 @TIME 5 SSS 0 <# # # ASCII : HOLD 2DROP 6 MMM 0 # # ASCII : HOLD 2DROP 7 HHH 0 # # #> ; 8 9 10 11 : .TIME (.TIME) VTYPE ; 12 13 : .DATE (.DATE) VTYPE ; 14 15 34 list Screen 34 not modified 0 \ CLOCK PCKEY 22:04 11/12/85 1 : SS+5 5 $SECONDS +! ; 2 : .CLOCK ( -- -- ) 3 @TIME SSS $SECONDS @ 2DUP 60 = SWAP 5 < AND 4 IF $SECONDS OFF THEN >= 5 IF NO-CURSOR 32 CUR! .TIME 6 SELECT-CURSOR SS+5 THEN ; 7 : PCKEY ( -- char|code 0 ) 8 BEGIN (KEY?) NOT 9 WHILE CUR@ KBF? 10 IF NO-CURSOR KBF DUP 11 .INS DUP .NUM DUP 12 .CAP .SRL SELECT-CURSOR 13 THEN .CLOCK CUR! 14 REPEAT {KEY} DUP 15 0= IF {KEY} SWAP THEN ; 35 list Screen 35 not modified 0 \ MODE .STATE #IN 22:55jwb11/06/85 1 : ( -- n ) 2 BEGIN PCKEY DUP 0= WHILE BEEP 2DROP REPEAT ; 3 : .STATE CUR@ KBF 4 DUP .INS DUP .CAP DUP .NUM .SRL .STAMP 5 SELECT-CURSOR CUR! ; 6 7 : #IN ( --- n ) 8 0 BEGIN 9 KEY 10 DUP 13 = IF DROP EXIT THEN 11 DUP 8 = IF VEMIT 32 VEMIT 8 VEMIT 10 / ELSE 12 DUP 48 < OVER 57 > OR IF DROP 7 VEMIT 13 ELSE DUP VEMIT 48 - SWAP 10 * + THEN THEN 14 AGAIN ; 15 36 list Screen 36 not modified 0 \ CLEARSCREEN SW -SW 18:17JWB11/09/85 1 \ Clear entire screen. 2 : CLEARSCREEN ( -- -- ) 3 0 0 79 24 ATRIB @ INIT-WINDOW 0 0 AT ; 4 5 \ Swap in our vectors for EMIT AND KEY . 6 : SW ( -- -- ) 7 ['] VEMIT IS EMIT 8 ['] IS KEY ; 9 10 \ Restore original routines for EMIT AND KEY . 11 : -SW ( -- -- ) 12 ['] (EMIT) IS EMIT 13 ['] (KEY) IS KEY ; 14 15 37 list Screen 37 not modified 0 \ STAMP-PAD 23:09JWB06/23/85 1 2 \ Set up screen title as comment with time date and initials. 3 : STAMP-PAD ( -- -- ) 4 $TITLE 42 + 22 BLANK 5 ( $205C or "\ " ) 8284 $TITLE ! 6 (.DATE) $TITLE 55 + SWAP CMOVE 7 (.TIME) 3 - $TITLE 47 + SWAP CMOVE 8 $INITIALS COUNT $TITLE 52 + SWAP CMOVE ; 9 10 11 12 13 14 15 38 list Screen 38 not modified 0 \ DATE-SCREEN 23:14JWB06/23/85 1 2 3 \ Stamp current screen with time, initials and date. 4 : DATE-SCREEN ( -- -- ) 5 0 SCREEN $TITLE 42 CMOVE STAMP-PAD 6 $TITLE 0 SCREEN C/L CMOVE ; 7 8 9 10 11 12 13 14 15 39 list Screen 39 not modified 0 \ DATE-SCR0 23:13JWB06/23/85 1 \ Stamp second line of screen 0 with date and last screen 2 \ modified. 3 : DATE-SCR0 ( -- -- ) 4 $TITLE C/L BLANK 5 " Last change: Screen " $TITLE 2+ SWAP CMOVE 6 0 <# # # # #> $TITLE 25 + SWAP CMOVE 7 STAMP-PAD $TITLE 0 BLOCK C/L + C/L CMOVE UPDATE ; 8 9 10 11 12 13 14 15 40 list Screen 40 not modified 0 \ CURSOR-CHK @(CURSOR) 16:28JWB06/22/85 1 \ Store top of stack as current cursor value 2 : CURSOR! ( n -- ) 3 CURSOR ! ; 4 \ Fetch current value of cursor. 5 : CURSOR@ ( -- n ) 6 CURSOR @ ; 7 \ Check for out of bounds cursor. 8 : CURSOR-CHK ( -- -- ) 9 CURSOR@ 1024 + 1024 MOD CURSOR! ; 10 \ Fetch storrage address corresponding to current cursor. 11 : ADCUR ( -- adr ) 12 CURSOR@ SCREEN ; 13 \ Fetch character stored at current cursor location. 14 : @(CURSOR) ( -- char ) 15 ADCUR C@ ; 41 list Screen 41 not modified 0 \ !(CURSOR .CURSOR CHAR-TO-EOL 20:49JWB11/06/85 1 \ Store character at current cursor position. 2 : !(CURSOR) ( char -- ) 3 ADCUR C! ; 4 5 \ Print current cursor position. 6 : .CURSOR ( -- -- ) 7 CURSOR@ C/L /MOD 2DUP SWAP NO-CURSOR 8 50 1 AT 0 <# # # BL HOLD 2DROP 0 # # #> VTYPE 9 6 3 D+ AT SELECT-CURSOR ; 10 11 \ Return character count to end of current line. 12 : CHAR-TO-EOL ( -- n ) 13 C/L CURSOR@ OVER MOD - ; 14 15 42 list Screen 42 not modified 0 \ +.CURSOR .LINE ?LINE 20:49JWB11/06/85 1 \ Add n to current current cursor and print it. 2 : +.CURSOR ( n -- ) 3 CURSOR +! CURSOR-CHK .CURSOR ; 4 5 \ Print line n of the current screen. 6 : .LINE ( n -- ) 7 DUP 3 + 6 SWAP AT 8 C/L * SCREEN C/L VTYPE ; 9 10 \ Return number of line that cursor is currently on. 11 : ?LINE ( -- n ) 12 CURSOR@ C/L / ; 13 \ Leave true flag if there is a blank at the end of the line. 14 : BLANK-AT-END? ( -- flag ) 15 ?LINE 1+ C/L * 1- SCREEN C@ BL = ; 43 list Screen 43 not modified 0 \ ?LINE64* .LINE-TO-END MOVE-LINE 08:46JWB06/22/85 1 2 \ Return currsor position of start of line containing cursor. 3 : ?LINE64* ( -- n ) 4 ?LINE C/L * ; 5 6 \ Reprint the line the cursor is currently on. 7 : .LINE-TO-END ( -- -- ) 8 ?LINE .LINE ; 9 10 \ Move line n1 to line n2 . 11 : MOVE-LINE ( n1 n2 -- ) 12 SWAP C/L * SCREEN SWAP C/L * SCREEN 13 C/L CMOVE ; 14 15 Screen 44 not modified 0 \ MOVE-HOLD SCROLLDOWN .CLEAN 18:29JWB11/09/85 1 \ 2 : MOVE-HOLD ( n1 n2 -- ) 3 SWAP C/L * HELD 4 SWAP C/L * HELD C/L CMOVE ; 5 \ Scroll screen down one line. 6 : SCROLLDOWN ( x y x' y' -- ) 7 FLIP + -ROT FLIP + ATRIB @ FLIP 1793 \ $701=1793 8 VIDEO-IO 2DROP 2DROP ; 9 10 \ Wipe reading or writing off upper right corner. 11 : .CLEAN ( -- -- ) 12 NO-CURSOR CUR@ 56 1 AT 13 ." F1 = HELP " 14 CUR! SELECT-CURSOR ; 15 Screen 45 not modified 0 \ SCROLLUP .SCREEN# 20:42JWB11/07/85 1 \ Scroll screen up one line. 2 : SCROLLUP ( x y x' y' -- ) 3 FLIP + -ROT FLIP + 4 ATRIB @ FLIP 1537 ( $601=1537 ) 5 VIDEO-IO 2DROP 2DROP ; 6 7 8 \ Print screen number and current editing file. 9 : .SCREEN# ( -- -- ) 10 .STATE 6 1 AT 11 ." Screen # " SCREEN# @ . SPACE 12 19 1 AT BROWSING @ 13 IF ." Browsing" ELSE ." Editing" THEN 14 ." file: " FILE? ; 15 Screen 46 not modified 0 \ .WRITING .READING 14:18JWB06/23/85 1 2 3 : .WRITING ( -- -- ) 4 NO-CURSOR CUR@ 56 1 AT 5 BLINK ." Writing disk" -BLINK 6 CUR! SELECT-CURSOR ; 7 : .READING ( -- -- ) 8 NO-CURSOR CUR@ 56 1 AT 9 BLINK ." Reading disk" -BLINK 10 CUR! SELECT-CURSOR ; 11 12 13 14 15 Screen 47 not modified 0 \ PRINT-SCREEN 20:49JWB11/06/85 1 \ Send current screen to the printer. 2 : PRINT-SCREEN ( -- -- ) 3 -SW PRINTING ON CR 4 SCREEN# @ 7 SPACES 5 ." Screen#" 4 .R 3 SPACES FILE? 6 3 SPACES .DATE SPACE .TIME 7 16 0 DO CR I 6 .R SPACE 8 0 SCREEN I C/L * + C/L -TRAILING TYPE 9 LOOP 10 CR PRINTING OFF SW ; 11 12 13 14 15 Screen 48 not modified 0 \ PUSH-TO-PROCEED @(SCREEN#) CLEAR-PROMPT 19:56JWB11/11/85 1 2 \ Prompt for key press to continue. 3 : PUSH-TO-PROCEED ( -- -- ) 4 ." Press any key to continue. " KEY DROP ; 5 6 7 \ Fetch screen n to the editing & backup buffer areas. 8 : @(SCREEN#) ( n -- ) 9 .READING SCREEN# @ BLOCK 0 SCREEN 10 1024 CMOVE 0 SCREEN 0 BACKBUF 1024 CMOVE ; 11 12 13 \ Clear n lines of prompt area below screen. 14 : CLEAR-PROMPT ( n -- ) 1 MAX 5 MIN 19 + 15 0 20 ROT 79 SWAP ATRIB @ INIT-WINDOW 6 20 AT ; Screen 49 not modified 0 \ !(SCREEN# 08:53JWB06/22/85 1 \ Store current screen in a FORTH buffer and mark as updated. 2 : !(SCREEN#) ( -- -- ) 3 .WRITING SCREEN# @ 4 BLOCK 0 SCREEN SWAP 5 2DUP 1024 COMP 0= 6 IF 2DROP 7 ELSE $AUTO @ 8 IF DATE-SCREEN 9 THEN 1024 CMOVE UPDATE $AUTO @ 10 IF SCREEN# @ DATE-SCR0 11 THEN 12 THEN ; 13 14 15 Screen 50 not modified 0 \ #RECORDS DISPLACEMENT ?SCREENS CHECK-SCR 21:01JWB11/13/85 1 \ Return n, the maximum number of records in current file. 2 : #RECORDS ( -- n ) 3 FILE @ [ DOS ] MAXREC# [ EDITOR ] @ 1+ ; 4 5 \ Return offset n, to the alternate or shadow screen. 6 : DISPLACEMENT ( -- n ) 7 #RECORDS 0 16 UM/MOD NIP ; 8 9 \ Return the number n, of the last screen in current file. 10 : ?SCREENS ( -- n ) 11 #RECORDS 0 8 UM/MOD NIP 1- ; 12 13 \ Do not allow n to exceed the last available screen. 14 : CHECK-SCREEN ( n n') 15 0 MAX ?SCREENS MIN ; Screen 51 not modified 0 \ SHADOW-SCR IBUF IMOV 19:58JWB11/11/85 1 \ Convert screen n to corresponding shadow s. 2 : SHADOW-SCR ( n s ) 3 DISPLACEMENT 2DUP < IF + ELSE - THEN ; 4 VARIABLE IPTR 5 : IBUF ( -- adr ) \ Leave pointer into insert buffer. 6 0 INSBUF IPTR @ 256 MOD + ; 7 : IMOV ( -- -- ) \ Move character under cursor to ins buf. 8 $KBF @ 16 AND \ Is scroll lock down? 9 IF IPTR @ 256 < 10 IF @(CURSOR) IBUF C! 1 IPTR +! 11 ELSE 2 CLEAR-PROMPT ." Insert buffer full!" CR 12 BEEP PUSH-TO-PROCEED .CURSOR 13 THEN 14 THEN ; 15 Screen 52 not modified 0 \ IBLANK BORDER 20:05JWB11/11/85 1 : IBLANK ( -- -- ) \ Clear insert buffer to blanks. 2 IPTR OFF IBUF 256 BLANK ; 3 \ Display screen border and exit prompt. 4 : BORDER ( -- -- ) 5 CLEARSCREEN PAD 64 196 FILL 5 2 AT 6 218 VEMIT PAD 64 VTYPE 7 191 VEMIT 5 19 AT 192 VEMIT 8 PAD 64 VTYPE 217 VEMIT 16 0 9 DO 5 I 3 + AT 179 VEMIT 10 70 I 3 + AT 179 VEMIT 11 LOOP 72 5 AT ." PRESS" 12 72 7 AT ." Esc " 13 72 9 AT ." TO" 14 72 11 AT ." EXIT" 15 72 13 AT ." EDITOR" ; Screen 53 not modified 0 \ SCAN+<> SCAN+= 09:28JWB06/22/85 1 : SCAN+<> ( char to.adr from.adr count ) 2 2DUP = \ Return 0 if there is 3 IF 3DROP 0 \ nothing to search. 4 ELSE 0 ROT ROT \ Otherwise scan memory 5 DO OVER I C@ <> \ from low to high until 6 ?LEAVE 1+ \ a missmatch is found. 7 LOOP NIP THEN ; \ Return with count to mismatch. 8 9 : SCAN+= ( char to.adr from.adr count ) 10 2DUP = \ Return 0 if there is nothing 11 IF 3DROP 0 \ to search. 12 ELSE 0 ROT ROT \ Other wise scan memory from 13 DO OVER I C@ = \ low to high until 14 ?LEAVE 1+ \ a match is found. 15 LOOP NIP THEN ; \ Return with count to match. Screen 54 not modified 0 \ 09:00JWB06/22/85 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 55 not modified 0 \ .BLANK-SCREEN .SCREEN 20:07JWB11/11/85 1 \ Clear interior of screen window to blanks. 2 : .BLANK-SCREEN ( -- -- ) 3 6 3 69 18 ATRIB @ INIT-WINDOW ; 4 \ Display screen contents and headings. 5 : .SCREEN ( -- -- ) 6 42 0 AT .DATE 7 52 0 AT ." FORTHSTAR 2.1 " 8 .SCREEN# .BLANK-SCREEN 16 0 9 DO I C/L * SCREEN C/L -TRAILING DUP 10 IF 6 I 3 + AT VTYPE 11 ELSE 2DROP 12 THEN 13 LOOP .CLEAN .CURSOR ; 14 15 Screen 56 not modified 0 \ NEW-SCREEN .SCREEN-TO-END CLEAR-PROMPT 20:50JWB11/06/85 1 \ Display a new screen. 2 : NEW-SCREEN ( -- -- ) 3 @(SCREEN#) CURSOR OFF .SCREEN ; 4 5 \ Redisplay lines from cursor to the end of the screen. 6 : .SCREEN-TO-END ( -- -- ) 7 6 ?LINE 3 + 69 18 ATRIB @ INIT-WINDOW 8 16 ?LINE 9 DO I C/L * SCREEN C/L -TRAILING DUP 10 IF 6 I 3 + AT VTYPE 11 ELSE 2DROP 12 THEN 13 LOOP .CURSOR ; 14 15 Screen 57 not modified 0 \ .HOLD WAIT.DIGIT 18:36JWB11/09/85 1 \ Display the top of the line stack. 2 : .HOLD ( -- -- ) 3 HOLD-DEPTH @ 4 IF 0 24 79 24 ATRIB @ INIT-WINDOW 5 0 24 AT HOLD-DEPTH @ 3 .R SPACE 6 0 HELD 64 -TRAILING VTYPE 7 ELSE 0 24 79 24 ATRIB @ INIT-WINDOW 8 THEN ; 9 \ Wait n seconds for key press and convert to digit 1 ... 9 10 : WAIT.DIGIT \ n 1 ...9 11 0 SWAP 2000 * 0 12 ?DO (KEY?) 13 IF DROP PCKEY DUP 0= IF 2DROP 0 THEN LEAVE THEN 14 LOOP 15 48 - 1 MAX 9 MIN ; Screen 58 not modified 0 \ NEXT-SCREEN PREV-SCREEN +MOVE 14:16JWB06/16/85 1 \ Go to screen n. 2 : GO-SCR ( n -- ) 3 CURSOR@ >R !(SCREEN#) CHECK-SCREEN 4 SCREEN# ! NEW-SCREEN R> CURSOR! ; 5 \ Go to next screen. 6 : NEXT-SCREEN ( -- -- ) 7 SCREEN# @ ( 2 WAIT.DIGIT +) 1+ GO-SCR .CURSOR ; 8 \ Go to previous screen. 9 : PREV-SCREEN ( -- -- ) 10 SCREEN# @ ( 2 WAIT.DIGIT -) 1- GO-SCR .CURSOR ; 11 \ Move lines from cursor to end up one ( down on screen). 12 : +MOVE ( -- -- ) 13 ?LINE 15 < 14 IF ?LINE 1+ 15 15 DO I 1- I MOVE-LINE -1 +LOOP THEN ; Screen 59 not modified 0 \ -MOVE ASK-SCR FIRST-SCR LAST-SCR 09:22JWB06/22/85 1 \ Move lines from cursor to bottom down one ( up on screen). 2 : -MOVE ( -- -- ) 3 ?LINE 15 - 4 IF 15 ?LINE 5 DO I 1+ I MOVE-LINE LOOP 6 THEN ; 7 \ Prompt for input of new screen number. 8 : ASK-SCR ( -- n ) 9 ." Enter screen number : " #IN ; 10 \ Move to first screen of this file. 11 : FIRST-SCR ( -- -- ) 12 0 GO-SCR .CURSOR ; 13 \ Move to the last screen of this file. 14 : LAST-SCR ( -- -- ) 15 ?SCREENS GO-SCR .CURSOR ; Screen 60 not modified 0 \ GO-SHADOW PUSH-LINE POP-LINE 20:14JWB11/11/85 1 \ Toggle between current screen and its shadow screen. 2 : GO-SHADOW ( -- -- ) 3 SCREEN# @ SHADOW-SCR GO-SCR .CURSOR ; 4 \ Push current line to line stack and display it. 5 : PUSH-LINE ( -- -- ) 6 -1 14 DO I DUP 1+ MOVE-HOLD -1 +LOOP 7 ?LINE64* SCREEN 0 HELD C/L CMOVE HOLD-DEPTH 8 @ 1+ 16 MIN HOLD-DEPTH ! .HOLD .CURSOR ; 9 \ Pop line from line stack. 10 : POP-LINE ( -- -- ) 11 0 HELD ?LINE64* SCREEN C/L CMOVE ?LINE 12 .LINE C/L HELD 0 HELD 960 CMOVE 960 HELD C/L BLANK 13 HOLD-DEPTH @ 1- 0 MAX HOLD-DEPTH ! .HOLD .CURSOR ; 14 15 Screen 61 not modified 0 \ SPLIT-LINE SPREAD-LINE 20:17JWB11/11/85 1 \ Split line at current currsor position. 2 : SPLIT-LINE ( -- -- ) 3 +MOVE ADCUR C/L BLANK 4 .SCREEN-TO-END ; 5 \ Insert blank line at current curssor postion. 6 : SPREAD-LINE ( -- -- ) 7 ?LINE 15 - DUP 8 IF ?LINE 1 - 14 9 DO I DUP 1 + MOVE-LINE -1 10 +LOOP 11 THEN ?LINE64* SCREEN C/L BLANK 12 IF 6 ?LINE 3 + 69 18 SCROLLDOWN 13 ELSE 15 .LINE .CURSOR 14 THEN ; 15 Screen 62 not modified 0 \ DELETE-LINE 20:17JWB11/11/85 1 \ Delete line at current currsor position and move rest up. 2 : DELETE-LINE ( -- -- ) 3 ?LINE 15 - DUP 4 IF ?LINE 1 + C/L * SCREEN 5 DUP C/L - OVER 1024 6 SCREEN SWAP - CMOVE 7 THEN 15 C/L * SCREEN C/L BLANK 8 IF 6 ?LINE 3 + 69 18 SCROLLUP 9 ELSE 15 .LINE .CURSOR 10 THEN ; 11 12 13 14 15 Screen 63 not modified 0 \ FORWARD BACKUP PUT-CHAR TAB-RIGHT 20:20JWB11/11/85 1 \ Move cursor forward one position. 2 : FORWARD ( -- -- ) 3 1 +.CURSOR ; 4 \ Back cursor up one position. 5 : BACKUP ( -- -- ) 6 -1 +.CURSOR ; 7 \ Store character and display it. 8 : PUT-CHAR ( char -- ) 9 DUP VEMIT !(CURSOR) FORWARD ; 10 \ Mover right to the next tab stop. 11 : TAB-RIGHT ( -- -- ) 12 TAB# @ CURSOR@ C/L MOD 13 OVER / OVER * ?LINE64* + + 14 CURSOR! CURSOR-CHK .CURSOR ; 15 Screen 64 not modified 0 \ TAB-LEFT TAB-UP +TRANSPOSE 20:22JWB11/11/85 1 \ Move to the next tabstop on the left. 2 : TAB-LEFT ( -- -- ) 3 TAB# @ CURSOR@ C/L MOD 4 OVER / OVER * ?LINE64* + SWAP - 5 CURSOR! CURSOR-CHK .CURSOR ; 6 \ Move cursor up one position. 7 : TAB-UP ( -- -- ) 8 -64 +.CURSOR ; 9 \ Transpose character under cursor with the one in front of it. 10 : +TRANSPOSE ( -- -- ) 11 CURSOR@ 1024 < 12 IF ADCUR @ 256 /MOD 13 PUT-CHAR 14 PUT-CHAR BACKUP 15 THEN ; Screen 65 not modified 0 \ TAB-DOWN ERASE-SCREEN -TRANSPOSE 20:24JWB11/11/85 1 2 \ Move cursor down one position. 3 : TAB-DOWN ( -- -- ) 4 C/L +.CURSOR ; 5 6 \ Erase current screen to blanks. 7 : ERASE-SCREEN ( -- -- ) 8 0 SCREEN 1024 BLANK .BLANK-SCREEN 9 CURSOR OFF .SCREEN# .CURSOR ; 10 11 \ Transpose character under cursor with the one behind it. 12 : -TRANSPOSE ( -- -- ) 13 CURSOR@ 14 IF BACKUP +TRANSPOSE BACKUP THEN ; 15 Screen 66 not modified 0 \ ERASE-TO-END ERASE-LINE 21:04JWB11/13/85 1 2 \ Erase from cursor to end of screen with blanks. 3 : ERASE-TO-END ( -- -- ) 4 ADCUR 1024 CURSOR@ - 5 BLANK .SCREEN-TO-END ; 6 7 \ Erase line that the cursor is on with blanks. 8 : ERASE-LINE ( -- -- ) 9 ?LINE64* DUP CURSOR! 10 SCREEN C/L BLANK .LINE-TO-END .CURSOR ; 11 12 13 14 15 Screen 67 not modified 0 \ ERASE-EOL (DELC) DELETE-CHAR 21:04JWB11/13/85 1 \ Erase line from cursor to end with blanks. 2 : ERASE-EOL ( -- -- ) 3 ADCUR CHAR-TO-EOL 4 2DUP BLANK VTYPE .CURSOR ; 5 \ Delete character under cursor. Display not refreshed. 6 : (DELC) ( -- -- ) 7 IMOV CHAR-TO-EOL ADCUR 8 2DUP DUP 1+ SWAP ROT CMOVE 9 + 1- BL SWAP C! ; 10 \ Delete character under cursor and refresh display. 11 : DELETE-CHAR ( -- -- ) 12 (DELC) 13 ADCUR CHAR-TO-EOL 14 -TRAILING 1+ VTYPE .CURSOR ; 15 Screen 68 not modified 0 \ (INS-CHAR) SPREAD-CHAR INSERT-CHAR 21:11JWB11/13/85 1 \ Insert char at cursor position and advance cursor n positions. 2 : (INS-CHAR) ( char n -- ) 3 SWAP \ c n 4 ADCUR CHAR-TO-EOL \ n c a e 5 2DUP + 1- C@ BL = \ n c a e flag 6 IF 2DUP SWAP DUP 1+ \ 7 ROT 1- CMOVE> 8 ROT 2 PICK C! 9 -TRAILING VTYPE +.CURSOR 10 ELSE 2DROP 2DROP BEEP THEN ; 11 \ Insert a blank at cursor position but do not advance cursor. 12 : SPREAD-CHAR ( -- -- ) BL 0 (INS-CHAR) ; 13 \ Insert char at cursor postion and advance one position. 14 : INSERT-CHAR ( char -- ) 1 (INS-CHAR) ; 15 Screen 69 not modified 0 \ DELETE-CHARLFT NOT-EMPTY-LINE? 21:05JWB11/13/85 1 2 \ Delete character behind cursor. 3 : DELETE-CHARLFT ( -- -- ) 4 CURSOR@ C/L MOD 0= 5 IF BEEP 6 ELSE -1 CURSOR +! .CURSOR DELETE-CHAR 7 THEN ; 8 9 \ Leave true flag if rest of line is not blank. 10 : NOT-EMPTY-LINE? ( -- flag ) 11 ADCUR CHAR-TO-EOL 12 -TRAILING NIP 0<> ; 13 14 15 Screen 70 not modified 0 \ IGET BACKSPACE 20:28JWB11/11/85 1 2 \ Insert character from ins buf at current cursor position. 3 : IGET ( -- -- ) 4 IPTR @ 0<> BLANK-AT-END? AND 5 IF -1 IPTR +! IBUF C@ 0 (INS-CHAR) 6 ELSE BEEP THEN ; 7 8 \ Backup and erase character behind cursor. 9 : BACKSPACE ( -- -- ) 10 CURSOR@ C/L MOD 0= 11 IF BEEP 12 ELSE -1 +.CURSOR BL !(CURSOR) 13 BL VEMIT .CURSOR 14 THEN ; 15 Screen 71 not modified 0 \ CURSOR-RIGHTWORD 20:29JWB11/11/85 1 \ Move cursor right one word. Word traversed goes to the 2 \ insert buffer if scroll lock is on. 3 : CURSOR-RIGHTWORD ( -- -- ) 4 BEGIN CURSOR@ 1+ DUP 1023 > 5 IF DROP TRUE 6 ELSE IMOV CURSOR! @(CURSOR) BL = 7 DUP IF IMOV THEN 8 THEN 9 UNTIL 10 BEGIN CURSOR@ 1+ DUP 1023 > 11 IF DROP TRUE 12 ELSE CURSOR! @(CURSOR) BL > 13 THEN 14 UNTIL .CURSOR ; 15 Screen 72 not modified 0 \ CURSOR-LEFTWORD 20:32JWB11/11/85 1 \ Move cursor left one word. 2 : CURSOR-LEFTWORD ( -- -- ) 3 @(CURSOR) BL > 4 IF -1 CURSOR +! CURSOR-CHK 5 THEN @(CURSOR) BL = 6 IF BEGIN CURSOR@ 1- DUP 0< 7 IF DROP TRUE 8 ELSE CURSOR! @(CURSOR) BL <> 9 THEN 10 UNTIL 11 THEN 12 BEGIN -1 CURSOR +! 13 CURSOR@ 0< 14 @(CURSOR) BL = OR 15 UNTIL FORWARD ; Screen 73 not modified 0 \ FIND-CHARACTER INSERT-WORDRIGHT 20:34JWB11/11/85 1 \ Move cursor to first occurance of inputed character. 2 : FIND-CHARACTER ( -- -- ) 3 KEY 1 CURSOR +! 4 0 SCREEN 1023 + 5 0 SCREEN CURSOR@ + 6 SCAN+= +.CURSOR ; 7 8 \ Insert word from the insert buffer. 9 : INSERT-WORDRIGHT ( -- -- ) 10 IPTR @ 0<> IBUF 1- C@ BL = AND 11 IF BEGIN BLANK-AT-END? IPTR @ 0<> IBUF 1- C@ BL = AND AND 12 WHILE IGET REPEAT 13 THEN BEGIN BLANK-AT-END? IPTR @ 0<> IBUF 1- C@ BL <> AND AND 14 WHILE IGET REPEAT ; 15 Screen 74 not modified 0 \ DELETE-WORDRIGHT 20:35JWB11/11/85 1 \ Delete word to the right of the cursor. 2 : DELETE-WORDRIGHT ( -- -- ) 3 NOT-EMPTY-LINE? 4 IF @(CURSOR) BL > 5 IF BEGIN (DELC) @(CURSOR) BL = 6 UNTIL 7 THEN NOT-EMPTY-LINE? 8 IF BEGIN (DELC) @(CURSOR) BL <> 9 UNTIL 10 THEN .LINE-TO-END .CURSOR 11 THEN ; 12 13 14 15 Screen 75 not modified 0 \ PULL-NEXT-LINE 20:39JWB11/11/85 1 \ Pull line next line ( below cursor ) over to the right 2 \ of the screen. Used in JOIN-LINE. 3 : PULL-NEXT-LINE ( -- -- ) 4 ?LINE 1+ C/L * 5 DUP SCREEN C@ 32 = 6 IF CURSOR@ >R CURSOR! 7 .CURSOR DELETE-WORDRIGHT 8 R> CURSOR! .CURSOR 9 ELSE DROP 10 THEN ; 11 12 13 14 15 Screen 76 not modified 0 \ MOVE-UPTO-BLANK 20:40JWB11/11/85 1 \ 2 3 : MOVE-UPTO-BLANK ( adr1 adr2 n n' ) 4 BEGIN DUP 1- 3 PICK + 5 C@ 32 <> OVER 0<> AND 6 WHILE 1- 7 REPEAT DUP DUP >R 8 IF CMOVE 9 ELSE DROP 2DROP 10 THEN R> ; 11 12 13 14 15 Screen 77 not modified 0 \ JOIN-LINE 20:41JWB11/11/85 1 \ Join line under cursor to the one containing the cursor. 2 : JOIN-LINE ( -- -- ) 3 ?LINE 15 - 4 IF ?LINE64* SCREEN C/L -TRAILING DUP 63 < 5 IF PULL-NEXT-LINE 1+ DUP >R + ?LINE 1+ 6 C/L * SCREEN SWAP C/L R> - MOVE-UPTO-BLANK 7 ?LINE 1+ C/L * SCREEN SWAP BLANK ?LINE .LINE 8 PULL-NEXT-LINE ?LINE 1+ C/L * SCREEN C/L 9 -TRAILING SWAP DROP 0= 10 IF CURSOR@ >R C/L CURSOR +! DELETE-LINE R> 11 CURSOR! .CURSOR 12 ELSE .SCREEN-TO-END 13 THEN 14 ELSE 2DROP 15 THEN THEN ; Screen 78 not modified 0 \ END-OF-SCREEN START-OF-SCREEN 21:11JWB11/08/85 1 2 \ Move to end of screen. 3 : END-OF-SCREEN ( -- -- ) 4 0 SCREEN 1023 -TRAILING 5 NIP CURSOR! .CURSOR ; 6 7 \ Move to start of screen. 8 : START-OF-SCREEN ( -- -- ) 9 CURSOR OFF .CURSOR ; 10 11 12 13 14 15 Screen 79 not modified 0 \ END-OF-LINE START-OF-LINE 20:42JWB11/11/85 1 2 \ Move to end of the line. 3 : END-OF-LINE ( -- -- ) 4 ?LINE64* DUP SCREEN C/L -TRAILING 5 NIP + CURSOR! .CURSOR ; 6 7 \ Move to the start of the line. 8 : START-OF-LINE ( -- -- ) 9 ?LINE64* CURSOR! .CURSOR ; 10 11 12 13 14 15 Screen 80 not modified 0 \ STRING-INPUT 21:14JWB11/08/85 1 2 \ Fetch string from user and return character count. 3 : STRING-INPUT ( -- n ) 4 HERE 1+ 30 EXPECT 5 SPAN @ DUP HERE C! ; 6 7 8 9 10 11 12 13 14 15 Screen 81 not modified 0 \ .SCH-TARGET 20:45JWB11/06/85 1 2 3 4 5 : .SCH-TARGET 6 1 CLEAR-PROMPT ." Find string: " ASCII " VEMIT 7 0 SEARCHBUF COUNT VTYPE ASCII " VEMIT 8 0 REPLACEBUF C@ 9 IF 4 SPACES ." Replace with: " ASCII " VEMIT 10 0 REPLACEBUF COUNT VTYPE ASCII " VEMIT 11 ELSE 4 SPACES ." (Press any key to cancel.)" 12 THEN ; 13 14 15 Screen 82 not modified 0 \ .SCH-NO-FIND .SCH-ILLEGAL 20:46JWB11/06/85 1 2 3 : .SCH-NO-FIND ( -- -- ) 4 1 CLEAR-PROMPT ." Can't find: " ASCII " VEMIT 5 0 SEARCHBUF COUNT VTYPE ASCII " VEMIT BEEP 6 PUSH-TO-PROCEED ; 7 8 : .SCH-ILLEGAL ( -- -- ) 9 1 CLEAR-PROMPT ." No FIND argument" BEEP 10 PUSH-TO-PROCEED ; 11 12 13 14 15 Screen 83 not modified 0 \ .SCH-ABORTED SEARCH-INPUT 21:16JWB11/08/85 1 2 3 : .SCH-ABORTED ( -- -- ) 4 1 CLEAR-PROMPT ." Search aborted" BEEP 5 PUSH-TO-PROCEED ; 6 7 : SEARCH-INPUT ( -- -- ) 8 1 CLEAR-PROMPT 9 ." String to find : " 10 STRING-INPUT ?DUP 11 IF DUP >R 0 SEARCHBUF C! 12 HERE 1+ 1 SEARCHBUF 13 R> CMOVE 14 THEN ; 15 Screen 84 not modified 0 \ REPLACE-INPUT 09:40JWB06/22/85 1 2 3 : REPLACE-INPUT 4 1 CLEAR-PROMPT ." Replace with : " 5 STRING-INPUT ?DUP 6 IF DUP >R 0 REPLACEBUF C! 7 HERE 1+ 1 REPLACEBUF R> CMOVE 8 THEN ; 9 10 11 12 13 14 15 Screen 85 not modified 0 \ .REP-ILLEGAL .REP-MISSING 20:44JWB11/11/85 1 \ Display replace error message. 2 : .REP-ILLEGAL ( -- -- ) 3 1 CLEAR-PROMPT ." REPLACE argument too long" 4 BEEP ; 5 6 \ Display replace error message. 7 : .REP-MISSING ( -- -- ) 8 1 CLEAR-PROMPT 9 ." Missing FIND or REPLACE argument" BEEP ; 10 11 12 13 14 15 Screen 86 not modified 0 \ REPLACE-VALIDATE 20:45JWB11/11/85 1 2 \ Validate search and replace arguments. 3 : REPLACE-VALIDATE ( -- -- ) 4 0 SEARCHBUF C@ 0= 0 REPLACEBUF C@ 5 0= OR 6 IF .REP-MISSING 0 7 ELSE 0 SEARCHBUF C@ 0 REPLACEBUF C@ < 8 IF .REP-ILLEGAL 0 9 ELSE 1 10 THEN 11 THEN ; 12 13 14 15 Screen 87 not modified 0 \ SEARCH-SCREEN SEARCH-ADJUST 20:47JWB11/11/85 1 2 3 \ Search screen n. 4 : SEARCH-SCREEN ( ) 5 BLOCK OVER + OVER 1024 SWAP - 1 6 SEARCHBUF 0 SEARCHBUF C@ MATCH ROT + SWAP 7 IF 1 8 ELSE DROP 0 9 THEN ; 10 11 12 : SEARCH-ADJUST 0 SEARCHBUF C@ - ; 13 14 15 Screen 88 not modified 0 \ SEARCH-TO-END 23:38JWB06/23/85 1 2 : SEARCH-TO-END 3 !(SCREEN#) FLUSH .READING SCREEN# @ 4 BEGIN CUR@ .CLOCK CUR! (KEY?) 5 IF DROP .SCH-ABORTED 0 $REPLACE ! 6 CURSOR-LEFTWORD KEY DROP EXIT 7 THEN 1+ DUP ?SCREENS > 8 IF DROP EMPTY-BUFFERS .SCH-NO-FIND 0 $REPLACE ! 9 CURSOR-LEFTWORD EXIT 10 ELSE 0 OVER SEARCH-SCREEN 11 IF SEARCH-ADJUST CURSOR! SCREEN# ! 12 @(SCREEN#) .SCREEN .CLEAN EXIT 13 THEN 14 THEN 15 AGAIN ; Screen 89 not modified 0 \ SEARCH-FILE 23:07JWB06/20/85 1 2 3 : SEARCH-FILE ( -- -- ) 4 -1 $REPLACE ! 5 CURSOR-RIGHTWORD CURSOR@ 6 SCREEN# @ SEARCH-SCREEN 7 IF SEARCH-ADJUST CURSOR! 8 ELSE SEARCH-TO-END 9 THEN ; 10 11 12 13 14 15 Screen 90 not modified 0 \ REPLACE-STRING 10:51JWB11/10/85 1 2 : REPLACE-STRING ( -- -- ) 3 $REPLACE @ 4 IF ADCUR 0 5 SEARCHBUF C@ BLANK 0 6 REPLACEBUF COUNT 7 ADCUR SWAP CMOVE 8 .CURSOR ADCUR 9 0 SEARCHBUF C@ VTYPE 10 THEN ; 11 12 13 14 15 Screen 91 not modified 0 \ HLP1 10:48JWB11/10/85 1 2 3 : HLP1 ( -- -- ) 4 2 20 AT 24 VEMIT ." or ^E cursor up" 5 2 21 AT 25 VEMIT ." or ^X cursor down" 6 2 22 AT 26 VEMIT ." or ^D cursor right" 7 2 23 AT 27 VEMIT ." or ^S cursor left" 8 26 20 AT ." aD transpose right" 9 26 21 AT ." aS transpose left" 10 26 22 AT 17 VEMIT 217 VEMIT ." new line" 11 26 23 AT ." F1 more help" 12 52 20 AT ." ^Home start of text" 13 52 21 AT ." Home start of line" 14 52 22 AT ." End end of line" 15 52 23 AT ." ^End end of text" ; Screen 92 not modified 0 \ HLP2 13:44JWB11/10/85 1 2 : HLP2 ( -- -- ) 3 2 20 AT 26 VEMIT 221 VEMIT ." or ^I tab right" 4 2 21 AT 222 VEMIT 27 VEMIT ." or ^O tab left" 5 2 22 AT 94 VEMIT 26 VEMIT ." or ^F word right" 6 2 23 AT 94 VEMIT 27 VEMIT ." or ^A word left" 7 26 20 AT ." ^Q followed by any" 8 29 21 AT ." character will" 9 29 22 AT ." move to its" 10 29 23 AT ." first occurance" 11 52 20 AT ." F7 find string" 12 52 21 AT ." ^L find again" 13 52 22 AT ." F8 find & replace" 14 52 23 AT ." F1 more help" ; 15 Screen 93 not modified 0 \ HLP3 17:56JWB11/09/85 1 2 : HLP3 ( -- -- ) 3 1 20 AT ." ^G delete char " 4 1 21 AT 17 VEMIT 196 VEMIT ." backsp & erase" 5 1 22 AT ." DEL backsp & delete" 6 1 23 AT ." ^C see ins buf" 7 22 20 AT ." ^T delete word" 22 21 AT ." ^R recall word" 8 22 22 AT ." ^B clr ins buf" 22 23 AT ." ^V recall char" 9 41 20 AT ." ^Y delete line" 41 21 AT ." ^U erase line" 10 41 22 AT ." aU erase to EOL" 41 23 AT ." INS insert toggle" 11 61 20 AT ." ^N insert line" 61 21 AT ." aN split line" 12 61 22 AT ." ^W insert space" 61 23 AT ." F1 more help" ; 13 14 15 Screen 94 not modified 0 \ HLP4 10:48JWB11/10/85 1 2 : HLP4 ( -- -- ) 3 1 20 AT ." PgUp previous screen" 4 1 21 AT ." ^R recall word" 5 1 22 AT ." ^PgUp first screen" 6 26 20 AT ." PgDn next screen" 7 26 21 AT ." ^C see ins buf" 8 26 22 AT ." ^PgDn last screen" 9 52 20 AT ." ^Z enter new screen" 10 52 21 AT ." aA shadow screen" 11 52 22 AT ." F1 more help" ; 12 13 14 15 Screen 95 not modified 0 \ HLP5 17:56JWB11/09/85 1 2 : HLP5 ( -- -- ) 3 1 20 AT ." ^J = join lines" 4 1 21 AT ." ^P = print screen" 5 1 22 AT ." aB = Better colors?" 6 21 20 AT ." aC = copy 1 screen" 7 21 21 AT ." aD = +transpose" 8 21 22 AT ." aG = get directory" 9 41 20 AT ." aI = screen index" 10 41 21 AT ." aM = copy many scrs" 11 41 22 AT ." aO = open new file" 12 61 20 AT ." aS = -transpose" 13 61 21 AT ." aT = set tab stops" 14 61 22 AT ." ESC= exit editor" 15 61 23 AT ." F1 = more help" ; Screen 96 not modified 0 \ HLP6 10:04JWB11/10/85 1 : HLP6 ( -- -- ) 2 1 20 AT ." aF2 set stamp" 3 1 21 AT ." F2 date stamp" 4 1 22 AT ." F3 push line" 5 18 20 AT ." F4 push & Delete" 6 18 21 AT ." F5 pop line" 7 18 22 AT ." F6 spread & pop" 8 38 20 AT ." F7 find string" 9 38 21 AT ." F8 find&replace" 10 38 22 AT ." F9 erase screen" 11 58 20 AT ." aF9 erase to EOS" 12 58 21 AT ." F10 restore screen" 13 58 22 AT ." F1 more help" ; 14 15 Screen 97 not modified 0 \ HLP0 10:41JWB11/10/85 1 : HLP0 ( -- -- ) 2 1 20 AT ." ^A word left" 1 21 AT ." ^C see ins buf" 3 1 22 AT ." ^D cursor right" 1 23 AT ." ^E cursor up" 4 1 24 AT ." ^F word right" 21 20 AT ." ^G delete under" 5 21 21 AT ." ^H delete behind" 21 22 AT ." ^I tab forward" 6 21 23 AT ." ^J join lines" 21 24 AT ." ^L repeat find" 7 41 20 AT ." ^N ins new line" 41 21 AT ." ^O tab backward" 8 41 22 AT ." ^P print screen" 41 23 AT ." ^Q quick to char" 9 41 24 AT ." ^S cursor right" 61 20 AT ." ^T delete word" 10 61 21 AT ." ^U blank line" 11 61 22 AT ." ^W ins blank char" 12 61 23 AT ." ^Y delete line" 13 61 24 AT ." ^Z new screen" ; 14 15 Screen 98 not modified 0 \ +HELP .MENU 10:48JWB11/10/85 1 VARIABLE VHELP 2 3 : +HELP ( -- -- ) \ Increment to next help screen. 4 VHELP @ 1+ 7 MOD VHELP ! ; 5 6 : .MENU ( -- -- ) 7 .CLEAN 5 CLEAR-PROMPT 8 CASE VHELP @ DUP IF .HOLD THEN 9 0 OF HLP0 ENDOF 1 OF HLP1 ENDOF 10 2 OF HLP2 ENDOF 3 OF HLP3 ENDOF 11 4 OF HLP4 ENDOF 5 OF HLP5 ENDOF 12 6 OF HLP6 ENDOF 13 ENDCASE .CURSOR ; 14 15 Screen 99 not modified 0 \ 10:03JWB11/10/85 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 100 not modified 0 \ CERROR 14:09JWB11/10/85 1 \ Screen color if we have an error. 2 79 CONSTANT CERROR 3 31 CONSTANT CNORMAL 4 14 CONSTANT CBROWSE 5 VARIABLE ERRORS 6 7 8 9 10 11 12 13 14 15 Screen 101 not modified 0 \ COLOR-INPUT 20:56JWB11/11/85 1 2 3 \ Choose the text background and forground colors. 4 : COLOR-INPUT ( -- -- ) 5 15 ATRIB ! 6 CLEARSCREEN 0 2 AT 7 128 0 DO I ATRIB ! I 4 .R LOOP 8 15 ATRIB ! CR CR 9 ." Choose text color : " #IN 10 1 MAX 127 MIN ATRIB ! 11 CLEARSCREEN BORDER .SCREEN .MENU .HOLD .CURSOR ; 12 13 14 15 Screen 102 not modified 0 \ SET-STAMP SHOW-IBUF 20:51JWB11/11/85 1 \ Reset initials for auto date stamp. 2 : SET-STAMP ( -- -- ) 3 $AUTO DUP @ IF OFF ELSE ON THEN 4 $AUTO @ 5 IF $INITIALS C@ 0= 6 IF 1 CLEAR-PROMPT ." Enter your initials: " 7 HERE 20 EXPECT SPAN @ 3 MIN $INITIALS 8 C! HERE $INITIALS 1+ SPAN @ 3 MIN 9 CMOVE 1 CLEAR-PROMPT 10 THEN 11 THEN .STAMP .MENU .CURSOR ; 12 \ Display contents of insert buffer. 13 : SHOW-IBUF ( -- -- ) 14 4 CLEAR-PROMPT 0 INSBUF IPTR @ VTYPE 15 CR PUSH-TO-PROCEED .MENU .CURSOR ; Screen 103 not modified 0 \ ONE-COPY COPY-ABORT 10:49JWB11/10/85 1 VARIABLE VARIABLE FINI? 2 \ Copy one screen to another. 3 : ONE-COPY ( -- -- ) 4 !(SCREEN#) .CLEAN 2 CLEAR-PROMPT 5 ." Enter screen # to copy from : " #IN SCREEN# ! 6 @(SCREEN#) 6 21 AT 7 ." Enter screen # to copy to : " #IN SCREEN# ! 8 !(SCREEN#) 2 CLEAR-PROMPT NEW-SCREEN 9 .MENU .HOLD .CURSOR ; 10 11 \ Send copy abort message. 12 : .CPY-ABORT ( -- -- ) 13 6 21 AT 14 ." MULTIPLE BLOCK COPY ABORTED!!" BEEP ; 15 Screen 104 not modified 0 \ (TRANSFER) 20:59JWB11/11/85 1 \ Copy screem range, first thru last to destination. 2 : (TRANSFER) ( first last dest -- ) 3 2 PICK - DUP 0< 4 IF 1 ! SWAP 1+ ROT 5 ELSE -1 ! ROT ROT THEN 6 ?DO I DUP .READING 7 3 CLEAR-PROMPT ." Coppying screen # " . 8 SCREEN# ! CUR@ NEW-SCREEN .CLOCK CUR! 9 I OVER + DUP ." to screen # " . .WRITING 10 6 21 AT ." Press any key to abort copying!" 11 BLOCK 0 SCREEN SWAP 1024 CMOVE 12 (KEY?) IF .CPY-ABORT LEAVE THEN 13 UPDATE FLUSH @ +LOOP DROP ; 14 15 Screen 105 not modified 0 \ MULTI-COPY 20:52JWB11/11/85 1 : MULTI-COPY 2 !(SCREEN#) .CLEAN 3 CLEAR-PROMPT 3 ." First source screen # : " #IN 6 21 AT 4 ." Last source screen # : " #IN 6 22 AT 5 ." First destination screen # : " #IN (TRANSFER) 6 3 CLEAR-PROMPT NEW-SCREEN .MENU .HOLD .CURSOR ; 7 \ Convert word to upper case. 8 : UCASE HERE SWAP OVER + SWAP 9 ?DO I C@ 97 122 WITHIN 10 IF 32 I CTOGGLE THEN LOOP ; 11 \ Get screen filen name from user. 12 : FILENAME-INPUT ( -- adr ) 13 BEGIN 1 CLEAR-PROMPT ." Enter screen file name : " 14 STRING-INPUT ?DUP 15 UNTIL UCASE HERE ; Screen 106 not modified 0 \ DRIVE-INPUT 20:53JWB11/11/85 1 2 : DRIVE-INPUT 3 STRING-INPUT DUP UCASE 4 IF HERE 1+ C@ DUP 96 > 5 IF 32 - 6 THEN 64 - 1 MAX 63 MIN 7 ELSE 0 25 BDOS 1+ 8 VEMIT DUP 8 64 + VEMIT 9 THEN ; 10 11 12 13 14 15 Screen 107 not modified 0 \ QUICK INDEX 18:51jwb11/05/85 1 : QUICK-INDEX 2 !(SCREEN#) .CLEAN 2 CLEAR-PROMPT 3 ." Enter first screen # : " #IN CHECK-SCREEN 6 21 AT 4 ." Enter final screen # : " #IN CHECK-SCREEN 2DUP < 5 IF SAVE-BUFFERS CLEARSCREEN 15 1 AT 6 ." Index for screen file " FILE? CR CR 1+ SWAP 7 DO I 3 .R SPACE I BLOCK 2+ 14 VTYPE 8 #OUT @ 60 > 9 IF CR 10 ELSE #OUT @ 20 MOD 20 SWAP - SPACES THEN 11 (KEY?) IF KEY 13 = ?LEAVE CR PUSH-TO-PROCEED CR THEN 12 LOOP CR PUSH-TO-PROCEED SSS 5 MOD 5 * $SECONDS ! 13 BORDER .STATE .MENU .HOLD NEW-SCREEN 14 ELSE 2DROP THEN ; 15 Screen 108 not modified 0 \ $DIR 13:59JWB11/10/85 1 \ Default drive input string. 2 : $DIR ( -- adr n ) 3 " C:*.*" ; 4 5 : OPEN-NEW-FILE ( -- -- ) 6 !(SCREEN#) 7 FILE @ PREV-FILE 42 CMOVE FLUSH 8 FILE @ [ DOS ] CLOSE [ EDITOR ] 9 FILENAME-INPUT OPEN-SCR 10 IF 1 CLEAR-PROMPT 11 ." Can't find: " FILE? PREV-FILE CUR-FILE 12 42 CMOVE [ DOS ] OPEN-FILE [ EDITOR ] 13 ELSE SCREEN# OFF 14 THEN NEW-SCREEN ; 15 Screen 109 not modified 0 \ QUICK-DIR ANOTHER-SEARCH 21:00JWB11/11/85 1 \ Lists files on specified drive. 2 : QUICK-DIR ( -- -- ) 3 !(SCREEN#) 1 CLEAR-PROMPT CURSOR@ 4 ." Enter drive:file - " STRING-INPUT DROP 5 .BLANK-SCREEN 6 HERE (DIR) .CLEAN 7 1 CLEAR-PROMPT PUSH-TO-PROCEED .MENU 8 NEW-SCREEN CURSOR! .CURSOR ; 9 \ Repeat previous search and replace. 10 : ANOTHER-SEARCH ( -- -- ) 11 !(SCREEN#) 0 0 REPLACEBUF C! 0 SEARCHBUF C@ 12 IF .SCH-TARGET SEARCH-FILE 13 ELSE .SCH-ILLEGAL 14 THEN .CLEAN .MENU .CURSOR ; 15 Screen 110 not modified 0 \ BACK-SPACE-KEY RETURN-KEY TABSET 21:01JWB11/11/85 1 : BACK-SPACE-KEY ( -- -- ) 2 KBF 128 AND ( check for insert mode ) 3 IF DELETE-CHARLFT 4 ELSE BACKSPACE @ THEN ; 5 \ Move to next line. 6 : RETURN-KEY ( -- -- ) 7 ?LINE 1+ 16 MOD C/L * DUP SCREEN C/L -TRAILING 8 NIP + CURSOR! CURSOR-CHK .CURSOR ; 9 \ Reset the current tab stops. 10 : TABSET ( -- -- ) 11 1 CLEAR-PROMPT ." Tab stops are now set at " 12 TAB# @ . ." enter new setting : " #IN 13 2 MAX 63 MIN TAB# ! .MENU .CURSOR ; 14 15 Screen 111 not modified 0 \ ENTER-SCR 17:58JWB06/22/85 1 : ENTER-SCR ( -- -- ) 2 1 CLEAR-PROMPT ASK-SCR GO-SCR 3 .MENU .CURSOR ; 4 : FIND-IT ( -- -- ) 5 !(SCREEN#) 0 0 REPLACEBUF C! 6 .CLEAN SEARCH-INPUT 0 SEARCHBUF C@ 7 IF .SCH-TARGET SEARCH-FILE 8 ELSE .SCH-ILLEGAL 9 THEN .CLEAN .MENU .CURSOR ; 10 : SEARCH-FOR-IT ( -- -- ) 11 !(SCREEN#) .CLEAN SEARCH-INPUT 12 REPLACE-INPUT REPLACE-VALIDATE 13 IF .SCH-TARGET SEARCH-FILE REPLACE-STRING 14 THEN .CLEAN .MENU .CURSOR ; 15 Screen 112 not modified 0 \ (IBM) 21:50JWB11/07/85 1 : (IBM) 2 DUP 3 CASE 4 BACK-TAB OF TAB-LEFT ENDOF 5 ^HOME OF START-OF-SCREEN ENDOF 6 ^END OF END-OF-SCREEN ENDOF 7 HOME OF START-OF-LINE ENDOF 8 END OF END-OF-LINE ENDOF 9 ^PG-UP OF FIRST-SCR ENDOF 10 ^PG-DN OF LAST-SCR ENDOF 11 PG-UP OF PREV-SCREEN ENDOF 12 LEFT-ARROW OF BACKUP ENDOF 13 ^LEFT-ARROW OF CURSOR-LEFTWORD ENDOF 14 ^RIGHT-ARROW OF CURSOR-RIGHTWORD ENDOF 15 Screen 113 not modified 0 \ (IBM) ... 21:51JWB11/07/85 1 RIGHT-ARROW OF FORWARD ENDOF 2 UP-ARROW OF TAB-UP ENDOF 3 DOWN-ARROW OF TAB-DOWN ENDOF 4 PG-DN OF NEXT-SCREEN ENDOF 5 INS OF .STATE ENDOF 6 ALTA OF GO-SHADOW ENDOF 7 ALTB OF COLOR-INPUT ENDOF 8 ALTG OF QUICK-DIR ENDOF 9 ALTT OF TABSET ENDOF 10 ALTO OF OPEN-NEW-FILE ENDOF 11 ALTI OF QUICK-INDEX ENDOF 12 F1 OF +HELP .MENU ENDOF 13 ALTF2 OF SET-STAMP ENDOF 14 F7 OF FIND-IT ENDOF 15 ENDCASE Screen 114 not modified 0 \ (IBM) ... 18:27JWB11/09/85 1 BROWSING @ IF DROP ELSE 2 CASE 3 4 DEL OF DELETE-CHAR ENDOF 5 ALTC OF ONE-COPY ENDOF 6 ALTD OF +TRANSPOSE ENDOF 7 ALTM OF MULTI-COPY ENDOF 8 ALTN OF SPLIT-LINE ENDOF 9 ALTU OF ERASE-EOL ENDOF 10 ALTS OF -TRANSPOSE ENDOF 11 12 13 14 15 Screen 115 not modified 0 \ (IBM) .. 22:04JWB06/20/85 1 F2 OF DATE-SCREEN 0 .LINE 2 2 CURSOR! .CURSOR ENDOF 3 F3 OF PUSH-LINE TAB-DOWN ENDOF 4 F4 OF PUSH-LINE DELETE-LINE ENDOF 5 F5 OF HOLD-DEPTH @ 6 IF POP-LINE TAB-UP THEN ENDOF 7 F6 OF HOLD-DEPTH @ 8 IF SPREAD-LINE POP-LINE THEN ENDOF 9 F8 OF SEARCH-FOR-IT ENDOF 10 F9 OF ERASE-SCREEN ENDOF 11 ALTF9 OF ERASE-TO-END ENDOF 12 F10 OF 0 BACKBUF 0 13 SCREEN 1024 CMOVE CURSOR OFF .SCREEN ENDOF 14 ENDCASE THEN ; 15 Screen 116 not modified 0 1 : CONTROL-CHAR 2 DUP 3 CASE 4 1 OF CURSOR-LEFTWORD ENDOF 5 2 OF IBLANK ENDOF 6 3 OF SHOW-IBUF ENDOF 7 5 OF TAB-UP ENDOF 8 4 OF FORWARD ENDOF 9 6 OF CURSOR-RIGHTWORD ENDOF 10 9 OF TAB-RIGHT ENDOF 11 12 OF ANOTHER-SEARCH ENDOF 12 13 OF RETURN-KEY ENDOF 13 15 OF TAB-LEFT ENDOF 14 15 Screen 117 not modified 0 \ (EDIT) 11:39JWB11/11/85 1 2 16 OF CLEARSCREEN 1 1 AT PRINT-SCREEN CLEARSCREEN 3 BORDER .SCREEN .MENU .HOLD .CURSOR ENDOF 4 17 OF FIND-CHARACTER ENDOF 5 19 OF BACKUP ENDOF 6 24 OF TAB-DOWN ENDOF 7 26 OF ENTER-SCR ENDOF 8 ESC OF !(SCREEN#) FINI? ON ENDOF 9 ENDCASE 10 11 12 13 14 15 Screen 118 not modified 0 \ (EDIT) 18:25JWB11/09/85 1 BROWSING @ IF DROP ELSE 2 CASE 3 7 OF DELETE-CHAR ENDOF 4 BS OF BACK-SPACE-KEY ENDOF 5 10 OF JOIN-LINE ENDOF 6 14 OF SPREAD-LINE ENDOF 7 18 OF INSERT-WORDRIGHT ENDOF 8 20 OF DELETE-WORDRIGHT ENDOF 9 21 OF ERASE-LINE ENDOF 10 22 OF IGET ENDOF 11 23 OF SPREAD-CHAR ENDOF 12 25 OF DELETE-LINE ENDOF 13 ENDCASE THEN ; 14 15 Screen 119 not modified 0 \ (EDIT) ... 11:40JWB11/11/85 1 : (EDIT) BORDER .MENU .STATE 2 @(SCREEN#) .SCREEN 3 ERRORS @ 4 IF ATRIB @ CERROR ATRIB ! .LINE-TO-END 5 CURSOR-LEFTWORD ATRIB ! THEN 6 BEGIN PCKEY DUP 31 > 7 IF BROWSING @ NOT 8 IF KBF 128 AND 9 IF INSERT-CHAR 10 ELSE PUT-CHAR THEN 11 ELSE DROP THEN 12 ELSE ?DUP 13 IF CONTROL-CHAR 14 ELSE (IBM) THEN 15 THEN FINI? @ UNTIL ; Screen 120 not modified 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 121 not modified 0 \ (VEDIT) 23:19JWB11/09/85 1 ONLY FORTH ALSO DOS ALSO FORTH DEFINITIONS 2 : (VEDIT) ( scr# -- ) 3 [ EDITOR ] DECIMAL 1 ?ENOUGH DUP SCR ! 4 TIB DP @ - 4056 U< 5 IF ." Not enough memory to EDIT" 6 ELSE DP @ DUP $SCRATCH ! 7 3684 + DP ! 8 HOLD-DEPTH OFF 0 SEARCHBUF 9 64 ERASE 0 REPLACEBUF 64 ERASE 10 8 TAB# ! FINI? OFF IBLANK 11 FILE @ CUR-FILE 42 CMOVE FILE @ OLD-FILE ! 12 CUR-FILE !FILES OPEN-FILE SW $INIT 13 TSMH OFF $SECONDS OFF BROWSING @ 14 IF CBROWSE ELSE CNORMAL THEN ATRIB ! 15 0 MAX ?SCREENS MIN SCREEN# ! (EDIT) Screen 122 not modified 0 \ (VEDIT) .. 23:19JWB11/09/85 1 15 ATRIB ! 2 BORDER .STATE NEW-SCREEN 0 20 AT 3 SCREEN# @ SCR ! 4 FILE @ PREV-FILE 42 CMOVE 5 FLUSH FILE @ CLOSE $SCRATCH @ DP ! -SW 6 ." You were editing screen # " SCREEN# @ . 7 ." of " FILE? CR 8 ." Source file and disk directory updated." CR 9 OLD-FILE @ !FILES OPEN-FILE 10 ." Current file is : " FILE? LITTLE-CURSOR 11 THEN CR ; FORTH 12 13 14 15 Screen 123 not modified 0 \ 14:10JWB11/10/85 1 2 : ( pos scr -- ) 3 CR R> R> R> 2DUP >R >R SPACE TYPE SPACE >R 4 2DUP ." Screen " . ." Line " C/L / . 5 ORDER DISK-ERROR @ 0= [ EDITOR ] 6 KEY BL = AND 7 IF SWAP CURSOR! ERRORS ON (VEDIT) THEN ; FORTH 8 9 ' IS WHERE 10 11 12 13 14 15 Screen 124 not modified 0 \ VEDIT VED BROWSE 14:10JWB11/10/85 1 2 : BROWSE ( scr# -- ) 3 [ EDITOR ] BROWSING ON 4 CURSOR OFF ERRORS OFF (VEDIT) ; FORTH 5 ' BROWSE IS EDIT 6 : VEDIT ( scr# -- ) 7 [ EDITOR ] BROWSING OFF 8 CURSOR OFF ERRORS OFF (VEDIT) ; FORTH 9 : VED ( -- -- ) 10 [ EDITOR ] BROWSING OFF 11 SCR @ 0 MAX ?SCREENS MIN 12 CURSOR OFF ERRORS OFF (VEDIT) ; FORTH 13 14 15 Screen 125 not modified 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 126 not modified 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 127 not modified 0 1 ONLY EDITOR ALSO FORTH ALSO 2 \ Leave true flag if KBF has changed. New value in $KBF . 3 CODE KBF? ( -- flag ) \ Was: $KBF @ KBF DUP $KBF ! <> 4 2 # AH MOV \ Function number 2 for kb flag 5 22 INT \ Call KBF is returned in AL 6 AH AH SUB \ Clear high byte of AX. 7 $KBF # DI MOV \ Address of old KBF to DI 8 0 [DI] BX MOV \ Fetch old value of KBF 9 AX BX CMP \ Compare new value with old. 10 0= IF AX AX SUB \ Leave false flag if the same 11 ELSE AX 0 [DI] MOV \ Update $KBF and 12 -1 # AX MOV \ return true if KBF has changed. 13 THEN 1PUSH \ Push AX and fall into NEXT 14 END-CODE 15 : TEST CLEARSCREEN BEGIN CR KBF? U. $KBF ? KEY? UNTIL ; Screen 128 not modified 0 \ 18:23jwb11/05/85 1 ONLY EDITOR ALSO FORTH ALSO DEFINITIONS 2 3 CREATE TSMH 4 ALLOT 4 CODE @TIME ( -- -- ) 5 44 ( 2C) # AH MOV 6 33 ( 21) INT 7 TSMH # DI MOV 8 DX 0 [DI] MOV 9 CX 2 [DI] MOV 10 NEXT END-CODE 11 : TT TSMH C@ ; : SS TSMH 1+ C@ ; : MM TSMH 2+ C@ ; 12 : HH TSMH 3 + C@ ; 13 : TEST CLEARSCREEN 14 BEGIN 1 1 AT @TIME HH 3 U.R MM 3 U.R 15 SS 3 U.R TT 3 U.R KEY? UNTIL ; Screen 129 not modified 0 \ ?MODE 23:09JWB11/04/85 1 \ Read current video mode. 2 \ 0 = 40x25 bw 3 = 80x25 color 4 = 320x200 color 3 \ 1 = 40x25 color 5 = 320x200 bw 4 \ 2 = 80x25 bw 6 = 640x200 bw 5 \ 6 CODE ?MODE ( -- mode ) 7 15 # AH MOV \ Read video state is #15. 8 16 INT \ Call video io routines. 9 AH AH SUB \ Clear high byte. 10 1PUSH \ Push AX which contains mode. 11 END-CODE 12 \ Note Function 15 of 16 INT also returns: 13 \ Number of columns on the screen in AH and current active 14 \ page in BH. Both of these are ignored by ?MODE 15 : MODE! 0 0 0 VIDEO-IO 2DROP 2DROP ;