sections/delta-color.rkt
#lang racket

;; Module In
(require racket/draw  ; color%
         plot/utils   ; vector calculus
         )

;;;
;;; Delta Color: Color Distance Arithmetic
;;;
;; Rationale: Colors are abstract concepts in the first place which
;; we can't calculate with. Color distances are easy to define even
;; for abstract unknown color spaces. The current definition is:
;;
;;  If delta is the difference between color 2 and color 1, then
;;   you get color 2 by adding the delta to color 1.
;;
;;  If you divide delta by n and add delta n times to color 1 you
;;   will get n color steps representing a smooth gradient from color
;;   1 to color 2.
;;
;; Everything else is currently undefined. This Color Distance
;; Arithmetic is currently only implemented for the usual virtual
;; interval integer RGB color space (RGB24 or hardware color
;; space). Color Deltas are vectors of exact numbers. For this you can
;; calculate with endless (memory limited) precision between the color
;; points in the color space.
;;
;; Domain Entry and Exit:
;;
;;    hardware-color - hardware-color -> color-delta
;;    color + color-delta -> hardware-color
;;    color - color-delta -> hardware-color


;; RGB Delta: Color Distance in our virtual RGB color space
;; The red, green and blue methods return byte data but we
;; use them as exact integers to allow further computation.
(define (rgb-delta rgb-1 rgb-2)
  (vector (- (send rgb-1 red)   (send rgb-2 red))
          (- (send rgb-1 green) (send rgb-2 green))
          (- (send rgb-1 blue)  (send rgb-2 blue)) ))

(define (delta? a)
  (and (vector? a)
       (= (vector-length a) 3)))
(define (red delta) (vector-ref delta 0))
(define (green delta) (vector-ref delta 1))
(define (blue delta) (vector-ref delta 2))

(define (exact->byte a)
  (if [and [<= a 255] [>= a 0]]
      (round a)
      (error "Delta Color: exact->byte: out of color space error: " a) ))

(define (make-rgb r g b)
  (make-color (exact->byte r)
              (exact->byte g)
              (exact->byte b)))

;; RGB Delta Plus: Domain Exit
(define (rgb-delta-plus rgb delta)
  (make-rgb (+ (send rgb red)   (red delta))
            (+ (send rgb green) (green delta))
            (+ (send rgb blue)  (blue delta))))

;; RGB Delta Minus: Domain Exit
(define (rgb-delta-minus rgb delta)
  (make-rgb (- (send rgb red) (red delta))
            (- (send rgb green) (green delta))
            (- (send rgb blue) (blue delta))))


(define (color? a) (is-a? a color%))

(define (subtract a b)
  (cond ([and (color? a) (color? b)] (rgb-delta a b))
        ([and (color? a) (delta? b)] (rgb-delta-minus a b))
        ([and (delta? a) (delta? b)] (v- a b))
        (else
         (error "Delta Color: subtract: out of domain error"))))

(define divide v/)
(define multiply v*)
(define (add a b)
  (cond ([and (delta? a) (delta? b)] (v+ a b)) ; intra-domain
        ([and (delta? a) (color? b)] ; domain exit
         (rgb-delta-plus b a))
        ([and (color? a) (delta? b)]
         (rgb-delta-plus a b))
        (else
         (error "Delta Color: add: out of domain error"))))


;; Module Out
(provide add subtract multiply divide ; suggested prefix-in: deco
         delta?)