1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-26 05:48:06 +11:00
collapseos/forth/readln.fs
Virgil Dupras af39b37dd1 Replace the "> " prompt with the more traditional "ok" one
This is more than cosmetic, it's also highly usable. The presence
or absence of the "ok" message allows us to know whether the command
aborted. Previously, the "> " prompt appeared when the system expected
a prompt in the INTERPRET context, whether the previous command aborted
or not.

Also, this allows us to get rid of that ugly FLAGS global variable.
2020-04-24 12:10:07 -04:00

85 lines
2.3 KiB
Forth

( requires core, parse, print )
( Managing variables in a core module is tricky. Sure, we
have (sysv), but here we need to allocate a big buffer, and
that cannot be done through (sysv). What we do is that we
allocate that buffer at runtime and use (sysv) to point to
it, a pointer that is set during the initialization
routine. )
64 CONSTANT INBUFSZ
: RDLNMEM+ 0x53 RAM+ @ + ;
( current position in INBUF )
: IN> 0 RDLNMEM+ ;
( points to INBUF )
: IN( 2 RDLNMEM+ ;
( points to INBUF's end )
: IN) INBUFSZ 2+ RDLNMEM+ ;
( flush input buffer )
( set IN> to IN( and set IN> @ to null )
: (infl) 0 IN( DUP IN> ! ! ;
( handle backspace: go back one char in IN>, if possible, then
emit SPC + BS )
: (inbs)
( already at IN( ? )
IN> @ IN( = IF EXIT THEN
IN> @ 1- IN> !
SPC BS
;
( read one char into input buffer and returns whether we
should continue, that is, whether CR was not met. )
: (rdlnc) ( -- f )
( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
( del? same as backspace )
DUP 0x7f = IF DROP 0x8 THEN
( lf? same as cr )
DUP 0x0a = IF DROP 0xd THEN
( echo back )
DUP EMIT ( c )
( bacspace? handle and exit )
DUP 0x8 = IF (inbs) EXIT THEN
( write and advance )
DUP ( keep as result ) ( c c )
( Here, we take advantage of the fact that c's MSB is
always zero and thus ! automatically null-terminates
our string )
IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN
;
( Read one line in input buffer and make IN> point to it )
: (rdln)
(infl)
BEGIN (rdlnc) NOT UNTIL
LF IN( IN> !
;
: RDLN<? IN> @ C@ ;
( And finally, implement a replacement for the (c<) routine )
: RDLN<
RDLN<? ( c )
( not EOL? good, inc and return )
DUP IF 1 IN> +! EXIT THEN ( c )
( EOL ? readline. we still return typed char though )
(rdln) ( c )
;
( Initializes the readln subsystem )
: RDLN$
( 53 == rdln's memory )
H@ 0x53 RAM+ !
( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
the last typed 0x0a and one for the following NULL. )
INBUFSZ 4 + ALLOT
(infl)
['] RDLN<? 0x06 RAM+ !
['] RDLN< 0x0c RAM+ !
;