(define-record-type pt
  (fields x y))

;; (a -> a -> b) -> (double -> a) -> (pt -> b)
(define mk-pt-unary-operator
  (lambda (comb op)
    (lambda (p)
      (comb (op (pt-x p)) (op (pt-y p))))))

;; (a -> a -> b) -> (double -> double -> a) -> (pt -> pt -> b)
(define mk-pt-binary-operator
  (lambda (comb op)
    (lambda (p1 p2)
      (comb (op (pt-x p1) (pt-x p2)) (op (pt-y p1) (pt-y p2))))))

;; pt -> pt
(define pt-negative (mk-pt-unary-operator make-pt -))
(define pt-abs (mk-pt-unary-operator make-pt abs))
(define pt-floor (mk-pt-unary-operator make-pt floor))
(define pt-ceiling (mk-pt-unary-operator make-pt ceiling))
(define pt-truncate (mk-pt-unary-operator make-pt truncate))
(define pt-round (mk-pt-unary-operator make-pt round))

(define and-f
  (lambda (p q)
    (and p q)))

;; pt -> pt -> bool
(define pt-=? (mk-pt-binary-operator and-f =))
(define pt->? (mk-pt-binary-operator and-f >))
(define pt->=? (mk-pt-binary-operator and-f >=))
(define pt-<? (mk-pt-binary-operator and-f <))
(define pt-<=? (mk-pt-binary-operator and-f <=))

;; pt -> pt -> pt
(define pt-+ (mk-pt-binary-operator make-pt +))
(define pt-* (mk-pt-binary-operator make-pt *))
(define pt-/ (mk-pt-binary-operator make-pt /))
(define pt-- (mk-pt-binary-operator make-pt -))

;; pt -> double -> pt
(define pt-translate
  (lambda (p n)
    (make-pt (+ (pt-x p) n) (+ (pt-y p) n))))

;; pt -> double -> pt
(define pt-scale
  (lambda (p n)
    (make-pt (* (pt-x p) n) (* (pt-y p) n))))

;; pt -> pt -> pt
(define pt-inverse
  (lambda (a b)
    (pt-+ (pt-- b a) b)))

;; double -> double -> double
(define (hypotenuse x y)
  (sqrt (+ (* x x) (* y y))))

;; pt -> double
(define pt-rho
  (lambda (p)
    (hypotenuse (pt-x p) (pt-y p))))

;; double -> double -> double
(define atan2*
  (lambda (y x)
    (if (and (zero? y) (zero? x)) 0 (atan y x))))

;; pt -> double
(define pt-theta
  (lambda (p)
    (atan2* (pt-y p) (pt-x p))))

;; pt -> pt
(define to-polar
  (lambda (p)
    (let ((x (pt-x p))
	  (y (pt-y p)))
      (make-pt (hypotenuse x y) (atan2* y x)))))

;; pt -> pt
(define from-polar
  (lambda (p)
    (let ((rho (pt-x p))
	  (theta (pt-y p)))
      (make-pt (* rho (cos theta)) (* rho (sin theta))))))

;; pt -> pt
(define pt-transpose
  (lambda (p)
    (make-pt (pt-y p) (pt-x p))))

;; #[double, double] -> pt
(define vector->pt
  (lambda (v)
    (make-pt (vector-ref v 0) (vector-ref v 1))))

;; pt -> #[double, double]
(define pt->vector
  (lambda (p)
    (vector (pt-x p) (pt-y p))))

;; pt -> pt -> double
(define pt-distance
  (lambda (p1 p2)
    (hypotenuse (- (pt-x p2) (pt-x p1)) (- (pt-y p2) (pt-y p1)))))

;; pt -> double
(define pt-distance0 
  (lambda (p)
    (hypotenuse (pt-x p) (pt-y p))))

;; pt -> pt -> double -> [pt]
(define pt-generate-line
  (lambda (a b xn)
    (let* ((d           (pt-- b a))
	   (left-right? (> (pt-x d) 0))
	   (end-test?   (if left-right? >= <=))
	   (dx          (if left-right? xn (- xn)))
	   (incr        (make-pt dx (/ (pt-y d) (/ (pt-x d) dx)))))
      (let loop ((line (list a))
		 (p a))
	(if (end-test? (pt-x p) (pt-x b))
	    (reverse line)
	    (let ((z (pt-+ p incr)))
	      (loop (cons z line) z)))))))