Let's write β

プログラミング中にできたことか、思ったこととか

クリスマスツリー by Common Lisp

とりあえず、とくに祝いもなかったので寝惚けまなこで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~%"))

適当に書いただけに適当なでき。
f:id:Pocket7878_dev:20111226132342p:image:w360