| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465 |
- ;;; 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~%~%"))))
|
