https://git.spwbk.site/swatson/clwars/raw/master/plumbing.lisp
___________________________________
;;; 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~%~%"))))

You are viewing proxied material from chate.io. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.