diff --git a/scheme/console.scm b/scheme/console.scm index 31bd312..d21c7a2 100644 --- a/scheme/console.scm +++ b/scheme/console.scm @@ -60,9 +60,11 @@ (lp paint?)))))))))) (define (pause-console-output console) + (debug-message "pause-console-output") (send (console-pause-channel console) 'ignore)) (define (resume-console-output console) + (debug-message "resume-console-output") (send (console-resume-channel console) 'ignore)) (define (view-console console) diff --git a/scheme/termbuf.scm b/scheme/termbuf.scm index 06d5314..91cd50f 100644 --- a/scheme/termbuf.scm +++ b/scheme/termbuf.scm @@ -1,10 +1,6 @@ -;; turn off debugging for the moment -(define debug-message - (lambda args #f)) - (define-record-type terminal-buffer :terminal-buffer (really-make-terminal-buffer width height view-index - x y buffer repaint? + x y buffer paint-fun esc-code) terminal-buffer? (width terminal-buffer-width) @@ -14,7 +10,7 @@ (x terminal-buffer-x set-terminal-buffer-x!) (y terminal-buffer-y set-terminal-buffer-y!) (buffer terminal-buffer-buffer set-terminal-buffer-buffer!) - (repaint? terminal-buffer-repaint? set-terminal-buffer-repaint?!) + (paint-fun terminal-buffer-paint-fun set-terminal-buffer-paint-fun!) (esc-code terminal-buffer-esc-code set-terminal-buffer-esc-code!)) (define-record-discloser :terminal-buffer @@ -24,7 +20,6 @@ (height ,(terminal-buffer-height tb)) (x ,(terminal-buffer-x tb)) (y ,(terminal-buffer-y tb)) - (repaint? ,(terminal-buffer-repaint? tb)) (esc-code ,(map char->ascii (string->list (terminal-buffer-esc-code tb))))))) (define (make-terminal-buffer width height) @@ -32,8 +27,10 @@ (lambda (ignore) (make-empty-line width)) (iota height)))) - (really-make-terminal-buffer width height buffer - 0 0 buffer #f ""))) + (really-make-terminal-buffer + width height buffer 0 0 buffer + curses-paint-terminal-buffer/complete + ""))) (define (line-at-cursor-position termbuf) (list-ref (terminal-buffer-view-index termbuf) @@ -51,18 +48,15 @@ (- (terminal-buffer-height termbuf) 1))) (define (append-empty-line termbuf) - (debug-message "append-empty-line") (append! (terminal-buffer-buffer termbuf) (list (make-empty-line (terminal-buffer-width termbuf))))) (define (goto-next-line termbuf) - (debug-message "goto-next-line") (set-terminal-buffer-y! termbuf (+ (terminal-buffer-y termbuf) 1)) (maybe-scroll-terminal-buffer termbuf)) (define (move-cursor termbuf x-offset y-offset) - (debug-message "move-cursor " termbuf " " x-offset " " y-offset) (let ((new-x (+ (terminal-buffer-x termbuf) x-offset)) (new-y (+ (terminal-buffer-y termbuf) y-offset))) @@ -87,10 +81,10 @@ (define (scroll-view-index-down termbuf) (set-terminal-buffer-view-index! termbuf (cdr (terminal-buffer-view-index termbuf))) - (set-terminal-buffer-repaint?! termbuf #t)) + (set-terminal-buffer-paint-fun! + termbuf paint-complete-buffer)) (define (maybe-scroll-terminal-buffer termbuf) - (debug-message "maybe-scroll-terminal-buffer") (and (>= (terminal-buffer-y termbuf) (terminal-buffer-height termbuf)) (begin @@ -100,23 +94,22 @@ (- (terminal-buffer-y termbuf) 1))))) (define (goto-beginning-of-line termbuf) - (debug-message "goto-beginning-of-line") (set-terminal-buffer-x! termbuf 0)) (define (terminal-buffer-add-char termbuf char) - (debug-message "add-char " termbuf " '" char "' " - (char->ascii char)) (cond ((not (string=? "" (terminal-buffer-esc-code termbuf))) (read-escape-code termbuf char)) ((char=? char (ascii->char 27)) (set-terminal-buffer-esc-code! termbuf (string char))) ((char=? char (ascii->char 13)) - (goto-beginning-of-line termbuf)) + (goto-beginning-of-line termbuf) + (set-terminal-buffer-paint-fun! termbuf position-cursor)) ((char=? char #\newline) (if (cursor-on-last-line? termbuf) (append-empty-line termbuf)) - (goto-next-line termbuf)) + (goto-next-line termbuf) + (set-terminal-buffer-paint-fun! termbuf position-cursor)) ((char-set-contains? char-set:printing char) (add-normal-char termbuf char)))) @@ -126,21 +119,16 @@ (append-empty-line termbuf) (goto-next-line termbuf) (goto-beginning-of-line termbuf) - (insert-char termbuf char)) + (insert-char termbuf char) + (set-terminal-buffer-paint-fun! + termbuf paint-complete-buffer)) (else (insert-char termbuf char) - (goto-next-char termbuf))) - (debug-message "add-normal-char " - (string-length (line-at-cursor-position termbuf)) - "'" (line-at-cursor-position termbuf) "'")) + (goto-next-char termbuf) + (set-terminal-buffer-paint-fun! + termbuf paint-single-char)))) -(define (curses-paint-terminal-buffer termbuf win) - (if (terminal-buffer-repaint? termbuf) - (clear/repaint-buffer termbuf win) - (paint-single-line termbuf win))) - -(define (clear/repaint-buffer termbuf win) - (debug-message "clear/repaint-buffer") +(define (paint-complete-buffer termbuf win) (wclear win) (let lp ((i (terminal-buffer-height termbuf)) (lines (terminal-buffer-view-index termbuf)) @@ -148,21 +136,31 @@ (if (zero? i) 'blorf (begin - (debug-message y ": '" (car lines) "'") (mvwaddstr win y 0 (car lines)) (lp (- i 1) (cdr lines) (+ y 1))))) (position-cursor termbuf win)) -(define curses-paint-terminal-buffer/complete - clear/repaint-buffer) - (define (paint-single-line termbuf win) - (debug-message "paint-single-line " termbuf) (wmove win (terminal-buffer-y termbuf) 0) (wclrtoeol win) (waddstr win (line-at-cursor-position termbuf)) (position-cursor termbuf win)) +(define (paint-single-char termbuf win) + (let ((x (if (zero? (terminal-buffer-x termbuf)) + (terminal-buffer-x termbuf) + (- (terminal-buffer-x termbuf) 1)))) + (waddch win +; (terminal-buffer-y termbuf) +; x + (string-ref (line-at-cursor-position termbuf) x)))) + +(define (curses-paint-terminal-buffer termbuf win) + ((terminal-buffer-paint-fun termbuf) termbuf win)) + +(define curses-paint-terminal-buffer/complete + paint-complete-buffer) + (define (position-cursor termbuf win) (wmove win (terminal-buffer-y termbuf) @@ -178,7 +176,6 @@ termbuf (+ 1 (terminal-buffer-x termbuf)))) (define (read-escape-code termbuf char) - (debug-message "read-escape-code " (char->ascii char) " " termbuf) (let ((code (string-append (terminal-buffer-esc-code termbuf) (string char)))) @@ -198,7 +195,6 @@ (set-terminal-buffer-esc-code! termbuf code))))) (define (recognize-cursor-movement partial-code) - (debug-message "recognize-cursor-movement " partial-code) (if-match (regexp-search (rx (: ,(ascii->char 27) #\[ (submatch digit) (submatch ("ABCD")) @@ -218,7 +214,6 @@ #f)) (define (recognize-simple-cursor-movement partial-code) - (debug-message "recognize-simple-cursor-movement ") (if-match (regexp-search (rx (: ,(ascii->char 27) (? #\[) (? #\O) (submatch ("ABCD")) eos)) partial-code)