#lang racket

(require test-engine/racket-tests)
(require 2htdp/image)

(provide +color 
         green+color
         blue+color
         red+color
         alpha+color 
         <-component
         for/image)

; exact-round : Number -> Number
; Produce exact, rounded x.
(define (exact-round x) (inexact->exact (round x)))
;
(check-expect (exact-round 1.6) 2)

; +color : symbol color value -> color
; Add component intensity val to col
(define (+color component val col)
  (color
   (if (eq? component 'red) (exact-round val) (color-red col))
   (if (eq? component 'green) (exact-round val) (color-green col))
   (if (eq? component 'blue) (exact-round val) (color-blue col))
   (if (eq? component 'alpha) (exact-round val) (color-alpha col))))
;
(check-expect (+color 'green 5 (color 1 2 3)) (color 1 5 3))

; <-component : symbol color -> color
; Produce component band of old
(define (<-component band old)
  ((cond
     [(equal? band 'red) color-red]
     [(equal? band 'green) color-green]
     [(equal? band 'blue) color-blue]
     [(equal? band 'alpha) color-alpha])
   old))
;
(check-expect (<-component 'blue (color 1 2 3 4)) 3)

; green+color : color value -> color
; Add green intensity val to col.
(define (green+color val col) (+color 'green val col))
;
(check-expect (green+color 10 (color 1 2 3 4)) (color 1 10 3 4))

; red+color : color value -> color
; Add red intensity val to col.
(define (red+color val col) (+color 'red val col))
;
(check-expect (red+color 10 (color 1 2 3 4)) (color 10 2 3 4))

; blue+color : color value -> color
; Add blue intensity val to col.
(define (blue+color val col) (+color 'blue val col))
;
(check-expect (blue+color 10 (color 1 2 3 4)) (color 1 2 10 4))

; alpha+color : color value -> color
; Add alpha intensity val to col.
(define (alpha+color val col) (+color 'alpha val col))
;
(check-expect (alpha+color 10 (color 1 2 3 4)) (color 1 2 3 10))

; for/image : ((id Image) ...+) expr -> Image
; Apply expr to bindings of ids to Image colors
; to produce a new image.
(define-syntax-rule
  (for/image ((id0 expr0) (id expr) ...)
             color-expr0 color-expr ...)
  (color-list->bitmap
   (for/list ([id0 (image->color-list expr0)]
              [id (image->color-list expr)] ...)
     color-expr0 color-expr ...)
   (image-width expr0)
   (image-height expr0)))

#;
(test)