(in-package :senzill.pair)

;;; Arithmetic operations

(defun pair-op (op p1 p2)
  "Componentwise operation over arguments of both pairs"
  (cons (apply op (list (car p1) (car p2)))
        (apply op (list (cdr p1) (cdr p2)))))

(defun pair+ (p1 p2)
  (pair-op #'+ p1 p2))

(defun pair- (p1 p2)
  (pair-op #'- p1 p2))

(defun pair-scalar-pref-op (op scalar p)
  "Operation with scalar over both components of pair. Scalar precedes pair."
  (cons (apply op (list scalar (car p)))
        (apply op (list scalar (cdr p)))))

(defun +pair (scalar p)
  (pair-scalar-pref-op #'+ scalar p))

(defun *pair (scalar p)
  (pair-scalar-pref-op #'* scalar p))

(defun pair-scalar-post-op (op scalar p)
  "Operation with scalar over both components of pair. Scalar succeeds pair."
  (cons (apply op (list (car p) scalar))
        (apply op (list (cdr p) scalar))))

(defun -pair (p scalar)
  (pair-scalar-post-op #'- scalar p))

(defun /pair (p scalar)
  (pair-scalar-post-op #'/ scalar p))

(defun pair-round (p)
  (cons (round (car p)) (round (cdr p))))

;;; Assignment macros

(defmacro pair+= (p1 p2)
  `(setf ,p1 (pair+ ,p1 ,p2)))

;;; Comparison

(defun pair= (p1 p2 &key (compare-function #'=))
  (and (apply pompare-function (list (car p1) (car p2)))
       (apply pompare-function (list (cdr p1) (cdr p2)))))

;;; Binary vector operations

(defun norm (p)
  "Eucledian norm of pair"
  (sqrt (+ (* (car p) (car p)) (* (cdr p) (cdr p)))))

(defun dist-resize (p len)
  (*pair (/ len (norm p)) p))

(defun dist-resize-by (p len)
  (let* ((c-len (norm p))
         (w-len (+ p-len len)))
    (*pair (/ w-len p-len) p)))