; figlet [-g] [-w width] [text...]: the text in big letters, two rows of
; half blocks a line, the board's own letters: crg's alphabet, the one of
; the small logo.
; With no text, each line of the input. -g paints them white-hot to coral,
; letter by letter; -w breaks between words at that width (on a terminal,
; at its own). A letter it has no shape for comes out as a question mark.

(def usage "usage: figlet [-g] [-w width] [text...]\nBig letters, two rows of half blocks; -g in the board's ember colours, -w the width to break at.")

(def FONT
  (list
    (tuple "A" "▄▀█" "█▀█") (tuple "B" "█▄▄" "█▄█") (tuple "C" "█▀▀" "█▄▄") (tuple "D" "█▀▄" "█▄▀")
    (tuple "E" "█▀▀" "██▄") (tuple "F" "█▀▀" "█▀ ") (tuple "G" "█▀▀" "█▄█") (tuple "H" "█ █" "█▀█")
    (tuple "I" "█" "█") (tuple "J" "  █" "█▄█") (tuple "K" "█▄▀" "█ █") (tuple "L" "█  " "█▄▄")
    (tuple "M" "█▀▄▀█" "█ ▀ █") (tuple "N" "█▄ █" "█ ▀█") (tuple "O" "█▀█" "█▄█") (tuple "P" "█▀█" "█▀▀")
    (tuple "Q" "█▀█" "▀▀█") (tuple "R" "█▀█" "█▀▄") (tuple "S" "█▀" "▄█") (tuple "T" "▀█▀" " █ ")
    (tuple "U" "█ █" "█▄█") (tuple "V" "█ █" "▀▄▀") (tuple "W" "█ █ █" "▀▄▀▄▀") (tuple "X" "▀▄▀" "█ █")
    (tuple "Y" "█▄█" " █ ") (tuple "Z" "▀█" "█▄") (tuple "0" "█▀█" "█▄█") (tuple "1" "▄█" " █")
    (tuple "2" "▀▀█" "█▀▀") (tuple "3" "▀▀█" "▄▄█") (tuple "4" "█ █" "▀▀█") (tuple "5" "█▀▀" "▄▄█")
    (tuple "6" "█▀▀" "█▄█") (tuple "7" "▀▀█" "  █") (tuple "8" "█▄█" "█▄█") (tuple "9" "█▀█" "▀▀█")
    (tuple " " "  " "  ") (tuple "." " " "▄") (tuple "," " " "▄") (tuple "!" "█" "▄")
    (tuple "?" "▀▀█" " ▄ ") (tuple "-" "▄▄" "  ") (tuple "+" "▄█▄" " ▀ ") (tuple ":" "▄" "▄")
    (tuple "'" "▀" " ") (tuple "/" "  ▄▀" "▄▀  ") (tuple "_" "   " "▄▄▄") (tuple "@" "█▀█" "█▄▄")
    (tuple "#" "▀█▀█▀" "▀█▀█▀") (tuple "*" "▀▄▀" "▀ ▀") (tuple "=" "▀▀" "▀▀")))
(def EMBER (list 230 223 222 215 209 203))

(def shape
  (fn (ch)
    (let ((found (filter (fn (g) (letv (k top bottom) g (= k ch))) FONT)))
      (if (is-empty found) (shape "?") (head found)))))
(def width-of (fn (g) (letv (k top bottom) g (+ (str-len top) 1))))

(def shapes (fn (text) (map (fn (i) (shape (str-sub text i (+ i 1)))) (range 0 (str-len text)))))

; the words of a line packed into rows no wider than width (0: one row)
(def rows-of
  (fn (text width)
    (let ((words (filter (fn (w) (not (is-empty w))) (str-split " " (str-upper text)))))
      (if (<= width 0)
        (list (str-join " " words))
        (fold
          (fn (acc w)
            (let ((last (if (is-empty acc) "" (nth acc (- (length acc) 1)))))
              (let ((joined (if (is-empty last) w (str-concat last " " w))))
                (if (or (is-empty acc) (> (fold + 0 (map width-of (shapes joined))) width))
                  (list-append acc w)
                  (list-concat (map (fn (i) (nth acc i)) (range 0 (- (length acc) 1))) (list joined))))))
          (list)
          words)))))

(def paint
  (fn (row colour)
    (let ((gs (shapes row)) (n (str-len row)))
      (map
        (fn (half)
          (out-write
            (str-join " "
              (map
                (fn (i)
                  (letv (k top bottom) (nth gs i)
                    (str-concat
                      (if colour (sgr 38 5 (nth EMBER (floor (/ (* i (length EMBER)) (math-max 1 n))))) "")
                      (if (= half 0) top bottom))))
                (range 0 (length gs))))
            (if colour (sgr 0) "")
            "\n"))
        (range 0 2)))))

(def banner
  (fn (text width colour)
    (let ((rows (rows-of text width)))
      (map (fn (i) (do (if (> i 0) (out-write "\n") #t) (paint (nth rows i) colour))) (range 0 (length rows))))))

(def whole-re (re-compile "^[0-9]+$" "E"))

(letv (opts words bad) (getopt ARGS "ghw:")
  (let ((flags (map (fn (o) (letv (l v) o l)) opts))
        (wopt (filter (fn (o) (letv (l v) o (= l "w"))) opts))
        (term (out-terminal)))
    (let ((width (cond ((not (is-empty wopt)) (letv (l v) (head wopt) (if (is-nil (re-match whole-re v)) -1 (number v))))
                       ((is-nil term) 0)
                       (else (letv (cols rows) term cols))))
          (colour (not (is-empty (filter (fn (f) (= f "g")) flags)))))
      (cond
        ((not (= bad "")) (do (err-write "figlet: bad option -" bad "\n" usage "\n") (exit-status 2)))
        ((not (is-empty (filter (fn (f) (= f "h")) flags))) (out-write usage "\n"))
        ((< width 0) (do (err-write "figlet: -w takes a width in columns\n") (exit-status 2)))
        ((not (is-empty words)) (banner (str-join " " words) width colour))
        (else
          (map (fn (l) (if (is-empty (str-trim l)) #t (banner l width colour)))
               (str-split "\n" (in-read))))))))