Update README

.gitignore

@@ -1,2 +1,3 @@
 *\~
+TAGS
 build-deps

README.org

@@ -8,9 +8,10 @@ Fancy pretty-printing utilities for [[https://cons.io/][Gerbil Scheme]].
 ** Features
 
 - [[https://en.wikipedia.org/wiki/ANSI_escape_code#CSI_(Control_Sequence_Introducer)_sequences][ANSI control codes]] for styling and cursor movement
-- Table formatting with [[https://unicode-table.com/en/blocks/box-drawing/][Unicode box drawing characters]]
+- Table formatting with [[https://unicode-table.com/en/blocks/box-drawing/][Unicode box drawing characters]] or in Markdown syntax
 - Horizontal rules
 - Spinners
+- Progress bars
 
 ** References
 

build.ss

@@ -6,4 +6,6 @@
   '("fancy/format"
     "fancy/table"
     "fancy/rule"
-    "fancy/spinner"))
+    "fancy/progress"
+    "fancy/spinner")
+  optimize: #t debug: 'src)

demo.ss

@@ -8,10 +8,11 @@
 	:dlozeve/fancy/format
 	:dlozeve/fancy/table
 	:dlozeve/fancy/rule
+	:dlozeve/fancy/progress
 	:dlozeve/fancy/spinner)
 
 (def (main)
-  (display (rule "[bold green]Fancy demo" style: 'simple))
+  (display (rule "[bold green]Fancy demo" style: 'simple width: 100))
   (displayln)
   (displayln (parse-markup
 	      "[bold red]Lorem ipsum[/bold red] dolor sit amet, [underline]consectetur[/underline] adipiscing elit, sed do
@@ -30,6 +31,11 @@ culpa qui officia deserunt mollit anim id est laborum."))
   (display (table-footer tab))
   (displayln)
   (displayln)
+  (def pbar (progress-bar 100 "[green]Progress: " percent: #f style: 'line))
+  (for ((i (in-range 100)))
+    (display (progress pbar (1+ i)))
+    (thread-sleep! 0.05))
+  (displayln)
   (for ((i (in-range 20)))
     (display (spinner i "[yellow]Waiting:" (format "(computing ~d/20)" (1+ i))
 		      style: 'dots))

fancy/format.ss

@@ -81,7 +81,7 @@
     ((? (lambda (t) (assgetq t +basic-bg-colors+)) => code) (format "4~d" code))
     (else #!void)))
 
-(def (graphics-style style)
+(def (graphics-style (style []))
   (def colors (lset-intersection eq? style (map car +basic-colors+)))
   (def bg-colors (lset-intersection eq? style (map car +basic-bg-colors+)))
   (def style-without-colors (lset-difference eq? style

fancy/progress.ss

@@ -0,0 +1,39 @@
+(export (struct-out progress-bar)
+	progress)
+
+(import :std/misc/string
+	:std/format
+	:dlozeve/fancy/format)
+
+(def +progress-styles+
+  '((ascii  . (#\[ #\= #\> #\  #\]))
+    (line   . (#\┝ #\━ #\━ #\  #\┥))
+    (double . (#\╞ #\═ #\═ #\  #\╡))
+    (block  . (#\│ #\█ #\█ #\ #\│))
+    (halfblock . (#\╻ #\▄ #\▄ #\ #\╻))
+    (dots   . (#\⣿ #\⠶ #\⠶ #\⠀ #\⣿))))
+
+(defstruct progress-bar (total description length style percent)
+  constructor: :init!)
+
+(defmethod {:init! progress-bar}
+  (lambda (self total (description #f) length: (length 80) style: (style 'line) percent: (percent #f))
+    (struct-instance-init! self total description length style percent)))
+
+(def (progress pbar n)
+  (with ((progress-bar total description length style percent) pbar)
+    (let* ((n (min total (max 0 n)))
+	   (n-done (inexact->exact (floor (* (- length 3) (/ n total)))))
+	   (n-remaining (inexact->exact (ceiling (* (- length 3) (/ (- total n) total)))))
+	   (progress-chars (assgetq style +progress-styles+))
+	   (bar (format "~c~a~c~a~c"
+			(list-ref progress-chars 0)
+			(make-string n-done (list-ref progress-chars 1))
+			(list-ref progress-chars 2)
+			(make-string n-remaining (list-ref progress-chars 3))
+			(list-ref progress-chars 4)))
+	   (progress (if percent
+		       (format "~3,0F%" (* 100 (/ n total)))
+		       (format "(~d/~d)"  n total))))
+      (str (cursor-up 1)
+	   (parse-markup description) bar " " progress "\n"))))

fancy/table.ss

@@ -6,25 +6,47 @@
 (import :std/misc/string
 	:dlozeve/fancy/format)
 
-(defstruct table (names widths))
+(defstruct table (names widths style)
+  constructor: :init!)
 
-(def (column-text text width)
+(defmethod {:init! table}
-  (str " "
+  (lambda (self names widths (style #f))
-       (parse-markup text)
+    (set! (table-names self) names)
-       (make-string (- width (string-length (remove-markup text)) 1) #\ )))
+    (set! (table-widths self) widths)
+    (set! (table-style self) style)))
+
+(def (column-text text width (style #f))
+  (match style
+    ('markdown
+     (str " " (remove-markup text) (make-string (- width (string-length (remove-markup text)) 1) #\ )))
+    (else
+     (str " "
+	  (parse-markup text)
+	  (make-string (- width (string-length (remove-markup text)) 1) #\ )))))
 
 (def (table-header tab)
-  (with ((table names widths) tab)
+  (match tab
-    (str "┌" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┬) "┐\n"
+    ((table names widths 'markdown)
-	 "│" (string-join (map (lambda (name width) (column-text name (+ 2 width))) names widths) #\│) "│\n"
+     (str "|" (string-join (map (lambda (name width) (column-text name (+ 2 width) 'markdown)) names widths) #\|) "|\n"
-	 "├" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┼) "┤\n")))
+	  "|" (string-join (map (lambda (w) (make-string (+ 2 w) #\-)) widths) #\|) "|\n"))
+    ((table names widths _)
+     (str "┌" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┬) "┐\n"
+	  "│" (string-join (map (lambda (name width) (column-text name (+ 2 width))) names widths) #\│) "│\n"
+	  "├" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┼) "┤\n"))))
 
 (def (table-row tab . args)
-  (with ((table names widths) tab)
+  (match tab
-    (str "│"
+    ((table names widths 'markdown)
-	 (string-join (map (lambda (text width) (column-text text (+ 2 width))) args widths) #\│)
+     (str "|"
-	 "│\n")))
+	  (string-join (map (lambda (text width) (column-text text (+ 2 width) 'markdown)) args widths) #\|)
+	  "|\n"))
+    ((table names widths _)
+     (str "│"
+	  (string-join (map (lambda (text width) (column-text text (+ 2 width))) args widths) #\│)
+	  "│\n"))))
 
 (def (table-footer tab)
-  (with ((table names widths) tab)
+  (match tab
-    (str "└" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┴) "┘\n")))
+    ((table names widths 'markdown) "\n")
+    ((table names widths _)
+     (str "└" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┴) "┘\n"))))