#lang racket/base
#|
;; snippet of code for experimentation
#lang racket/gui
(require 2htdp/image
         lang/posn
         (only-in lang/htdp-advanced equal~?))

(define images
  (list (rhombus 10 90 'solid 'black)
        (rotate 45 (square 10 'solid 'black))))

(define t (new text%))
(define f (new frame% [label ""] [width 600] [height 400]))
(define ec (new editor-canvas% [parent f] [editor t]))
(for ((i (in-list images))) (send t insert i) (send t insert " "))
(send f show #t)
|#

(require "../image.ss"
         (only-in "../../mrlib/image-core.ss" 
                  image%
                  make-image
                  image-shape
                  image-bb
                  image-normalized?
                  skip-image-equality-fast-path
                  make-overlay
                  make-translate
                  make-bb
                  normalize-shape
                  make-ellipse
                  make-polygon
                  make-point
                  make-crop
                  crop?
                  normalized-shape?
                  image-snip->image
                  to-img)
         (only-in "../private/image-more.ss" 
                  bring-between
                  swizzle)
         ; "../private/img-err.ss"
         "../../mrlib/private/image-core-bitmap.ss"
         lang/posn
         racket/math
         racket/class
         racket/file
         racket/gui/base
         rackunit
         (prefix-in 1: htdp/image)
         (only-in lang/htdp-advanced equal~?))

(require (for-syntax racket/base))
(define-syntax (test stx)
  (syntax-case stx ()
    [(test a => b)
     (with-syntax ([check-equal? (datum->syntax #'here 'check-equal? stx)])
       #`(begin
           ;(printf "running line ~a\n" #,(syntax-line stx))
           #,(quasisyntax/loc stx (check-equal? a b))
           (parameterize ([skip-image-equality-fast-path #t])
             #,(quasisyntax/loc stx (check-equal? a b)))))]))

(define-syntax (test/exn stx)
  (syntax-case stx ()
    [(test/exn a => b)
     (with-syntax ([check-equal? (datum->syntax #'here 'check-equal? stx)])
       #`(let ([reg b])
           (unless (regexp? reg)
             (error 'test/exn "expected a regular expression, got ~e" reg))
           ;(printf "running line ~a\n" #,(syntax-line stx))
           #,(quasisyntax/loc stx (check-regexp-match 
                                   reg
                                   (with-handlers ((exn:fail? exn-message)) a "NO EXN!")))))]))

;; test case: (beside (text "a"...) (text "b" ...)) vs (text "ab")

;(show-image (frame (rotate 30 (ellipse 200 400 'solid 'purple))))

(define-simple-check (check-close a b)
  (and (number? a)
       (number? b)
       (< (abs (- a b)) 0.001)))

(define-syntax-rule 
  (round-numbers e)
  (call-with-values (λ () e) round-numbers/values))

(define (round-numbers/values . args) (apply values (round-numbers/proc args)))

(define (round-numbers/proc x)
  (let loop ([x x])
    (cond
      [(number? x) (let ([n (exact->inexact (/ (round (* 100. x)) 100))])
                     (if (equal? n -0.0)
                         0.0
                         n))]
      [(pair? x) (cons (loop (car x)) (loop (cdr x)))]
      [(vector? x) (apply vector (map loop (vector->list x)))]
      [(is-a? x image%)
       (make-image 
        (loop (image-shape x))
        (loop (image-bb x))
        (loop (image-normalized? x)))]
      [(object? x)
       ;; add a random number here to hack around the way Eli's tester treats two errors as a passing test
       (error 'round-numbers/proc "cannot handle objects ~a" (random))]
      [(let-values ([(a b) (struct-info x)]) a)
       =>
       (λ (struct-type)
         (apply
          (struct-type-make-constructor struct-type)
          (map loop (cdr (vector->list (struct->vector x))))))]
      [else x])))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; circle vs ellipse
;;

(test (ellipse 40 40 'outline 'black)
      =>
      (circle 20 'outline 'black))
(test (ellipse 60 60 'solid 'red)
      =>
      (circle 30 'solid 'red))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; width and height
;;

(test (image-width (rectangle 10 20 'solid 'blue))
      =>
      10)
(test (image-height (rectangle 10 20 'solid 'blue))
      =>
      20)
(test (image-width (rectangle 0 100 'solid 'blue))
      =>
      0)
(test (image-height (rectangle 0 100 'solid 'blue))
      =>
      100)
(test (image-width (rectangle 100 0 'solid 'blue))
      =>
      100)
(test (image-height (rectangle 100 0 'solid 'blue))
      =>
      0)

(check-close (image-width (rotate 45 (rectangle 100 0 'solid 'blue)))
             (inexact->exact (ceiling (* (sin (* pi 1/4)) 100))))
(check-close (image-height (rotate 45 (rectangle 100 0 'solid 'blue)))
             (inexact->exact (ceiling (* (sin (* pi 1/4)) 100))))
(check-close (image-width (rotate 45 (rectangle 0 100 'solid 'blue)))
             (inexact->exact (ceiling (* (sin (* pi 1/4)) 100))))
(check-close (image-height (rotate 45 (rectangle 0 100 'solid 'blue)))
             (inexact->exact (ceiling (* (sin (* pi 1/4)) 100))))

(test (image-width (scale 4 (rectangle 10 10 'outline 'black)))
      =>
      40)
(test (image-width (rotate 90 (scale 4 (rectangle 10 10 'outline 'black))))
      =>
      40)

(test (image-width (scale 4 (rectangle 10 10 'solid 'black)))
      =>
      40)
(test (image-width (rotate 90 (scale 4 (rectangle 10 10 'solid 'black))))
      =>
      40)


(test (image-width (ellipse 10 20 'solid 'blue))
      =>
      10)
(test (image-height (ellipse 10 20 'solid 'blue))
      =>
      20)
(test (image-width (ellipse 0 100 'solid 'blue))
      =>
      0)
(test (image-height (ellipse 0 100 'solid 'blue))
      =>
      100)
(test (image-width (ellipse 100 0 'solid 'blue))
      =>
      100)
(test (image-height (ellipse 100 0 'solid 'blue))
      =>
      0)

(test (image-width (rotate 30 (ellipse 100 0 'solid 'blue)))
      =>
      (inexact->exact (ceiling (* (cos (* pi 1/6)) 100))))
(test (image-height (rotate 30 (ellipse 100 0 'solid 'blue)))
      =>
      (inexact->exact (ceiling (* (sin (* pi 1/6)) 100))))
(check-close (image-width (rotate 30 (ellipse 0 100 'solid 'blue)))
             (* (sin (* pi 1/6)) 100))
(check-close (image-height (rotate 30 (ellipse 0 100 'solid 'blue)))
             (ceiling (* (cos (* pi 1/6)) 100)))

;; zero-sized htdp/image images should also work
(test (image-width (1:text "" 18 "blue"))
      =>
      0)
(test (image-height (1:rectangle 10 0 'solid "red"))
      =>
      0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  polygon equality
;;

(test (polygon (list (make-posn 0 0)
                     (make-posn 10 10)
                     (make-posn 10 0))
               "solid" "plum")
      =>
      (polygon (list (make-posn 10 10)
                     (make-posn 10 0)
                     (make-posn 0 0))
               "solid" "plum"))

(test (polygon (list (make-posn 0 0)
                     (make-posn 0 10)
                     (make-posn 10 10)
                     (make-posn 10 0))
               "solid" "plum")
      =>
      (rectangle 10 10 "solid" "plum"))

(test (polygon (list (make-posn 0 0)
                     (make-posn 0 10)
                     (make-posn 10 10)
                     (make-posn 10 0))
               "solid" "plum")
      =>
      (polygon (list (make-posn 0 0)
                     (make-posn 0 10)
                     (make-posn 10 10)
                     (make-posn 10 0)
                     (make-posn 0 0))
               "solid" "plum"))

(test (polygon (list (make-posn 0 0)
                     (make-posn 0 10)
                     (make-posn 10 10)
                     (make-posn 10 0))
               "outline"
               (make-pen "plum" 8 "solid" "round" "round"))
      =>
      (polygon (list (make-posn 0 0)
                     (make-posn 0 10)
                     (make-posn 10 10)
                     (make-posn 10 0)
                     (make-posn 0 0))
               "outline"
               (make-pen "plum" 8 "solid" "round" "round")))

;; make sure equality isn't equating everything
(test (equal? (rectangle 10 10 'solid 'blue)
              (rectangle 10 10 'solid 'red))
      =>
      #f)

;; make sure 'white and black match up with color structs
(test (rectangle 10 10 'solid (make-color 255 255 255))
      =>
      (rectangle 10 10 'solid 'white))
(test (rectangle 10 10 'solid (make-color 0 0 0))
      =>
      (rectangle 10 10 'solid 'black))

;; test zero sized image equalities

(test (rectangle 0 100 'solid 'white)
      =>
      (rectangle 0 100 'solid 'white))

(test (rectangle 0 100 'solid 'white)
      =>
      (rectangle 0 100 'solid 'black))

(test (rectangle 100 0 'solid 'white)
      =>
      (rectangle 100 0 'solid 'black))

(test (rectangle 0 0 'solid 'black)
      =>
      (rectangle 0 0 'solid 'orange))

(test (equal~? (rectangle 0 100 'solid 'white)
               (rotate 90 (rectangle 100 0 'solid 'black))
               .1)
      =>
      #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  testing overlays
;;

(test (overlay (ellipse 100 100 'solid 'blue)
               (ellipse 120 120 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue)))
        (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red))))
       (make-bb 120
                120
                120)
       #f))

(test (overlay/xy (ellipse 100 100 'solid 'blue)
                  -10 -10
                  (ellipse 120 120 'solid 'red))
      =>
      (overlay (ellipse 100 100 'solid 'blue)
               (ellipse 120 120 'solid 'red)))


(test (overlay/xy (ellipse 50 100 'solid 'red)
                  -25 25
                  (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate
         25 0
         (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate
         0 25
         (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100
                100
                100)
       #f))

(test (overlay/xy (ellipse 100 50 'solid 'green)
                  10 10
                  (ellipse 50 100 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 0 0 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 10 10 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100
                110
                110)
       #f))

(test (overlay (ellipse 100 50 'solid 'green)
               (ellipse 50 100 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100
                100
                100)
       #f))

(test (overlay (ellipse 100 100 'solid 'blue)
               (ellipse 120 120 'solid 'red)
               (ellipse 140 140 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 
         10 10
         (make-overlay
          (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue)))
          (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red)))))
        (make-translate 0 0 (image-shape (ellipse 140 140 'solid 'green))))
       (make-bb 140 140 140)
       #f))

(test (overlay/align 'middle
                     'middle
                     (ellipse 100 50 'solid 'green)
                     (ellipse 50 100 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100 100 100)
       #f))

(test (overlay/align 'middle
                     'middle
                     (ellipse 50 100 'solid 'red)
                     (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100 100 100)
       #f))


(test (overlay/align 'right
                     'bottom
                     (ellipse 50 100 'solid 'red)
                     (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 50 (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100 100 100)
       #f))

(test (overlay/align 'right
                     'baseline
                     (ellipse 50 100 'solid 'red)
                     (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 50 (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100 100 100)
       #f))

(test (beside/align 'top
                    (ellipse 50 100 'solid 'red)
                    (ellipse 100 50 'solid 'blue))
      
      =>
      (make-image
       (make-overlay
        (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 50 0 (image-shape (ellipse 100 50 'solid 'blue))))
       (make-bb 150 100 100)
       #f))

(test (beside/align 'center
                    (ellipse 50 100 'solid 'red)
                    (ellipse 100 50 'solid 'blue))
      
      =>
      (make-image
       (make-overlay
        (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 50 25 (image-shape (ellipse 100 50 'solid 'blue))))
       (make-bb 150 100 100)
       #f))

(test (beside/align 'baseline
                    (ellipse 50 100 'solid 'red)
                    (ellipse 100 50 'solid 'blue))
      
      =>
      (make-image
       (make-overlay
        (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 50 50 (image-shape (ellipse 100 50 'solid 'blue))))
       (make-bb 150 100 100)
       #f))

(test (beside (ellipse 50 100 'solid 'red)
              (ellipse 100 50 'solid 'blue))
      =>
      (beside/align 'center
                    (ellipse 50 100 'solid 'red)
                    (ellipse 100 50 'solid 'blue)))

(test (above/align 'left
                   (ellipse 50 100 'solid 'red)
                   (ellipse 100 50 'solid 'blue))
      
      =>
      (make-image
       (make-overlay
        (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 100 (image-shape (ellipse 100 50 'solid 'blue))))
       (make-bb 100 150 150)
       #f))

(test (above/align 'center
                   (ellipse 50 100 'solid 'red)
                   (ellipse 100 50 'solid 'blue))
      
      =>
      (make-image
       (make-overlay
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 100 (image-shape (ellipse 100 50 'solid 'blue))))
       (make-bb 100 150 150)
       #f))

(test (above/align 'right
                   (ellipse 50 100 'solid 'red)
                   (ellipse 100 50 'solid 'blue))
      
      =>
      (make-image
       (make-overlay
        (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 100 (image-shape (ellipse 100 50 'solid 'blue))))
       (make-bb 100 150 150)
       #f))

(test (above (ellipse 50 100 'solid 'red)
             (ellipse 100 50 'solid 'blue))
      =>
      (above/align 'center
                   (ellipse 50 100 'solid 'red)
                   (ellipse 100 50 'solid 'blue)))



(test (underlay (ellipse 100 100 'solid 'blue)
                (ellipse 120 120 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red)))
        (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue))))
       (make-bb 120
                120
                120)
       #f))

(test (underlay/xy (ellipse 100 100 'solid 'blue)
                   -10 -10
                   (ellipse 120 120 'solid 'red))
      =>
      (underlay (ellipse 100 100 'solid 'blue)
                (ellipse 120 120 'solid 'red)))


(test (underlay/xy (ellipse 50 100 'solid 'red)
                   -25 25
                   (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100
                100
                100)
       #f))

(test (underlay/xy (ellipse 100 50 'solid 'green)
                   10 10
                   (ellipse 50 100 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 10 10 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 0 (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100
                110
                110)
       #f))

(test (underlay (ellipse 100 50 'solid 'green)
                (ellipse 50 100 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100
                100
                100)
       #f))

(test (underlay (ellipse 100 100 'solid 'blue)
                (ellipse 120 120 'solid 'red)
                (ellipse 140 140 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 
         0 0
         (make-overlay
          (make-translate 0 0 (image-shape (ellipse 140 140 'solid 'green)))
          (make-translate 10 10 (image-shape (ellipse 120 120 'solid 'red)))))
        (make-translate 10 10 (image-shape (ellipse 100 100 'solid 'blue))))
       (make-bb 140 140 140)
       #f))

(test (underlay/align 'middle
                      'middle
                      (ellipse 100 50 'solid 'green)
                      (ellipse 50 100 'solid 'red))
      =>
      (make-image
       (make-overlay
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green))))
       (make-bb 100 100 100)
       #f))

(test (underlay/align 'middle
                      'middle
                      (ellipse 50 100 'solid 'red)
                      (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100 100 100)
       #f))

(test (underlay/align 'right
                      'bottom
                      (ellipse 50 100 'solid 'red)
                      (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 0 50 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100 100 100)
       #f))

(test (underlay/align "right"
                      "baseline"
                      (ellipse 50 100 'solid 'red)
                      (ellipse 100 50 'solid 'green))
      =>
      (make-image
       (make-overlay
        (make-translate 0 50 (image-shape (ellipse 100 50 'solid 'green)))
        (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red))))
       (make-bb 100 100 100)
       #f))

(test (empty-scene 185 100)
      =>
      (crop 0 0 185 100
            (overlay (rectangle 185 100 'outline (pen "black" 2 'solid 'round 'round))
                     (rectangle 185 100 'solid 'white))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  testing normalization
;;

(test (normalize-shape (image-shape (ellipse 50 100 'solid 'red))
                       values)
      =>
      (make-translate 25 50 (make-ellipse 50 100 0 'solid "red")))

(test (normalize-shape (make-overlay (image-shape (ellipse 50 100 'solid 'red))
                                     (image-shape (ellipse 50 100 'solid 'blue)))
                       values)
      =>
      (make-overlay (image-shape (ellipse 50 100 'solid 'red))
                    (image-shape (ellipse 50 100 'solid 'blue))))

(test (normalize-shape (make-overlay
                        (make-overlay (image-shape (ellipse 50 100 'solid 'red))
                                      (image-shape (ellipse 50 100 'solid 'blue)))
                        (image-shape (ellipse 50 100 'solid 'green)))
                       values)
      =>
      (make-overlay 
       (make-overlay (make-translate 25 50 (make-ellipse 50 100 0 'solid "red"))
                     (make-translate 25 50 (make-ellipse 50 100 0 'solid "blue")))
       (make-translate 25 50 (make-ellipse 50 100 0 'solid "green"))))

(test (normalize-shape (make-overlay
                        (image-shape (ellipse 50 100 'solid 'green))
                        (make-overlay (image-shape (ellipse 50 100 'solid 'red))
                                      (image-shape (ellipse 50 100 'solid 'blue))))
                       values)
      =>
      (make-overlay 
       (make-overlay (make-translate 25 50 (make-ellipse 50 100 0 'solid "green"))
                     (make-translate 25 50 (make-ellipse 50 100 0 'solid "red")))
       (make-translate 25 50 (make-ellipse 50 100 0 'solid "blue"))))

(test (normalize-shape (make-translate 100 100 (image-shape (ellipse 50 100 'solid 'blue)))
                       values)
      =>
      (make-translate 125 150 (make-ellipse 50 100 0 'solid "blue")))

(test (normalize-shape (make-translate 10 20 (make-translate 100 100 (image-shape (ellipse 50 100 'solid 'blue))))
                       values)
      =>
      (make-translate 135 170 (make-ellipse 50 100 0 'solid "blue")))

(test (normalize-shape (image-shape
                        (beside/align 'top
                                      (rectangle 10 10 'solid 'black)
                                      (crop 0 0 5 5 (rectangle 10 10 'solid 'green)))))
      =>
      (make-overlay
       (make-polygon
        (list (make-point 0 0)
              (make-point 10 0)
              (make-point 10 10)
              (make-point 0 10))
        'solid
        "black")
       (make-crop
        (list (make-point 10 0)
              (make-point 15 0)
              (make-point 15 5)
              (make-point 10 5))
        (make-polygon
         (list (make-point 10 0)
               (make-point 20 0)
               (make-point 20 10)
               (make-point 10 10))
         'solid
         "green"))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  testing rotating
;;

(test (bring-between 123 360) => 123)
(test (bring-between 365 360) => 5)
(test (bring-between -5 360) => 355)
(test (bring-between 720 360) => 0)
(test (bring-between 720.5 360) => .5)

(test (equal~? (rotate 90 (rectangle 100 100 'solid 'blue))
               (rectangle 100 100 'solid 'blue)
               .1)
      =>
      #t)

(test (round-numbers
       (normalize-shape (image-shape (rotate 90 (rotate 90 (rectangle 50 100 'solid 'purple))))
                        values))
      =>
      (round-numbers
       (normalize-shape (image-shape (rotate 180 (rectangle 50 100 'solid 'purple)))
                        values)))

(test (round-numbers (normalize-shape (image-shape (rotate 90 (ellipse 10 10 'solid 'red)))))
      =>
      (round-numbers (normalize-shape (image-shape (ellipse 10 10 'solid 'red)))))

(test (round-numbers (normalize-shape (image-shape (rotate 90 (ellipse 10 12 'solid 'red)))))
      =>
      (round-numbers (normalize-shape (image-shape (ellipse 12 10 'solid 'red)))))

(test (round-numbers (normalize-shape (image-shape (rotate 135 (ellipse 10 12 'solid 'red)))))
      =>
      (round-numbers (normalize-shape (image-shape (rotate 45 (ellipse 12 10 'solid 'red))))))

(test (round-numbers (rotate -90 (ellipse 200 400 'solid 'purple)))
      =>
      (round-numbers (rotate 90 (ellipse 200 400 'solid 'purple))))

(test (equal~? (rectangle 100 10 'solid 'red)
               (rotate 90 (rectangle 10 100 'solid 'red))
               0.1)
      =>
      #t)

(test (equal~? (rectangle 100 10 'solid 'red)
               (rotate 90 (rectangle 10.0001 100.0001 'solid 'red))
               0.1)
      =>
      #t)

(test (equal~? (rotate 
                90
                (overlay/xy (rectangle 20 100 'solid 'purple)
                            20 0
                            (ellipse 40 40 'solid 'orange)))
               (overlay/xy (rectangle 100 20 'solid 'purple)
                           0 -40
                           (ellipse 40 40 'solid 'orange))
               .1)
      =>
      #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; scaling tests
;;

(test (scale 2 (rectangle 100 10 'solid 'blue))
      =>
      (rectangle 200 20 'solid 'blue))

(test (scale 3
             (overlay/xy (rectangle 100 10 'solid 'blue)
                         0
                         20
                         (rectangle 100 10 'solid 'red)))
      =>
      (overlay/xy (rectangle 300 30 'solid 'blue)
                  0
                  60
                  (rectangle 300 30 'solid 'red)))

(test (scale 3
             (overlay/xy (rectangle 100 10 'solid 'blue)
                         0
                         20
                         (overlay/xy (rectangle 100 10 'solid 'blue)
                                     0
                                     20
                                     (rectangle 100 10 'solid 'purple))))
      =>
      (overlay/xy (rectangle 300 30 'solid 'blue)
                  0
                  60
                  (overlay/xy (rectangle 300 30 'solid 'blue)
                              0
                              60
                              (rectangle 300 30 'solid 'purple))))

(test (scale/xy 3 4 (ellipse 30 60 'outline 'purple))
      =>
      (ellipse (* 30 3) (* 60 4) 'outline 'purple))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; misc tests
;;

(test (rectangle 100 10 'solid 'blue)
      =>
      (rectangle 100 10 "solid" "blue"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  regular polygon
;;

;; note: the regular-polygon and the rectangle generate the points in reverse directions.
(test (round-numbers (regular-polygon 100 4 'outline 'green))
      =>
      (round-numbers (rectangle 100 100 'outline 'green)))

(test (swizzle (list 0 1 2 3 4) 2)
      =>
      (list 0 2 4 1 3))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  text
;;

(test (beside/align "baseline"
                    (text "a" 18 "black")
                    (text "b" 18 "black"))
      =>
      (text "ab" 18 "black"))

(test (round-numbers
       (image-width (rotate 45 (text "One" 18 'black))))
      =>
      (round-numbers
       (let ([t (text "One" 18 'black)])
         (image-width (rotate 45 (rectangle (image-width t) 
                                            (image-height t)
                                            'solid 'black))))))

(test (text "ab" 18 (make-color 0 0 255))
      =>
      (text "ab" 18 "blue"))

;; make sure this doesn't crash (there was a bug that would be triggered by drawing these guys)
(test (equal? (scale 0.1 (text "Howdy!" 12 'black))
              (scale 0.1 (text "Howdy!" 12 'red)))
      =>
      #f)
      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; triangle
;;

(test (round-numbers (rotate 180 (isosceles-triangle 60 330 "solid" "lightseagreen")))
      =>
      (round-numbers (isosceles-triangle 60 30 "solid" "lightseagreen")))

(test (triangle 40 'outline 'black)
      =>
      (regular-polygon 40 3 'outline 'black))

(test (equal~? (rotate (+ 180 45) (right-triangle 50 50 'solid 'black))
               (isosceles-triangle 50 90 'solid 'black)
               0.001)
      =>
      #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; square
;;

(test (square 10 'solid 'black)
      =>
      (rectangle 10 10 'solid 'black))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; rhombus
;;

(test (equal~? (rhombus 10 90 'solid 'black)
               (rotate 45 (square 10 'solid 'black))
               0.01)
      =>
      #t)

(test (equal~? (rhombus 50 150 'solid 'black)
               (rotate 90 (rhombus 50 30 'solid 'black))
               0.01)
      =>
      #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; lines
;;

(test (image-width (line 10 20 'black))
      =>
      11)
(test (image-height (line 10 20 'black))
      =>
      21)

(test (round-numbers (rotate 90 (line 10 20 'black)))
      =>
      (round-numbers (line 20 -10 'black)))

(test (round-numbers (line 20 30 "red"))
      =>
      (round-numbers (rotate 180 (line 20 30 "red"))))

(test (round-numbers (line -30 20 "red"))
      =>
      (round-numbers (line 30 -20 "red")))

(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             10 10 90 190 "red"))
      =>
      100)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              10 10 90 190 "red"))
      =>
      200)
(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             10 10 200 200 "red"))
      =>
      200)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              10 10 200 200 "red"))
      =>
      200)

(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             10 10 300 300 "red"))
      =>
      300)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              10 10 300 300 "red"))
      =>
      300)

(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             -10 10 100 200 "red"))
      =>
      110)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              -10 10 100 200 "red"))
      =>
      200)

(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             10 -10 100 200 "red"))
      =>
      100)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              10 -10 100 200 "red"))
      =>
      210)

(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             100 200 10 -10 "red"))
      =>
      100)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              100 200 10 -10 "red"))
      =>
      210)

(test (image-width (add-line (rectangle 100 200 'solid 'black)
                             100 200 -10 10 "red"))
      =>
      110)
(test (image-height (add-line (rectangle 100 200 'solid 'black)
                              100 200 -10 10 "red"))
      =>
      200)

(let* ([txt (text "H" 24 'black)]
       [bl (image-baseline txt)])
  (test (image-baseline (add-line txt 0 0 100 100 'red))
        =>
        bl))

(let* ([txt (text "H" 24 'black)]
       [bl (image-baseline txt)])
  (test (image-baseline (add-line txt 0 -10 100 100 'red))
        =>
        (+ bl 10)))

(test (scene+line (rectangle 100 100 'solid 'black)
                  10 10 
                  90 50
                  "red")
      =>
      (add-line (rectangle 100 100 'solid 'black)
                10 10 
                90 50
                "red"))

(test (image-width (scene+line (rectangle 100 100 'solid 'black)
                               -10 -20
                               110 120
                               "green"))
      =>
      100)
(test (image-height (scene+line (rectangle 100 100 'solid 'black)
                               -10 -20
                               110 120
                               'purple))
      =>
      100)
(test (image-baseline (scene+line (rectangle 100 100 'solid 'black)
                                  -10 -20
                                  110 120
                                  'olive))
      =>
      100)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  curves
;;

;; make sure a curve stays roughly in the middle pixels by
;; covering up a white curve with a thin black bar
(test (overlay/align 'middle
                     'middle 
                     (rectangle 82 2 'solid 'black)
                     (add-curve (rectangle 100 20 'solid 'black)
                                10 10 0 1/4
                                90 10 0 1/4 
                                'white))
                      
      =>
      (rectangle 100 20 'solid 'black))

;; and then make sure the curve actually draws something ...
(test (not (equal? (add-curve (rectangle 100 20 'solid 'black)
                              10 10 0 1/4
                              90 10 0 1/4 
                              'white)
                   (rectangle 100 20 'solid 'black)))
      =>
      #t)

(test (scale 2
             (add-curve 
              (rectangle 100 100 'solid 'black)
              20 20 0 1/3 80 80 0 1/3 'white))
      =>
      (add-curve 
       (rectangle 200 200 'solid 'black)
       40 40 0 1/3 160 160 0 1/3 'white))

(test (rotate 
       90
       (add-curve 
        (rectangle 100 100 'solid 'black)
        20 20 0 1/3 80 80 0 1/3 'white))
      =>
      (add-curve 
       (rectangle 100 100 'solid 'black)
       20 80 90 1/3 80 20 90 1/3 'white))

(test (add-curve (rectangle 100 100 'solid 'black)
                 10 10 0 1/4
                 90 90 0 1/4
                 'white)
      =>
      (scene+curve (rectangle 100 100 'solid 'black)
                   10 10 0 1/4
                   90 90 0 1/4
                   'white))
(test (scene+curve (rectangle 100 100 'solid 'black)
                   10 10 0 1/4
                   110 110 0 1/4
                   'red)
      
      =>
      (crop 0 0 100 100
            (add-curve (rectangle 100 100 'solid 'black)
                       10 10 0 1/4
                       110 110 0 1/4
                       'red)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  bitmap tests
;;

(test (clamp-1 0 3 5)
      => 3)
(test (clamp-1 0 0 5)
      => 0)
(test (clamp-1 0 -2 5)
      => 0)
(test (clamp-1 0 4 5)
      => 4)
(test (clamp-1 0 7 5)
      => 4)

(test (build-bytes 5 sqr)
      => (list->bytes '(0 1 4 9 16)))


(define onePixel (list->bytes '(255 0 0 255)))
;(call-with-values (λ () (scale onePixel 1 1 100)) show-bitmap)

(define blue2x1 (list->bytes '(255 0 0 255   255 0 255 0)))
;(call-with-values (λ () (scale blue2x1 2 1 20)) show-bitmap)

(define blue2x2 (list->bytes '(255 0 0 255   255 0 0 255   255 0 0 255   255 0 0 255)))
(define gray2x2 (list->bytes '(255 100 100 100   255 100 100 100   255 100 100 100   255 100 100 100)))
;; Some blue x green checkerboards:
(define checker2x2 (list->bytes '(255 0 0 255   255 0 255 0
                                      255 0 255 0   255 0 0 255)))
(define checker3x3 (list->bytes '(255 0 0 255   255 0 255 0    255 0 0 255
                                      255 0 255 0   255 0 0 255    255 0 255 0
                                      255 0 0 255   255 0 255 0    255 0 0 255 )))


(test (bmbytes-ref/safe checker3x3 3 3 0 0)   => (list->bytes '(255 0 0 255)))
(test (bmbytes-ref/safe checker3x3 3 3 1 1)   => (list->bytes '(255 0 0 255)))
(test (bmbytes-ref/safe checker3x3 3 3 2 2)   => (list->bytes '(255 0 0 255)))
(test (bmbytes-ref/safe checker3x3 3 3 1 2)   => (list->bytes '(255 0 255 0)))
(test (bmbytes-ref/safe checker3x3 3 3 0 3)   => (list->bytes '(  0 0 0 255)))
(test (bmbytes-ref/safe checker3x3 3 3 -1 -1) => (list->bytes '(  0 0 0 255)))
(test (bmbytes-ref/safe checker3x3 3 3 -1 1)  => (list->bytes '(  0 0 255 0)))
(test (bmbytes-ref/safe checker3x3 3 3 1 19)  => (list->bytes '(  0 0 255 0)))

#;
(test (bytes->list (interpolate checker2x2 2 2 1 0))
      =>
      '(255 0 255 0))

#;
(test (bytes->list (interpolate checker3x3 3 3 0 0))
      =>
      '(255 0 0 255))

#;
(test (bytes->list (interpolate checker3x3 3 3 0 1))
      =>
      '(255 0 255 0))

#;
(test (bytes->list (interpolate checker3x3 3 3 0 2))
      =>
      '(255 0 0 255))

#;
(test (bytes->list (interpolate checker3x3 3 3 0.5 0))
      =>
      '(255 0 128 128))

(test (image-width (bitmap icons/stop-16x16.png))
      =>
      16)
(test (image-height (bitmap icons/stop-16x16.png))
      =>
      16)

(test (let ()
        (define bmp (make-object bitmap% 4 4))
        (define mask (make-object bitmap% 4 4))
        (define bdc (make-object bitmap-dc% bmp))
        (send bdc set-brush "black" 'solid)
        (send bdc draw-rectangle 0 0 4 4)
        (send bdc set-bitmap mask)
        (send bdc set-brush "black" 'solid)
        (send bdc clear)
        (send bdc draw-rectangle 1 1 1 1)
        (send bdc set-bitmap #f)
        (let-values ([(bytes w h) (bitmap->bytes bmp mask)])
          bytes))
      =>
      (bytes-append #"\0\0\0\0" #"\0\0\0\0"   #"\0\0\0\0" #"\0\0\0\0"
                    #"\0\0\0\0" #"\377\0\0\0" #"\0\0\0\0" #"\0\0\0\0"
                    #"\0\0\0\0" #"\0\0\0\0"   #"\0\0\0\0" #"\0\0\0\0"
                    #"\0\0\0\0" #"\0\0\0\0"   #"\0\0\0\0" #"\0\0\0\0"))

;; ensure no error
(test (begin (scale 2 (make-object bitmap% 10 10))
             (void))
      =>
      (void))


(define (fill-bitmap b color [x 0] [y 0] [w (send b get-width)] [h (send b get-height)])
  (let ([bdc (make-object bitmap-dc% b)])
    (send bdc set-brush color 'solid)
    (send bdc set-pen color 1 'transparent)
    (send bdc draw-rectangle x y w h)
    (send bdc set-bitmap #f)))

(define blue-10x20-bitmap (make-object bitmap% 10 20))
(fill-bitmap blue-10x20-bitmap "blue")
(define blue-20x10-bitmap (make-object bitmap% 20 10))
(fill-bitmap blue-20x10-bitmap "blue")
(define blue-20x40-bitmap (make-object bitmap% 20 40))
(fill-bitmap blue-20x40-bitmap "blue")

(define green-blue-10x20-bitmap (make-object bitmap% 10 20))
(fill-bitmap green-blue-10x20-bitmap "green")
(fill-bitmap green-blue-10x20-bitmap "blue" 0 0 10 10)

(define green-blue-20x10-bitmap (make-object bitmap% 20 10))
(fill-bitmap green-blue-20x10-bitmap "green")
(fill-bitmap green-blue-20x10-bitmap "blue" 10 0 10 10)

(test (image-width (image-snip->image (make-object image-snip% blue-10x20-bitmap)))
      => 
      10)
(test (image-height (image-snip->image (make-object image-snip% blue-10x20-bitmap)))
      => 
      20)
(test (image-baseline (image-snip->image (make-object image-snip% blue-10x20-bitmap)))
      => 
      20)
(test (scale 2 (make-object image-snip% blue-10x20-bitmap))
      =>
      (image-snip->image (make-object image-snip% blue-20x40-bitmap)))

(test (rotate 90 (make-object image-snip% blue-10x20-bitmap))
      =>
      (image-snip->image (make-object image-snip% blue-20x10-bitmap)))

(test (rotate 90 (make-object image-snip% green-blue-20x10-bitmap))
      =>
      (image-snip->image (make-object image-snip% green-blue-10x20-bitmap)))

(test (rotate 90 (rotate 90 (make-object image-snip% green-blue-20x10-bitmap)))
      =>
      (rotate 180 (make-object image-snip% green-blue-20x10-bitmap)))

(test (rotate 90 (flip-vertical (rotate 90 (make-object image-snip% green-blue-20x10-bitmap))))
      =>
      (rotate 0 (make-object image-snip% green-blue-20x10-bitmap)))

;; there was a bug in the bounding box computation for scaled bitmaps that this test exposes
(test (image-width (frame (rotate 90 (scale 1/2 (bitmap icons/plt-logo-red-diffuse.png)))))
      =>
      128)

;; Rotation by 0 should produce an equivalent object
(test (rotate 0 (make-object image-snip% green-blue-20x10-bitmap))
      =>
      (to-img (make-object image-snip% green-blue-20x10-bitmap)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; cropping (and place-image)
;;

(test (crop 0 0 10 10 (rectangle 20 20 'solid 'black))
      =>
      (rectangle 10 10 'solid 'black))

(test (equal~? (crop 0 0 40 40 (circle 40 'solid 'red))
               (rotate 180 (crop 40 40 40 40 (circle 40 'solid 'red)))
               0.1)
      =>
      #t)

(test (beside/align 'middle
                    (rectangle 10 10 'solid 'black)
                    (crop 0 0 10 10 (rectangle 10 10 'solid 'green)))
      =>
      (beside/align 'middle
                    (rectangle 10 10 'solid 'black)
                    (rectangle 10 10 'solid 'green)))

(test (place-image/align (circle 4 'solid 'black)
                         10 10
                         'left 'top
                         (rectangle 40 40 'solid 'orange))
      =>
      (underlay/xy (rectangle 40 40 'solid 'orange)
                   10 10
                   (circle 4 'solid 'black)))

(test (place-image/align (circle 4 'solid 'black)
                         50 50
                         'left 'top
                         (rectangle 40 40 'solid 'orange))
      =>
      (rectangle 40 40 'solid 'orange))

(test (place-image/align (circle 4 'solid 'black)
                         36 36
                         'left 'top
                         (rectangle 40 40 'solid 'orange))
      =>
      (underlay/xy (rectangle 40 40 'solid 'orange)
                   36 36
                   (crop 0 0 4 4 (circle 4 'solid 'black))))

(test (place-image/align (circle 8 'solid 'black)
                         -4 -4
                         'left 'top
                         (rectangle 40 40 'solid 'orange))
      =>
      (overlay/xy (crop 4 4 16 16 (circle 8 'solid 'black))
                  0 0
                  (rectangle 40 40 'solid 'orange)))

(test (place-image/align (circle 4 'solid 'black)
                         -4 0
                         'left 'top
                         (rectangle 40 40 'solid 'orange))
      =>
      (overlay/xy (crop 4 0 4 8 (circle 4 'solid 'black))
                  0 0
                  (rectangle 40 40 'solid 'orange)))

(test (place-image/align (circle 4 'solid 'black)
                         5 10 'center 'center
                         (rectangle 40 40 'solid 'orange))
      =>
      (underlay/xy (rectangle 40 40 'solid 'orange)
                   1 6
                   (circle 4 'solid 'black)))


(test (place-image/align (circle 4 'solid 'black)
                         10 15 'right 'bottom
                         (rectangle 40 40 'solid 'orange))
      =>
      (underlay/xy (rectangle 40 40 'solid 'orange)
                   2 7
                   (circle 4 'solid 'black)))

;; this test case checks to make sure the number of crops doesn't 
;; grow when normalizing shapes.

(let* ([an-image 
        (crop
         0 0 50 50
         (crop
          0 10 60 60
          (crop
           10 0 60 60
           (overlay
            (overlay
             (ellipse 20 50 'solid 'red)
             (ellipse 30 40 'solid 'black))
            (overlay
             (ellipse 20 50 'solid 'red)
             (ellipse 30 40 'solid 'black))))))]
       [an-image+crop
        (crop 5 5 10 10 an-image)])
  
  (define (count-crops s)
    (define crops 0)
    (let loop ([s s])
      (when (crop? s)
        (set! crops (+ crops 1)))
      (when (struct? s)
        (for-each loop (vector->list (struct->vector s)))))
    crops)
  
  (test (+ (count-crops (normalize-shape (image-shape an-image))) 1)
        =>
        (count-crops (normalize-shape (image-shape an-image+crop)))))

(check-exn #rx"crop" (λ () (crop 100 100 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop 9 100 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop 100 9 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop -9 9 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop 9 -9 10 10 (rectangle 20 20 "solid" "black"))))

(test (crop 20 20 100 100 (rectangle 40 40 "solid" "black"))
      =>
      (rectangle 20 20 "solid" "black"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  flipping
;;

(test (flip-horizontal (rotate -30 (rectangle 100 10 'solid 'red)))
      =>
      (rotate 30 (rectangle 100 10 'solid 'red)))

(test (flip-vertical (rotate -30 (rectangle 100 10 'solid 'red)))
      =>
      (rotate 30 (rectangle 100 10 'solid 'red)))
(test (flip-vertical
       (rotate
        -30
        (overlay (rectangle 100 10 'solid 'red)
                 (ellipse 10 100 'solid 'blue))))
      =>
      (rotate
       30
       (overlay (rectangle 100 10 'solid 'red)
                (ellipse 10 100 'solid 'blue))))
(test (flip-horizontal (overlay/xy (rectangle 100 10 'solid 'red)
                                   10 10
                                   (ellipse 10 100 'solid 'blue)))
      =>
      (overlay/xy (rectangle 100 10 'solid 'red)
                  80 10
                  (ellipse 10 100 'solid 'blue)))
(test (flip-vertical (overlay/xy (rectangle 100 10 'solid 'red)
                                 10 10
                                 (ellipse 10 100 'solid 'blue)))
      =>
      (overlay/xy (rectangle 100 10 'solid 'red)
                  10 -100
                  (ellipse 10 100 'solid 'blue)))

(test (flip-vertical (add-curve (rectangle 200 100 'solid 'black)
                                20 20 0 1
                                180 80 -90 1/3
                                "white"))
      =>
      (add-curve (rectangle 200 100 'solid 'black)
                 20 80 0 1
                 180 20 90 1/3
                 "white"))

(let* ([bdc (make-object bitmap-dc%)]
       [bm-ul (make-object bitmap% 10 10)]
       [bm-ur (make-object bitmap% 10 10)]
       [bm-ll (make-object bitmap% 10 10)])
  (send bdc set-bitmap bm-ul)
  (send bdc set-pen "red" 1 'transparent)
  (send bdc set-brush "red" 'solid)
  (send bdc clear)
  (send bdc draw-rectangle 0 0 5 5)
  (send bdc set-bitmap bm-ur)
  (send bdc set-pen "red" 1 'solid)
  (send bdc clear)
  (send bdc draw-rectangle 5 0 5 5)
  (send bdc set-bitmap bm-ll)
  (send bdc clear)
  (send bdc draw-rectangle 0 5 5 5)
  (send bdc set-bitmap #f)
  (test (flip-vertical bm-ul) => (to-img bm-ll))
  (test (flip-horizontal bm-ul) => (to-img bm-ur)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; pen arguments
;;

;; just make sure no errors.
(test (image? (polygon (list (make-posn 0 0)
                             (make-posn 100 100)
                             (make-posn 100 0)
                             (make-posn 0 100))
                       "outline"
                       (make-pen "darkslategray" 6 "solid" "round" "round")))
      =>
      #t)

(test (image? (line 10 
                    10 
                    (make-pen "darkslategray" 6 "solid" "round" "round")))
      =>
      #t)

(test (scale 2
             (polygon (list (make-posn 0 0)
                            (make-posn 100 0)
                            (make-posn 100 100))
                      "outline"
                      (make-pen "black" 6 "solid" "round" "round")))
      =>
      (polygon (list (make-posn 0 0)
                     (make-posn 200 0)
                     (make-posn 200 200))
               "outline"
               (make-pen "black" 12 "solid" "round" "round")))

(test (scale 2
             (ellipse 30 40 "outline"
                      (make-pen "black" 2 "solid" "round" "round")))
      =>
      (ellipse 60 80 "outline"
               (make-pen "black" 4 "solid" "round" "round")))

(test (scale 2
             (polygon (list (make-posn 0 0)
                            (make-posn 100 0)
                            (make-posn 100 100))
                      "outline"
                      (make-pen "black" 0 "solid" "round" "round")))
      =>
      (polygon (list (make-posn 0 0)
                     (make-posn 200 0)
                     (make-posn 200 200))
               "outline"
               (make-pen "black" 0 "solid" "round" "round")))

(test (scale 2
             (add-line
              (rectangle 100 100 'solid 'black)
              20 20 80 80
              (make-pen "black" 6 "solid" "round" "round")))
      =>
      (add-line
       (rectangle 200 200 'solid 'black)
       40 40 160 160
       (make-pen "black" 12 "solid" "round" "round")))

(test (scale 2
             (add-curve
              (rectangle 100 100 'solid 'black)
              20 20 0 1/2
              80 80 0 1/2
              (make-pen "black" 6 "solid" "round" "round")))
      =>
      (add-curve
       (rectangle 200 200 'solid 'black)
       40 40 0 1/2
       160 160 0 1/2
       (make-pen "black" 12 "solid" "round" "round")))

(test (image->color-list
       (above (beside (rectangle 1 1 'solid (color 1 1 1))
                      (rectangle 1 1 'solid (color 2 2 2))
                      (rectangle 1 1 'solid (color 3 3 3)))
              (beside (rectangle 1 1 'solid (color 4 4 4))
                      (rectangle 1 1 'solid (color 5 5 5))
                      (rectangle 1 1 'solid (color 6 6 6)))))
      =>
      (list (color 1 1 1) (color 2 2 2) (color 3 3 3) 
            (color 4 4 4) (color 5 5 5) (color 6 6 6)))

(test (color-list->bitmap
       (list (color 1 1 1) (color 2 2 2) (color 3 3 3) 
             (color 4 4 4) (color 5 5 5) (color 6 6 6))
       3 2)
      =>
      (above (beside (rectangle 1 1 'solid (color 1 1 1))
                     (rectangle 1 1 'solid (color 2 2 2))
                     (rectangle 1 1 'solid (color 3 3 3)))
             (beside (rectangle 1 1 'solid (color 4 4 4))
                     (rectangle 1 1 'solid (color 5 5 5))
                     (rectangle 1 1 'solid (color 6 6 6)))))

(let ([has-color? 
       (λ (img) 
         (ormap (λ (x) (or (not (equal? (color-red x)
                                        (color-green x)))
                           (not (equal? (color-red x)
                                        (color-blue x)))))
                (image->color-list img)))])
  (test (has-color? (place-image (rectangle 1 10 "solid" "red") 2 10
                                 (empty-scene 5 20)))
        =>
        #t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  test pinholes.
;;

(test (pinhole-x (rectangle 10 10 'solid 'blue)) => #f)
(test (pinhole-y (rectangle 10 10 'solid 'blue)) => #f)
(test (pinhole-x (put-pinhole 2 3 (rectangle 10 10 'solid 'blue))) => 2)
(test (pinhole-y (put-pinhole 2 3 (rectangle 10 10 'solid 'blue))) => 3)
(test (pinhole-x (center-pinhole (rectangle 10 24 'solid 'blue))) => 5)
(test (pinhole-y (center-pinhole (rectangle 10 24 'solid 'blue))) => 12)
(test (pinhole-x (clear-pinhole (center-pinhole (rectangle 10 24 'solid 'blue)))) => #f)
(test (pinhole-y (clear-pinhole (center-pinhole (rectangle 10 24 'solid 'blue)))) => #f)
(test (pinhole-x (clear-pinhole (rectangle 10 24 'solid 'blue))) => #f)
(test (pinhole-y (clear-pinhole (rectangle 10 24 'solid 'blue))) => #f)

(test (pinhole-x (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
      =>
      55)
(test (pinhole-y (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
      =>
      132)
(test (round-numbers (pinhole-x (rotate 90 (center-pinhole (rectangle 40 20 'solid 'red)))))
      =>
      10.0)
(test (round-numbers (pinhole-y (rotate 90 (center-pinhole (rectangle 40 20 'solid 'red)))))
      =>
      20.0)
(test (pinhole-x (flip-vertical (put-pinhole 1 2 (rectangle 10 20 'solid 'red))))
      =>
      1)
(test (pinhole-y (flip-vertical (put-pinhole 1 2 (rectangle 10 20 'solid 'red))))
      =>
      18)
(test (pinhole-x (flip-horizontal (put-pinhole 1 2 (rectangle 10 20 'solid 'red))))
      =>
      9.0)
(test (pinhole-y (flip-horizontal (put-pinhole 1 2 (rectangle 10 20 'solid 'red))))
      =>
      2.0)
(test (equal? (center-pinhole (rectangle 10 12 'solid 'blue))
              (rectangle 10 12 'solid 'blue))
      =>
      #f)
(test (equal? (center-pinhole (rectangle 10 12 'solid 'blue))
              (put-pinhole 5 6 (rectangle 10 12 'solid 'blue)))
      =>
      #t)
(test (pinhole-x (add-line (center-pinhole (rectangle 100 120 'solid 'red)) 10 10 20 20 'blue))
      =>
      50)
(test (pinhole-y (add-line (center-pinhole (rectangle 100 120 'solid 'red)) 10 10 20 20 'blue))
      =>
      60)
(test (pinhole-x (add-curve (center-pinhole (rectangle 100 120 'solid 'red)) 
                            10 10 30 1/2
                            20 20 60 1/2
                            'white))
      =>
      50)
(test (pinhole-y (add-curve (center-pinhole (rectangle 100 120 'solid 'red)) 
                            10 10 30 1/2
                            20 20 60 1/2
                            'white))
      =>
      60)

(test (pinhole-x (scene+line (center-pinhole (rectangle 100 120 'solid 'red)) 10 10 20 20 'blue))
      =>
      50)
(test (pinhole-y (scene+line (center-pinhole (rectangle 100 120 'solid 'red)) 10 10 20 20 'blue))
      =>
      60)
(test (pinhole-x (scene+curve (center-pinhole (rectangle 100 120 'solid 'red)) 
                              10 10 30 1/2
                              20 20 60 1/2
                              'white))
      =>
      50)
(test (pinhole-y (scene+curve (center-pinhole (rectangle 100 120 'solid 'red)) 
                              10 10 30 1/2
                              20 20 60 1/2
                              'white))
      =>
      60)

(test (pinhole-x (crop 2 2 8 10
                       (center-pinhole (rectangle 10 12 'solid 'red))))
      =>
      3)
(test (pinhole-y (crop 2 2 8 10
                       (center-pinhole (rectangle 10 12 'solid 'red))))
      =>
      4)

(test (pinhole-x (frame (center-pinhole (rectangle 10 12 'solid 'red))))
      =>
      5)
(test (pinhole-y (frame (center-pinhole (rectangle 10 12 'solid 'red))))
      =>
      6)

(test (pinhole-x (overlay (put-pinhole 1 2 (rectangle 10 100 'solid 'red))
                          (put-pinhole 75 9 (rectangle 100 10 'solid 'blue))))
      =>
      46)
(test (pinhole-y (overlay (put-pinhole 1 2 (rectangle 10 100 'solid 'red))
                          (put-pinhole 75 9 (rectangle 100 10 'solid 'blue))))
      =>
      2)
(test (pinhole-x (overlay (put-pinhole 75 9 (rectangle 100 10 'solid 'blue))
                          (put-pinhole 1 2 (rectangle 10 100 'solid 'red))))
      =>
      75)
(test (pinhole-y (overlay (put-pinhole 75 9 (rectangle 100 10 'solid 'blue))
                          (put-pinhole 1 2 (rectangle 10 100 'solid 'red))))
      =>
      54)
(test (pinhole-x (overlay (rectangle 100 10 'solid 'blue)
                          (put-pinhole 1 2 (rectangle 10 100 'solid 'red))))
      =>
      #f)
(test (pinhole-y (overlay (rectangle 100 10 'solid 'blue)
                          (put-pinhole 1 2 (rectangle 10 100 'solid 'red))))
      =>
      #f)
(test (pinhole-x (beside (center-pinhole (rectangle 10 100 'solid 'red))
                         (center-pinhole (rectangle 100 10 'solid 'blue))))
      =>
      5)
(test (pinhole-y (beside (center-pinhole (rectangle 10 100 'solid 'red))
                         (center-pinhole (rectangle 100 10 'solid 'blue))))
      =>
      50)
(test (pinhole-x (above (center-pinhole (rectangle 10 100 'solid 'red))
                        (center-pinhole (rectangle 100 10 'solid 'blue))))
      =>
      50)
(test (pinhole-y (above (center-pinhole (rectangle 10 100 'solid 'red))
                        (center-pinhole (rectangle 100 10 'solid 'blue))))
      =>
      50)

(test (pinhole-x (place-image (center-pinhole (rectangle 10 100 'solid 'red))
                              0 0
                              (center-pinhole (rectangle 100 10 'solid 'blue))))
      =>
      50)
(test (pinhole-y (place-image (center-pinhole (rectangle 10 100 'solid 'red))
                              0 0
                              (center-pinhole (rectangle 100 10 'solid 'blue))))
      =>
      5)

(test (clear-pinhole
       (overlay/align "pinhole" 'pinhole
                      (center-pinhole (rectangle 40 100 'solid 'red))
                      (put-pinhole 0 0 (rectangle 100 40 'solid 'blue))))
      =>
      (overlay/xy (rectangle 40 100 'solid 'red)
                  20 50
                  (rectangle 100 40 'solid 'blue)))

(test (clear-pinhole
       (underlay/align "pinhole" 'pinhole
                       (center-pinhole (rectangle 40 100 'solid 'red))
                       (put-pinhole 100 40 (rectangle 100 40 'solid 'blue))))
      =>
      (underlay/xy (rectangle 40 100 'solid 'red)
                   -80 10
                   (rectangle 100 40 'solid 'blue)))

(test (clear-pinhole
       (beside/align "pinhole"
                     (center-pinhole (rectangle 100 40 'solid 'purple))
                     (center-pinhole (rectangle 40 100 'solid 'purple))))
      =>
      (beside (rectangle 100 40 'solid 'purple)
              (rectangle 40 100 'solid 'purple)))


(test (clear-pinhole
       (above/align "pinhole"
                    (center-pinhole (rectangle 100 40 'solid 'purple))
                    (center-pinhole (rectangle 40 100 'solid 'purple))))
      =>
      (above (rectangle 100 40 'solid 'purple)
             (rectangle 40 100 'solid 'purple)))

(test (clear-pinhole
       (place-image/align
        (center-pinhole (rectangle 100 10 'solid 'red))
        0 0 "pinhole" "pinhole"
        (center-pinhole (rectangle 10 100 'solid 'blue))))
      =>
      (place-image/align
       (rectangle 100 10 'solid 'red)
       0 0 "center" "center"
       (rectangle 10 100 'solid 'blue)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  test errors.
;;  mostly test that the extra mode check is there
;;

(test/exn (rectangle 10 10 "solid" (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^rectangle: expected <image-color>")

(test/exn (rectangle 10 10 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^rectangle: expected <image-color>")

(test/exn (circle 10 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^circle: expected <image-color>")

(test/exn (ellipse 10 10 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^ellipse: expected <image-color>")

(test/exn (triangle 10 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^triangle: expected <image-color>")

(test/exn (right-triangle 10 12 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^right-triangle: expected <image-color>")

(test/exn (isosceles-triangle 10 120 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^isosceles-triangle: expected <image-color>")

(test/exn (square 10 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^square: expected <image-color>")

(test/exn (rhombus 40 45 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^rhombus: expected <image-color>")

(test/exn (regular-polygon 40 6 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^regular-polygon: expected <image-color>")

(test/exn (star 40 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^star: expected <image-color>")

(test/exn (star-polygon 40 7 3 'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^star-polygon: expected <image-color>")

(test/exn (polygon (list (make-posn 0 0) (make-posn 100 0) (make-posn 100 100))
                   'solid (make-pen "black" 12 "solid" "round" "round"))
          =>
          #rx"^polygon: expected <image-color>")

(test/exn (save-image "tri.png" (triangle 50 "solid" "purple"))
          =>
          #rx"^save-image:")

(test/exn (pen 1 2 3 4 5)
          =>
          #rx"^pen:")

(test/exn (make-pen 1 2 3 4 5)
          =>
          #rx"^make-pen:")

(test/exn (make-color #f #f #f)
          =>
          #rx"^make-color:")
(test/exn (color #f #f #f)
          =>
          #rx"^color:")
(test/exn (color-list->bitmap
           (list (color 1 1 1) (color 2 2 2) (color 3 3 3) 
                 (color 4 4 4) (color 5 5 5) (color 6 6 6))
           3 3)
          =>
          #rx"^color-list->bitmap")

(test/exn (overlay/align
           "pinhole" "center"
           (center-pinhole (rectangle 10 100 'solid 'blue))
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^overlay/align")
(test/exn (overlay/align
           "center" "pinhole" 
           (center-pinhole (rectangle 10 100 'solid 'blue))
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^overlay/align")
(test/exn (overlay/align
           "pinhole" "center"
           (rectangle 100 10 'solid 'red)
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^overlay/align")
(test/exn (overlay/align
           "center" "pinhole" 
           (rectangle 100 10 'solid 'red)
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^overlay/align")

(test/exn (underlay/align
           "pinhole" "center"
           (center-pinhole (rectangle 10 100 'solid 'blue))
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^underlay/align")
(test/exn (underlay/align
           "center" "pinhole" 
           (center-pinhole (rectangle 10 100 'solid 'blue))
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^underlay/align")
(test/exn (underlay/align
           "pinhole" "center"
           (rectangle 100 10 'solid 'red)
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^underlay/align")
(test/exn (underlay/align
           "center" "pinhole" 
           (rectangle 100 10 'solid 'red)
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^underlay/align")

(test/exn (place-image/align
           (center-pinhole (rectangle 10 100 'solid 'blue))
           0 0 "pinhole" "center"
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^place-image/align")
(test/exn (place-image/align
           (center-pinhole (rectangle 10 100 'solid 'blue))
           0 0 "center" "pinhole" 
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^place-image/align")
(test/exn (place-image/align
           (rectangle 100 10 'solid 'red)
           0 0 "pinhole" "center"
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^place-image/align")
(test/exn (place-image/align
           (rectangle 100 10 'solid 'red)
           0 0 "center" "pinhole" 
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^place-image/align")



(test/exn (above/align
           "pinhole" 
           (rectangle 100 10 'solid 'red)
           (center-pinhole (rectangle 10 100 'solid 'blue)))
          =>
          #rx"^above/align")
(test/exn (beside/align
           "pinhole" 
           (center-pinhole (rectangle 10 100 'solid 'blue))
           (rectangle 100 10 'solid 'red))
          =>
          #rx"^beside/align")



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  random testing of normalization
;;    make sure normalization actually normalizes
;;    and that normalization doesn't introduce new structs
;;

(require redex/reduction-semantics)

(define-language 2htdp/image
  (image (rectangle size size mode color)
         (line coord coord color)
         (add-curve (rectangle size size mode color)
                    coord coord pull angle
                    coord coord pull angle
                    color)
         (overlay image image)
         (overlay/xy image coord coord image)
         (underlay image image)
         (underlay/xy image coord coord image)
         (let ([i image])
           (crop (max 0 (min (image-width i) coord))
                 (max 0 (min (image-height i) coord))
                 size
                 size
                 i))
         (scale/xy factor factor image)
         (scale factor image)
         (rotate angle image)
         (flip-vertical image)
         (flip-horizontal image)
         (bitmap bmp-spec))
  
  (bmp-spec icons/b-run.png
            icons/stop-16x16.png)

  (factor (+ 1 big-nat) 1/2 1/3 1/4) ;; scaling factors
  (size big-nat)
  (mode 'outline 'solid "outline" "solid")
  (color "red" 'red "blue" "orange" "green" "black")
  (coord big-int)
  (pull 0 1/2 1/3 2 (/ big-nat (+ 1 big-nat)))
  (angle 0 90 45 30 180 natural (* 4 natural))
  
  ; Redex tends to choose small numbers.
  (big-nat (+ (* 10 natural) natural))
  (big-int (+ (* 10 integer) integer)))

(define-namespace-anchor anchor)

(define (image-struct-count obj)
  (let ([counts (make-hash)])
    (let loop ([obj obj])
      (when (struct? obj)
        (let ([stuff (vector->list (struct->vector obj))])
          (unless (member (car stuff) '(struct:flip struct:translate struct:scale)) ;; skip these becuase normalization eliminates them
            (hash-set! counts (car stuff) (+ 1 (hash-ref counts (car stuff) 0))))
          (for-each loop (cdr stuff)))))
    (sort (hash-map counts list) string<=? #:key (λ (x) (symbol->string (car x))))))

(define (check-image-properties img-sexp img)
  (let* ([raw-size (image-struct-count (image-shape img))]
         [normalized (normalize-shape (image-shape img) values)]
         [norm-size (image-struct-count normalized)]) 
    (unless (normalized-shape? normalized)
      (error 'test-image.ss "found a non-normalized shape after normalization:\n~s" 
             img-sexp))
    (unless (equal? norm-size raw-size)
      (error 'test-image.ss "found differing sizes for ~s:\n  ~s\n  ~s" 
             img-sexp raw-size norm-size))))


(time
 (redex-check
  2htdp/image
  image
  (check-image-properties 
   (term image)
   (to-img (eval (term image) (namespace-anchor->namespace anchor))))
  #:attempts 1000))

(define (test-save/load img fn)
  (let ([t1 (new text%)]
        [t2 (new text%)])
    (send t1 insert img)
    (send t1 save-file fn)
    (send t2 load-file fn)
    (let ([s1 (send t1 find-first-snip)]
          [s2 (send t2 find-first-snip)])
      (equal? s1 s2))))

;; scale-down : image -> image
;; scale image so that it is at most 10000 pixels in area
(define (scale-down img)
  (let* ([w (image-width img)]
         [h (image-height img)]
         [s (* w h)]
         [max-s (sqr 100)])
    (if (< s max-s)
        img
        (scale/xy (/ (sqrt max-s) w) 
                  (/ (sqrt max-s) h)
                  img))))

#;
(time
 (let ([fn (make-temporary-file "test-image~a")])
   (redex-check
    2htdp/image
    image
    (let-values ([(ans real cpu gc)
                  (time-apply
                   (λ ()
                     (let ([img (to-img (eval (term image) (namespace-anchor->namespace anchor)))])
                       (test-save/load (scale-down img) fn)))
                   '())])
      (unless (car ans)
        (error 'test-image.rkt
               "saving and loading this image fails:\n  ~s"
               (term image)))
      (unless (< cpu 4000)
        (error 'test-image.rkt
               "saving and loading this image takes too longer than 4 seconds:\n  ~s"
               (term image))))
    #:attempts 1000)))

;;This expression was found by the above. Its problematic because it has a negative width.
#;
(begin
  (define i
   (let* ([b (rectangle 17 17 "solid" "black")]
          [i (overlay/xy b -37 40 b)])
     (rotate 30 (crop 54 30 20 10 i))))
  (image-width i) (image-height i) i)


#|

This was found by the first redex check above:

(let ((i (flip-horizontal 
          (let ((i (line (+ (* 10 1) -2) (+ (* 10 3) 4) "green")))
            (crop (max 0 (min (image-width i) (+ (* 10 4) 13)))
                  (max 0 (min (image-height i) (+ (* 10 2) 0)))
                  (+ (* 10 3) 2)
                  (+ (* 10 7) 0)
                  i)))))
  (crop (max 0 (min (image-width i) (+ (* 10 0) 2))) 
        (max 0 (min (image-height i) (+ (* 10 2) 12))) 
        (+ (* 10 1) 7) (+ (* 10 1) 2)
        i))
raises an exception crop: expected <number that is between 0 than the width (-1)> as first argument, given: 0

|#
