added debug-output (using tty-debug), code cleanup, shift window
refreshing to application code
This commit is contained in:
parent
d76ca37524
commit
0c44395f9b
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue