“Finish” the Figlet parser-&-renderer

Problem: There is no text-smushing. Without that,
any line takes up too much space!

figlet.lisp

@@ -19,6 +19,20 @@
 
 (in-package :figlet)
 
+
+;;; ———————————————————————————————————
+;;; Misc. utilities
+;;; ———————————————————————————————————
+(defun contains-char-p (character string)
+  "Whether or not a STRING contains the given CHARACTER."
+  (str:containsp (string character) string))
+
+
+(defun characters (string)
+  "Return a list of a STRING’s characters."
+  (loop for char across string
+        collect char))
+
 
 (defun string->integer (string)
   "Convert a string to a number, potentially in 0x… hexadecimal form.
@@ -30,38 +44,77 @@ If no number is parsed out, return NIL."
     (ignore-errors (parse-integer string :radix radix))))
 
 
-(defun parse-lines (lines &optional (font-plist '()) (current-symbol 32))
+(defun unlines (strings)
+  "Wrapper around STR:UNLINES that removes all non-strings from the STRINGS list."
+  (str:unlines (remove-if-not #'stringp strings)))
+
+
+
+;;; ———————————————————————————————————
+;;; Font-parsing
+;;; ———————————————————————————————————
+(defun parse-lines (lines &optional (font-plist '()) (current-charcode 32))
   "Parse a list of lines from a Figlet font-file (.FLF) into a plist
 associating a character with its respective string in the font-file.
   (#\A \"TEXT-ART-A\" #\B \"TEXT-ART-B\" …)"
   (if lines
     (let* ((line (car lines))
-           (sans-@ (cl:string-trim "@" line))
+           (sans-@ (string-trim "@" line)) ;; Lines are terminated by ‘@’
-           (last-of-symbol-p (str:ends-with-p "@@" line))
+           (last-of-symbol-p (str:ends-with-p "@@" line)) ;; Character-art is terminated by ‘@@’
-           (not-art-line (not (str:ends-with-p "@" line)))
+           (not-art-line-p (not (str:ends-with-p "@" line))) ;; If no @ at all, line’s a comment or header
-           (first-word (car (str:split " " line)))
+           (first-word-num (string->integer (car (str:words line)))) ;; If header line, this’ll be a character-code
-           (first-word-num (string->integer first-word))
+           (current-art (ignore-errors (getf font-plist (code-char current-charcode)))))
-           (new-symbol-header-p (and not-art-line first-word-num)))
+      (cond
-      (cond (new-symbol-header-p
+        ;; This is a header for a new char-art of specific char-code.
-             (parse-lines (cdr lines) font-plist first-word-num))
+        ((and not-art-line-p first-word-num)
-            ((not not-art-line)
+         (parse-lines (cdr lines) font-plist first-word-num))
-             (setf (getf font-plist (code-char current-symbol))
+        ;; If a line of char-art, amass it!
-                   (format nil "~A~A~%"
+        ((not not-art-line-p)
-                           (or (getf font-plist (code-char current-symbol))
+         (setf (getf font-plist (code-char current-charcode))
-                               "")
+               (unlines (list current-art
-                           sans-@))
+                              (str:replace-all (getf font-plist :space-char) " " sans-@))))
-             (parse-lines (cdr lines) font-plist (if last-of-symbol-p
+         (parse-lines (cdr lines) font-plist (if last-of-symbol-p
-                                                     (+ current-symbol 1)
+                                                (+ current-charcode 1)
-                                                     current-symbol)))
+                                                current-charcode)))
-            ('t
+        ;; This is the first line of the file, the header line.
-             (parse-lines (cdr lines) font-plist current-symbol))))
+        ((str:starts-with-p "flf2a" line)
+         (setf (getf font-plist :space-char)
+               (subseq line 5 6)) ;; A char (often $) to substitute spaces.
+         (parse-lines (cdr lines) font-plist current-charcode))
+        ;; If none of the above, it’s a comment!
+        ('t
+         (setf (getf font-plist :comments)
+               (unlines (list (getf font-plist :comments) line)))
+         (parse-lines (cdr lines) font-plist current-charcode))))
     font-plist))
 
 
-(defun figlet-font-plist (path)
+(defun figlet-font-plist (font-path)
   "Parse a Figlet font-file (.FLF) into a plist associating a character
 with its respective string in the font-file.
   (#\A \"TEXT-ART-A\" #\B \"TEXT-ART-B\" …)"
   (parse-lines
    (str:lines
-    (alexandria:read-file-into-string path))))
+    (alexandria:read-file-into-string font-path))))
+
+
+
+;;; ———————————————————————————————————
+;;; Output of Figlet-style strings
+;;; ———————————————————————————————————
+(defun figlet-string (string &key (font-path nil) (font-plist (figlet-font-plist font-path)))
+  (if (contains-char-p #\newline string)
+      (mapcar (lambda (line) (figlet-string line :font-path font-path :font-plist font-plist))
+              (str:lines string))
+      (let* ((char-lines
+               (mapcar (lambda (char)
+                         (str:lines (getf font-plist char)))
+                       (characters string)))
+             (lines’-parts
+               (loop for i to (- (length (car char-lines)) 1)
+                    collect (mapcar (lambda (lines)
+                                      (nth i lines))
+                                    char-lines))))
+        (str:unlines (mapcar (lambda (line-parts)
+                               (reduce #'str:concat line-parts))
+                             lines’-parts)))))