#!/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)))