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

(in-package group)

(export '(EDGE-FILE-TO-CONVEX-GROUP-FILE))

(defun EDGE-FILE-TO-CONVEX-GROUP-FILE (infile outfile k &key (width 640) (height 486))
  "This takes a file that gives edges, in raw format, where 0 indicates no edge,
   and 255 indicates an edge.  The output is an ASCII file showing the convex groups
   found.  Each line in the file shows a line segment, there are blank lines separating
   the convex groups.  k indicates the salience of each group (see the paper).
  "
  (let ((cgs (remove-duplicate-answers 
                (CONVEX-LINES-FROM-EDGES-SPLIT 
                  (read-raw-canny-edges infile :width width :height height) k))))
    (with-open-file (s outfile :direction :output)
       (loop for cg in cgs
             doing
          (loop for ls in (convex-group-bounding-line-segments cg)
                doing
                (format s "((~A ~A) (~A ~A))~%"
                        (point-x (line-segment-point-1 ls))
                        (point-y (line-segment-point-1 ls))
                        (point-x (line-segment-point-2 ls))
                        (point-y (line-segment-point-2 ls))))
           (format s "~%")))))
    

(defun READ-RAW-CANNY-EDGES (file &key (width 640) (height 486))
  (let ((a (make-array (list height width) :element-type 'bit :initial-element 0)))
   (with-open-file (s file :direction :input :element-type '(unsigned-byte 1)) 
     (loop for i from 0 below height doing
           (loop for j from 0 below width doing
                 (when (= 255 (read-byte s)) (setf (aref a i j) 1)))))
   a))

(defun N-LONGEST-LINES (edges n &optional (m 1))
  (loop repeat n
        for line in (sort (split-and-merge (edge-image-strings edges)
                            (* 2dg::*string-line-break-max-err* m)
		            (* 2dg::*string-line-break-max-ave-err* m))
                          #'>
                          :key #'(lambda (line) (distance (line-segment-point-1 line)
                                                          (line-segment-point-2 line))))
        collecting line))

(defun CONVEX-LINES-USING-LONGEST (edges n k &optional (m 1))
  (group:convex-lines (n-longest-lines edges n m) nil k))

(defun N-BEST-DISJOINT-CGS (edges k n &key (num-lines 350))
  (n-best-cgs (group::remove-duplicate-answers (convex-lines-using-longest edges num-lines k)) n))

(defun N-BEST-CGS (cgs n)
  (loop repeat n
        for cg in
  (sort (copy-list cgs)
        #'(lambda (cg1 cg2) (< (/ (convex-group-gap-length cg1) 
                                  (convex-group-length cg1))
                               (/ (convex-group-gap-length cg2) 
                                  (convex-group-length cg2)))))
        collecting cg))

(defun CONVEX-GROUP-BOUNDING-LINE-SEGMENTS (cg)
 (reverse
  (loop for cl in (convex-group-lines cg)
        for lr in (convex-group-length-reductions cg)
        collect (make-line-segment 
                  (add (c-line-point-1 cl) (multiply (c-line-vector cl) (car lr)))
                  (add (c-line-point-2 cl) (multiply (c-line-reverse-vector cl) (cadr lr)))))))

(defun SORT-CONVEX-GROUPS-BY-LENGTH (cgs)
  (sort (copy-list cgs) #'> :key #'convex-group-length))

;;; Since a convex group can contain disconnected line segments, it defines two
;;; closed convex polygons.  One is the "inner" ie smallest convex polygon that
;;; contains the group, the other is the "outer" largest such convex polygon.
;;; The useful routines here are: CONVEX-GROUP-INNER-POLYGON-VERTICES and
;;; CONVEX-GROUP-OUTER-POLYGON-VERTICES.

(defun LINE-SEGMENTS-INNER-POLYGON-VERTICES (lss)
  (jarvis-march-convex-hull (loop for ls in lss appending (defining-points-list ls))))

(defun CONVEX-GROUP-INNER-POLYGON-VERTICES (cg)
  (line-segments-inner-polygon-vertices (convex-group-bounding-line-segments cg)))

(defun LINE-SEGMENTS-OUTER-POLYGON-VERTICES (lss)
  "This doesn't work if the polygon is unbounded."
  (jarvis-march-convex-hull (loop for ls1 in (append (last lss) lss)
                                  for ls2 in lss
                                  collecting
                                  (intersection-of-line-and-line
                                    (g-coerce ls1 '2dg::line)
                                    (g-coerce ls2 '2dg::line)))))
         
(defun CONVEX-GROUP-OUTER-POLYGON-VERTICES (cg)
  (line-segments-outer-polygon-vertices (convex-group-bounding-line-segments cg)))

(defun BEST-NON-OVERLAPPING-CGS (cgs)
  (loop for cg in (sort (copy-list cgs) #'> 
                    :key #'(lambda (cg) (/ (convex-group-length cg)
                                           (+ (convex-group-length cg) (convex-group-gap-length cg)))))
        with best-cgs = nil
        doing
    (when (non-overlap-list cg best-cgs) (push cg best-cgs))
        finally (return (reverse best-cgs))))

(defun LEAST-GAP-NON-OVERLAPPING-CGS (cgs)
  (loop for cg in (sort (copy-list cgs) #'<
                    :key #'(lambda (cg) (convex-group-gap-length cg)))
        with best-cgs = nil
        doing
    (when (non-overlap-list cg best-cgs) (push cg best-cgs))
        finally (return (reverse best-cgs))))

(defun NON-OVERLAP-LIST (cg cg-list)
  (loop for cg2 in cg-list 
        always 
     (non-overlap cg cg2)))

(defun NON-OVERLAP (cg1 cg2)
  (loop for cl1 in (convex-group-lines cg1)
        always
     (loop for cl2 in (convex-group-lines cg2)
           always
           (not (eq cl1 cl2)))))