tests/moby-programs/image-equality.rkt
#lang s-exp "../../lang/wescheme.rkt"
(require "../../image/image.rkt")

;; Tests on images.
;;
;; An image can be a circle, star, ns:rectangle, rectangle, triangle, ellipse, line, text, place-image, overlay, underlay

(define a-circle (circle 20 'solid 'green))
(define a-star (star 5 20 30 'solid 'blue))
(define a-nw-rect (nw:rectangle 20 30 'solid 'turquoise))
(define a-rect (rectangle 50 60 'outline 'black))
(define a-triangle (triangle 50 'solid 'magenta))
(define a-line (line 30 40 'red))
(define a-text (text "hello world" 20 "black"))


;; Let's show these at the toplevel to make sure the drawing is working
;; ok
(printf "should be a circle:") a-circle
(printf "should be a star:") a-star
(printf "should be a nw:rectangle:") a-nw-rect
(printf "should be a rectangle:") a-rect
(printf "should be a triangle:") a-triangle
(printf "should be a line:") a-line
(printf "should be a text:") a-text


;; check-fail-contract: (-> void) -> void
;; Make sure we fail with a contract error.
(define (check-fail-contract thunk)
  (with-handlers ([exn:fail:contract? void])
    (thunk)
    (raise (format "failure expected: ~s" thunk))))



;; Now do image comparisons
(printf "running image comparison tests\n")

;; circles
(check-expect (equal? (circle 20 'solid 'green)
                      (circle 20 'solid 'green))
              true)
(check-expect (equal? (circle 20 'solid 'green)
                      (circle 21 'solid 'green))
              false)
(check-expect (equal? (circle 20 'solid 'green)
                      (circle 20 'solid 'blue))
              false)
(check-fail-contract (lambda () (circle 20 "foobar" "green")))
(check-fail-contract (lambda () (circle 20 "outline" "not-a-color")))
(check-fail-contract (lambda () (circle 20 'green 'outline)))
(check-fail-contract (lambda () (circle 'green 'outline 20)))
(check-fail-contract (lambda () (circle)))
(check-fail-contract (lambda () (circle 20)))
(check-fail-contract (lambda () (circle 20 'outline)))
(check-fail-contract (lambda () (circle 20 'outline "black" "too-many-args")))


;; star
(check-expect (equal? (star 20 10 60 'solid 'purple)
                      (star 20 10 60 'solid 'purple))
              true)
(check-expect (equal? (star 20 9 60 'solid 'purple)
                      (star 20 10 60 'solid 'purple))
              false)
(check-expect (equal? (star 20 10 60 'solid 'purple)
                      (star 20 10 49 'solid 'purple))
              false)
(check-expect (equal? (star 20 10 60 'solid 'purple)
                      (star 20 10 60 'outline 'purple))
              false)
(check-expect (equal? (star 20 10 60 'solid 'purple)
                      (star 20 10 60 'solid 'magenta))
              false)
(check-fail-contract (lambda () (star 20 10 60 "foobar" 'green)))
(check-fail-contract (lambda () (star 20 10 60 "outline" 'not-a-color)))
(check-fail-contract (lambda () (star 20 10 60 "green" 'outline)))
(check-fail-contract (lambda () (star 10 60 "green" 'outline 20)))
(check-fail-contract (lambda () (star)))
(check-fail-contract (lambda () (star 10)))
(check-fail-contract (lambda () (star 10 60)))
(check-fail-contract (lambda () (star 10 60 50)))
(check-fail-contract (lambda () (star 10 60 50 'outline)))
(check-fail-contract (lambda () (star 10 60 50 'outline 'green 'too-many-args)))
 

;; nw:rect
(check-expect (equal? (nw:rectangle 10 20 'solid 'black)
                      (nw:rectangle 10 20 'solid 'black))
              true)
(check-expect (equal? (nw:rectangle 20 10 'solid 'black)
                      (nw:rectangle 10 20 'solid 'black))
              false)
(check-expect (equal? (nw:rectangle 10 10 'solid 'black)
                      (nw:rectangle 10 20 'solid 'black))
              false)
(check-expect (equal? (nw:rectangle 10 20 'solid 'black)
                      (nw:rectangle 10 20 'outline 'black))
              false)
(check-expect (equal? (nw:rectangle 10 20 'solid 'black)
                      (nw:rectangle 10 20 'outline 'white))
              false)
(check-fail-contract (lambda () (nw:rectangle 10 20 "foobar" 'green)))
(check-fail-contract (lambda () (nw:rectangle 10 20 "outline" 'not-a-color)))
(check-fail-contract (lambda () (nw:rectangle 10 20 'green 'outline)))
(check-fail-contract (lambda () (nw:rectangle 20 'green 'outline 10)))
(check-fail-contract (lambda () (nw:rectangle)))
(check-fail-contract (lambda () (nw:rectangle 10)))
(check-fail-contract (lambda () (nw:rectangle 10 20)))
(check-fail-contract (lambda () (nw:rectangle 10 20 'solid)))
(check-fail-contract 
 (lambda () (nw:rectangle 10 20 'solid 'green 'too-many-args)))


;; rect
(check-expect (equal? (rectangle 10 20 'solid 'black)
                      (rectangle 10 20 'solid 'black))
              true)
(check-expect (equal? (rectangle 20 10 'solid 'black)
                      (rectangle 10 20 'solid 'black))
              false)
(check-expect (equal? (rectangle 10 10 'solid 'black)
                      (rectangle 10 20 'solid 'black))
              false)
(check-expect (equal? (rectangle 10 20 'solid 'black)
                      (rectangle 10 20 'outline 'black))
              false)
(check-expect (equal? (rectangle 10 20 'solid 'black)
                      (rectangle 10 20 'outline 'white))
              false)
(check-fail-contract (lambda () (rectangle 10 20 "foobar" 'green)))
(check-fail-contract (lambda () (rectangle 10 20 "outline" 'not-a-color)))
(check-fail-contract (lambda () (rectangle 10 20 'green 'outline)))
(check-fail-contract (lambda () (rectangle 20 'green 'outline 10)))
(check-fail-contract (lambda () (rectangle)))
(check-fail-contract (lambda () (rectangle 10)))
(check-fail-contract (lambda () (rectangle 10 20)))
(check-fail-contract (lambda () (rectangle 10 20 'solid)))
(check-fail-contract (lambda () (rectangle 10 20 'solid 'green 'too-many-args)))
 
 

;; triangle
(check-expect (equal? (triangle 10 'solid 'green)
                      (triangle 10 'solid 'green))
              true)

(check-expect (equal? (triangle 10 'solid 'green)
                      (triangle 9 'solid 'green))
              false)
(check-expect (equal? (triangle 10 'solid 'green)
                      (triangle 10 'outline 'green))
              false)
(check-expect (equal? (triangle 10 'solid 'green)
                      (triangle 10 'solid 'olive))
              false)
(check-fail-contract (lambda () (triangle 10 'foobar 'green)))
(check-fail-contract (lambda () (triangle 10 'outline 'not-a-color)))
(check-fail-contract (lambda () (triangle 10 'green 'outline)))
(check-fail-contract (lambda () (triangle 'green 'outline 10)))
(check-fail-contract (lambda () (triangle)))
(check-fail-contract (lambda () (triangle 'outline)))
(check-fail-contract (lambda () (triangle 10)))
(check-fail-contract (lambda () (triangle 10 'outline)))
(check-fail-contract (lambda () (triangle 10 'outline 'green 'too-many-args)))


;; line
(check-expect (equal? (line 10 20 'blue)
                      (line 10 20 'blue))
              true)
(check-expect (equal? (line 10 20 'blue)
                      (line 20 10 'blue))
              false)
(check-fail-contract (lambda () (line 10 20 'not-a-color)))
(check-fail-contract (lambda () (line 'not-a-color 20 10)))
(check-fail-contract (lambda () (line)))
(check-fail-contract (lambda () (line 10)))
(check-fail-contract (lambda () (line 10 20)))
(check-fail-contract (lambda () (line 10 20 "black" "too-many-args")))


;; text
(check-expect (equal? (text "hello" 20 'yellow)
                      (text "hello" 20 'yellow))
              true)

(check-expect (equal? (text "hello" 20 'yellow)
                      (text "hi" 20 'yellow))
              false)
(check-fail-contract (lambda () (text "hello")))
(check-fail-contract (lambda () (text "hello" 20)))
(check-fail-contract (lambda () (text "hello" 20 'yellow 'too-many-args)))
(check-fail-contract (lambda () (text 'hi 20 'yellow)))
(check-fail-contract (lambda () (text "hello" 'yellow 20)))


              

;; empty scenes
(check-expect (empty-scene 10 20)
              (empty-scene 10 20))
(check-expect (equal? (empty-scene 10 20)
                      (empty-scene 11 20))
              false)
(check-fail-contract (lambda () (empty-scene 'one 'two)))
(check-fail-contract (lambda () (empty-scene 10 20 30)))
(check-fail-contract (lambda () (empty-scene 10)))


;; place images
(check-fail-contract (lambda () (place-image)))
(check-fail-contract (lambda () (place-image 10)))
(check-fail-contract (lambda () (place-image (circle 20 'solid 'green))))
(check-fail-contract (lambda () (place-image (circle 20 'solid 'green) 10)))
(check-fail-contract (lambda () (place-image (circle 20 'solid 'green) 10 20)))
(check-fail-contract 
 (lambda () 
   (place-image (circle 20 'solid 'green) 10 20 (empty-scene 3 4) 
                "too-many-args")))
(check-fail-contract 
 (lambda () 
   (place-image 10 20 (circle 20 'solid 'green) (empty-scene 3 4))))


(check-expect (place-image (circle 10 'solid 'green)
                           50
                           50
                           (empty-scene 100 100))
              (place-image (circle 10 'solid 'green)
                           50
                           50
                           (empty-scene 100 100)))
                         
(check-expect (equal? (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100))
                      (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100)))
              true)

(check-expect (equal? (place-image (circle 9 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100))
                      (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100)))
              false)


(check-expect (equal? (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100))
                      (place-image (circle 10 'solid 'green)
                                   40
                                   50
                                   (empty-scene 100 100)))
              false)

(check-expect (equal? (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100))
                      (place-image (circle 10 'solid 'green)
                                   50
                                   40
                                   (empty-scene 100 100)))
              false)

(check-expect (equal? (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 100))
                      (place-image (circle 10 'solid 'green)
                                   50
                                   50
                                   (empty-scene 100 99)))
              false)



;; overlay
(check-fail-contract (lambda () (overlay)))

(check-expect (overlay (rectangle 10 20 'solid 'blue)
                       (circle 20 'solid 'green))
              (overlay (rectangle 10 20 'solid 'blue)
                       (circle 20 'solid 'green)))
(check-expect (equal? (overlay (rectangle 10 20 'solid 'blue)
                               (circle 20 'solid 'green))
                      (overlay (circle 20 'solid 'green)
                               (rectangle 10 20 'solid 'blue)))
              false)



;; underlay
(check-fail-contract (lambda () (underlay)))
(check-expect (underlay (rectangle 10 20 'solid 'blue)
                        (circle 20 'solid 'green))
              (underlay (rectangle 10 20 'solid 'blue)
                        (circle 20 'solid 'green)))
(check-expect (equal? (underlay (rectangle 10 20 'solid 'blue)
                                (circle 20 'solid 'green))
                      (underlay (circle 20 'solid 'green)
                                (rectangle 10 20 'solid 'blue)))
              false)




(printf "ran image comparison tests\n")