;;; TABLE PRINTING
;;; Taken from: https://gist.github.com/WetHat/a49e6f2140b401a190d45d31e052af8f
;;; Used for pretty printing output
(defvar +CELL-FORMATS+ '(:left "~vA"
:center "~v:@<~A~>"
:right "~v@A"))
(defun format-table (stream data &key (column-label (loop for i from 1 to (length (car data))
collect (format nil "COL~D" i)))
(column-align (loop for i from 1 to (length (car data))
collect :left)))
(let* ((col-count (length column-label))
(strtable (cons column-label ; table header
(loop for row in data ; table body with all cells as strings
collect (loop for cell in row
collect (if (stringp cell)
cell
;else
(format nil "~A" cell))))))
(col-widths (loop with widths = (make-array col-count :initial-element 0)
for row in strtable
do (loop for cell in row
for i from 0
do (setf (aref widths i)
(max (aref widths i) (length cell))))
finally (return widths))))
;------------------------------------------------------------------------------------
; splice in the header separator
(setq strtable
(nconc (list (car strtable) ; table header
(loop for align in column-align ; generate separator
for width across col-widths
collect (case align
(:left (format nil ":~v@{~A~:*~}"
(1- width) "-"))
(:right (format nil "~v@{~A~:*~}:"
(1- width) "-"))
(:center (format nil ":~v@{~A~:*~}:"
(- width 2) "-")))))
(cdr strtable))) ; table body
;------------------------------------------------------------------------------------
; Generate the formatted table
(let ((row-fmt (format nil "| ~{~A~^ | ~} |~~%" ; compile the row format
(loop for align in column-align
collect (getf +CELL-FORMATS+ align))))
(widths (loop for w across col-widths collect w)))
; write each line to the given stream
(dolist (row strtable)
(apply #'format stream row-fmt (mapcan #'list widths row))))))
;; https://stackoverflow.com/questions/4882361/which-command-could-be-used-to-clear-screen-in-clisp
(defun cls()
(format t "~A[H~@*~A[J" #\escape))
(defun prompt-read (prompt)
(format *query-io* "~a" prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun handle-opt (opt lookup-table)
"When given a string and a list 'lookup table' call the
function associated with the opt used"
(let ((handler (cdr (assoc opt lookup-table))))
(if handler (funcall handler) (format t "Invalid opt~%~%"))))