1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; and now
for something completely different
...
3 ;; UrForth
/C Forth Engine
!
4 ;; Copyright
(C
) 2023 Ketmar Dark
// Invisible Vector
6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7 ;; simple line
-oriented editor
8 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13 reset input line
(make it empty
)
16 edit line without redrawing the prompt
.
17 result is in LINORE
:ACCEPT
-RESULT
.
19 1 for enter
, -1 on esc
/^C
/^D
21 LINORE
:LINE
( -- addr count
)
30 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; it will be filled later
36 SIMPLE
-VOCABULARY OSC
-ACTIONS
40 -1 CONSTANT RESULT
-ESC
41 1 CONSTANT RESULT
-ENTER
43 ;; if set
, LINORE will
switch to raw mode on entering
44 ;; edit loop
, and
then switch back
.
45 TRUE VALUE TTY
-SET
/RESET
47 ;; set this
to non
-zero in key handler
to exit edit loop
.
48 ;; can be checked after editing
.
51 ;; start x position
for line drawing
.
55 ;; when cursor is out of visible line part
, make at
56 ;; least this number of chars visible before
/after the cursor
.
57 ;; do not set
to zero or negative
.
58 10 VALUE VISIBLE
-AMOUNT
60 ;; reset input buffer
(i
.e
. make it empty
).
61 ;; defined here
, because we need it in the code
.
65 ;; use this from key processors
to exit with this code
.
66 : FINISH
-IT
! ( code
-- ) TO ACCEPT
-RESULT
;
68 ;; called
for normal keys
(non
-OSC
).
69 ;; drop `ch` and
return TRUE
if you handled it
.
70 ;; you can replace char code here
.
71 ;; negative `ch` means that this is
"ESC something" sequence
(not OSC
).
72 : KEY
-PROCESSOR
( ch FALSE
-- ch FALSE
/ TRUE
) ... ;
74 ;; called
for OSC keys
. string is OSC without
"\e[".
75 ;; drop string and
return TRUE
if you handled it
.
76 ;; you can replace string here
.
77 : OSC
-KEY
-PROCESSOR
( addr count FALSE
-- addr count FALSE
/ TRUE
) ... ;
79 ;; called before redrawing the input line
.
80 ;; return TRUE
to prevent redraw
.
81 : ON
-BEFORE
-DRAW
( FALSE
-- FALSE
/ TRUE
) ... ;
83 ;; called after redrawing the input line
.
84 : ON
-AFTER
-DRAW
( -- ) ... ;
86 ;; this is called after screen switching
87 : ON
-START
-EDITING
( -- ) ... ;
89 ;; this is called before screen switching
90 : ON
-END-EDITING
( -- ) ... ;
95 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
100 VOCABULARY LINORE
-INTERNAL
101 ALSO
-DEFS
: LINORE
-INTERNAL
105 (USER
-TIB
-SIZE
) 1- VALUE BUF
-SIZE
110 ;; if set
, first input will erase the line
114 ;; OSC buffer
(without first
2 chars
)
115 32 CONSTANT keybuf
-size
117 CREATE keybuf keybuf-size ALLOT CREATE;
120 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121 ;; working with cursor position
124 : NORM
-CURSOR
-POS
( -- ) CUR
-OFS BUF
-LEN MIN
0 MAX
TO CUR
-OFS
;
126 : CURVIS
-AT
-LEFT
( -- )
127 CUR
-OFS VISIBLE
-AMOUNT
- 0 MAX
TO DRAW
-OFS
130 : CURVIS
-AT
-RIGHT
( -- )
132 CUR
-OFS DRAW
-WIDTH
- VISIBLE
-AMOUNT
+ 0 MAX
133 BUF
-LEN VISIBLE
-AMOUNT
- 0 MAX
137 : MAKE
-CURSOR
-VISIBLE
( -- )
139 CUR
-OFS DRAW
-OFS
< IF CURVIS
-AT
-LEFT
140 ELSE CUR
-OFS DRAW
-OFS
- DRAW
-WIDTH
>= IF CURVIS
-AT
-RIGHT
145 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
146 ;; drawing the edit line
149 : .OSC
-1 ( n cmd
-char
-- )
151 SWAP
<# #S #
> TTY
:RAW
-TYPE
163 : HIGLIGHT
-FIRST
-INPUT
( -- )
174 BUF DRAW
-OFS
+ BUF
-LEN DRAW
-OFS
- DRAW
-WIDTH MIN TTY
:RAW
-TYPE
175 " \e[0m\e[K" TTY
:RAW
-TYPE
179 START
-X CUR
-OFS DRAW
-OFS
- + GOTO-X
184 TO-START
-X DRAW
-LINE POS
-CURSOR
189 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
190 ;; line editing helper words
193 ;; -1 when out of bounds
195 CUR
-OFS
0 BUF
-LEN WITHIN
IF BUF CUR
-OFS
+ C@
200 : (GO-LEFT
-RIGHT
) ( mdir cmp
-cfa
-- mdir
)
210 : (GO-WORD
-LEFT
-RIGHT
) ( mdir
-- )
212 DUP
0< IF -1-TO CUR
-OFS
ENDIF
214 CUR
-C@ BL
<= IF ['] <= ELSE ['] > ENDIF
216 0< IF +1-TO CUR
-OFS
ENDIF
217 ELSE 0< IF +1-TO CUR
-OFS
ENDIF
221 PREV
-DEFS
;; in LINORE again
224 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
225 ;; line editing words
228 SIMPLE
-VOCABULARY LINORE
-EDIT
-API
230 ALSO
-DEFS
: LINORE
-EDIT
-API
232 : RESET
-FIRST
-INPUT
( -- ) FALSE
TO FIRST
-INPUT
;
234 : LEFT
( -- ) RESET
-FIRST
-INPUT
-1-TO CUR
-OFS
;
235 : RIGHT
( -- ) RESET
-FIRST
-INPUT
+1-TO CUR
-OFS
;
236 : HOME
( -- ) RESET
-FIRST
-INPUT
0-TO CUR
-OFS
;
237 : END ( -- ) RESET
-FIRST
-INPUT BUF
-LEN
TO CUR
-OFS
;
239 : WORD
-LEFT
( -- ) RESET
-FIRST
-INPUT
-1 (GO-WORD
-LEFT
-RIGHT
) ;
240 : WORD
-RIGHT
( -- ) RESET
-FIRST
-INPUT
+1 (GO-WORD
-LEFT
-RIGHT
) ;
246 BUF CUR
-OFS
+ DUP
1+ SWAP
247 BUF
-LEN CUR
-OFS
- MOVE
255 CUR
-OFS
IF LEFT DELETE
ENDIF
259 FIRST
-INPUT
IF LINORE
:RESET RESET
-FIRST
-INPUT
ENDIF
262 BUF
-LEN CUR
-OFS
- MOVE
268 PREV
-DEFS
;; in LINORE
-INTERNAL again
271 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
276 CREATE (CTRL-KEYS-HANDLERS) 32 CELLS ALLOT CREATE;
277 ;; default is
"do nothing"
278 (CTRL
-KEYS
-HANDLERS
) 32 CELLS ERASE
280 : SET
-CTRL
-HANDLER
( cfa code
-- )
281 DUP
0 32 WITHIN
" invalid ctrl code" ?NOT
-ERROR
282 CELLS
(CTRL
-KEYS
-HANDLERS
) + !
285 :NONAME
( -- ) RESULT
-^C LINORE
:FINISH
-IT
! ; 3 SET
-CTRL
-HANDLER
;; ^C
286 :NONAME
( -- ) RESULT
-^D LINORE
:FINISH
-IT
! ; 4 SET
-CTRL
-HANDLER
;; ^D
288 :NONAME
( -- ) RESULT
-ESC LINORE
:FINISH
-IT
! ; 27 SET
-CTRL
-HANDLER
;; ESC
290 :NONAME
( -- ) RESULT
-ENTER LINORE
:FINISH
-IT
! ;
291 DUP
10 SET
-CTRL
-HANDLER
292 DUP
13 SET
-CTRL
-HANDLER
295 ' LINORE-EDIT-API:BACKSPACE 8 SET-CTRL-HANDLER ;; ^H
296 ' LINORE
:RESET
25 SET
-CTRL
-HANDLER
;; ^Y
299 ;; collect OSC
(without first
2 chars
)
300 : (COLLECT
-OSC
) ( -- )
303 DROP TTY
:RAW
-READCH DUP BL
>
305 keybuf
-len keybuf
-size
= IF BREAK ENDIF
306 DUP keybuf keybuf
-len
+ C
! +1-TO keybuf
-len
311 : (EDIT
-PROCESS
-OSC
) ( -- )
313 keybuf keybuf
-len FALSE LINORE
:OSC
-KEY
-PROCESSOR
315 VOCID
: LINORE
:OSC
-ACTIONS FIND
-WORD
-IN
-VOC
320 : (EDIT
-PROCESS
-OTHER
) ( ch
-- )
321 FALSE LINORE
:KEY
-PROCESSOR IFNOT
323 CELLS
(CTRL
-KEYS
-HANDLERS
) + @ ?DUP
IF EXECUTE
ENDIF
325 DUP
127 = IF DROP LINORE
-EDIT
-API
:BACKSPACE
326 ELSE DUP BL
>= IF LINORE
-EDIT
-API
:INS
-CHAR
ELSE DROP
ENDIF
332 : (EDIT
-PROCESS
-ESC
) ( ch
-- )
333 DROP
;; it is always
27
334 TTY
:RAW
-READCH DUP
[CHAR
] [ = IF ;; OSC start
335 DROP
(EDIT
-PROCESS
-OSC
)
336 ELSE ;; esc
+something
; negate keycode
337 DUP
27 <> IF ( not esc
-esc
) NEGATE
ENDIF
342 PREV
-DEFS
;; in LINORE again
346 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
347 ;; default OSC handlers
350 ALSO
-DEFS
: OSC
-ACTIONS
352 : D LINORE
-EDIT
-API
:LEFT
;
353 : C LINORE
-EDIT
-API
:RIGHT
;
354 : 7~ LINORE
-EDIT
-API
:HOME
;
355 : 8~ LINORE
-EDIT
-API
:END ;
356 : 3~ LINORE
-EDIT
-API
:DELETE
;
357 : 1;5D LINORE
-EDIT
-API
:WORD
-LEFT
;
358 : 1;5C LINORE
-EDIT
-API
:WORD
-RIGHT
;
360 PREV
-DEFS
;; in LINORE again
363 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
371 :NONAME
( -- ) 0-TO BUF
-LEN
0-TO DRAW
-OFS
0-TO CUR
-OFS
;
374 : LINE
( -- addr count
) BUF BUF
-LEN
;
376 : LINE
! ( addr count
-- )
377 BUF
-SIZE MIN DUP
TO BUF
-LEN BUF SWAP MOVE
382 TTY
-SET
/RESET
IF TTY
:SET
-RAW
" fuck!" ?NOT
-ERROR
ENDIF
383 0 TO ACCEPT
-RESULT TRUE
TO FIRST
-INPUT
386 FALSE ON
-BEFORE
-DRAW IFNOT DRAW
ENDIF ON
-AFTER
-DRAW
387 TTY
:RAW
-READCH DUP
0>=
389 DUP
27 = IF (EDIT
-PROCESS
-ESC
)
390 ELSE (EDIT
-PROCESS
-OTHER
)
394 TTY
-SET
/RESET
IF TTY
:SET
-COOKED DROP
ENDIF
399 PREVIOUS PREVIOUS PREV-DEFS