Add tables and spinners

demo.scm

@@ -0,0 +1,27 @@
+(import (chicken format) srfi-18 fancy)
+
+(define (main . args)
+  (display (rule "[bold green]Fancy demo" style: 'simple))
+  (display (parse-markup
+	  "[bold red]Lorem ipsum[/bold red] dolor sit amet, [underline]consectetur[/underline] adipiscing elit, sed do
+eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad
+minim veniam, [cyan]quis nostrud exercitation [yellow]ullamco[/yellow] laboris[/cyan] nisi ut
+aliquip ex ea commodo consequat. Duis aute irure dolor in
+reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla
+pariatur. [black on yellow]Excepteur sint [on red]occaecat[/on red] cupidatat non proident, sunt in
+culpa qui officia deserunt mollit anim id est laborum."))
+  (display "\n\n")
+
+  (define tab (make-table '("[bold]#" "[bold]Name" "[bold]Property") '(3 20 20)))
+  (display (table-header tab))
+  (display (table-row tab "42" "[green]Foo" "Bar"))
+  (display (table-row tab "21" "[red]Toto" "Blublu"))
+  (display (table-footer tab))
+  (display "\n\n")
+
+  (let loop ((i 0))
+    (when (< i 20)
+      (display (spinner i "[yellow]Waiting:" (format "(computing ~a/20)" (add1 i))
+			style: 'dots))
+      (thread-sleep! 0.1)
+      (loop (add1 i)))))

fancy.scm

@@ -18,7 +18,12 @@
  parse-tag
  parse-markup
  remove-markup
- rule)
+ rule
+ make-table
+ table-header
+ table-row
+ table-footer
+ spinner)
 
 (import scheme
 	(chicken base)
@@ -31,5 +36,6 @@
 (include "colors.scm")
 (include "format.scm")
 (include "rule.scm")
-
+(include "table.scm")
+(include "spinner.scm")
 )

format.scm

@@ -86,7 +86,7 @@
   (if match
       (let-values (((control-seq new-style) (parse-tag (irregex-match-substring match 1) style)))
 	(parse-markup (irregex-replace +re-tags+ text control-seq) new-style))
-      (string-join (list text (graphics-style '())))))
+      (string-append text (graphics-style '()))))
 
 (define (remove-markup text)
   (irregex-replace/all +re-tags+ text ""))

spinner.scm

@@ -0,0 +1,19 @@
+(define +spinner-styles+
+  '((dots . "⠋⠙⠹⠸⠼⠴⠦⠧⠇⠏")
+    (block . "▖▘▝▗")
+    (triangle . "◢◣◤◥")
+    (circle . "◐◓◑◒")
+    (vertical . "▁▃▄▅▆▇█▇▆▅▄▃")
+    (horizontal . "▉▊▋▌▍▎▏▎▍▌▋▊▉")
+    (ascii . "|/-\\")))
+
+(define (spinner i text-before text-after #!key (style 'dots))
+  (define spinner-chars (cdr (assoc style +spinner-styles+)))
+  (string-append
+   (cursor-up 1)
+   (parse-markup text-before)
+   " "
+   (string (string-ref spinner-chars (modulo i (string-length spinner-chars))))
+   " "
+   (parse-markup text-after)
+   "\n"))

table.scm

@@ -0,0 +1,22 @@
+(define-record table names widths)
+
+(define (column-text text width)
+  (string-append
+   " "
+   (parse-markup text)
+   (make-string (- width (string-length (remove-markup text)) 1) #\ )))
+
+(define (table-header tab)
+  (string-append
+   "┌" (string-join (map (lambda (w) (make-string (+ 2 w) #\─))  (table-widths tab)) "┬") "┐\n"
+   "│" (string-join (map (lambda (name width) (column-text name (+ 2 width))) (table-names tab) (table-widths tab)) "│") "│\n"
+   "├" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) (table-widths tab)) "┼") "┤\n"))
+
+(define (table-row tab . args)
+  (string-append
+   "│"
+   (string-join (map (lambda (text width) (column-text text (+ 2 width))) args (table-widths tab)) "│")
+   "│\n"))
+
+(define (table-footer tab)
+  (string-append "└" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) (table-widths tab)) "┴") "┘\n"))