-
Notifications
You must be signed in to change notification settings - Fork 0
/
EDIT.4TH
199 lines (187 loc) · 7.44 KB
/
EDIT.4TH
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
59 CLEAR ( CONST HLP# = 59 )
0 P ( EDIT - HELP ) --> Esc-H: help
1 P Arrows, Ins, BckSp, Tab: normal
2 P Esc-Q: quit (empty-buffers)
3 P Esc-S: save (flush)
4 P Esc-Z: undo (empty-buffers)
5 P Return: next line
6 P Shf-Ins: ins ln*; Esc-1:5: plgns
7 P Shf-Del: del ln*; Esc-T/F: color
8 P Esc-V: ins last del ln*
9 P Esc-B: forth command line
10 P Esc-R: rotate/sides ( / )
11 P Esc-N: screen+1/empt-bf ( > )
12 P Esc-L: screen-1/empt-bf ( < )
13 P Ctl-Ins: ins space;
14 P Ctl-BckSpc: del; Esc-0: cold
15 P Clear: clear screen (Shf> Ctl>)
60 CLEAR
0 P ( EDIT - BY M. DOUGHERTY )
1 P : EDIT( ; DECIMAL : CLS 125 EMIT ;
2 P 752 CONSTANT CRSINH 59 CONSTANT HLP#
3 P 709 CONSTANT FNT# 710 CONSTANT BGR#
4 P 18 CONSTANT TOP-BOT 2 CONSTANT REDGE
5 P 22 CONSTANT LEDGE 0 VARIABLE SIDE
6 P 17 VARIABLE EXTRAOFF 0 VARIABLE STOP
7 P 0 VARIABLE SAV-BUF 64 ALLOT HLP# VARIABLE HLPM
8 P 3 VARIABLE LINEOFF 3 VARIABLE CHAROFF
9 P 0 VARIABLE CLINE 0 VARIABLE CCHAR
10 P : EREAD 16 0 DO I SCR @ (LINE)
11 P DROP UPDATE DROP LOOP 0 CLINE ! 0 CCHAR ! 0 SIDE ! ;
12 P : POINT-CURSOR 85 ! 84 C! ; 712 CONSTANT FRM#
13 P : CURSOR@ CLINE @ LINEOFF @ +
14 P CCHAR @ SIDE @ IF 32 - ENDIF CHAROFF @ + ;
15 P : CURSOR CURSOR@ POINT-CURSOR ; -->
61 CLEAR
0 P ( EDIT - SCREEN-CURSOR, ... )
1 P : SCREEN-CURSOR CURSOR@ SWAP 40 * + 106 C@ 256 *
2 P 960 - + DUP C@ 128 XOR SWAP C! ;
3 P : HLINE 34 0 DO TOP-BOT EMIT LOOP ;
4 P : LADDR CLINE @ SCR @ (LINE) DROP
5 P SIDE @ IF 32 + ENDIF ;
6 P : EADDR CLINE @ SCR @ (LINE) DROP
7 P SIDE @ 0= IF 32 + ENDIF ;
8 P : ELINE LEDGE EMIT LADDR 32 TYPE REDGE EMIT ;
9 P : XLINE LEDGE EMIT EADDR 32 TYPE REDGE EMIT ;
10 P : WRITE-LINE CLINE @ LINEOFF @ + CHAROFF @ 1 -
11 P POINT-CURSOR ELINE ;
12 P : WRITE-EXTRA EXTRAOFF @ LINEOFF @ + CHAROFF @ 1 -
13 P POINT-CURSOR XLINE ; : FRE 741 @ HERE - ;
14 P : 2TOP LINEOFF @ 1 - CHAROFF @ 1 - POINT-CURSOR HLINE ;
15 P -->
62 CLEAR
0 P ( EDIT - DISPLAY, CASE )
1 P : BOT LINEOFF @ 16 + CHAROFF @ 1 - POINT-CURSOR HLINE ;
2 P : ETITLE 0 CHAROFF @ POINT-CURSOR ." EDIT / Dr"
3 P OFFSET @ 0= 0= . ." Scr"
4 P SCR ? ." Side" SIDE
5 P ? ." Free" FRE U. ;
6 P : DISPLAY CLS 1 CRSINH C! ETITLE 2TOP CLINE @
7 P 16 0 DO I CLINE ! WRITE-LINE LOOP CLINE !
8 P SIDE @ IF 32 ELSE 0 ENDIF CCHAR ! BOT
9 P WRITE-EXTRA CURSOR SCREEN-CURSOR ;
10 P : ANYK CR ." (Return)" KEY DROP ; : ANYKD ANYK DISPLAY ;
11 P : CASES ?COMP CSP @ !CSP 4 ; IMMEDIATE
12 P : CASE 4 ?PAIRS COMPILE OVER COMPILE =
13 P COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE
14 P : IS 5 ?PAIRS COMPILE BRANCH HERE 0 ,
15 P SWAP 2 [COMPILE] ENDIF 4 ; IMMEDIATE -->
63 CLEAR
0 P ( EDIT - CASE, MOVEMENT )
1 P : END-CASES 4 ?PAIRS COMPILE DROP
2 P BEGIN SP@ CSP @ = 0= WHILE
3 P 2 [COMPILE] ENDIF REPEAT
4 P CSP ! ; IMMEDIATE
5 P : MOVE-RIGHT CCHAR @ 1 + SIDE @ IF
6 P DUP 64 = IF DROP 32 ENDIF ELSE
7 P DUP 32 = IF DROP 0 ENDIF ENDIF
8 P CCHAR ! ;
9 P : RIGHT MOVE-RIGHT SCREEN-CURSOR ;
10 P : RIGHT-CURSOR SCREEN-CURSOR RIGHT ;
11 P : MOVE-LEFT CCHAR @ 1 - SIDE @ IF
12 P DUP 31 = IF DROP 63 ENDIF ELSE
13 P DUP -1 = IF DROP 31 ENDIF ENDIF
14 P CCHAR ! ;
15 P : LEFT MOVE-LEFT SCREEN-CURSOR ; -->
64 CLEAR
0 P ( EDIT - MOVEMENT, KEYJOY )
1 P : LEFT-CURSOR SCREEN-CURSOR LEFT ;
2 P : MOVE-UP CLINE @ 1 - 15 AND
3 P CLINE ! WRITE-EXTRA ;
4 P : EUP MOVE-UP SCREEN-CURSOR ;
5 P : UP-CURSOR SCREEN-CURSOR EUP ;
6 P : MOVE-DOWN CLINE @ 1 + 15 AND
7 P CLINE ! WRITE-EXTRA ;
8 P : DOWN MOVE-DOWN SCREEN-CURSOR ;
9 P : DOWN-CURSOR SCREEN-CURSOR DOWN ;
10 P : RETURN SCREEN-CURSOR SIDE @ IF
11 P 32 ELSE 0 ENDIF CCHAR ! DOWN ;
12 P : EABORT EMPTY-BUFFERS 1 STOP ! ;
13 P : FLASH FRM# @ 255 XOR FRM# ! ; ( FIXME )
14 P : BEEPF BEEP FLASH ;
15 P -->
65 CLEAR
0 P ( EDIT - REFORTH, SCREEN<>, HLP )
1 P : SH CLS 0 CRSINH C! IN @ >R BLK @ >R 0 IN !
2 P 0 BLK ! CR QUERY INTERPRET R> BLK ! R> IN ! ANYKD ;
3 P : UNDOSCR EMPTY-BUFFERS SCR +! EREAD DISPLAY ; ( n -- )
4 P : ENEXT 1 UNDOSCR ;
5 P : ELAST -1 UNDOSCR ;
6 P : ADDR CLINE @ SCR @ (LINE) DROP CCHAR @ + ; ( UPDATE HERE? )
7 P : ADDKEY DUP ADDR C! CURSOR EMIT RIGHT ;
8 P : CHSIDE SIDE @ 1 XOR SIDE ! DISPLAY ;
9 P : INSERT-CHAR ADDR SWAP CCHAR @ -
10 P SWAP OVER + SWAP -DUP IF 0 DO
11 P DUP 1 - C@ OVER C! 1 - LOOP ENDIF BL SWAP C! ;
12 P : INSERT SIDE @ IF 63 ELSE 31 ENDIF
13 P INSERT-CHAR WRITE-LINE CURSOR SCREEN-CURSOR ;
14 P : HLP SCR @ HLP# = IF HLPM @ SCR ! ELSE
15 P SCR @ HLPM ! HLP# SCR ! ENDIF DISPLAY ; -->
66 CLEAR
0 P ( EDIT - DELETE, INSERT )
1 P : DELETE-CHAR ADDR SWAP CCHAR @ -
2 P -DUP IF 0 DO DUP 1 + C@ OVER C!
3 P 1 + LOOP ENDIF BL SWAP C! ;
4 P : DELETE SIDE @ IF 63 ELSE 31 ENDIF
5 P DELETE-CHAR WRITE-LINE CURSOR SCREEN-CURSOR ;
6 P : L-A SCR @ (LINE) DROP ;
7 P : DELETE-L CLINE @ L-A SAV-BUF 64 CMOVE
8 P 15 CLINE @ - IF 15 CLINE @ DO
9 P I 1+ L-A I L-A 64 CMOVE LOOP ENDIF
10 P 15 L-A 64 BLANKS ;
11 P : INSERT-L 15 CLINE @ - IF
12 P CLINE @ 15 DO I 1 - L-A I L-A 64 CMOVE
13 P -1 +LOOP ENDIF CLINE @ L-A 64 BLANKS ;
14 P : INSERT-LINE INSERT-L DISPLAY ;
15 P : DELETE-LINE DELETE-L DISPLAY ; -->
67 CLEAR
0 P ( EDIT - PUTLINE, TAB )
1 P : PUT-LINE INSERT-L SAV-BUF CLINE @
2 P L-A 64 CMOVE DISPLAY ;
3 P : TAB 2 0 DO RIGHT-CURSOR LOOP ;
4 P : DEL LEFT-CURSOR BL DUP ADDR C!
5 P CURSOR EMIT SCREEN-CURSOR ;
6 P : CLEAR-SCR
7 P 16 0 DO I L-A 64 BLANKS LOOP DISPLAY ;
8 P : THEME DUP C@ 148 XOR SWAP C! ;
9 P : SAVESCR FLUSH EREAD DISPLAY ;
10 P : BGRC 710 THEME ; : FNTC 709 THEME ;
11 P : PIN1 CLS VLIST ANYKD ; ( vlist )
12 P : PIN2 CLS SCR @ LIST ANYKD ; ( list )
13 P : PIN3 CLS SCR @ TRIAD ANYKD ; ( triad )
14 P : PIN4 CLS DR0 18 SCR ! ANYKD ; ( set DR0, 18th screen )
15 P : PIN5 CLS SCR @ LOAD ANYKD ; ( load ) -->
68 CLEAR
0 P ( EDIT - COMMANDS )
1 P : REVB FRM# @ 128 XOR FRM# ! ; ( reverse frame when Esc )
2 P : ESC REVB KEY CASES
3 P 82 CASE CHSIDE IS ( R ) 47 CASE CHSIDE IS ( / )
4 P 78 CASE ENEXT IS ( N ) 62 CASE ENEXT IS ( > )
5 P 76 CASE ELAST IS ( L ) 60 CASE ENEXT IS ( < )
6 P 83 CASE SAVESCR IS ( S ) 49 CASE PIN1 IS ( 1 )
7 P 81 CASE EABORT IS ( Q ) 50 CASE PIN2 IS ( 2 )
8 P 86 CASE PUT-LINE IS ( V ) 51 CASE PIN3 IS ( 3 )
9 P 90 CASE 0 UNDOSCR IS ( Z ) 52 CASE PIN4 IS ( 4 )
10 P 66 CASE SH IS ( B ) 53 CASE PIN5 IS ( 5 )
11 P 48 CASE BOOT IS ( 0 ) 84 CASE BGRC IS ( T )
12 P 72 CASE HLP IS ( H ) 70 CASE FNTC IS ( F )
13 P BEEPF END-CASES REVB ;
14 P : DEEP SP@ 12 +ORIGIN @ SWAP - 2 / ; ( if no DEPTH dfnd )
15 P : SETSCR DEEP 0= IF HLP# ENDIF SCR ! ; -->
69 CLEAR
0 P ( EDIT - ends ) ( n EDIT )
1 P : EDIT SETSCR EREAD DISPLAY 0 STOP ! BEGIN
2 P KEY CASES
3 P 27 CASE ESC IS 155 CASE RETURN IS
4 P 28 CASE UP-CURSOR IS 29 CASE DOWN-CURSOR IS
5 P 31 CASE RIGHT-CURSOR IS 30 CASE LEFT-CURSOR IS
6 P 255 CASE INSERT IS 254 CASE DELETE IS
7 P 157 CASE INSERT-LINE IS 156 CASE DELETE-LINE IS
8 P 126 CASE DEL IS 127 CASE TAB IS
9 P 125 CASE CLEAR-SCR IS
10 P DUP ADDKEY
11 P END-CASES
12 P STOP @ UNTIL
13 P CLS 0 CRSINH ! ;
14 P : )EDIT ;
15 P ;S