#lang racket/base

(require racket/contract
         racket-sprintf
         )

(provide rgba
         hex->rgba
         rgba->hex
         rgba?
         rgba-blue
         rgba-red
         rgba-green
         rgba-alpha
         rgba-blue!
         rgba-red!
         rgba-green!
         rgba-alpha!
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data structures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-struct rgba*
  ([red #:mutable] [green #:mutable] [blue #:mutable] [alpha #:mutable])
  #:transparent
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (between-0-255? x)
  (and (integer? x)
       (>= x 0)
       (<= x 255)))


(define (optional-between-0-255? x)
  (write x)
  (newline)
  (or (null? x)
      (and (= (length x) 1)
           (between-0-255? (car x)))))

(define (hex2->int str)
  (let ((s (string-downcase str))
        (sub (- (char->integer #\a) 10))
        (subnum (char->integer #\0)))
    (let ((ac (string-ref s 0))
          (bc (string-ref s 1)))
      (let ((a (- (char->integer ac) (if (char>=? ac #\a) sub subnum)))
            (b (- (char->integer bc) (if (char>=? bc #\a) sub subnum))))
        (+ (* a 16) b)))))

(define (hex-color? c)
  (let ((re #px"[#]?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})?"))
    (let ((m (regexp-match re c)))
      (not (eq? m #f)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (rgba? c)
  (rgba*? c))

(define/contract (rgba r g b . a)
  (->* (between-0-255? between-0-255? between-0-255?) (between-0-255?) rgba?)
  (make-rgba* r g b (if (null? a) 255 (car a)))
  )

(define/contract (hex->rgba h)
  (-> hex-color? rgba?)
  (let ((re #px"[#]?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})?"))
    (let ((m (regexp-match re h)))
      (if (eq? m #f)
          (error "Not a CSS hex color string")
          (rgba (hex2->int (list-ref m 1))
                (hex2->int (list-ref m 2))
                (hex2->int (list-ref m 3))
                (if (eq? (list-ref m 4) #f)
                    255
                    (hex2->int (list-ref m 4))))))))

(define/contract (rgba->hex c)
  (-> rgba? string?)
  (string-append 
      (sprintf "#%02x%02x%02x" (rgba-red c) (rgba-green c) (rgba-blue c))
      (if (= (rgba-alpha c) 255)
          ""
          (sprintf "%02x" (rgba-alpha c)))))


(define/contract (rgba-red! c r)
  (-> rgba? between-0-255? rgba?)
  (set-rgba*-red! c r))

(define/contract (rgba-green! c g)
  (-> rgba? between-0-255? rgba?)
  (set-rgba*-green! c g))

(define/contract (rgba-blue! c b)
  (-> rgba? between-0-255? rgba?)
  (set-rgba*-blue! c b))

(define/contract (rgba-alpha! c a)
  (-> rgba? between-0-255? rgba?)
  (set-rgba*-alpha! c a))

(define/contract (rgba-red c)
  (-> rgba? between-0-255?)
  (rgba*-red c))

(define/contract (rgba-green c)
  (-> rgba? between-0-255?)
  (rgba*-green c))

(define/contract (rgba-blue c)
  (-> rgba? between-0-255?)
  (rgba*-blue c))

(define/contract (rgba-alpha c)
  (-> rgba? between-0-255?)
  (rgba*-alpha c))