public
Created

Ascii table generator

  • Download Gist
table.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
#lang typed/racket/base
 
;;; Laurent Orseau <laurent orseau gmail com> -- 2010-02-10
;;; License: WTFPL
 
(require/typed srfi/13
(string-pad-right (String Integer -> String)))
 
(require
(only-in racket/list
first second third))
 
 
;;(provide (all-defined-out))
 
(: ->string (Any -> String))
(define (->string a)
(format "~a" a))
 
;;;;;;;;;;;;;;;;;;;;
;;; ASCII Tables ;;;
;;;;;;;;;;;;;;;;;;;;
 
(define-type BorderType (U 'normal 'rounded 'double))
 
(define-type Border (List String String String))
 
(define-type TemplateGlyph (U '< '+ '> (List String Integer)))
 
(struct: Table ([head : (Listof TemplateGlyph)]
[dash : Char]
[sep : String]
[top-line : Border]
[mid-line : Border]
[bottom-line : Border]) #:transparent)
 
(: table-map (Table (Integer String Integer -> String) String String String -> (Listof String)))
(define (table-map table f-col ch-deb ch ch-end)
(let ([n 0])
(map (λ: ((s : TemplateGlyph))
(cond [(equal? s '<) ch-deb]
[(equal? s '+) ch]
[(equal? s '>) ch-end]
[(list? s) (begin0
(apply f-col n s)
(set! n (+ 1 n)))]))
;;[(string? s) (f-col s (string-length s))]
(Table-head table))))
 
(: print-line (Table (Table -> Border) -> Void))
(define (print-line table getter)
(: border Border)
(define border (getter table))
(define line-segments (table-map table
(λ: ((n : Integer) (str : String) (len : Integer))
(build-string len (λ (n) (Table-dash table))))
(first border)
(second border)
(third border)))
 
(displayln (apply string-append line-segments)))
 
(: row-line (Table (Listof Any) -> Void))
(define (row-line table row)
(displayln (apply string-append
(table-map table
(λ (n str len)
(string-pad-right (->string (list-ref row n)) len))
(Table-sep table)
(Table-sep table)
(Table-sep table)))))
 
(: head-line (Table -> Void))
(define (head-line table)
(define line-segments (table-map table
(λ (n str len)
(string-pad-right (->string str) len))
(Table-sep table)
(Table-sep table)
(Table-sep table)))
(displayln (apply string-append line-segments)))
 
(: top-line (Table -> Void))
(define (top-line table)
(print-line table Table-top-line))
 
(: mid-line (Table -> Void))
(define (mid-line table)
(print-line table Table-mid-line))
 
(: bottom-line (Table -> Void))
(define (bottom-line table)
(print-line table Table-bottom-line))
 
(: table-framed ((Listof TemplateGlyph) BorderType -> Table))
(define (table-framed head borders)
 
(: dash Char)
(define dash (case borders
[(normal rounded) #\─]
[(double) #\═]
[else #\─]))
 
(: sep String)
(define sep
(case borders
[(normal rounded) "│"]
[(double) "║"]
[else "|"]))
 
(: top-line Border)
(define top-line
(case borders
[(normal) '("┌" "┬" "┐")]
[(rounded)'("╭" "┬" "╮")]
[(double) '("╔" "╦" "╗")]
[else '("┌" "┬" "┐")]))
 
(: mid-line Border)
(define mid-line
(case borders
[(normal rounded) '("├" "┼" "┤")]
[(double) '("╠" "╬" "╣")]
[else '("├" "┼" "┤")]))
 
(: bottom-line Border)
(define bottom-line
(case borders
[(normal) '("└" "┴" "┘")]
[(rounded) '("╰" "┴" "╯")]
[(double) '("╚" "╩" "╝")]
[else '("└" "┴" "┘")]))
 
(Table head dash sep top-line mid-line bottom-line))
 
(: test (-> Void))
(define (test)
(define border 'normal)
(define template '(< ("i" 4) + + ("f1" 8) + ("f2" 4) >) )
(define t1 (table-framed template border))
(top-line t1)
(head-line t1)
(mid-line t1)
(mid-line t1)
(row-line t1 '(a b c))
(mid-line t1)
(row-line t1 '(x y z))
(bottom-line t1))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.