1 ;;; TABLE PRINTING
2 ;;; Taken from: https://gist.github.com/WetHat/a49e6f2140b401a190d45d31e052af8f
3 ;;; Used for pretty printing output
4 (defvar +CELL-FORMATS+ '(:left "~vA"
5 :center "~v:@<~A~>"
6 :right "~v@A"))
7
8 (defun format-table (stream data &key (column-label (loop for i from 1 to (length (car data))
9 collect (format nil "COL~D" i)))
10 (column-align (loop for i from 1 to (length (car data))
11 collect :left)))
12 (let* ((col-count (length column-label))
13 (strtable (cons column-label ; table header
14 (loop for row in data ; table body with all cells as strings
15 collect (loop for cell in row
16 collect (if (stringp cell)
17 cell
18 ;else
19 (format nil "~A" cell))))))
20 (col-widths (loop with widths = (make-array col-count :initial-element 0)
21 for row in strtable
22 do (loop for cell in row
23 for i from 0
24 do (setf (aref widths i)
25 (max (aref widths i) (length cell))))
26 finally (return widths))))
27 ;------------------------------------------------------------------------------------
28 ; splice in the header separator
29 (setq strtable
30 (nconc (list (car strtable) ; table header
31 (loop for align in column-align ; generate separator
32 for width across col-widths
33 collect (case align
34 (:left (format nil ":~v@{~A~:*~}"
35 (1- width) "-"))
36 (:right (format nil "~v@{~A~:*~}:"
37 (1- width) "-"))
38 (:center (format nil ":~v@{~A~:*~}:"
39 (- width 2) "-")))))
40 (cdr strtable))) ; table body
41 ;------------------------------------------------------------------------------------
42 ; Generate the formatted table
43 (let ((row-fmt (format nil "| ~{~A~^ | ~} |~~%" ; compile the row format
44 (loop for align in column-align
45 collect (getf +CELL-FORMATS+ align))))
46 (widths (loop for w across col-widths collect w)))
47 ; write each line to the given stream
48 (dolist (row strtable)
49 (apply #'format stream row-fmt (mapcan #'list widths row))))))
50
51
52 ;; https://stackoverflow.com/questions/4882361/which-command-could-be-used-to-clear-screen-in-clisp
53 (defun cls()
54 (format t "~A[H~@*~A[J" #\escape))
55
56 (defun prompt-read (prompt)
57 (format *query-io* "~a" prompt)
58 (force-output *query-io*)
59 (read-line *query-io*))
60
61 (defun handle-opt (opt lookup-table)
62 "When given a string and a list 'lookup table' call the
63 function associated with the opt used"
64 (let ((handler (cdr (assoc opt lookup-table))))
65 (if handler (funcall handler) (format t "Invalid opt~%~%"))))