brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Finish table implementation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-22 19:57:44 +01:00
parent e95906e631
commit 471ea24874
1 changed files with 34 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

96
table.scm
View file

@ -243,27 +243,49 @@
(if stylepair (if stylepair
(cdr stylepair) (cdr stylepair)
(cdar table-borders-lookup))) (cdar table-borders-lookup)))
(cell-borders (cell-borders (list (if table-border (vector-ref stylevec 4) "")
(if column-border (if column-border (vector-ref stylevec 6) "")
(map (lambda (idx) (if table-border (vector-ref stylevec 7) "")))
(vector-ref stylevec idx)) (cws (map (compose ansi-string-length car) (car table))))
'(4 6 7))
'("" "" ""))))
(let loop ((rows table) (let loop ((rows table)
(res '()) (res (if table-border
(list (table-row-delimiter/styled table-border
column-border
cws
stylevec
0))
'()))
(idx 0)) (idx 0))
(if (null? rows) (if (null? rows)
(string-intersperse (let ((res0 (if table-border
(flatten (reverse res)) (cons (table-row-delimiter/styled table-border
"\n") column-border
cws
stylevec
3)
res)
res)))
(string-intersperse
(flatten (reverse res0))
"\n"))
(let* ((res0 (let* ((res0
(if (and row-border
(> idx 0))
(cons (table-row-delimiter/styled table-border
column-border
cws
stylevec
2)
res)
res))
(res1
(cons (cons
(apply table-row->lines (apply table-row->lines
(car rows) (car rows)
cell-borders) cell-borders)
res))) res0)))
(loop (cdr rows) (loop (cdr rows)
res0 res1
(add1 idx))))))))) (add1 idx)))))))))
;; Performs module self-tests ;; Performs module self-tests
@ -318,53 +340,3 @@
)) ))
) )
(import table)
(table-tests!)
(print (table-row-delimiter '(1 2 3 1) "/" "-" "+" "\\"))
(print
(table->string
'(("a" "bb" "ccc" "")
("" "b" "z" "x"))))
(print (table-row-delimiter/styled #t #t '(1 2 3 1) (cdr (assq 'unicode table-borders-lookup)) 3))
(print "************")
(print
(table->string
'(("a" "bb" "ccc" "")
("" "b" "z" "x"))
#:table-border #f
#:col-border #f
))
(print "************")
(print
(table->string
'(("a" "bb" "ccc" "")
("" "b" "z" "x"))
#:table-border #f
#:col-border #t
))
(print "************")
(print
(table->string
'(("a" "bb" "ccc" "")
("" "b" "z" "x"))
#:table-border #t
#:col-border #f
#:row-border #t
#:border-style 'unicode
))
(print "************")
(print
(table->string
'(("a" "bb" "ccc" "")
("" "b" "z" "x"))
#:table-border #t
#:row-border #t
#:col-border #t
#:border-style 'unicode
))