diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-06-01 16:02:54 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-06-01 21:42:53 +0200 |
commit | 38f708452bc1032ee1e42cf0e345ca8851316e4a (patch) | |
tree | e569c12648b2ad848583299f1d7170340e1e54f7 /module/output/text.scm | |
parent | Remove *TOP* tags from descriptions. (diff) | |
download | calp-38f708452bc1032ee1e42cf0e345ca8851316e4a.tar.gz calp-38f708452bc1032ee1e42cf0e345ca8851316e4a.tar.xz |
Break text procedures into modules.
Diffstat (limited to '')
-rw-r--r-- | module/text/numbers.scm (renamed from module/output/text.scm) | 88 |
1 files changed, 2 insertions, 86 deletions
diff --git a/module/output/text.scm b/module/text/numbers.scm index 4697b70a..c590c188 100644 --- a/module/output/text.scm +++ b/module/text/numbers.scm @@ -1,89 +1,5 @@ -(define-module (output text) - #:use-module (srfi srfi-1) - #:use-module (util) - #:export (justify-line flow-text)) - -(define-public (words str) (string-split str #\space)) -(define-public (unwords list) (string-join list " " 'infix)) - -(define-public (lines str) (string-split str #\newline)) -(define-public (unlines list) (string-join list "\n" 'infix)) - -;; Alternative string-length whith counts ANSI escapes as 0-length. -;; NOTE Some way to opt in and out of different features would be nice. -(define (true-string-length word) - (let loop ((chars (string->list word))) - (if (null? chars) - 0 - (let ((char (car chars))) - (if (eqv? #\escape char) - (loop (cdr (memv #\m chars))) - (1+ (loop (cdr chars)))))))) - - -;; (str) -> str -(define* (justify-line-helper words #:key (width 70)) - (let* ((phrase-length (true-string-length (string-concatenate/shared words))) - (needed-spaces (- width phrase-length)) - (slots (1- (length words))) - (space-list - (let loop ((n needed-spaces) (d slots)) - (unless (zero? d) - (let ((v (round (/ n d)))) - (cons v (loop (- n v) - (1- d)))))))) - (string-concatenate/shared - (merge words (map (lambda (n) (make-string n #\space)) - space-list) - (let ((f #t)) (lambda _ (mod/r! f not))))))) - - - -;; Splits and justifies the given line to @var{#:width}. -;; Returns a list of justified strings. -;; str -> (str) -(define* (justify-line line #:key (width 70)) - (let recur ((lst (words line))) - (let* ((head tail (span - (let ((w 0)) - (lambda (word) ; Take words until we are above the limit. - (< (mod/r! w = (+ 1 (true-string-length word))) - width))) - lst))) - (cond ((null? tail) (list (unwords head))) ; Don't justify last line. - ((null? head) - ;; an empty head implies that we found a word longer - ;; than our max width. Add it as is and continue - ;; (while crying). - (cons (car tail) (recur (cdr tail)))) - (else (cons (justify-line-helper head #:width width) - (recur tail))))))) - -;; str -> (str) -(define* (flow-text str #:key (width 70)) - (flatten - (map (lambda (line) (justify-line line #:width width)) - (lines str)))) - -(define-public (trim-to-width str len) - (let ((trimmed (string-pad-right str len))) - (if (< (string-length trimmed) - (string-length str)) - (string-append (string-drop-right trimmed 1) - "…") - trimmed))) - - - -;; TODO more options for infix strings -(define*-public (add-enumeration-punctuation - list optional: (final-delim "&")) - (cond [(null? list) ""] - [(= 1 (length list)) (car list)] - [else - (let* (((tail . rest) (reverse list))) - (reverse (cons* tail " " final-delim " " - (intersperce ", " rest))))])) +(define-module (text numbers) + :use-module (util)) ;; only used in number->string-cardinal (define (large-prefix e) |