1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; and now
for something completely different
...
5 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12 reset input line
(make it empty
)
14 " pp>" LINORE
:PROMPT
-EDIT
16 return TRUE on enter
, or FALSE on esc
/^C
/^D
19 edit line without redrawing the prompt
.
20 return TRUE on enter
, or FALSE on esc
/^C
/^D
22 LINORE
:LINE
( -- addr count
)
31 VOCABULARY LINORE
-INTERNAL
32 ALSO
-DEFS
: LINORE
-INTERNAL
36 (USER
-TIB
-SIZE
) VALUE BUF
-SIZE
40 ;; start position
for line drawing
46 ;; OSC buffer
(without first
2 chars
)
47 32 CONSTANT keybuf
-size
49 CREATE keybuf keybuf-size ALLOT CREATE;
51 ;; collect OSC
(without first
2 chars
)
52 : (COLLECT
-OSC
) ( -- )
55 DROP TTY
:RAW
-READCH DUP BL
>
57 keybuf
-len keybuf
-size
= IF BREAK ENDIF
58 DUP keybuf keybuf
-len
+ C
! +1-TO keybuf
-len
64 : NORM
-CURSOR
-POS
( -- ) CUR
-OFS BUF
-LEN MIN
0 MAX
TO CUR
-OFS
;
67 : CURVIS
-AT
-LEFT
( -- )
68 CUR
-OFS DRAW
-MARGIN
- 0 MAX
TO DRAW
-OFS
71 : CURVIS
-AT
-RIGHT
( -- )
73 CUR
-OFS DRAW
-WIDTH
- DRAW
-MARGIN
+ 0 MAX
74 BUF
-LEN DRAW
-MARGIN
- 0 MAX
78 : MAKE
-CURSOR
-VISIBLE
( -- )
80 CUR
-OFS DRAW
-OFS
< IF CURVIS
-AT
-LEFT
81 ELSE CUR
-OFS DRAW
-OFS
- DRAW
-WIDTH
>= IF CURVIS
-AT
-RIGHT
86 : .OSC
-1 ( n cmd
-char
-- )
88 SWAP
<# #S #
> TTY
:RAW
-TYPE
101 BUF DRAW
-OFS
+ BUF
-LEN DRAW
-OFS
- DRAW
-WIDTH MIN TTY
:RAW
-TYPE
106 START
-X CUR
-OFS DRAW
-OFS
- + GOTO-X
111 TO-START
-X DRAW
-LINE POS
-CURSOR
116 ;; -1 when out of bounds
118 CUR
-OFS
0 BUF
-LEN WITHIN
IF BUF CUR
-OFS
+ C@
123 ;; various commands
to bind
124 : DO-LEFT
( -- ) -1-TO CUR
-OFS
;
125 : DO-RIGHT
( -- ) +1-TO CUR
-OFS
;
126 : DO-HOME
( -- ) 0-TO CUR
-OFS
;
127 : DO-END ( -- ) BUF
-LEN
TO CUR
-OFS
;
129 : (GO-LEFT
-RIGHT
) ( mdir cmp
-cfa
-- mdir
)
139 : (GO-WORD
-LEFT
-RIGHT
) ( mdir
-- )
141 DUP
0< IF -1-TO CUR
-OFS
ENDIF
143 CUR
-C@ BL
<= IF ['] <= ELSE ['] > ENDIF
145 0< IF +1-TO CUR
-OFS
ENDIF
146 ELSE 0< IF +1-TO CUR
-OFS
ENDIF
150 : DO-WORD
-LEFT
( -- ) -1 (GO-WORD
-LEFT
-RIGHT
) ;
151 : DO-WORD
-RIGHT
( -- ) +1 (GO-WORD
-LEFT
-RIGHT
) ;
156 BUF CUR
-OFS
+ DUP
1+ SWAP
157 BUF
-LEN CUR
-OFS
- MOVE
162 : DO-BACKSPACE
( -- )
164 CUR
-OFS
IF DO-LEFT
DO-DELETE
ENDIF
167 : DO-INS
-CHAR
( ch
-- )
170 BUF
-LEN CUR
-OFS
- MOVE
177 : MAX
-PROMPT
-LEN
( -- len
)
178 DRAW
-WIDTH DRAW
-MARGIN
3 * - 0 MAX
181 : PROMPT
( addr count
-- )
182 0 MAX
;; just in case
183 TTY
:SIZE DROP
TO DRAW
-WIDTH
184 \
30 TO DRAW
-WIDTH
-- debug
185 DUP MAX
-PROMPT
-LEN
> IF
186 ;; prompt is too long
187 MAX
-PROMPT
-LEN
>R SWAP R@
+ SWAP R
> - 0 MAX
189 DUP
TO START
-X DUP
-TO DRAW
-WIDTH
190 13 TTY
:RAW
-EMIT TTY
:RAW
-TYPE
199 : KEY
-PROCESSOR
( ch FALSE
-- ch FALSE
/ TRUE
) ... ;
200 : ESC
-PROCESSOR
( ch FALSE
-- ch FALSE
/ TRUE
) ... ;
201 : OSC
-KEY
-PROCESSOR
( addr count FALSE
-- addr count FALSE
/ TRUE
) ... ;
203 : ON
-ESCAPED
( -- ) ... ;
204 : ON
-ACCEPTED
( -- ) ... ;
205 : ON
-START
-EDIT
( -- ) ... ;
206 : ON
-BEFORE
-DRAW
( FALSE
-- FALSE
/ TRUE
) ... ;
207 : ON
-AFTER
-DRAW
( -- ) ... ;
210 SIMPLE
-VOCABULARY OSC
-ACTIONS
211 ALSO
-DEFS
: OSC
-ACTIONS
218 : 1;5D
DO-WORD
-LEFT
;
219 : 1;5C
DO-WORD
-RIGHT
;
226 ;; reset input buffer
(i
.e
. make it empty
)
227 : RESET
( -- ) 0-TO BUF
-LEN
0-TO DRAW
-OFS
0-TO CUR
-OFS
;
229 : LINE
( -- addr count
) BUF BUF
-LEN
;
231 : LINE
! ( addr count
-- )
232 BUF
-SIZE MIN DUP
TO BUF
-LEN BUF SWAP MOVE
236 : (EDIT
-PROCESS
-OSC
) ( -- exitflag
)
238 keybuf keybuf
-len FALSE OSC
-KEY
-PROCESSOR
240 VOCID
: OSC
-ACTIONS FIND
-WORD
-IN
-VOC
246 : (EDIT
-PROCESS
-ESC
) ( ch
-- exitflag
)
247 DROP
;; it is always
27
248 TTY
:RAW
-READCH DUP
[CHAR
] [ = IF DROP
(EDIT
-PROCESS
-OSC
)
249 ELSE FALSE ESC
-PROCESSOR IFNOT
27 = IF -1 ELSE FALSE
ENDIF
254 : (EDIT
-PROCESS
-OTHER
) ( ch
-- exitflag
)
255 FALSE KEY
-PROCESSOR IFNOT
259 8 OF
DO-BACKSPACE FALSE ENDOF
262 25 OF RESET FALSE ENDOF
;; ^Y
263 127 OF
DO-BACKSPACE FALSE ENDOF
264 OTHERWISE
DO-INS
-CHAR FALSE
270 : EDIT
-LOOP
( -- accepted
)
271 TTY
:SET
-RAW
" fuck!" ?NOT
-ERROR
274 DROP
;; drop old exit flag
275 FALSE ON
-BEFORE
-DRAW IFNOT DRAW
ENDIF ON
-AFTER
-DRAW
276 TTY
:RAW
-READCH DUP
0>=
278 DUP
27 = IF (EDIT
-PROCESS
-ESC
)
279 ELSE (EDIT
-PROCESS
-OTHER
)
283 DUP
IF ON
-ACCEPTED
ELSE ON
-ESCAPED
ENDIF
286 : PROMPT
-EDIT
( addr count
-- accepted
)
287 TTY
:SET
-RAW
" fuck!" ?NOT
-ERROR