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