revamp code for positioning the cursor, code cleanup
This commit is contained in:
eknauel
parent
0c44395f9b
commit
0fc804b345
|
|
@ -34,13 +34,15 @@
|
|||
;;It is very esential, that you set keypad to true und call noecho!!!
|
||||
|
||||
|
||||
(define first-column 2)
|
||||
|
||||
;;record-type buffer
|
||||
(define-record-type buffer :buffer
|
||||
(make-buffer text
|
||||
pos-line
|
||||
pos-line ;; Cursor-Position auf text bezogen
|
||||
pos-col
|
||||
pos-fin-ln
|
||||
pos-y
|
||||
pos-fin-ln ;; ???
|
||||
pos-y ;; Cursor relativ zum Fenster
|
||||
pos-x
|
||||
num-lines
|
||||
num-cols
|
||||
|
|
@ -67,319 +69,295 @@
|
|||
(pos-y . ,buffer-pos-y)
|
||||
(pos-x . ,buffer-pos-x))))))
|
||||
|
||||
(define (buffer-text-current-line buffer)
|
||||
(list-ref (buffer-text buffer)
|
||||
(- (buffer-pos-line buffer) 1)))
|
||||
|
||||
;;handle input
|
||||
(define input
|
||||
(lambda (buffer ch)
|
||||
(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
|
||||
(cond
|
||||
(define (input buffer ch)
|
||||
(cond
|
||||
|
||||
;;Enter
|
||||
((= ch 10)
|
||||
(begin
|
||||
(set! text (append text (list "")))
|
||||
(set! pos-line (+ pos-line 1))
|
||||
(set! history-pos (- (length text) 1))
|
||||
(set! pos-col 2)))
|
||||
;; enter key
|
||||
((= ch 10)
|
||||
(set-buffer-text! buffer
|
||||
(append (buffer-text buffer (list ""))))
|
||||
(set-buffer-pos-line! buffer
|
||||
(+ (buffer-pos-line buffer) 1))
|
||||
(set-buffer-pos-col! buffer first-column)
|
||||
(set-buffer-history-pos! buffer
|
||||
(+ (length (buffer-text buffer)) 1)))
|
||||
;; backspace
|
||||
((and (= ch key-backspace)
|
||||
(buffer-can-write buffer)
|
||||
(not (< (buffer-pos-col buffer) 3)))
|
||||
(set-buffer-text! buffer
|
||||
(remove-from-command-buffer
|
||||
(buffer-text buffer)
|
||||
(buffer-pos-col buffer)))
|
||||
(regress-buffer-cursor-column! buffer))
|
||||
|
||||
;;Backspace
|
||||
((= ch key-backspace)
|
||||
(if can-write
|
||||
(if (< pos-col 3)
|
||||
(values)
|
||||
(begin
|
||||
(set! text (remove-from-command-buffer text pos-col))
|
||||
(set! pos-col (- pos-col 1))))
|
||||
(values)))
|
||||
;; FIXME
|
||||
;; move cursor to previous line Ctrl-p, keycode 16
|
||||
; ((= ch 16)
|
||||
; (if (< pos-fin-ln 2)
|
||||
; (values)
|
||||
; (let ((length-prev-line
|
||||
; (string-length
|
||||
; (list-ref text (- pos-line 2)))))
|
||||
; (set! can-write #f)
|
||||
; (set! pos-line (- pos-line 1))
|
||||
; (set! pos-col (+ length-prev-line 2)))))
|
||||
|
||||
;; FIXME
|
||||
;; move cursor to previous line Ctrl-p, keycode 16
|
||||
((= ch 16)
|
||||
(if (< pos-fin-ln 2)
|
||||
(values)
|
||||
(let ((length-prev-line
|
||||
(string-length
|
||||
(list-ref text (- pos-line 2)))))
|
||||
(set! can-write #f)
|
||||
(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)))
|
||||
(if (>= pos-line last-pos)
|
||||
(values)
|
||||
(let ((length-next-line
|
||||
(string-length
|
||||
(list-ref text pos-line))))
|
||||
(begin
|
||||
(set! pos-col (+ length-next-line 2))
|
||||
(set! pos-line (+ pos-line 1))
|
||||
(if (= pos-line last-pos)
|
||||
(set! can-write #t)))))))
|
||||
|
||||
((= ch key-left)
|
||||
(if (<= pos-col 2)
|
||||
(values)
|
||||
(begin
|
||||
(set! pos-col (- pos-col 1)))))
|
||||
|
||||
((= ch key-right)
|
||||
(let ((line-length (string-length
|
||||
(list-ref text
|
||||
(- pos-line 1)))))
|
||||
(if (>= pos-col (+ line-length 2))
|
||||
(values)
|
||||
(begin
|
||||
(set! pos-col (+ pos-col 1))))))
|
||||
;; FIXME
|
||||
;; move cursor to next line Ctrl-n, keycode 141
|
||||
; ((= ch 141)
|
||||
; (let ((last-pos (length text)))
|
||||
; (if (>= pos-line last-pos)
|
||||
; (values)
|
||||
; (let ((length-next-line
|
||||
; (string-length
|
||||
; (list-ref text pos-line))))
|
||||
; (begin
|
||||
; (set! pos-col (+ length-next-line 2))
|
||||
; (set! pos-line (+ pos-line 1))
|
||||
; (if (= pos-line last-pos)
|
||||
; (set! can-write #t)))))))
|
||||
|
||||
;; CursorLeft
|
||||
((and (= ch key-left)
|
||||
(> (buffer-pos-col buffer) first-column))
|
||||
(regress-buffer-cursor-column! buffer))
|
||||
|
||||
;; CursorRight
|
||||
((= ch key-right)
|
||||
(let ((line-length (string-length
|
||||
(buffer-text-current-line buffer))))
|
||||
(if (< (buffer-pos-col buffer) (+ line-length first-column))
|
||||
(advance-buffer-cursor-column! buffer))))
|
||||
|
||||
;;Ctrl+a -> Pos 1
|
||||
((= ch 1)
|
||||
(begin
|
||||
(set! pos-col 2)))
|
||||
;;Ctrl+a -> Pos 1
|
||||
((= ch 1)
|
||||
(set-buffer-pos-col! buffer first-column))
|
||||
|
||||
;;Ctrl-e -> End
|
||||
((= ch 5)
|
||||
(let ((line-length (string-length
|
||||
(list-ref text (- pos-line 1)))))
|
||||
(begin
|
||||
(set! pos-col (+ line-length 2)))))
|
||||
;;Ctrl-e -> End
|
||||
((= ch 5)
|
||||
(let ((line-length (string-length
|
||||
(buffer-text-current-line buffer))))
|
||||
(set-buffer-pos-col! buffer
|
||||
(+ line-length first-column))))
|
||||
|
||||
;;Ctrl+k -> Zeile löschen
|
||||
((= ch 11)
|
||||
(if can-write
|
||||
(let ((text-front (sublist text 0 (- (length text) 1))))
|
||||
(begin
|
||||
(set! text (append text-front '("")))
|
||||
(set! pos-col 2)))))
|
||||
;; Ctrl+k -> Zeile löschen
|
||||
((and (= ch 11)
|
||||
(buffer-can-write buffer))
|
||||
(let ((text-front (sublist (buffer-text buffer)
|
||||
0 (- (length (buffer-text buffer)) 1))))
|
||||
(set-buffer-text! buffer (append text-front '("")))
|
||||
(set-buffer-pos-col! buffer first-column)))
|
||||
|
||||
;; forward in command history -- CursorDown
|
||||
((= ch key-down)
|
||||
(if can-write
|
||||
(begin
|
||||
(if (< history-pos (- (length text) 1))
|
||||
(set! history-pos (+ history-pos 1)))
|
||||
(let ((rest (sublist text 0 (- (length text) 1)))
|
||||
(hist (if (= history-pos (- (length text) 1))
|
||||
""
|
||||
(list-ref text history-pos))))
|
||||
(set! text (append rest (list hist))))
|
||||
(let ((line-length (string-length
|
||||
(list-ref text (- (length text) 1)))))
|
||||
(set! pos-col (+ line-length 2))))))
|
||||
;; forward in command history -- CursorDown
|
||||
((and (= ch key-down)
|
||||
(buffer-can-write buffer))
|
||||
(if (< (buffer-history-pos buffer)
|
||||
(- (length (buffer-text buffer)) 1))
|
||||
(set-buffer-history-pos! buffer
|
||||
(+ (buffer-history-pos buffer) 1)))
|
||||
(let ((rest (sublist (buffer-text buffer) 0
|
||||
(- (length (buffer-text buffer)) 1)))
|
||||
(hist (if (= (buffer-history-pos buffer)
|
||||
(- (length (buffer-text buffer)) 1))
|
||||
""
|
||||
(list-ref (buffer-text buffer)
|
||||
(buffer-history-pos buffer)))))
|
||||
(set-buffer-text! buffer (append rest (list hist)))
|
||||
(let ((line-length
|
||||
(string-length
|
||||
(list-ref (buffer-text buffer)
|
||||
(- (length (buffer-text buffer)) 1)))))
|
||||
(set-buffer-pos-col! buffer (+ line-length first-column)))))
|
||||
|
||||
;; back in command history -- CursorUp
|
||||
((= ch key-up)
|
||||
(if can-write
|
||||
(begin
|
||||
(if (> history-pos 0)
|
||||
(set! history-pos (- history-pos 1)))
|
||||
(let ((rest (sublist text 0 (- (length text) 1)))
|
||||
(hist (list-ref text history-pos)))
|
||||
(set! text (append rest (list hist))))
|
||||
(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
|
||||
(values)))
|
||||
|
||||
(make-buffer text pos-line pos-col pos-fin-ln pos-y pos-x
|
||||
num-lines num-cols can-write history-pos)))))
|
||||
;; back in command history -- CursorUp
|
||||
((and (= ch key-up)
|
||||
(buffer-can-write buffer))
|
||||
(if (> (buffer-history-pos buffer) 0)
|
||||
(set-buffer-history-pos! (- (buffer-history-pos 1))))
|
||||
(let ((rest (sublist (buffer-text buffer) 0
|
||||
(- (length (buffer-text buffer)) 1)))
|
||||
(hist (list-ref (buffer-text buffer)
|
||||
(buffer-history-pos buffer))))
|
||||
(set-buffer-text! buffer
|
||||
(append rest (list hist))))
|
||||
(let ((line-length (string-length
|
||||
(list-ref (buffer-text buffer)
|
||||
(- (length (buffer-text buffer)) 1)))))
|
||||
(set-buffer-pos-col! buffer (+ line-length first-column))))
|
||||
|
||||
((and (buffer-can-write buffer) (<= ch 255))
|
||||
(append-char-to-buffer! ch buffer)
|
||||
(advance-buffer-cursor-column! buffer))
|
||||
|
||||
(values)))
|
||||
|
||||
;;print content of the buffer into the specified window
|
||||
(define print-command-buffer
|
||||
(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)))
|
||||
(let* ((l (get-right-command-lines text pos-fin-ln num-lines
|
||||
pos-line num-cols))
|
||||
(lines (car l)))
|
||||
(begin
|
||||
(set! pos-fin-ln (cdr l))
|
||||
(let loop ((pos 1))
|
||||
(if (> pos num-lines)
|
||||
(make-buffer text pos-line pos-col pos-fin-ln pos-y
|
||||
pos-x num-lines num-cols can-write history-pos)
|
||||
(let ((line (list-ref lines (- pos 1))))
|
||||
(begin
|
||||
(mvwaddstr win pos 1 line)
|
||||
;(wrefresh win)
|
||||
(loop (+ pos 1)))))))))))
|
||||
|
||||
(define (print-command-buffer win buffer)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(get-right-command-lines buffer))
|
||||
(lambda (lines new-pos-fin-ln)
|
||||
(set-buffer-pos-fin-ln! buffer new-pos-fin-ln)
|
||||
(let lp ((lines lines) (line-count 0))
|
||||
(if (or (null? lines)
|
||||
(> line-count (buffer-num-lines buffer)))
|
||||
(values)
|
||||
(begin
|
||||
(mvwaddstr win line-count 1 (car lines))
|
||||
(lp (cdr lines) (+ line-count 1))))))))
|
||||
|
||||
;;compute the visible lines
|
||||
(define get-right-command-lines
|
||||
(lambda (text pos-fin-ln num-lines pos-line num-cols)
|
||||
(let* ((res (all-commands-seperated text pos-line num-cols
|
||||
pos-fin-ln ))
|
||||
(all-lines-seperated (car res))
|
||||
(num-all-lines (length all-lines-seperated)))
|
||||
(begin
|
||||
(set! pos-fin-ln (cdr res))
|
||||
(define (get-right-command-lines buffer)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(all-commands-seperated buffer))
|
||||
(lambda (all-lines-seperated new-pos-fin-ln)
|
||||
(let ((num-all-lines (length all-lines-seperated))
|
||||
(num-lines (buffer-num-lines buffer))
|
||||
(pos-fin-ln (buffer-pos-fin-ln buffer)))
|
||||
(set! pos-fin-ln new-pos-fin-ln)
|
||||
(if (>= pos-fin-ln num-lines)
|
||||
;;aktive Zeile ist die unterste
|
||||
(cons (sublist all-lines-seperated
|
||||
(- pos-fin-ln num-lines)
|
||||
num-lines)
|
||||
pos-fin-ln)
|
||||
(values (sublist all-lines-seperated
|
||||
(- pos-fin-ln num-lines)
|
||||
num-lines)
|
||||
pos-fin-ln)
|
||||
(if (<= num-all-lines num-lines)
|
||||
;;noch keine ganze Seite im Buffer
|
||||
(cons (prepare-lines all-lines-seperated
|
||||
num-lines (- pos-fin-ln 1))
|
||||
pos-fin-ln)
|
||||
(values (prepare-lines all-lines-seperated
|
||||
num-lines (- pos-fin-ln 1))
|
||||
pos-fin-ln)
|
||||
;;scrollen auf der ersten Seite
|
||||
(cons (sublist all-lines-seperated 0 num-lines)
|
||||
pos-fin-ln)))))))
|
||||
|
||||
(values (sublist all-lines-seperated 0 num-lines)
|
||||
pos-fin-ln)))))))
|
||||
|
||||
;;seperate all statements
|
||||
(define all-commands-seperated
|
||||
(lambda (commands pos-line num-cols pos-fin-ln)
|
||||
(let loop ((act-pos 1)
|
||||
(new '()))
|
||||
(begin
|
||||
(if (= act-pos pos-line)
|
||||
(let* ((length-new (length new))
|
||||
(first-el-old (list-ref commands (- act-pos 1)))
|
||||
(seperated-act (seperate-line-com
|
||||
first-el-old num-cols))
|
||||
(length-act (length seperated-act)))
|
||||
(set! pos-fin-ln (+ length-new length-act))))
|
||||
|
||||
(if (> act-pos (length commands))
|
||||
(cons (reverse new) pos-fin-ln)
|
||||
(let* ((first-el-old (list-ref commands (- act-pos 1)))
|
||||
(seperated-fst-el-old
|
||||
(seperate-line-com first-el-old num-cols)))
|
||||
(loop (+ act-pos 1) (append seperated-fst-el-old new))))))))
|
||||
(define (all-commands-seperated buffer)
|
||||
(let ((num-cols (buffer-num-cols buffer))
|
||||
(pos-fin-ln (buffer-pos-fin-ln buffer))
|
||||
(commands (buffer-text buffer)))
|
||||
(let loop ((act-pos 1) (new '()))
|
||||
(if (= act-pos (buffer-pos-line buffer))
|
||||
(let* ((length-new (length new))
|
||||
(first-el-old (list-ref commands (- act-pos 1)))
|
||||
(seperated-act (seperate-line-com
|
||||
first-el-old num-cols))
|
||||
(length-act (length seperated-act)))
|
||||
(set! pos-fin-ln (+ length-new length-act))))
|
||||
|
||||
(if (> act-pos (length commands))
|
||||
(values (reverse new) pos-fin-ln)
|
||||
(let* ((first-el-old (list-ref commands (- act-pos 1)))
|
||||
(seperated-fst-el-old
|
||||
(seperate-line-com first-el-old num-cols)))
|
||||
(loop (+ act-pos 1) (append seperated-fst-el-old new)))))))
|
||||
|
||||
;;seperate one statement
|
||||
(define seperate-line-com
|
||||
(lambda (line width)
|
||||
(let loop ((new '())
|
||||
(old line))
|
||||
(if (> width (string-length old))
|
||||
(if (= 0 (string-length old))
|
||||
(if (equal? new '())
|
||||
(add-prompts '(""))
|
||||
(add-prompts new))
|
||||
;new
|
||||
(add-prompts (append (list old) new)))
|
||||
;(append (list old) new))
|
||||
(let ((next-line (substring old 0 width))
|
||||
(rest-old (substring old width (string-length old))))
|
||||
(loop (cons next-line new) rest-old))))))
|
||||
|
||||
(define (seperate-line-com line width)
|
||||
(let loop ((new '())
|
||||
(old line))
|
||||
(if (> width (string-length old))
|
||||
(if (= 0 (string-length old))
|
||||
(if (equal? new '())
|
||||
(add-prompts '(""))
|
||||
(add-prompts new))
|
||||
;new
|
||||
(add-prompts (append (list old) new)))
|
||||
;(append (list old) new))
|
||||
(let ((next-line (substring old 0 width))
|
||||
(rest-old (substring old width (string-length old))))
|
||||
(loop (cons next-line new) rest-old)))))
|
||||
|
||||
;;add ">"
|
||||
(define add-prompts
|
||||
(lambda (l)
|
||||
(let* ((lr (reverse l))
|
||||
(old-first-el (list-ref lr 0))
|
||||
(new-first-el (string-append ">" old-first-el))
|
||||
(old-rest (list-tail lr 1)))
|
||||
(let loop ((old old-rest)
|
||||
(new (list new-first-el)))
|
||||
(if (> (length old) 0)
|
||||
(let* ((old-first-el (list-ref old 0))
|
||||
(new-first-el (string-append " " old-first-el)))
|
||||
(loop (list-tail old 1) (append new (list new-first-el))))
|
||||
(reverse new))))))
|
||||
|
||||
(define (add-prompts l)
|
||||
(let* ((lr (reverse l))
|
||||
(old-first-el (list-ref lr 0))
|
||||
(new-first-el (string-append ">" old-first-el))
|
||||
(old-rest (list-tail lr 1)))
|
||||
(let loop ((old old-rest)
|
||||
(new (list new-first-el)))
|
||||
(if (> (length old) 0)
|
||||
(let* ((old-first-el (list-ref old 0))
|
||||
(new-first-el (string-append " " old-first-el)))
|
||||
(loop (list-tail old 1) (append new (list new-first-el))))
|
||||
(reverse new)))))
|
||||
|
||||
;;Find the lines to print
|
||||
(define prepare-lines
|
||||
(lambda (l height pos)
|
||||
(if (< (length l) height)
|
||||
;; Liste zu kurz -> ""s hinzufügen
|
||||
(let loop ((tmp-list l))
|
||||
(if (= height (length tmp-list))
|
||||
tmp-list
|
||||
(loop (append tmp-list (list "")))))
|
||||
;; Teilliste holen
|
||||
(if (< pos height)
|
||||
;;pos nicht ganz unten
|
||||
(sublist l 0 height)
|
||||
;;standard-Fall
|
||||
(sublist l (- pos height) height)))))
|
||||
|
||||
|
||||
(define (prepare-lines l height pos)
|
||||
(if (< (length l) height)
|
||||
;; Liste zu kurz -> ""s hinzufügen
|
||||
(let loop ((tmp-list l))
|
||||
(if (= height (length tmp-list))
|
||||
tmp-list
|
||||
(loop (append tmp-list (list "")))))
|
||||
;; Teilliste holen
|
||||
(if (< pos height)
|
||||
;;pos nicht ganz unten
|
||||
(sublist l 0 height)
|
||||
;;standard-Fall
|
||||
(sublist l (- pos height) height))))
|
||||
|
||||
;;Cursor
|
||||
;;Put Cursor to the right position
|
||||
(define (cursor-right-pos win buffer)
|
||||
(let ((text (buffer-text buffer))
|
||||
(pos-line (buffer-pos-line buffer))
|
||||
(pos-col (buffer-pos-col buffer))
|
||||
(let ((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)))
|
||||
(offset (lines-from-fin-line num-cols pos-col line)))
|
||||
(if (>= pos-fin-ln num-lines)
|
||||
;;unterste Zeile
|
||||
(set! pos-y (- num-lines offset))
|
||||
;;sonst
|
||||
(set! pos-y (- pos-fin-ln offset))))
|
||||
(let ((posx (modulo pos-col num-cols)))
|
||||
(if (<= posx 1)
|
||||
(set! pos-x (+ num-cols posx))
|
||||
(if (and (= posx 2)
|
||||
(> pos-col num-cols))
|
||||
(set! pos-x (+ num-cols 1))
|
||||
(set! pos-x posx)))
|
||||
(wmove win 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-cols (buffer-num-cols buffer)))
|
||||
|
||||
(define lines-from-fin-line
|
||||
(lambda (num-cols pos-col line)
|
||||
(let* ((lines (ceiling (/ (string-length line) num-cols)))
|
||||
(end-pos (* lines num-cols)))
|
||||
(if (= (string-length line) 0)
|
||||
0
|
||||
(let loop ((offset 0)
|
||||
(end end-pos))
|
||||
(if (<= (+ end 2) pos-col)
|
||||
(- offset 1)
|
||||
(loop (+ offset 1) (- end num-cols))))))))
|
||||
;; y position
|
||||
(let* ((item-length (string-length (buffer-text-current-line buffer)))
|
||||
(no-wrapped-lines (quotient item-length num-cols))
|
||||
(first-line-offset (quotient (- pos-col first-column) num-cols))
|
||||
(new-y (- (+ (- pos-fin-ln no-wrapped-lines)
|
||||
first-line-offset)
|
||||
1)))
|
||||
(debug-message "num-cols "
|
||||
num-cols
|
||||
" no-wrapped-lines "
|
||||
no-wrapped-lines
|
||||
" first-line-offset "
|
||||
first-line-offset
|
||||
" new-y " new-y
|
||||
" length "
|
||||
item-length
|
||||
" pos-fin-ln "
|
||||
pos-fin-ln
|
||||
" pos-col "
|
||||
pos-col)
|
||||
(set-buffer-pos-y! buffer new-y))
|
||||
|
||||
;; x position
|
||||
(let ((posx (modulo pos-col num-cols)))
|
||||
(if (<= posx 1)
|
||||
(set-buffer-pos-x! buffer (+ num-cols posx))
|
||||
(if (and (= posx 2)
|
||||
(> pos-col num-cols))
|
||||
(set-buffer-pos-x! buffer (+ num-cols 1))
|
||||
(set-buffer-pos-x! buffer posx))))
|
||||
|
||||
(wmove win (buffer-pos-y buffer) (buffer-pos-x buffer))))
|
||||
|
||||
(define (advance-buffer-cursor-column! buffer)
|
||||
(set-buffer-pos-col! buffer
|
||||
(+ 1 (buffer-pos-col buffer))))
|
||||
|
||||
(define (regress-buffer-cursor-column! buffer)
|
||||
(set-buffer-pos-col! buffer
|
||||
(- (buffer-pos-col buffer) 1)))
|
||||
|
||||
;; add one character to the buffer
|
||||
(define (add-to-command-buffer ch text pos-col)
|
||||
(let* ((last-pos (- (length text) 1))
|
||||
(define (append-char-to-buffer! ch buffer)
|
||||
(let* ((text (buffer-text buffer))
|
||||
(pos-col (buffer-pos-col buffer))
|
||||
(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
|
||||
|
|
@ -390,7 +368,8 @@
|
|||
(new-last-el (string-append before-ch
|
||||
(string (ascii->char ch))
|
||||
after-ch)))
|
||||
(append old-rest (list new-last-el))))
|
||||
(set-buffer-text! buffer
|
||||
(append old-rest (list new-last-el)))))
|
||||
|
||||
;;Remove one character from the line (backspace)
|
||||
(define remove-from-command-buffer
|
||||
|
|
@ -419,11 +398,10 @@
|
|||
|
||||
;;Create a fitting buffer for a window with box and a welcome-Message
|
||||
;;If the message is "", the buffer starts in line one
|
||||
(define make-buffer-welcome
|
||||
(lambda (height width welcome-message)
|
||||
(if (equal? "" welcome-message)
|
||||
(make-buffer (list "") 1 2 1 1 2 (- height 2) (- width 3) #t 1)
|
||||
(make-buffer (list welcome-message "") 2 2 2 2 2
|
||||
(- height 2) (- width 3) #t 1) )))
|
||||
(define (make-buffer-welcome height width welcome-message)
|
||||
(if (string=? "" welcome-message)
|
||||
(make-buffer (list "") 1 2 1 1 2 (- height 2) (- width 3) #t 1)
|
||||
(make-buffer (list welcome-message "") 2 2 2 2 2
|
||||
(- height 2) (- width 3) #t 1) ))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -368,10 +368,12 @@
|
|||
|
||||
(define-structure ncurses ncurses-interface
|
||||
(open scheme-with-scsh
|
||||
srfi-1
|
||||
external-calls
|
||||
define-record-types
|
||||
conditions
|
||||
signals
|
||||
tty-debug
|
||||
handle)
|
||||
(files ncurses
|
||||
ncurses-constants
|
||||
|
|
|
|||
Loading…
Reference in New Issue