Read whole buffers at once, rather than a character at a time
This commit is contained in:
parent
6b967002c5
commit
f70354c683
|
@ -45,15 +45,19 @@
|
|||
(define-values (cooked-in cooked-out) (make-pipe))
|
||||
(thread
|
||||
(lambda ()
|
||||
(define input-buffer (make-bytes 4096))
|
||||
(let loop ((b (buffer '() #f)))
|
||||
(if (port-closed? cooked-out)
|
||||
;; our job here is
|
||||
'done
|
||||
(let ((s (read-string 1 raw-in)))
|
||||
(if (eof-object? s)
|
||||
(let ((count (read-bytes-avail! input-buffer raw-in)))
|
||||
(if (eof-object? count)
|
||||
(begin (close-output-port cooked-out)
|
||||
(loop b))
|
||||
(begin (update-buffer b (string-ref s 0) prompt
|
||||
(let process-bytes ((i 0) (b b))
|
||||
(if (>= i count)
|
||||
(loop b)
|
||||
(update-buffer b (integer->char (bytes-ref input-buffer i)) prompt
|
||||
(lambda ()
|
||||
(close-output-port cooked-out)
|
||||
(close-input-port raw-in))
|
||||
|
@ -61,10 +65,10 @@
|
|||
(write-string "\r\n" raw-out)
|
||||
(write-string line cooked-out)
|
||||
(newline cooked-out)
|
||||
(loop new-b))
|
||||
(process-bytes (+ i 1) new-b))
|
||||
(lambda (new-b feedback)
|
||||
(write-string feedback raw-out)
|
||||
(loop new-b))))))))))
|
||||
(process-bytes (+ i 1) new-b)))))))))))
|
||||
(values cooked-in (cook-output raw-out)))
|
||||
|
||||
(define (cook-output raw-out)
|
||||
|
|
Loading…
Reference in New Issue