;;; 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)

;;; This file contains code to create a random convex polygon.
;;; It's not obvious, at least to me, what it means to make a random polygon from a uniform 
;;; Distribution over all polygons.  The approach taken here is to allow the user to provide
;;; distributions on certain aspects of a polygon, with defaults provided for all distributions.

;;; First of all, the user provides a function which, when called with no arguments, returns the
;;; number of sides the polygon should have.  Secondly, the user provides a scaling function, which
;;; decides how big the polygon should be.  Given a polygon, this function returns a factor by which
;;; the polygon is scaled.  For example, the default is to choose a diameter randomly from between
;;; *MIN-RANDOM-POLYGON-DIAMETER*, and *MAX-RANDOM-POLYGON-DIAMETER*, and scale the polygon so that it has that diameter.
;;; Next, a length function is provided.  This is called with no arguments, and returns the length of a
;;; side of the polygon.  Finally, an angle function is provided, which is called with the total number
;;; of sides of the polygon, the angles selected so far, a minimum angle and a maximum angle.

;;; First, the sides function is called, to find the the number of sides the polygon has.  Next, the length
;;; function is called that number of times, to find the length of each side.  Finally, if there are n sides,
;;; the angle function is called (n - 2) times, to find all but 2 of the polygon angles.  Since a collection of 
;;; too large or too small angles will make it impossible to form a convex polygon, we calculate the minimum
;;; and maximum possible angles before each call to the angle generating function.  This function may return
;;; nil too indicate that the whole process should begin over in generating a random convex polygon.

;;; This whole process is a bit kludgey, but fine for generating sort of random polygons with no specific
;;; characteristics.

(export '(random-polygon random-polygon-uniform-vertices))

(defvar *MAX-RANDOM-POLYGON-DIAMETER* 100)

(defvar *MIN-RANDOM-POLYGON-DIAMETER* 10)

(defvar *MAX-RANDOM-POLYGON-ANGLE* (- PI .01))

(defvar *MIN-RANDOM-POLYGON-ANGLE* .01)

(defvar *MAX-RANDOM-POLYGON-EDGE-LENGTH* 10.0)

(defvar *MIN-RANDOM-POLYGON-EDGE-LENGTH* 2.0)

(defun *DEFAULT-SIDES-FUNCTION* ()
  (+ 3 (random 4)))

(defun *DEFAULT-SIZE-FUNCTION* (poly)
  (let ((dia (random-between *MIN-RANDOM-POLYGON-DIAMETER* *MAX-RANDOM-POLYGON-DIAMETER*)))
    (/ dia (polygon-diameter poly))))

;;; The idea is to figure out the average angle value left over, and pick an angle
;;; from a distribution that slopes linearly upward from a minimum to that angle,
;;; then slopes downward to the maximum possible angle.
(defun *DEFAULT-ANGLE-FUNCTION* (num-sides angles min-angle max-angle)
  (when (< min-angle max-angle)
    (let* ((total-angles (* PI (- num-sides 2)))
	   (angles-left (- total-angles (apply #'+ angles)))
	   (number-angles-left (- num-sides (length angles)))
	   (average-left (/ angles-left number-angles-left))
	   (above-average? (> (+ min-angle (random (- max-angle min-angle)))
			      average-left)))
      (if above-average? (+ average-left (random (random (- max-angle average-left))))
	  (- average-left (random (random (- average-left min-angle))))))))

(defun *DEFAULT-LENGTH-FUNCTION* ()
  (+ *MIN-RANDOM-POLYGON-EDGE-LENGTH*
     (random (- *MAX-RANDOM-POLYGON-EDGE-LENGTH* *MIN-RANDOM-POLYGON-EDGE-LENGTH*))))

(defun RANDOM-POLYGON (&key (sides #'*default-sides-function*)	
			  (size #'*default-size-function*)	
			  (length #'*default-length-function*)
			  (angle-function #'*default-angle-function*)
			  &aux (polygon nil))
  (let ((num-sides (apply sides nil)))
    (loop while (not polygon)
	  doing
      (let ((lengths (loop for i from 1 to num-sides
			   collecting
			     (apply length nil))))
	(setf polygon (calculate-polygon lengths angle-function))))
    (multiply polygon (apply size (list polygon)))))

(defun RANDOM-POLYGON-UNIFORM-VERTICES (&key (sides #'*default-sides-function*)	
			  (image-size-x 500) (image-size-y 500))
  (let ((num-sides (apply sides nil)))
    (loop for vertices = (n-random-round-points num-sides image-size-x image-size-y)
          for convex-hull = (jarvis-march-convex-hull vertices)
          until (= num-sides (length convex-hull))
          finally (return (make-polygon convex-hull)))))

(defun N-RANDOM-ROUND-POINTS (n max-x max-y)
  (loop repeat n
        collecting
        (make-point (random max-x) (random max-y))))

;;; This proc creates a polygon on n sides with n side-lengths, and an angle generating function.
(defun CALCULATE-POLYGON (side-lengths angle-function &aux (polygon-possible t))
  (let* ((lines (list (make-line-segment (make-point (car side-lengths) 0) (make-point 0 0))))
	 (angles nil)
	 (num-sides (length side-lengths))
	 (total-angles (* PI (- num-sides 2))))
    (loop for length in (nthrdc 2 (cdr side-lengths))
	  while polygon-possible
	  doing
      (let* ((angles-left (- total-angles (apply #'+ angles)))
	     (number-angles-left (- num-sides (length angles)))
	     (angle
	       (apply angle-function
		      (list num-sides angles
			    (max *MIN-RANDOM-POLYGON-ANGLE*
				 (- angles-left (* (1- number-angles-left) *MAX-RANDOM-POLYGON-ANGLE*))
				 (connected-line-angle
				   (make-line-segment (make-point 0 0) (line-segment-point-1 (car lines)))
				   (car lines)))
			    (min *MAX-RANDOM-POLYGON-ANGLE*
				 (- angles-left (* (1- number-angles-left)
						   *MIN-RANDOM-POLYGON-ANGLE*)))))))
	(if angle
	    (progn (push angle angles) (push (calculate-line angle length (car lines)) lines))
	    (setf polygon-possible nil))))
    (if (not polygon-possible) nil
	(let ((next-length (nlast 1 side-lengths))
	      (last-length (nlast 0 side-lengths))
	      (length-left (distance (line-segment-point-1 (car lines))
				     (make-point 0 0))))
	  (if (not (lengths-make-triangle next-length last-length length-left)) nil
	      (let ((next-angle
		      (+ (connected-line-angle (make-line-segment (make-point 0 0) (line-segment-point-1 (car lines)))
					  (car lines))
			 (angle-from-sides last-length length-left next-length)))
		    (mid-angle (angle-from-sides length-left last-length next-length))
		    (last-angle
		      (+ (connected-line-angle (nlast 0 lines)
					  (make-line-segment (make-point 0 0) (line-segment-point-1 (car lines))))
			 (angle-from-sides next-length last-length length-left))))
		(if (or (< PI next-angle) (< PI mid-angle) (< PI last-angle))
		    nil
		    (progn
		      (push (calculate-line next-angle next-length (car lines)) lines)
		      (push (calculate-line mid-angle last-length (car lines)) lines)
		      (make-polygon-from-lines lines)))))))))

;;; Given a line, an angle and a length, determine a new line that connects to 
;;; the start of the old line.
(defun CALCULATE-LINE (angle length last-line) 
  (let* ((unit-last (unit (g-coerce last-line 'point)))
	 (unit-new (add (multiply unit-last (cos angle))
			(multiply (normal unit-last) (sin angle)))))
    (make-line-segment 
      (add (line-segment-point-1 last-line)
	   (multiply unit-new length))
      (line-segment-point-1 last-line))))

;;; Finds angle of triangle opposite to side a
(defun ANGLE-FROM-SIDES (a b c)
  (acos (/ (- (+ (square b) (square c)) (square a)) (* 2 b c))))

;;; Can a triangle be made from lines of these lengths?
(defun LENGTHS-MAKE-TRIANGLE (a b c)
  (and (< a (+ b c)) (< b (+ a c)) (< c (+ a b))))


