2020-04-05 01:28:00 +11:00
|
|
|
( requires core, parse, print )
|
2020-03-21 04:35:02 +11:00
|
|
|
|
|
|
|
( 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
|
2020-04-13 10:42:00 +10:00
|
|
|
: RDLNMEM+ 0x53 RAM+ @ + ;
|
|
|
|
( current position in INBUF )
|
|
|
|
: IN> 0 RDLNMEM+ ;
|
2020-03-21 04:35:02 +11:00
|
|
|
( points to INBUF )
|
2020-04-13 10:42:00 +10:00
|
|
|
: IN( 2 RDLNMEM+ ;
|
2020-03-21 04:35:02 +11:00
|
|
|
( points to INBUF's end )
|
2020-04-16 11:29:39 +10:00
|
|
|
: IN) INBUFSZ 2+ RDLNMEM+ ;
|
2020-03-21 04:35:02 +11:00
|
|
|
|
|
|
|
( flush input buffer )
|
|
|
|
( set IN> to IN( and set IN> @ to null )
|
2020-04-13 10:42:00 +10:00
|
|
|
: (infl) 0 IN( DUP IN> ! ! ;
|
2020-03-21 04:35:02 +11:00
|
|
|
|
|
|
|
( handle backspace: go back one char in IN>, if possible, then
|
|
|
|
emit SPC + BS )
|
|
|
|
: (inbs)
|
|
|
|
( already at IN( ? )
|
2020-04-13 10:42:00 +10:00
|
|
|
IN> @ IN( = IF EXIT THEN
|
2020-04-16 11:29:39 +10:00
|
|
|
IN> @ 1- IN> !
|
2020-03-21 04:35:02 +11:00
|
|
|
SPC BS
|
|
|
|
;
|
|
|
|
|
|
|
|
( read one char into input buffer and returns whether we
|
2020-04-05 23:09:00 +10:00
|
|
|
should continue, that is, whether CR was not met. )
|
2020-03-21 04:35:02 +11:00
|
|
|
: (rdlnc) ( -- f )
|
2020-04-03 04:24:25 +11:00
|
|
|
( buffer overflow? same as if we typed a newline )
|
2020-04-13 10:42:00 +10:00
|
|
|
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
|
2020-03-21 04:35:02 +11:00
|
|
|
( del? same as backspace )
|
2020-04-03 04:24:25 +11:00
|
|
|
DUP 0x7f = IF DROP 0x8 THEN
|
2020-04-05 23:09:00 +10:00
|
|
|
( lf? same as cr )
|
|
|
|
DUP 0x0a = IF DROP 0xd THEN
|
2020-04-03 04:24:25 +11:00
|
|
|
( echo back )
|
|
|
|
DUP EMIT ( c )
|
2020-03-21 04:35:02 +11:00
|
|
|
( bacspace? handle and exit )
|
|
|
|
DUP 0x8 = IF (inbs) EXIT THEN
|
|
|
|
( write and advance )
|
|
|
|
DUP ( keep as result ) ( c c )
|
2020-04-03 04:24:25 +11:00
|
|
|
( Here, we take advantage of the fact that c's MSB is
|
|
|
|
always zero and thus ! automatically null-terminates
|
|
|
|
our string )
|
2020-03-21 04:35:02 +11:00
|
|
|
IN> @ ! 1 IN> +! ( c )
|
2020-04-03 04:24:25 +11:00
|
|
|
( if newline, replace with zero to indicate EOL )
|
2020-04-05 23:09:00 +10:00
|
|
|
DUP 0xd = IF DROP 0 THEN
|
2020-03-21 04:35:02 +11:00
|
|
|
;
|
|
|
|
|
|
|
|
( Read one line in input buffer and make IN> point to it )
|
|
|
|
: (rdln)
|
|
|
|
(infl)
|
|
|
|
BEGIN (rdlnc) NOT UNTIL
|
2020-04-13 10:42:00 +10:00
|
|
|
LF IN( IN> !
|
2020-03-21 04:35:02 +11:00
|
|
|
;
|
|
|
|
|
2020-04-25 02:10:07 +10:00
|
|
|
: RDLN<? IN> @ C@ ;
|
|
|
|
|
2020-03-26 11:39:07 +11:00
|
|
|
( And finally, implement a replacement for the (c<) routine )
|
2020-04-25 02:10:07 +10:00
|
|
|
: RDLN<
|
|
|
|
RDLN<? ( c )
|
2020-03-21 04:35:02 +11:00
|
|
|
( not EOL? good, inc and return )
|
|
|
|
DUP IF 1 IN> +! EXIT THEN ( c )
|
|
|
|
( EOL ? readline. we still return typed char though )
|
2020-04-05 07:43:00 +10:00
|
|
|
(rdln) ( c )
|
2020-03-21 04:35:02 +11:00
|
|
|
;
|
2020-04-13 04:01:54 +10:00
|
|
|
|
|
|
|
( Initializes the readln subsystem )
|
2020-04-13 10:42:00 +10:00
|
|
|
: 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
|
2020-04-13 04:01:54 +10:00
|
|
|
(infl)
|
2020-04-25 02:10:07 +10:00
|
|
|
['] RDLN<? 0x06 RAM+ !
|
|
|
|
['] RDLN< 0x0c RAM+ !
|
2020-04-13 04:01:54 +10:00
|
|
|
;
|
|
|
|
|