;;; geometry
(define-record-type point :point
  (make-point x y)
  point?
  (x point-x)
  (y point-y))

(define-record-discloser :point
  (lambda (r)
    `(point (x ,(point-x r)) (y ,(point-y r)))))

(define-record-type rectangle :rectangle
  (make-rectangle x y width height)
  rectangle?
  (x rectangle-x)
  (y rectangle-y)
  (width rectangle-width)
  (height rectangle-height))

(define-record-discloser :rectangle
  (lambda (r)
    `(rectangle (x ,(rectangle-x r)) 
		(y ,(rectangle-y r))
		(width ,(rectangle-width r))
		(height ,(rectangle-height r)))))

(define (point+ a b)
  (make-point (+ (point-x a) (point-x b))
	      (+ (point-y a) (point-y b))))

(define (point- a b)
  (make-point (- (point-x a) (point-x b))
	      (- (point-y a) (point-y b))))

(define (point<? a b)
  (and (< (point-x a) (point-x b))
       (< (point-y a) (point-y b))))
			 
(define (point-in-rectangle? a r)
  (and (>= (point-x a) (rectangle-x r))
       (<= (point-x a) (+ (rectangle-width r) (rectangle-x r)))
       (>= (point-y a) (rectangle-y r))
       (<= (point-y a) (+ (rectangle-height r) (rectangle-y r)))))

(define (rectangle-origin r)
  (make-point (rectangle-x r) (rectangle-y r)))

(define (make-rectangle-with-origin p width height)
  (make-rectangle (point-x p) (point-y p) width height))

(define (rectangle-move r p)
  (make-rectangle (+ (point-x p) (rectangle-x r))
		  (+ (point-y p) (rectangle-y r))
		  (rectangle-width r)
		  (rectangle-height r)))

(define (rectangle+ r p)
  (make-rectangle-with-origin 
   (point+ (rectangle-origin r) p)
   (rectangle-width r)
   (rectangle-height r)))

(define (rectangle- r p)
  (make-rectangle-with-origin
   (point- (rectangle-origin r) p)
   (rectangle-width r)
   (rectangle-height r)))

(define (within-dim d1 ext1 d2 ext2)
  (if (< (+ d2 ext2) (+ d1 ext1))
      d2
      (max 0
	   (- (+ d1 ext1) d2))))

(define (rectangle-within r1 r2)
  (make-rectangle (within-dim (rectangle-x r1) (rectangle-width r1)
			      (rectangle-x r2) (rectangle-width r2))
		  (within-dim (rectangle-y r1) (rectangle-height r1)
			      (rectangle-y r2) (rectangle-height r2))
		  (rectangle-width r2)
		  (rectangle-height r2)))


  
