projects:editor.blk
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 <MATCH>
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 <KEY> 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 : <KEY> ( -- 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 ['] <KEY> 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 <return> : "
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 <return> : "
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 <INCR> 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 <INCR> ! SWAP 1+ ROT
5 ELSE -1 <INCR> ! 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 <INCR> @ +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 \ <WHERE> 14:10JWB11/10/85
1
2 : <WHERE> ( 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 ' <WHERE> 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 ;
projects/editor.blk.txt · Zuletzt geändert: 2013-06-06 21:27 von 127.0.0.1