;; The Visitor Pattern Version (version 3, extended)

(define Shape (interface () visit))
(define ShapeVisitor (interface () forRect forCirc forUnion))

(define Rectangle 
  (class* object% (Shape) (width height)
    (public
      (get-width (lambda () width))
      (get-height (lambda () height))
      (visit (lambda (v) (send v forRect this))))
    (sequence (super-init))))

(define Circle
  (class* object% (Shape) (radius)
    (public
      (get-radius (lambda () radius))
      (visit (lambda (v) (send v forCirc this))))
    (sequence (super-init))))

(define Union
  (class* object% (Shape) (shape1 shape2)
    (public
      (get-shape1 (lambda () shape1))
      (get-shape2 (lambda () shape2))
      (visit (lambda (v) (send v forUnion this))))
    (sequence (super-init))))

(define DrawVisitor
  (class* object% (ShapeVisitor) (window x y)
    (public 
      (forRect (lambda (rect) 
                 (printf "Rect would draw at (~a ~a) using width ~a and height ~a ~n"
			 x y (send rect get-width) (send rect get-height))))
      (forCirc (lambda (circ) 
                 (printf "Circle would draw at (~a ~a) using radius ~a ~n"
			 x y (send circ get-radius))))
      (forUnion (lambda (union)
                  (send (send union get-shape1) visit this)
                  (send (send union get-shape2) visit this))))
    (sequence (super-init))))

(define CopyVisitor
  (class* object% (ShapeVisitor) ()
    (public
      (forRect 
       (lambda (rect) 
         (make-object Rectangle (send rect get-width) (send rect get-height))))
      (forCirc (lambda (circ) (make-object Circle (send circ get-radius))))
      (forUnion (lambda (un)
                  (make-object Union 
                    (send (send un get-shape1) visit this)
                    (send (send un get-shape2) visit this)))))
    (sequence (super-init))))
                    
(define draw (make-object DrawVisitor #f 0 0))
(define copy (make-object CopyVisitor))
(define C (make-object Circle 6))
(send C visit draw)
(define R (make-object Rectangle 10 15))
(define U (make-object Union C R))
(send U visit draw)
(send U visit copy)

;; add an operation (screen-slide)

(define SlideVisitor
  (class* object% (ShapeVisitor) (window x y)
    (private
      (within-window-size?
       (lambda (x y window)
         (and (< x 200) (< y 200)))))
    (public
      (forRect (lambda (rect)
                 (when (within-window-size? x y window)
                   (begin (send rect visit (make-object DrawVisitor window x y))
                          (send rect visit (make-object SlideVisitor window 
                                             (+ x 50) (+ y 50)))))))
      (forCirc (lambda (circ)
                 (when (within-window-size? x y window)
                   (begin (send circ visit (make-object DrawVisitor window x y))
                          (send circ visit (make-object SlideVisitor window 
                                             (+ x 50) (+ y 50)))))))
      (forUnion (lambda (un)
                 (when (within-window-size? x y window)
                   (begin (send un visit (make-object DrawVisitor window x y))
                          (send un visit (make-object SlideVisitor window 
                                           (+ x 50) (+ 50 y))))))))
    (sequence (super-init))))

;; This is a better version of SlideVisitor which shares common code
(define SlideVisitor
  (class* object% (ShapeVisitor) (window x y)
    (private
       (draw-and-slide
       (lambda (shape)
         (when (within-window-size? x y window)
           (begin (send shape visit (make-object DrawVisitor window x y))
                  (send shape visit (make-object SlideVisitor window 
                                      (+ x 50) (+ y 50))))))))
    (public
      (within-window-size?
       (lambda (x y window)
         (and (< x 200) (< y 200))))
      (forRect draw-and-slide)
      (forCirc draw-and-slide)
      (forUnion draw-and-slide))
    (sequence (super-init))))

(send U visit (make-object SlideVisitor #f 0 0))  

;; Adding the Trans variant

(define Trans
  (class* object% (Shape) (a-shape change-x change-y)
    (public
      (get-shape (lambda () a-shape))
      (get-change-x (lambda () change-x))
      (get-change-y (lambda () change-y))
      (visit (lambda (v) (send v forTrans this))))
    (sequence (super-init))))

(define TransVisitor (interface (ShapeVisitor) forTrans))

(define DrawTransVisitor
  (class* DrawVisitor (TransVisitor) (window x y)
    (public
      (forTrans (lambda (trans) 
                  (send (send trans get-shape) visit 
                        (make-object DrawTransVisitor window 
                          (+ x (send trans get-change-x)) 
                          (+ y (send trans get-change-y)))))))
    (sequence (super-init window x y))))


(define SlideTransVisitor
  (class* SlideVisitor (TransVisitor) (window x y)
    (inherit within-window-size?)
    (public
      (forTrans (lambda (tr)
                  (when (within-window-size? x y window)
                    (begin (send tr visit (make-object DrawTransVisitor window x y))
                           (send tr visit (make-object SlideTransVisitor window 
                                            (+ x 50) (+ y 50))))))))
    (sequence (super-init window x y))))

(define T (make-object Trans U 20 50))
(send T visit (make-object SlideTransVisitor #f 0 0))
(define U2 (make-object Union T (make-object Circle 50)))
(send U2 visit (make-object SlideTransVisitor #f 0 0))