added debug-output (using tty-debug), code cleanup, shift window

refreshing to application code
This commit is contained in:
eknauel 2005-05-18 18:54:08 +00:00
parent d76ca37524
commit 0c44395f9b
2 changed files with 52 additions and 54 deletions

View File

@ -35,7 +35,7 @@
;;record-type buffer ;;record-type buffer
(define-record-type buffer buffer (define-record-type buffer :buffer
(make-buffer text (make-buffer text
pos-line pos-line
pos-col pos-col
@ -57,6 +57,16 @@
(can-write buffer-can-write set-buffer-can-write!) (can-write buffer-can-write set-buffer-can-write!)
(history-pos buffer-history-pos set-buffer-history-pos!)) (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 ;;handle input
(define input (define input
(lambda (buffer ch) (lambda (buffer ch)
@ -91,6 +101,7 @@
(set! pos-col (- pos-col 1)))) (set! pos-col (- pos-col 1))))
(values))) (values)))
;; FIXME
;; move cursor to previous line Ctrl-p, keycode 16 ;; move cursor to previous line Ctrl-p, keycode 16
((= ch 16) ((= ch 16)
(if (< pos-fin-ln 2) (if (< pos-fin-ln 2)
@ -102,6 +113,7 @@
(set! pos-line (- pos-line 1)) (set! pos-line (- pos-line 1))
(set! pos-col (+ length-prev-line 2))))) (set! pos-col (+ length-prev-line 2)))))
;; FIXME
;; move cursor to next line Ctrl-n, keycode 141 ;; move cursor to next line Ctrl-n, keycode 141
((= ch 141) ((= ch 141)
(let ((last-pos (length text))) (let ((last-pos (length text)))
@ -180,17 +192,13 @@
(list-ref text (- (length text) 1))))) (list-ref text (- (length text) 1)))))
(set! pos-col (+ line-length 2)))))) (set! pos-col (+ line-length 2))))))
((and can-write (<= ch 255))
(else
(if (<= ch 255)
(if can-write
(begin
(begin
(set! text (add-to-command-buffer ch text pos-col)) (set! text (add-to-command-buffer ch text pos-col))
(set! pos-col (+ pos-col 1))) (set! pos-col (+ pos-col 1)))
(else
(values))) (values)))
(values))))
(make-buffer text pos-line pos-col pos-fin-ln pos-y pos-x (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)))))
@ -221,7 +229,7 @@
(let ((line (list-ref lines (- pos 1)))) (let ((line (list-ref lines (- pos 1))))
(begin (begin
(mvwaddstr win pos 1 line) (mvwaddstr win pos 1 line)
(wrefresh win) ;(wrefresh win)
(loop (+ pos 1))))))))))) (loop (+ pos 1)))))))))))
@ -326,8 +334,7 @@
;;Cursor ;;Cursor
;;Put Cursor to the right position ;;Put Cursor to the right position
(define cursor-right-pos (define (cursor-right-pos win buffer)
(lambda (win buffer)
(let ((text (buffer-text buffer)) (let ((text (buffer-text buffer))
(pos-line (buffer-pos-line buffer)) (pos-line (buffer-pos-line buffer))
(pos-col (buffer-pos-col buffer)) (pos-col (buffer-pos-col buffer))
@ -355,9 +362,8 @@
(set! pos-x (+ num-cols 1)) (set! pos-x (+ num-cols 1))
(set! pos-x posx))) (set! pos-x posx)))
(wmove win pos-y pos-x) (wmove win pos-y pos-x)
(wrefresh win)
(make-buffer text pos-line pos-col pos-fin-ln pos-y pos-x (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 (define lines-from-fin-line
(lambda (num-cols pos-col line) (lambda (num-cols pos-col line)
@ -371,13 +377,8 @@
(- offset 1) (- offset 1)
(loop (+ offset 1) (- end num-cols)))))))) (loop (+ offset 1) (- end num-cols))))))))
;; add one character to the buffer
(define (add-to-command-buffer ch text pos-col)
;;Add one character to the buffer
(define add-to-command-buffer
(lambda (ch text pos-col)
(let* ((last-pos (- (length text) 1)) (let* ((last-pos (- (length text) 1))
(old-last-el (list-ref text last-pos)) (old-last-el (list-ref text last-pos))
(old-rest (sublist text 0 last-pos)) (old-rest (sublist text 0 last-pos))
@ -389,8 +390,7 @@
(new-last-el (string-append before-ch (new-last-el (string-append before-ch
(string (ascii->char ch)) (string (ascii->char ch))
after-ch))) after-ch)))
(append old-rest (list new-last-el))))) (append old-rest (list new-last-el))))
;;Remove one character from the line (backspace) ;;Remove one character from the line (backspace)
(define remove-from-command-buffer (define remove-from-command-buffer
@ -412,11 +412,10 @@
(string-append before-ch after-ch)))) (string-append before-ch after-ch))))
(append old-rest (list new-last-el))))) (append old-rest (list new-last-el)))))
(define sublist (define (sublist l pos k)
(lambda (l pos k)
(let ((tmp (list-tail l pos))) (let ((tmp (list-tail l pos)))
(reverse (list-tail (reverse tmp) (reverse (list-tail (reverse tmp)
(- (length tmp) k)))))) (- (length tmp) k)))))
;;Create a fitting buffer for a window with box and a welcome-Message ;;Create a fitting buffer for a window with box and a welcome-Message
;;If the message is "", the buffer starts in line one ;;If the message is "", the buffer starts in line one

View File

@ -340,7 +340,6 @@
key-event key-event
buffer
buffer-text buffer-text
set-buffer-text! set-buffer-text!
buffer-pos-line buffer-pos-line