とりあえず、とくに祝いもなかったので寝惚けまなこで5分ぐらいで適当に書いてみました。
(defun mkstr (list) (with-output-to-string (s) (dolist (a list) (princ a s)))) (defvar foreground-color-list '(:black 30 :red 31 :green 32 :yellow 33 :blue 34 :magenta 35 :purple 35 :cyan 36 :white 37 :default 39)) (defvar background-color-list '(:black 40 :red 41 :green 42 :yellow 43 :blue 44 :magenta 45 :purple 45 :cyan 46 :white 47 :default 49)) (defvar reset-code 0) (defun color-string (str &key (foreground :default) (background :default)) (format nil "~C[~Am~C[~Am~A~C[~Am" #\Esc (getf foreground-color-list foreground) #\Esc (getf background-color-list background) str #\Esc reset-code )) (defun random-atom (list) (let ((len (length list))) (nth (random len) list))) (defvar ornaments '("@" "P" "q" "*" "?" "!")) (defun tree-line (length) (labels ((%tree-line (acc length) (if (zerop length) acc (%tree-line (cons (if (zerop (random 4)) (color-string (nth (random (length ornaments)) ornaments) :foreground (random-atom '(:green :blue :magenta :cyan :yellow :red))) #\Space) acc) (1- length))))) (mkstr (%tree-line nil length)))) (defun tree (n) (let ((padding 10)) (loop for i from 1 upto n do (if (= i 1) (format t "~A~A~%" (make-string (+ padding (1- n)) :initial-element #\space) (color-string "*" :foreground :yellow)) (format t "~A~A~A~A~%" (make-string (+ padding (- n i)) :initial-element #\space) (color-string "*" :foreground :green) (tree-line (1- (* (1- i) 2))) (color-string "*" :foreground :green)))) ;;Tree bottom (format t "~A~A~%" (make-string (1- padding) :initial-element #\Space) (color-string (make-string (1+ (* n 2)) :initial-element #\*) :foreground :green)) ;;Tunk of tree (dotimes (i 5) (format t "~A~A~%" (make-string (+ padding n -3) :initial-element #\Space) (color-string "******" :foreground :yellow)))) (format t "Merry christmas~%"))