;;; 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 '(point-x point-y point-p make-point mutate-point line-segment-point-1 line-segment-point-2
	  line-segment-p make-line-segment mutate-line-segment line-point-1 line-point-2
	  line-p make-line mutate-line polygon-points polygon-p make-polygon mutate-polygon
	  rectangle-min-x rectangle-max-x rectangle-min-y rectangle-max-y rectangle-p make-rectangle
	  mutate-rectangle geometric-type))

;;; This file contains definitions for all the structures in the geometry package.
;;; For each structure, xxx, there is a routine "make-xxx", accessors for all components
;;; of the stucture, called "xxx-component", a predicate to test for that type of
;;; structure, called xxx-p, and a mutator called mutate-xxx.  Their is also a routine
;;; called geometric-type that returns 'xxx when called with an instance of xxx as an arguement.
;;; The contents of this file can be freely changed as long as they conform to these conventions.
;;; No other routines will rely on any other aspect of an object's structure.

;;; For example, to make points use up less space 
;;; one might redefine make-point as cons, point-x as car, point-y as cdr,
;;; point-p as (and (consp pt) (numberp (car pt)) (numberp (cdr pt))),
;;; mutate-point as (defun (pt new-x new-y) (rplaca pt new-x) (rplacd pt new-y) pt).
;;; One would also have to redefine geometric-type  as 
;;; (defun geometric-type (object) (if (point-p object) 'point (type-of object))).
;;; All code in the geometry package should then continue to work correctly.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Points
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defstruct (point
	    ;:named
	    (:constructor make-point (x &optional y))
	    :predicate
	    (:print-function (lambda (point stream &rest ignore)
			      (format stream "#<POINT ~A ~A>"
				      (point-x point) (point-y point)))))
  "A point"
  (x 0)
  (y 0))

(defun MUTATE-POINT (point new-x new-y)
  "Mutate POINT so that its components are now NEW-X, and NEW-Y.  The mutated point is
   returned."
  (setf (point-x point) new-x)
  (setf (point-y point) new-y)
  point)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Line Segments
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defstruct (line-segment
	    ;:named
	    (:constructor make-line-segment (point-1 point-2))
	    :predicate
	    (:print-function
	     (lambda (line-segment stream &rest ignore)
	      (format stream "#<LINE-SEGMENT (~A ~A)-(~A ~A)>"
		      (point-x (line-segment-point-1 line-segment))
		      (point-y (line-segment-point-1 line-segment))
		      (point-x (line-segment-point-2 line-segment))
		      (point-y (line-segment-point-2 line-segment))))))
  "A line segment"
  point-1
  point-2)

(defun mutate-line-segment (line-segment new-point-1 new-point-2)
  "Mutate LINE-SEGMENT so that its components are now NEW-POINT-1 and NEW-POINT-2.  The
   mutated point is returned."
  (setf (line-segment-point-1 line-segment) new-point-1)
  (setf (line-segment-point-2 line-segment) new-point-2)
  line-segment)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defstruct (line
	    ;:named
	    (:constructor make-line (point-1 point-2))
	    :predicate
	    (:print-function
	     (lambda (line stream &rest ignore)
	      (format stream "#<LINE (~A ~A)-(~A ~A)>"
		      (point-x (line-point-1 line))
		      (point-y (line-point-1 line))
		      (point-x (line-point-2 line))
		      (point-y (line-point-2 line))))))
  "A line"
  point-1
  point-2)

(defun MUTATE-LINE (line new-point-1 new-point-2)
  "Mutate LINE so that its components are now NEW-POINT-1 and NEW-POINT-2.  The
   mutated point is returned."
  (setf (line-point-1 line) new-point-1)
  (setf (line-point-2 line) new-point-2)
  line)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Polygons
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defstruct (polygon
	    ;:named
	    (:constructor make-polygon (POINTS))
	    :predicate
	    (:print-function
	     (lambda (POLYGON stream &rest ignore)
	      (format stream "#<POLYGON ~A>"
		      (POLYGON-POINTS POLYGON)))))
  "A polygon"
  points)

(defun MUTATE-POLYGON (polygon new-points)
  "Mutate polygon so that its points are new-points."
  (setf (polygon-points polygon) new-points)
  polygon)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Rectangles
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defstruct (rectangle
	     ;:NAMED
	     (:CONSTRUCTOR MAKE-RECTANGLE (MIN-X MAX-X MIN-Y MAX-Y))
	     :PREDICATE
	     (:PRINT-FUNCTION
	       (LAMBDA (RECTANGLE STREAM &REST IGNORE)
		 (FORMAT STREAM "#<RECTANGLE ~A ~A ~A ~A>"
			 (RECTANGLE-MIN-X RECTANGLE)
			 (RECTANGLE-MAX-X RECTANGLE)
			 (RECTANGLE-MIN-Y RECTANGLE)
			 (RECTANGLE-MAX-Y RECTANGLE)))))
  "A rectangle"
  min-x
  max-x
  min-y
  max-y)

(defun MUTATE-RECTANGLE (rectangle min-x max-x min-y max-y)
  "Mutate LINE so that its components are now NEW-POINT-1 and NEW-POINT-2.  The
   mutated point is returned."
  (setf (rectangle-min-x rectangle) min-x)
  (setf (rectangle-max-x rectangle) max-x)
  (setf (rectangle-min-y rectangle) min-y)
  (setf (rectangle-max-y rectangle) max-y)
  rectangle)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; General
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun GEOMETRIC-TYPE (object)
  (type-of object))
