;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-beginner-reader.ss" "lang")((modname map-image-bsl-tests) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require picturing-programs)

; Test cases for primitives:
(check-expect (real->int 3.2) 3)
(check-expect (real->int 3.7) 4)
(check-expect (real->int 3.5) 4)
(check-expect (real->int 2.5) 2)
(check-expect (real->int #i3.2) 3)
(check-expect (real->int #i3.7) 4)
(check-expect (real->int #i3.5) 4)
(check-expect (real->int #i2.5) 2)

;(check-expect (maybe-color? (make-color 3 4 5)) true)
;(check-expect (maybe-color? (make-color 3 4 5 6)) true)
;(check-expect (maybe-color? false) true)
;(check-expect (maybe-color? true) false)
;(check-expect (maybe-color? (make-posn 3 4)) false)
;(check-expect (maybe-color? "red") false)

(check-expect (name->color "white") (make-color 255 255 255))
(check-expect (name->color "black") (make-color 0 0 0))
(check-expect (name->color "blue") (make-color 0 0 255))
(check-expect (name->color "plaid") false)
(check-error (name->color 7) "name->color: Expected a string or symbol, but received 7")

(check-expect (color=? (make-color 5 10 15) (make-color 5 10 15)) true)
(check-expect (color=? (make-color 5 10 15) (make-color 5 15 10)) false)
(check-expect (color=? (make-color 255 255 255) "white") true)
(check-expect (color=? (make-color 255 255 255) "blue") false)
(check-expect (color=? "forest green" 'forestgreen) true)
(check-expect (color=? "forest green" 'lightblue) false)
(check-expect (color=? (make-color 5 10 15 20) (make-color 5 10 15)) false)
(check-expect (color=? (make-color 5 10 15 255) (make-color 5 10 15)) true)
(check-expect (color=? (make-color 5 10 15 0) false) true)
(check-expect (color=? (make-color 5 10 15 20) false) false)
(check-error (color=? "white" 3) "colorize: Expected a color, but received 3")
(check-error (color=? "plaid" "white") "color=?: Expected a color or color name as first argument, but received \"plaid\"")
(check-error (color=? "white" "plaid") "color=?: Expected a color or color name as second argument, but received \"plaid\"")

; Test cases for map3-image:
;(check-error (map3-image 5 + + pic:bloch)
;             "map3-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
; Actually, the above is caught by Check Syntax, before map3-image has a chance to check anything.
(check-error (map3-image sqrt + + pic:bloch)
             "map3-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
;(check-error (map3-image + 5 + pic:bloch)
;             "map3-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument")
(check-error (map3-image + sqrt + pic:bloch)
             "map3-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument")
;(check-error (map3-image + + 5 pic:bloch)
;             "map3-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument")
(check-error (map3-image + + sqrt pic:bloch)
             "map3-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument")
(check-error (map3-image + + + 5)
             "map3-image: Expected an image as fourth argument, but received 5")

; red-id : x y r g b -> num
(define (red-id x y r g b) r)
; green-id : x y r g b -> num
(define (green-id x y r g b) g)
; blue-id : x y r g b -> num
(define (blue-id x y r g b) b)
; zero-5-args : x y r g b -> num
(define (zero-5-args x y r g b) 0)

(define tri (triangle 60 "solid" "orange"))
(define hieroglyphics pic:hieroglyphics)
(define scheme-logo pic:scheme-logo)
(define bloch pic:bloch)

"Test cases for map3-image:"
"tri:" tri
"(map3-image red-id green-id blue-id tri) should be tri:"
(map3-image red-id green-id blue-id tri)
"(map3-image zero-5-args green-id blue-id tri) should be a green triangle:"
(map3-image zero-5-args green-id blue-id tri)

"(map3-image zero-5-args green-id blue-id bloch) should be a de-redded Steve Bloch:"
(map3-image zero-5-args green-id blue-id bloch)

; x-gradient-5 : x y r g b -> num
(define (x-gradient-5 x y r g b) (min 255 (* 4 x)))
; y-gradient-5 : x y r g b -> num
(define (y-gradient-5 x y r g b) (min 255 (* 4 y)))
"(map3-image zero-5-args x-gradient-5 y-gradient-5 tri) should be a triangular window on a 2-dimensional color gradient:"
(map3-image zero-5-args x-gradient-5 y-gradient-5 tri)
"The same thing with some red:"
(map3-image red-id x-gradient-5 y-gradient-5 tri)
"And now let's try it on bloch.  Should get a rectangular 2-dimensional color gradient, no bloch:"
(map3-image zero-5-args x-gradient-5 y-gradient-5 bloch)
"The same thing preserving the red:"
(map3-image red-id x-gradient-5 y-gradient-5 bloch)
"Rotating colors r->g->b->r:"
(map3-image blue-id red-id green-id bloch)

"Test cases for map4-image:"
;(check-error (map4-image 5 + + + pic:bloch)
;             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
(check-error (map4-image sqrt + + + pic:bloch)
             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(r) as first argument")
;(check-error (map4-image + 5 + + pic:bloch)
;             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second argument")
(check-error (map4-image + sqrt + + pic:bloch)
             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second argument")
;(check-error (map4-image + + 5 + pic:bloch)
;             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument")
(check-error (map4-image + + sqrt + pic:bloch)
             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument")
;(check-error (map4-image + + + 5 pic:bloch)
;             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(a) as fourth argument")
(check-error (map4-image + + + sqrt pic:bloch)
             "map4-image: Expected a function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as fourth argument")
(check-error (map4-image + + + + 5)
             "map4-image: Expected an image as fifth argument, but received 5")
; red-id6 : x y r g b a -> num
(define (red-id6 x y r g b a) r)
; green-id6 : x y r g b a -> num
(define (green-id6 x y r g b a) g)
; blue-id6 : x y r g b a -> num
(define (blue-id6 x y r g b a) b)
; alpha-id6 : x y r g b a -> num
(define (alpha-id6 x y r g b a) a)
; zero-6-args : x y r g b a -> num
(define (zero-6-args x y r g b a) 0)
; 

"(map4-image red-id6 green-id6 blue-id6 alpha-id6 tri) should be tri:"
(map4-image red-id6 green-id6 blue-id6 alpha-id6 tri)
"(map4-image zero-6-args green-id6 blue-id6 alpha-id6 tri) should be a green triangle:"
(map4-image zero-6-args green-id6 blue-id6 alpha-id6 tri)

"(map4-image zero-6-args green-id6 blue-id6 alpha-id6 bloch) should be a de-redded Steve Bloch:"
(map4-image zero-6-args green-id6 blue-id6 alpha-id6 bloch)

(define bluebox (rectangle 100 100 "solid" "light blue"))
; x-gradient-6 : x y r g b a -> num
(define (x-gradient-6 x y r g b a) (min 255 (* 4 x)))
; y-gradient-6 : x y r g b a -> num
(define (y-gradient-6 x y r g b a) (min 255 (* 4 y)))
"(map4-image zero-6-args x-gradient-6 y-gradient-6 alpha-id6 tri) should be a triangular window on a 2-dimensional color gradient, light blue background:"
(overlay (map4-image zero-6-args x-gradient-6 y-gradient-6 alpha-id6 tri) bluebox)
"(map4-image red-id green-id blue-id x-gradient-6 tri) should be a triangle with a 1-dimensional alpha gradient:"
(overlay (map4-image red-id6 green-id6 blue-id6 x-gradient-6 tri) bluebox)

"Same thing on bloch:"
(overlay (map4-image red-id6 green-id6 blue-id6 x-gradient-6 bloch) bluebox)

; Test cases for map-image:
;(check-error (map-image 5 pic:bloch)
;             "map-image: Expected a function with contract num(x) num(y) color -> color as first argument")
(check-error (map-image make-posn pic:bloch)
             "map-image: Expected a function of one or three parameters as first argument")
(check-error (map-image + 5)
             "map-image: Expected an image as second argument, but received 5")

; color-id : x y color -> color
(define (color-id x y c)
  c)

; kill-red : x y color -> color
(define (kill-red x y c)
  (make-color 0 (color-green c) (color-blue c)))
(define (kill-red-preserving-alpha x y c)
  (make-color 0 (color-green c) (color-blue c) (color-alpha c)))
(define (kill-red-without-xy c)
  (make-color 0 (color-green c) (color-blue c) (color-alpha c)))

; make-gradient : x y color -> color
(define (make-gradient x y c)
  (make-color 0 (min (* 4 x) 255) (min (* 4 y) 255)))

"tri:" tri
"(map-image color-id tri):" 
(define ex1 (map-image color-id tri)) ex1
"(map-image kill-red tri): should be green, on an opaque background with no red" 
(define ex2 (map-image kill-red tri)) ex2
"(map-image kill-red-preserving-alpha tri):"
(define ex2prime (map-image kill-red-preserving-alpha tri)) ex2prime
"(map-image kill-red-ignoring-xy tri):"
(define ex2again (map-image kill-red-without-xy tri)) ex2again
"(map-image make-gradient tri):"
(define ex3 (map-image make-gradient tri)) ex3
"(map-image kill-red hieroglyphics): should be on an opaque background with no red"
(define ex4 (map-image kill-red hieroglyphics)) ex4
"(map-image kill-red scheme-logo):"
(define ex5 (map-image kill-red scheme-logo)) ex5
"(map-image kill-red bloch):"
(define ex6 (map-image kill-red bloch)) ex6
"(map-image kill-red-without-xy bloch) (should look the same):"
(define ex7 (map-image kill-red-without-xy bloch)) ex7

(define (return-5 x y c) 5)

(check-error (map-image return-5 bloch) "colorize: Expected a color, but received 5")

"Test cases for build3-image:"
(define (x-gradient-2 x y) (min 255 (* 4 x)))
(define (y-gradient-2 x y) (min 255 (* 4 y)))
(define (zero-2-args x y) 0)
"(build3-image 60 40 zero-2-args x-gradient-2 y-gradient-2) should be a 60x40 rectangle with no red, green increasing from left to right, and blue increasing from top to bottom:"
(build3-image 60 40 zero-2-args x-gradient-2 y-gradient-2)
(check-error (build3-image "hello" true sqrt sqrt sqrt)
             "build3-image: Expected a natural number as first argument, but received \"hello\"")
(check-error (build3-image 17 true sqrt sqrt sqrt)
             "build3-image: Expected a natural number as second argument, but received true")
(check-error (build3-image 17 24 sqrt sqrt sqrt)
             "build3-image: Expected a function with contract num(x) num(y) -> color as third argument")
(check-error (build3-image 17 24 x-gradient-2 sqrt sqrt)
             "build3-image: Expected a function with contract num(x) num(y) -> color as fourth argument")
(check-error (build3-image 17 24 x-gradient-2 y-gradient-2 sqrt)
             "build3-image: Expected a function with contract num(x) num(y) -> color as fifth argument")

(define (return-minus-5 x y) -5)
(check-error (build3-image 17 24 x-gradient-2 y-gradient-2 return-minus-5)
             "make-color: expects an integer between 0 and 255 as third argument, given -5")

"Test cases for build4-image:"
"(build4-image 50 50 x-gradient-2 x-gradient-2 zero-2-args y-gradient-2) should be a square, increasingly yellow from left to right and increasingly alpha from top to bottom.  On a blue background."
(overlay (build4-image 50 50 x-gradient-2 x-gradient-2 zero-2-args y-gradient-2) bluebox)

"Test cases for build-image:"
(define (always-red x y) (name->color "red"))
"(build-image 50 35 (lambda (x y) red)):"
(build-image 50 35 always-red)
"should be a 50x35 red rectangle"
(define (a-gradient x y) (make-color (real->int (* x 2.5))
                                     (real->int (* y 2.5))
                                     0))
"(build-image 100 100 (lambda (x y) (make-color (* x 2.5) (* y 2.5) 0))):"
(build-image 100 100 a-gradient)
"should be a 100x100 square with a color gradient increasing in red from left to right, and in green from top to bottom"
(check-error (build-image 3.2 100 a-gradient) "build-image: Expected a natural number as first argument, but received 3.2")
(check-error (build-image 100 -2 a-gradient) "build-image: Expected a natural number as second argument, but received -2")
(check-error (build-image 100 100 sqrt) "build-image: Expected a function with contract num(x) num(y) -> color as third argument")



(define (other-bloch-pixel x y)
  (get-pixel-color x (- (image-height bloch) y 1) bloch))
"(build-image (image-width bloch) (image-height bloch) other-bloch-pixel): should be flipped vertically"
(build-image (image-width bloch) (image-height bloch) other-bloch-pixel)

(define (other-pixel x y pic)
  (get-pixel-color x (- (image-height pic) y 1) pic))
(define (my-flip pic)
  (build-image/extra (image-width pic) (image-height pic) other-pixel pic))

"(my-flip pic:hieroglyphics):"
(my-flip pic:hieroglyphics)


(define RADIUS 3)

(define (clip-to n low high)
  (min (max n low) high))
(check-expect (clip-to 10 5 15) 10)
(check-expect (clip-to 10 15 20) 15)
(check-expect (clip-to 10 -20 7) 7)

(define (near-bloch-pixel x y)
  (get-pixel-color
   (clip-to (+ x (- RADIUS) (random (+ 1 RADIUS RADIUS))) 0 (sub1 (image-width bloch)))
   (clip-to (+ y (- RADIUS) (random (+ 1 RADIUS RADIUS))) 0 (sub1 (image-height bloch)))
   bloch))

"fuzzy bloch, radius=3, not adjusting size of image:"
(define fuzzy-bloch
  (build-image (image-width bloch) (image-height bloch) near-bloch-pixel))
fuzzy-bloch

(define (near-tri-mpixel x y)
  (get-pixel-color
   (clip-to (+ x (- RADIUS) (random (+ 1 RADIUS RADIUS)))
            0 (+ RADIUS RADIUS -1 (image-width tri)))
   (clip-to (+ y (- RADIUS) (random (+ 1 RADIUS RADIUS)))
            0 (+ RADIUS RADIUS -1 (image-height tri)))
   tri)
  )
(define fuzzy-tri
  (build-image (+ RADIUS RADIUS (image-width tri))
               (+ RADIUS RADIUS (image-height tri))
               near-tri-mpixel))
"fuzzy triangle, radius=3, adjusting size of image to allow fuzz on all sides:"
fuzzy-tri

; Convert all white pixels to transparent
(define (white-pixel->trans old-color)
  (if (> (+ (color-red old-color) (color-green old-color) (color-blue old-color))
         750)
      false
      old-color))
(define (white->trans pic)
  (map-image
   white-pixel->trans
   pic))

"(overlay (white->trans hieroglyphics) (rectangle 100 100 'solid 'blue)):"
(define hier (white->trans hieroglyphics))
(overlay hier (rectangle 100 100 "solid" "blue"))

; pixel->gray : x y color -> color
(check-expect (pixel->gray (make-color 0 0 0)) (make-color 0 0 0))
(check-expect (pixel->gray (make-color 50 100 150)) (make-color 100 100 100))
(define (pixel->gray c)
  (make-gray (quotient (+ (color-red c)
                          (color-green c) 
                          (color-blue c))
                       3)
             (color-alpha c)))
                                   
; make-gray : natural(value) natural(alpha) -> color
(define (make-gray value alpha)
  (make-color value value value alpha))

; color->gray : image -> image
(define (color->gray pic)
  (map-image pixel->gray pic))

"(color->gray bloch):"
(color->gray bloch)
"(overlay (color->gray hieroglyphics) bluebox):"
(overlay (color->gray hieroglyphics) bluebox)
"(overlay (color->gray (white->trans hieroglyphics)) bluebox):"
(overlay (color->gray (white->trans hieroglyphics)) bluebox)

; invert-pixel : x y color -> color
(check-expect (invert-pixel (make-color 0 0 0)) (make-color 255 255 255))
(check-expect (invert-pixel (make-color 50 100 150)) (make-color 205 155 105))
(define (invert-pixel color)
  (make-color (- 255 (color-red color))
              (- 255 (color-green color))
              (- 255 (color-blue color))))

; invert-pic : image -> image
(define (invert-pic pic)
  (map-image invert-pixel pic))

(check-expect (invert-pic (rectangle 30 20 "solid" "red"))
              (rectangle 30 20 "solid" (make-color 0 255 255)))
(invert-pic pic:bloch) "should be Dr. Bloch in photonegative"

; Test cases for map-image/extra and build-image/extra:
; Exercise 27.4.1:

; apply-threshold : number threshold -> number
(check-expect (apply-threshold 100 200) 0)
(check-expect (apply-threshold 100 100) 255)
(check-expect (apply-threshold 100 75) 255)
(define (apply-threshold component threshold)
  (if (< component threshold)
      0
      255))
; simple-new-pixel : color number(threshold) -> color
; Converts color components below threshold to 0, and those >= threshold to 255.
(check-expect (simple-new-pixel  (make-color 50 100 200) 150)
              (make-color 0 0 255))
(check-expect (simple-new-pixel (make-color 50 100 200) 90)
              (make-color 0 255 255))
(define (simple-new-pixel c threshold)
  (make-color (apply-threshold (color-red c) threshold)
              (apply-threshold (color-green c) threshold)
              (apply-threshold (color-blue c) threshold)))
"map-image/extra simple-new-pixel..."
(map-image/extra simple-new-pixel pic:bloch 200)
(map-image/extra simple-new-pixel pic:bloch 150)
(map-image/extra simple-new-pixel pic:bloch 100)


; new-pixel : number(x) number(y) color height -> color
(check-expect (new-pixel 36 100 (make-color 30 60 90) 100)
              (make-color 30 60 255))
(check-expect (new-pixel 58 40 (make-color 30 60 90) 100)
              (make-color 30 60 102))
(define (new-pixel x y c h)
  ; x         number
  ; y         number
  ; c         color
  ; h         number
  (make-color (color-red c)
              (color-green c)
              (real->int (* 255 (/ y h)))))

; apply-blue-gradient : image -> image
(define (apply-blue-gradient pic)
  (map-image/extra new-pixel pic (image-height pic)))

(apply-blue-gradient pic:bloch)
"should be Dr. Bloch with an amount of blue increasing steadily from top to bottom"
(apply-blue-gradient (rectangle 40 60 "solid" "red"))
"should be a rectangle shading from red at the top to purple at the bottom"

; flip-pixel : num(x) num(y) image -> color
(define (flip-pixel x y pic)
   (if (>= x y)
       (get-pixel-color x y pic)
       (get-pixel-color y x pic)))

(define (diag-mirror pic)
   (build-image/extra (image-width pic) (image-width pic) flip-pixel pic))

(diag-mirror pic:bloch)
"should be the upper-right corner of Dr. Bloch's head, mirrored to the lower-left"


; myflip : image -> image
; vertical reflection defined by bitmap operations
(define (myflip pic)
  (build-image/extra (image-width pic) (image-height pic)
                 myflip-helper pic))

; myflip-helper : number(x) number(y) image -> color
(check-expect (myflip-helper 10 2 tri) (name->color "orange"))
(check-expect (myflip-helper 10 49 tri) (make-color 255 255 255 0)) ; Why it's a transparent white
; rather than a transparent black, I don't know....
(check-expect (myflip-helper 30 2 tri) (name->color "orange"))
(check-expect (myflip-helper 30 49 tri) (name->color "orange"))
(define (myflip-helper x y pic)
  (get-pixel-color x (- (image-height pic) y 1) pic))

(check-expect (myflip pic:bloch) (flip-vertical pic:bloch))

; add-red : image number -> image
(define (add-red pic how-much)
  (map-image/extra add-red-helper pic how-much))

; add-red-helper : num(x) num(y) color number -> color
(check-expect (add-red-helper 58 19 (make-color 29 59 89) 40)
              (make-color 69 59 89))
(check-expect (add-red-helper 214 3 (make-color 250 200 150 100) 30)
              (make-color 255 200 150 100))
(define (add-red-helper x y c how-much)
  (make-color (min 255 (+ how-much (color-red c)))
              (color-green c)
              (color-blue c)
              (color-alpha c)))

(define red-bloch (add-red pic:bloch 50))
(check-expect (get-pixel-color 30 20 red-bloch)
              (make-color 133 56 35))
(check-expect (get-pixel-color 30 50 red-bloch)
              (make-color 255 173 149))

; clip-color : color number -> color
(check-expect (clip-color (make-color 30 60 90) 100)
              (make-color 30 60 90))
(check-expect (clip-color (make-color 30 60 90) 50)
              (make-color 30 50 50))
(define (clip-color c limit)
    (make-color (min limit (color-red c))
                (min limit (color-green c))
                (min limit (color-blue c))))
 
; clip-picture-colors : number(limit) image -> image
(define (clip-picture-colors limit pic)
    (map-image/extra clip-color pic limit))

pic:bloch
"clip-picture-colors..."
(clip-picture-colors 240 pic:bloch)
(clip-picture-colors 200 pic:bloch)
(clip-picture-colors 150 pic:bloch)
(clip-picture-colors 100 pic:bloch)
; another-white : color number -> number
(define (another-white c old)
  (+ old (if (color=? c "white") 1 0)))
; count-white-pixels : image -> number
(define (count-white-pixels pic)
  (fold-image another-white 0 pic))
(check-expect (count-white-pixels (rectangle 15 10 "solid" "blue")) 0)
(check-expect (count-white-pixels (rectangle 15 10 "solid" "white")) 150)

; another-color : color number color -> number
(define (another-color c old color-to-count)
  (+ old (if (color=? c color-to-count) 1 0)))
; count-colored-pixels : image color -> number
(define (count-colored-pixels pic color-to-count)
  (fold-image/extra another-color 0 pic color-to-count))
(check-expect (count-colored-pixels (rectangle 15 10 "solid" "blue") "blue") 150)
(check-expect (count-colored-pixels (overlay (rectangle 5 10 "solid" "blue") (ellipse 15 30 "solid" "green"))
                                    "blue")
              50)
(check-expect (count-colored-pixels (overlay (rectangle 5 10 "solid" "blue") (ellipse 20 30 "solid" "green"))
                                    "blue")
              40) ; because the overlaid rectangle is offset by half a pixel, so the top and bottom rows aren't "blue"

(define-struct rgba (red green blue alpha))
; like "color" but without bounds-checking
; accumulate-color : color rgba -> rgba
(define (accumulate-color c old)
  (make-rgba (+ (color-red c) (rgba-red old))
             (+ (color-green c) (rgba-green old))
             (+ (color-blue c) (rgba-blue old))
             (+ (color-alpha c) (rgba-alpha old))))

; scale-rgba : number rgba -> rgba
(define (scale-rgba factor old)
  (make-rgba (* factor (rgba-red old))
             (* factor (rgba-green old))
             (* factor (rgba-blue old))
             (* factor (rgba-alpha old))))

; average-color : image -> rgba
(define (average-color pic)
  (scale-rgba (/ 1 (* (image-width pic) (image-height pic)))
              (fold-image accumulate-color (make-rgba 0 0 0 0) pic)))
(check-expect (average-color (rectangle 5 10 "solid" "blue"))
              (make-rgba 0 0 255 255))
(check-expect (average-color (overlay (rectangle 5 10 "solid" "blue")
                                      (rectangle 25 10 "solid" "black")))
              (make-rgba 0 0 51 255))