diff options
| -rw-r--r-- | par/piece-table.scm | 61 |
1 files changed, 50 insertions, 11 deletions
diff --git a/par/piece-table.scm b/par/piece-table.scm index 6b3985b..a9c9ef7 100644 --- a/par/piece-table.scm +++ b/par/piece-table.scm @@ -24,13 +24,36 @@ ;; The type defines how they should be rendered, it makes ;; possible to account for hyperlinks or stuff like that in the future with ;; ease. +;; Linebreaks is a vector of linebreaks (easy to count length) (define-record-type <piece> - (make-piece buffer start length type) + (%make-piece buffer start length type linebreaks) piece? (buffer piece-buffer set-piece-buffer!) (start piece-start set-piece-start!) (length piece-length set-piece-length!) - (type piece-type set-piece-type!)) + (type piece-type set-piece-type!) + (linebreaks piece-linebreaks set-piece-linebreaks!)) + +(define (index-linebreaks buffer start length) + (define (character-newline? ch) + (char=? ch #\newline)) + (define str (buffer->string buffer)) + (define (string-foreach* str f from length) + (let loop ((i 0)) + (when (not (= i length)) + (f i (string-ref str (+ start i))) + (loop (+ i 1))))) + (define outlist (list)) + + (string-foreach* (buffer->string buffer) + (lambda (i ch) + (when (character-newline? ch) + (set! outlist (cons i outlist)))) + start length) + (list->vector (reverse outlist))) + +(define (make-piece buffer start length type) + (%make-piece buffer start length type (index-linebreaks buffer start length))) (define (can-merge-pieces? a b) (and (eq? (piece-buffer a) (piece-buffer b)) @@ -39,18 +62,34 @@ (define (merge-pieces! a b) (set-piece-length! a (+ (piece-length a) (piece-length b))) + (set-piece-linebreaks! a (vector-append (piece-linebreaks a) + (piece-linebreaks b))) a) +(define (split-linebreaks linebreaks at) + (let* ((lb-l (vector-length linebreaks)) + (lb-at (let loop ((i 0)) + (if (and (< i lb-l) (< at (vector-ref linebreaks i))) + (loop (+ i 1)) + i)))) + (values + (vector-copy linebreaks 0 lb-at) + (vector-map (lambda (x) (- x at)) + (vector-copy linebreaks lb-at lb-l))))) + (define (split-piece! a at) - (values - (make-piece (piece-buffer a) - (piece-start a) - at - (piece-type a)) - (make-piece (piece-buffer a) - (+ at (piece-start a)) - (- (piece-length a) at) - (piece-type a)))) + (let-values (((lb-a lb-b) (split-linebreaks (piece-linebreaks a) at))) + (values + (%make-piece (piece-buffer a) + (piece-start a) + at + (piece-type a) + lb-a) + (%make-piece (piece-buffer a) + (+ at (piece-start a)) + (- (piece-length a) at) + (piece-type a) + lb-b)))) |