(load "objects.l")
(load "vutils.l")

(defmacro disk-count (object)
  `(length (disks ,object)))

(defmacro rod-count (object)
  `(length (rods ,object)))

;; "lookat" checks for very obvious features.  Firstly, all objects must have
;; three disks.  Each object has its own unique feature.  The dog is the
;; only object with 8 rods.  The bird is the only object that has five
;; rods coming out of one of its disks.  The person has the feature of
;; not having any of the above features (except for having 3 disks).  So
;; if none of the unique features are detected the only thing it could be
;; is a person.  When "lookat" decides what object it could be it calls
;; a more specific feature detector aimed for that particular object.

(defun lookat (object)
  (cond ((not (eq (disk-count object) 3)) ;object has to have 3 disks
	 (format t "This object cannot be any known object because there are not three disks ~%")
	 nil)
	((eq (rod-count object) 8) ;dog has 8 rods
	 (format t "The object might be a dog...")
	 (more-careful-match object dog)) 
	((check-disks-for-rods 5 object) ;bird has disk with 5 rods
	 (format t "The object might be a bird...")
	 (more-careful-match object bird))
	(t
	 (format t "The object might be a person...")
	 (more-careful-match object person))))

;; "more-careful-match" is a more specific tester.  First it checks to see
;; that disks in the hypothesized template has the same number of rods as
;; the disks in the object in question.  It doesn't assign any mappings
;; between disks yet, it just sees that there are the same number of
;; disks with a certain number of rods in them for both objects.  Then
;; we call "simple-matcher."  It is called simple matcher because it
;; is not a general object matcher.  I general object matcher could take
;; polinomial time to make a match.  Since we know that all our possible
;; objects have three disks I made a more simple matcher my narrowing the
;; search space.  More detail on how this works is given in its comment.

(defun more-careful-match (object template)
  (cond ((not (disk-feature-match object template)) ;check if disks have right # of rods
	 (format t "but it's not; there is at least one disk with the wrong number of rods.~%") nil)
	((not (simple-matcher template object))
	 (format t "but it isn't.~%") nil)
	(t (format t "and it is!~%") t)))

;; "simple-matcher" assumes that the two objects given it have three disks
;; (we know at this point in the program that they both have the same
;; number of disks, and since all the template objects have three disks
;; then both these objects must have three disks).  It finds the middle
;; disks of both objects and finds the difference in their coordinates.
;; It sends all this information to "aux-matcher" which does the real
;; work.

(defun simple-matcher (template object)
  (let ((mo-disk (middle-disk object)) (mt-disk (middle-disk template)))
    (aux-matcher template mt-disk object mo-disk
		 (delta-crds (crds mt-disk) (crds mo-disk)))))

;; "aux-matcher" checks the angles between rods, the length of the rods,
;; and if there are any disks on the rods of the template disk and the
;; object disk.  If both disks (these are the middle disks of the object)
;; have rods with the same angles between them, where a mapping can be
;; set up so that a rod from one disk matches a rod from the other in
;; length and also what it has on its end (another disk or nothing) then
;; "r-end" is set to a list containing the rod names off the middle disks
;; that have disks on their other ends.  The format is:
;;      (rod-of-tdisk-with-disk analogous-rod-of-odisk-with-disk
;;       rod-of-tdisk-with-disk analogous-rod-of-odisk-with-disk)
;; We know there will be only two rods off each middle disk that have
;; disks at the other end.  We then take the first two rods from this
;; list and check to see that the disks on the other end have the
;; same properties, i.e. rod angles, lengths, and also that their
;; difference in coords is the same as the middle disk.  If everything
;; is okay there then we do it with the last two rods in the list.  If
;; that works then the two objects are the same.

(defun aux-matcher (template tdisk object odisk delta-crds)
  (let ((r-end (check-angles-lengths-ends tdisk odisk template object)))
    (cond ((null r-end) nil)
	  ((not (check-angles-lengths-crds
		 (disk-on (car r-end) tdisk template)
		 (disk-on (nth 1 r-end) odisk object)
		 (rods template) (rods object)
		 delta-crds)) nil)
	  (t (check-angles-lengths-crds
	      (disk-on (nth 2 r-end) tdisk template)
	      (disk-on (nth 3 r-end) odisk object)
	      (rods template) (rods object)
	      delta-crds)))))