diff --git a/scheme/input-buffer.scm b/scheme/input-buffer.scm index f5ba754..40fe0ff 100644 --- a/scheme/input-buffer.scm +++ b/scheme/input-buffer.scm @@ -35,7 +35,7 @@ ;;record-type buffer -(define-record-type buffer buffer +(define-record-type buffer :buffer (make-buffer text pos-line pos-col @@ -57,6 +57,16 @@ (can-write buffer-can-write set-buffer-can-write!) (history-pos buffer-history-pos set-buffer-history-pos!)) +(define-record-discloser :buffer + (lambda (rec) + `(buffer ,@(map (lambda (p) + (cons (car p) ((cdr p) rec))) + `((pos-line . ,buffer-pos-line) + (pos-col . ,buffer-pos-col) + (pos-fin-ln . ,buffer-pos-fin-ln) + (pos-y . ,buffer-pos-y) + (pos-x . ,buffer-pos-x)))))) + ;;handle input (define input (lambda (buffer ch) @@ -91,9 +101,10 @@ (set! pos-col (- pos-col 1)))) (values))) + ;; FIXME ;; move cursor to previous line Ctrl-p, keycode 16 ((= ch 16) - (if (< pos-fin-ln 2) + (if (< pos-fin-ln 2) (values) (let ((length-prev-line (string-length @@ -102,6 +113,7 @@ (set! pos-line (- pos-line 1)) (set! pos-col (+ length-prev-line 2))))) + ;; FIXME ;; move cursor to next line Ctrl-n, keycode 141 ((= ch 141) (let ((last-pos (length text))) @@ -179,18 +191,14 @@ (let ((line-length (string-length (list-ref text (- (length text) 1))))) (set! pos-col (+ line-length 2)))))) - - - + + ((and can-write (<= ch 255)) + (set! text (add-to-command-buffer ch text pos-col)) + (set! pos-col (+ pos-col 1))) + (else - (if (<= ch 255) - (if can-write - (begin - (begin - (set! text (add-to-command-buffer ch text pos-col)) - (set! pos-col (+ pos-col 1))) - (values))) - (values)))) + (values))) + (make-buffer text pos-line pos-col pos-fin-ln pos-y pos-x num-lines num-cols can-write history-pos))))) @@ -221,7 +229,7 @@ (let ((line (list-ref lines (- pos 1)))) (begin (mvwaddstr win pos 1 line) - (wrefresh win) + ;(wrefresh win) (loop (+ pos 1))))))))))) @@ -326,18 +334,17 @@ ;;Cursor ;;Put Cursor to the right position -(define cursor-right-pos - (lambda (win buffer) - (let ((text (buffer-text buffer)) - (pos-line (buffer-pos-line buffer)) - (pos-col (buffer-pos-col buffer)) - (pos-fin-ln (buffer-pos-fin-ln buffer)) - (pos-y (buffer-pos-y buffer)) - (pos-x (buffer-pos-x buffer)) - (num-lines (buffer-num-lines buffer)) - (num-cols (buffer-num-cols buffer)) - (can-write (buffer-can-write buffer)) - (history-pos (buffer-history-pos buffer))) +(define (cursor-right-pos win buffer) + (let ((text (buffer-text buffer)) + (pos-line (buffer-pos-line buffer)) + (pos-col (buffer-pos-col buffer)) + (pos-fin-ln (buffer-pos-fin-ln buffer)) + (pos-y (buffer-pos-y buffer)) + (pos-x (buffer-pos-x buffer)) + (num-lines (buffer-num-lines buffer)) + (num-cols (buffer-num-cols buffer)) + (can-write (buffer-can-write buffer)) + (history-pos (buffer-history-pos buffer))) (begin ;;zuerst mal y (let* ((line (list-ref text (- pos-line 1))) @@ -355,9 +362,8 @@ (set! pos-x (+ num-cols 1)) (set! pos-x posx))) (wmove win pos-y pos-x) - (wrefresh win) (make-buffer text pos-line pos-col pos-fin-ln pos-y pos-x - num-lines num-cols can-write history-pos)))))) + num-lines num-cols can-write history-pos))))) (define lines-from-fin-line (lambda (num-cols pos-col line) @@ -371,26 +377,20 @@ (- offset 1) (loop (+ offset 1) (- end num-cols)))))))) - - - - -;;Add one character to the buffer -(define add-to-command-buffer - (lambda (ch text pos-col) - (let* ((last-pos (- (length text) 1)) - (old-last-el (list-ref text last-pos)) - (old-rest (sublist text 0 last-pos)) - (before-ch (substring old-last-el 0 - (max 0 (- pos-col 2)))) - (after-ch (substring old-last-el - (max 0 (- pos-col 2)) - (string-length old-last-el))) - (new-last-el (string-append before-ch - (string (ascii->char ch)) - after-ch))) - (append old-rest (list new-last-el))))) - +;; add one character to the buffer +(define (add-to-command-buffer ch text pos-col) + (let* ((last-pos (- (length text) 1)) + (old-last-el (list-ref text last-pos)) + (old-rest (sublist text 0 last-pos)) + (before-ch (substring old-last-el 0 + (max 0 (- pos-col 2)))) + (after-ch (substring old-last-el + (max 0 (- pos-col 2)) + (string-length old-last-el))) + (new-last-el (string-append before-ch + (string (ascii->char ch)) + after-ch))) + (append old-rest (list new-last-el)))) ;;Remove one character from the line (backspace) (define remove-from-command-buffer @@ -412,11 +412,10 @@ (string-append before-ch after-ch)))) (append old-rest (list new-last-el))))) -(define sublist - (lambda (l pos k) - (let ((tmp (list-tail l pos))) - (reverse (list-tail (reverse tmp) - (- (length tmp) k)))))) +(define (sublist l pos k) + (let ((tmp (list-tail l pos))) + (reverse (list-tail (reverse tmp) + (- (length tmp) k))))) ;;Create a fitting buffer for a window with box and a welcome-Message ;;If the message is "", the buffer starts in line one diff --git a/scheme/ncurses-packages.scm b/scheme/ncurses-packages.scm index 30e0617..e0434d8 100644 --- a/scheme/ncurses-packages.scm +++ b/scheme/ncurses-packages.scm @@ -340,7 +340,6 @@ key-event - buffer buffer-text set-buffer-text! buffer-pos-line