Jaidyn Ann
24d8c4a225
Problem: There is no text-smushing. Without that, any line takes up too much space!
121 lines
5.4 KiB
Common Lisp
121 lines
5.4 KiB
Common Lisp
;;;; Copyright © 2023, Jaidyn Ann <jadedctrl@posteo.at>
|
||
;;;;
|
||
;;;; This program is free software: you can redistribute it and/or
|
||
;;;; modify it under the terms of the GNU General Public License as
|
||
;;;; published by the Free Software Foundation, either version 3 of
|
||
;;;; the License, or (at your option) any later version.
|
||
;;;;
|
||
;;;; This program is distributed in the hope that it will be useful,
|
||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;;; GNU General Public License for more details.
|
||
;;;;
|
||
;;;; You should have received a copy of the GNU General Public License
|
||
;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;;; FIGLET
|
||
;;;; A package for parsing Figlet fonts into simple associative lists, for
|
||
;;;; devious text-rendering purposes.
|
||
|
||
(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.
|
||
If no number is parsed out, return NIL."
|
||
(let ((radix (if (str:starts-with-p "0x" string)
|
||
16 10))
|
||
(string (if (str:starts-with-p "0x" string)
|
||
(subseq string 2) string)))
|
||
(ignore-errors (parse-integer string :radix radix))))
|
||
|
||
|
||
(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-@ (string-trim "@" line)) ;; Lines are terminated by ‘@’
|
||
(last-of-symbol-p (str:ends-with-p "@@" line)) ;; Character-art is terminated by ‘@@’
|
||
(not-art-line-p (not (str:ends-with-p "@" line))) ;; If no @ at all, line’s a comment or header
|
||
(first-word-num (string->integer (car (str:words line)))) ;; If header line, this’ll be a character-code
|
||
(current-art (ignore-errors (getf font-plist (code-char current-charcode)))))
|
||
(cond
|
||
;; This is a header for a new char-art of specific char-code.
|
||
((and not-art-line-p first-word-num)
|
||
(parse-lines (cdr lines) font-plist first-word-num))
|
||
;; If a line of char-art, amass it!
|
||
((not not-art-line-p)
|
||
(setf (getf font-plist (code-char current-charcode))
|
||
(unlines (list current-art
|
||
(str:replace-all (getf font-plist :space-char) " " sans-@))))
|
||
(parse-lines (cdr lines) font-plist (if last-of-symbol-p
|
||
(+ current-charcode 1)
|
||
current-charcode)))
|
||
;; This is the first line of the file, the header line.
|
||
((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 (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 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)))))
|