#!/usr/local/bin/gosh

(use srfi-1)
(use util.match)
(use gauche.parseopt)

;;;
;;;  - christmas tree
;;;     http://parametron.blogspot.com/2010/12/blog-post.html
;;;  - ansi coloring
;;;     http://d.hatena.ne.jp/trotr/20091031/1257001416
;;;

(define (usage)
  (print "Usage: christmas-tree [options ...]")
  (print "  - s|size  : tree size (default 5)")
  (print "  - c|color : coloring tree (ansi)")
  (print "  - h|help  : print usage")
  (exit 2))

;; main algorithm
(define (make-christmas-tree size)
  (define (next tree)
    (filter (pa$ (complement null?))
            (append-map
             (^l (let ((ss0 (map (cut append <> (list #f)) l))
                       (ss1 (map (cut append <> (list #t)) l)))
                   (let ((ss1 (cons (car ss0) ss1))
                         (ss0 (cdr ss0)))
                     (list ss0 ss1))))
             tree)))
  (let rec ((n (- size 1))(tree '(((#f)(#t)))))
    (if (<= n 0)
        tree
        (rec (- n 1)(next tree)))))


(define (tree-leaf-> tchar fchar tree)
  (map (map$ (.$ list->string (map$ (^e (if e tchar fchar))))) tree))

;;
;; coloring
;;
(define (field->ansi-color-escape row)
  (define (string->ansi-escape str num)
    (apply string-append
           (map (apply$ string)
                (list `(#\escape #\[ ,@(string->list (x->string num)) #\m)
                      (string->list str)
                      `(#\escape #\[ ,@'(#\0) #\m)))))
  (define (string->num-list str)
    (map (.$ x->integer string)(string->list str)))
  (define (escape prev cur next)
    (apply string-append
           (map (^ (p c n)
                   (match (list p c n)
                     ((_ 0 1)(string->ansi-escape
                              (string->ansi-escape (x->string c) 31) 1))
                     ((0 1 _)(string->ansi-escape
                              (string->ansi-escape (x->string c) 36) 1))
                     (else (string->ansi-escape (x->string c) 32))))
                (string->num-list (if prev prev (make-string (string-length cur))))
                (string->num-list cur)
                (string->num-list (if next next (make-string (string-length cur)))))))
  ;; body
  (let rec ((rest row)(prev #f)(acc '()))
    (if (null? rest)
        (reverse acc)
        (let1 escaped (escape prev (car rest)(and (not (null? (cdr rest)))
                                                  (cadr rest)))
        (rec (cdr rest)(car rest)
             (cons escaped  acc))))))

(define (print-christmas-tree tree :optional (color #f))
  (define (print-field row)
    (for-each (^f (display f)
                  (display " "))
              row)
    (newline))
  (define (fill-field n fill row)
    (let rec ((n n)(acc row))
      (if (zero? n)
          acc
          (rec (- n 1)(cons fill acc)))))
  ;; body
  (let* ((field-width (length (caar tree)))
         (max-field-count (apply max (map length tree)))
         (empty-field (make-string field-width #\space)))
    (let1 tree (tree-leaf-> #\1 #\0 tree)
      (for-each
       (^r (let* ((row (if color (field->ansi-color-escape r) r))
                  (lacks (quotient (- max-field-count (length row)) 2))
                  (row (fill-field lacks empty-field row)))
             (print-field row)))
       tree))))

(define (main args)
  (let-args (cdr args)
      ((size "s|size=i" 6)
       (color "c|color")
       (help "h|help" => usage)
       (else (opt . _)
             (print "Unknown option : " opt)
             (usage))
       . rest)
    (print-christmas-tree (make-christmas-tree size) color)))