; ( addr n1 -- n2 ) System ; R( -- ) ; reads a line with KEY into addr until n1 characters are reveived or cr/lf detected. VE_ACCEPT: .dw $ff06 .db "accept" .dw VE_HEAD .set VE_HEAD = VE_ACCEPT XT_ACCEPT: .dw DO_COLON PFA_ACCEPT: .dw XT_DUP ; ( -- addr n1 n1) .dw XT_TO_R .dw XT_TO_R PFA_ACCEPT1: ; ( -- addr ) .dw XT_KEY ; ( -- addr k ) .dw XT_DUP ; ( -- addr k k ) .dw XT_DOLITERAL .dw 10 .dw XT_NOTEQUAL .dw XT_DOCONDBRANCH ; case linefeed -> done&exit .dw PFA_ACCEPT2 .dw XT_DUP .dw XT_DOLITERAL .dw 13 .dw XT_NOTEQUAL .dw XT_DOCONDBRANCH ; case cr -> done&exit .dw PFA_ACCEPT2 ; check backspace .dw XT_DUP .dw XT_DOLITERAL .dw 8 .dw XT_EQUAL .dw XT_DOCONDBRANCH ; case BS do the backspace .dw PFA_ACCEPT3 ; delete previous character ; check beginning of line .dw XT_R_FROM ; ( -- addr k n1 ) .dw XT_R_FETCH ; ( -- addr k n1 n2) .dw XT_OVER ; ( -- addr k n1 n2 n1) .dw XT_TO_R .dw XT_EQUAL ; ( -- addr k f ) .dw XT_DOCONDBRANCH ; .dw PFA_ACCEPT5 ; we are at the beginning of the line, ignore this character .dw XT_DROP ; ( -- addr ) .dw XT_DOBRANCH ; recurse .dw PFA_ACCEPT1 PFA_ACCEPT5: ; backspace handdling in Terminal .if (halfduplex==1) ; emit nothing = echo cancellation; BS is localy echod in the ring. .else ; emit the key = echo .dw XT_DUP ; ( -- addr k k ) .dw XT_EMIT ; ( -- addr k ) ; BS .endif .dw XT_SPACE ; ( -- addr k ) ; space .dw XT_EMIT ; ( -- addr ) ; BS .dw XT_1MINUS ; ( -- addr--) .dw XT_R_FROM .dw XT_1PLUS .dw XT_DOBRANCH ; goto .dw PFA_ACCEPT4 PFA_ACCEPT3: ; check for remaining control characters, replace them with blank .dw XT_DUP ; ( -- addr k k ) .dw XT_BL .dw XT_LESS .dw XT_DOCONDBRANCH .dw PFA_ACCEPT6 .dw XT_DROP .dw XT_BL PFA_ACCEPT6: ; send echo: .if (halfduplex==1) ; emit nothing = echo cancellation. ; ( -- addr k) .else ; emit the key = echo .dw XT_DUP ; ( -- addr k k) .dw XT_EMIT ; ( -- addr k) .endif ; now store the key to buffer .dw XT_OVER ; ( -- addr k addr .dw XT_CSTORE ; ( -- addr) .dw XT_1PLUS ; ( -- addr++) .dw XT_R_FROM ; ( -- addr n1) .dw XT_1MINUS ; ( -- addr n1--) PFA_ACCEPT4: .dw XT_DUP .dw XT_TO_R .dw XT_EQUALZERO .dw XT_DOCONDBRANCH ; If recurse .dw PFA_ACCEPT1 .dw XT_DUP PFA_ACCEPT2: ; get number of tokens in TIB .dw XT_SLASHKEY .dw XT_DROP .dw XT_DROP .dw XT_R_FROM .dw XT_R_FROM .dw XT_SWAP .dw XT_MINUS .if (halfduplex==1) ; noop .else .dw XT_CR .endif .dw XT_EXIT