From ac81aeaddc49370af1f8dc34217f79495f502036 Mon Sep 17 00:00:00 2001
From: Dimitri Lozeve <dimitri@lozeve.com>
Date: Mon, 22 Nov 2021 18:29:40 +0100
Subject: [PATCH] Add tables and spinners

---
 demo.scm    | 27 +++++++++++++++++++++++++++
 fancy.scm   | 10 ++++++++--
 format.scm  |  2 +-
 spinner.scm | 19 +++++++++++++++++++
 table.scm   | 22 ++++++++++++++++++++++
 5 files changed, 77 insertions(+), 3 deletions(-)
 create mode 100755 demo.scm
 create mode 100644 spinner.scm
 create mode 100644 table.scm

diff --git a/demo.scm b/demo.scm
new file mode 100755
index 0000000..49ca862
--- /dev/null
+++ b/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)))))
diff --git a/fancy.scm b/fancy.scm
index 3918376..f379748 100644
--- a/fancy.scm
+++ b/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")
 )
diff --git a/format.scm b/format.scm
index f9d89be..d92ec61 100644
--- a/format.scm
+++ b/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 ""))
diff --git a/spinner.scm b/spinner.scm
new file mode 100644
index 0000000..584cddc
--- /dev/null
+++ b/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"))
diff --git a/table.scm b/table.scm
new file mode 100644
index 0000000..a35907e
--- /dev/null
+++ b/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"))