#!/usr/local/bin/chicken-csi -ss
;; cards.scm -- CHICKEN Scheme ASCII card generator
;; example:
;;
;; $ ./cards.scm AD 9H
;; .----. .----.
;; |A   | |9   |
;; | <> | | <3 |
;; |   A| |   9|
;; '----' '----'
(import regex
        (chicken format)
        (chicken string)
        (chicken io))

(define (usage) (die! "usage: cards.scm [0-9AJQK][HSCD] ..."))

(define (err msg)
  (fprintf (current-error-port) "~A\n" msg))

(define (die! msg)
  (err msg)
  (exit 1))

(define card-re "^([0-9AJQK]+)([HSCD])$")

(define (invalid-card? card)
  (not (string-match card-re card)))

(define (filter pred? lst)
  (if (null? lst)
      '()
      (if (pred? (car lst))
          (cons (car lst) (filter pred? (cdr lst)))
          (filter pred? (cdr lst)))))

(define (parse-card c)
  (let* ((match (string-match card-re c))
         (value (cadr match))
         (suit (caddr match)))
    (cond ((equal? suit "H") (list value "<3"))
          ((equal? suit "D") (list value "<>"))
          ((equal? suit "S") (list value "{>"))
          ((equal? suit "C") (list value "qB"))
          (else (error "Bad suit")))))

;; prints the output of fmt on each parsed card, with a space in
;; between each output.
;; fmt should take a value and a suit and return a single line string.
(define (pr-per-card cards fmt)
  (if (null? cards)
      (newline)
      (begin (display (apply fmt (parse-card (car cards))))
             (if (not (null? (cdr cards))) (display " "))
             (pr-per-card (cdr cards) fmt))))

(define (left-pad s)
  (if (< (string-length s) 2)
      (format " ~A" s)
      s))

(define (right-pad s)
  (if (< (string-length s) 2)
      (format "~A " s)
      s))

(define (print-cards cards)
  (let ((invalid-cards (filter invalid-card? cards)))
    (if (not (null? invalid-cards))
        (die! (format "error: Invalid cards: ~A" invalid-cards))
        (begin
          (pr-per-card cards (lambda (v s) ".----."))
          (pr-per-card cards (lambda (v s) (format "|~A  |" (right-pad v))))
          (pr-per-card cards (lambda (v s) (format "| ~A |" s)))
          (pr-per-card cards (lambda (v s) (format "|  ~A|" (left-pad v))))
          (pr-per-card cards (lambda (v s) "'----'"))))))

(define (main args)
  (if (null? args)
      (usage)
      (print-cards args)))