;;; This software is being provided to you, the LICENSEE, by the
;;; Massachusetts Institute of Technology (M.I.T.), and the NEC Research
;;; Institute (NECI) under the following license.  By obtaining, using
;;; and/or copying this software, you agree that you have read,
;;; understood, and will comply with these terms and conditions:
;;; 
;;; Permission to use, copy, modify and distribute, including the right to
;;; grant others rights to distribute at any tier, this software and its
;;; documentation for research purposes only and without fee or royalty is
;;; hereby granted, provided that you agree to comply with the following
;;; copyright notice and statements, including the disclaimer, and that
;;; the same appear on ALL copies of the software and documentation,
;;; including modifications that you make for internal use or for
;;; distribution:
;;; 
;;; Copyright 1995 by the Massachusetts Institute of Technology.  All
;;; rights reserved.  Copyright 1995 by NEC Research Institute Inc. All
;;; rights reserved
;;; 
;;; THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. and NECI MAKE NO
;;; REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED.  By way of example,
;;; but not limitation, M.I.T. and NECI MAKE NO REPRESENTATIONS OR
;;; WARRANTIES OF MERCHANTABILITY OR FITNESS FOR ANY PARTICULAR PURPOSE OR
;;; THAT THE USE OF THE LICENSED SOFTWARE OR DOCUMENTATION WILL NOT
;;; INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER
;;; RIGHTS.
;;; 
;;; The name of the Massachusetts Institute of Technology or M.I.T., or
;;; NEC Research Institute, or NECI may NOT be used in advertising or
;;; publicity pertaining to distribution of the software.  Title to
;;; copyright in this software and any associated documentation shall at
;;; all times remain with M.I.T. and NECI, and USER agrees to preserve
;;; same.
;;; 

;;; -*- Mode: LISP; Base: 10; Package: 2DG; Syntax: Common-Lisp -*-
(in-package '2DG)

(export '(multiply divide bounding-box extreme-point norm norm-squared points-between
          line-segment-length average-points))

;;; This file contains some miscellaneous geometric functions, too short
;;; to deserve their own files.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Scaling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun MULTIPLY (object scalar)
  "Multiply the components of OBJECT by SCALAR and return the new object."
  (make-from-defining-points
    (loop for point in (defining-points-list object)
	  collecting
	    (make-point (* (point-x point) scalar)
			(* (point-y point) scalar)))
    (geometric-type object)))

(defun DIVIDE (object scalar)
  "Divide the components of OBJECT by SCALAR and return the new object."
  (make-from-defining-points
    (loop for point in (defining-points-list object)
	  collecting
	    (make-point (/ (point-x point) scalar)
			(/ (point-y point) scalar)))
    (geometric-type object)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Bounding box functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun BOUNDING-BOX (object)
  "
  Purpose:  Find the bounding box of OBJECT.  The edges are aligned with the x- and y-axes.
  Args:	OBJECT	-- a point, line segment, or polygon
  Returns:  A bounding box as a rectangle
  "
  (declare (values (rectangle)))
  (case (geometric-type object)
    ((point line-segment polygon)
     (loop for point in (defining-points-list object)
	   as x = (point-x point)
	   as y = (point-y point)
	   with min-x = most-positive-single-float
	   with max-x = most-negative-single-float
	   with min-y = most-positive-single-float
	   with max-y = most-negative-single-float
	   do
       (when (> x max-x) (setf max-x x))
       (when (< x min-x) (setf min-x x))
       (when (> y max-y) (setf max-y y))
       (when (< y min-y) (setf min-y y))
	   finally
	     (return (make-rectangle min-x max-x min-y max-y))))
    (line (multiple-value-bind (x1 y1 x2 y2) (defining-point-coordinates object)
	    (make-rectangle (if (~= x1 x2) x1 most-negative-single-float) (if (~= x1 x2) x1 most-positive-single-float)
			    (if (~= y1 y2) y1 most-negative-single-float) (if (~= y1 y2) y1 most-positive-single-float))))
    (rectangle object)
    (otherwise
      (error "Can't find bounding box of ~A" object))))

(defun EXTREME-POINT (points)
  "
  Purpose:  Find the point in a point set with the smallest y-coordinate.  If more than one such point exists, the one with the smallest x-coordinate is chosen.
  Returns:  Multiple-value-returns a point and the zero-based index of its position in POINTS
  "
  (declare (values point position))
  (loop for point in points
	as position from 0
	with best-point = (make-point most-positive-fixnum most-positive-fixnum)
	with best-position
	do
    (cond ((< (point-y point) (point-y best-point))
	   (setf best-point point
		 best-position position))
	  ((= (point-y point) (point-y best-point))
	   (when (< (point-x point) (point-x best-point))
	     (setf best-point point
		   best-position position))))
	finally (return (values best-point best-position))))

(defun NORM (point)
  "
  Purpose:  Find the Euclidean norm of POINT.
  Args:	POINT
  Returns:  SQRT (X^2 + Y^2)
  "
  (declare (values norm))
  (sqrt (norm-squared point)))

(defun NORM-SQUARED (point)
  "
  Purpose:  Find the square of the Euclidean norm of POINT.
  Args:	POINT
  Returns:  X^2 + Y^2
  "
  (declare (values norm-squared))
  (+ (sq (point-x point)) (sq (point-y point))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Points in between 2 Points.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun POINTS-BETWEEN (point-1 point-2)
  "
  Purpose:  Find the points which lie between POINT-1 and POINT-2 which have integral x-, y-coordinates. 
	Rounds the x- and y-coordinates of POINT-1 and POINT-2.
  Returns:  A list of points.  The first point corresponds to POINT-1 and the last to POINT-2.
  "
  (let ((x1 (round (point-x point-1)))
	(y1 (round (point-y point-1)))
	(x2 (round (point-x point-2)))
	(y2 (round (point-y point-2))))
    (if (and (= x1 x2) (= y1 y2))
	;; Degenerate case, so try to be reasonable
	(list (make-point x1 y1))
	;; Non-degenerate case
	(let (first-x first-y last-x last-y)
	  (if (> (abs (- x1 x2)) (abs (- y1 y2)))
	      ;; X-distance is longer
	      (progn
		(if (> x2 x1)
		    (setf last-x x2 last-y y2 first-x x1 first-y y1)
		    (setf last-x x1 last-y y1 first-x x2 first-y y2))
		(loop for x from first-x to last-x
		      as offset from 0
		      with y-ratio = (/ (- last-y first-y) (- last-x first-x))
		      collect (make-point x (round (+ first-y (* offset y-ratio))))))
	      ;; Y-distance is longer
	      (progn
		(if (> y2 y1)
		    (setf last-y y2 last-x x2 first-y y1 first-x x1)
		    (setf last-y y1 last-x x1 first-y y2 first-x x2))
		(loop for y from first-y to last-y
		      as offset from 0
		      with x-ratio = (/ (- last-x first-x) (- last-y first-y))
		      collect (make-point (round (+ first-x (* offset x-ratio))) y))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SIZE FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun LINE-SEGMENT-LENGTH (ls)
  (distance-between-point-and-point (line-segment-point-1 ls) (line-segment-point-2 ls)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MISCELLANEOUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun AVERAGE-POINTS (pts)
  (loop for i from 0
	for pt in pts
	sum (point-x pt) into x
	sum (point-y pt) into y
	finally (return (make-point (float (/ x i)) (float (/ y i))))))

