diamond.lisp

(defun diamond (letter)
  (labels ((letter-value (letter)
             (- (char-code (char-downcase letter))
                (char-code #\a)))
           (pad-char (char n)
             (loop repeat n do (write-char #\space))
             (write-char char))
           (write-letter-line (letter front back)
             (pad-char letter front)
             (unless (zerop back)
               (pad-char letter (1- (* 2 back))))
             (pad-char #\newline front))
           (diamond-rec (letter front back i n dir
                         &aux (previous-letter (code-char (1- (char-code letter)))))
             (cond ((= i n)
                    (write-letter-line letter front 0))
                   ((= i 1)
                    (diamond-rec previous-letter (1+ front) (1- back) (1+ i) n :up)
                    (write-letter-line letter 0 back)           
                    (diamond-rec previous-letter (1+ front) (1- back) (1+ i) n :down))
                   ((eq dir :up)
                    (diamond-rec previous-letter (1+ front) (1- back) (1+ i) n :up)
                    (write-letter-line letter front back))
                   ((eq dir :down)
                    (write-letter-line letter front back)
                    (diamond-rec previous-letter (1+ front) (1- back) (1+ i) n :down)))))
    (let ((n (1+ (letter-value letter))))
      (diamond-rec letter 0 (1- n) 1 n :none)
      (values))))

; (diamond #\g)