Skip to content

@RayRacine /table.rkt
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Ascii table generator
#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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.