home *** CD-ROM | disk | FTP | other *** search
/ vis-ftp.cs.umass.edu / vis-ftp.cs.umass.edu.tar / vis-ftp.cs.umass.edu / pub / Software / ASCENDER / ascender.tar.Z / ascender.tar / Epipolar / epiinit-rcde.lisp < prev    next >
Lisp/Scheme  |  1996-03-06  |  6KB  |  160 lines
  1. ;;; EPIINIT-RCDE.LISP
  2. ;;;
  3. ;;; Init epipolar matcher within RCDE
  4. ;;; to be used in conjunction with $CME/code/CME-5d/UMass/umass-system.lisp
  5. ;;;
  6. ;;; Author: Robert T. Collins
  7. ;;; Date: Apr 13, 1995
  8. ;;;
  9. ;-----------------------------------------------------------------
  10. ; (c) Copyright 1995 by The University of Massachusetts
  11. ;------------------------------------------------------------------
  12.  
  13. (in-package 'cme)
  14.  
  15. (defvar *tokenset-grid-cache* nil 
  16.   "cache of grid structures for line tokensets")
  17.  
  18. (defvar *projection-fbipfile-cache* nil 
  19.   "cache of ascii-fbip files for 3d-to-2d projections")
  20.  
  21.  (defun get-or-make-line-grid (tokenset)
  22.   (let ((grid (second (find tokenset *tokenset-grid-cache* :key #'car))))
  23.     (unless grid
  24.        (format t "Making ISR grid structure for ~a...~%" tokenset)
  25.        (setf grid (epi::gridify-data-lines tokenset))
  26.        (push (list tokenset grid) *tokenset-grid-cache*))
  27.     grid))
  28.  
  29.  
  30. (defun get-or-make-fbip-file (2dworld)
  31.     (let* ((proj (3d-to-2d-projection 2dworld))
  32.            (fbip nil)
  33.            (filename (second (find proj *projection-fbipfile-cache* :key #'car))))
  34.       (unless filename
  35.          (setf filename
  36.                (concatenate 'string
  37.                   (translated-unix-path
  38.             (format nil "~a" user::*temp-directory*))
  39.                   (replace-spaces-with-hyphens (string (name 2dworld)))
  40.                   ".ascii-fbip"))
  41.          (format t "Writing temp fbip file ~a...~%" filename)
  42.          (ecase (type-of proj)
  43.            (FAST-BLOCK-INTERPOLATION-PROJECTION
  44.             (setf fbip proj))
  45.            (4X4-COORDINATE-PROJECTION
  46.             (setf fbip nil)) ;(make-dummy-fbip-shell (base-image 2dworld) proj)))
  47.            (COMPOSITE-COORDINATE-PROJECTION
  48.             (let ((tlist (transform-list proj)))
  49.               (if (and
  50.                    (typep (first tlist) '4X4-COORDINATE-TRANSFORM)
  51.                    (typep (second tlist) 'FAST-BLOCK-INTERPOLATION-PROJECTION))
  52.                   (let ((oldfbip (fbip (second tlist))))
  53.                     (setf fbip (make-fast-block-interpolation-projection
  54.                      :projection proj
  55.                                 :z-levels (fbip-z-levels oldfbip)
  56.                                 :umin (fbip-umin oldfbip)
  57.                                 :umax (fbip-umax oldfbip)
  58.                                 :vmin (fbip-vmin oldfbip)
  59.                                 :vmax (fbip-vmax oldfbip)
  60.                                 :blocks-wide (fbip-blocks-wide oldfbip)
  61.                                 :blocks-hi (fbip-blocks-hi oldfbip))))
  62.                   (error "Can only handle composite transforms of the form (4X4-COORDINATE-TRANSFORM FAST-BLOCK-INTERPOLATION-PROJECTION)")))))
  63.          (when fbip (write-ascii-data-bip-file fbip filename))
  64.      (push (list proj filename) *projection-fbipfile-cache*))
  65.       filename))
  66.  
  67.  
  68. (defun rcde-init-epi-view (2dworld &key 
  69.          (require-boldt-lines (not epi::*topdown-line-finder*))
  70.          (require-view-loaded epi::*demo-mode*))
  71.   (let* ((linefs (find-fs-named 2dworld *2d-line-fsname*))
  72.      (isrobject (when linefs
  73.                (find 'ISR-LINE-TOKENSET-OBJECT (inferiors linefs) 
  74.                  :key #'type-of :test #'equal)))
  75.      (rcde-view (car (view-list 2dworld))))
  76.     (when (and
  77.        (or (not require-view-loaded) (and require-view-loaded rcde-view))
  78.        (or (not require-boldt-lines) (and require-boldt-lines isrobject)))
  79.        (let ((view (epi::make-view :label (name 2dworld)))
  80.          (tks (and isrobject (tokenset isrobject))))
  81.      (setf (epi::view-image view) 
  82.            (ic::top-of-image-hierarchy (view-image rcde-view)))
  83.      (setf (epi::view-projection view) (3d-to-2d-projection 2dworld))
  84.      (setf (epi::view-projfile view) (get-or-make-fbip-file 2dworld))
  85.      (setf (epi::view-line-tokenset view) tks)
  86.      (setf (epi::view-line-grid view) (and tks (get-or-make-line-grid tks)))
  87.      (setf (epi::view-topdown-linelist view) nil)
  88.      (setf (epi::view-topdown-edgels view) nil)
  89.      (setf (epi::view-window view) rcde-view)
  90.      view))))
  91.  
  92.  
  93. (defvar *epipolar-viewlist* nil "list of view structures for epipolar matcher")
  94.  
  95. (defun find-epi-view-for-world (2dworld)
  96.   (find (name 2dworld) *epipolar-viewlist* 
  97.     :key #'epi::view-label :test #'string-equal))
  98.  
  99. (defun find-the-other-epi-views (2dworld)
  100.   (remove (name 2dworld) *epipolar-viewlist*
  101.       :key #'epi::view-label :test #'string-equal))
  102.  
  103. ;;for mb1 zmin = -92.0 zmax = 146.0
  104.  
  105. (defun rcde-init-epipolar-views (3dworld)
  106.   (setf *epipolar-viewlist* nil)
  107.   (dolist (2dworld (2d-worlds 3dworld))
  108.      (let ((view (rcde-init-epi-view 2dworld)))
  109.        (when view (push view *epipolar-viewlist*))))
  110.   3dworld)
  111.  
  112.  
  113. (defun rcde-init-height-histograms (zmin zmax)
  114.   (epi::set-global-height-range zmin zmax)
  115.   (epi::init-epipolar-histograms))
  116.  
  117. (defun  trans-vertex-list (transform vertex-list)
  118.   (mapcar #'(lambda (vert)
  119.           (cme::bind-vertex-elements (x y)
  120.          (cme::inline-transform transform vert)
  121.          (list x y)))
  122.       vertex-list))
  123.  
  124. (defun linelist-from-2dcurve (curve)
  125.   (let* ((trans (cme::object-to-world-transform curve))
  126.      (vertexlist (la::listarray (cme::vertices curve)))
  127.      (vertices (trans-vertex-list trans vertexlist))
  128.      (n (length vertices))
  129.      (result nil))
  130.     (dotimes (i n (nreverse result))
  131.        (push (append (elt vertices i) (elt vertices (mod (+ i 1) n)))
  132.          result))))
  133.  
  134.  
  135. (defun rcde-run-epipolar-matcher (2dworld curve &key (filename nil)
  136.                    (endpoint-slop 1.0)(delta-theta .1)
  137.                    (run-canny? epi::*topdown-line-finder*))
  138.   (let ((view1 (find-epi-view-for-world 2dworld))
  139.     (otherviews (find-the-other-epi-views 2dworld))
  140.     (linelist (linelist-from-2dcurve curve)))
  141.     (when run-canny?
  142.        (dolist (view2 otherviews)
  143.      (let ((boundingbox (epi::epipolar-search-area-bbox 
  144.                    view1 view2 linelist)))
  145.        (setf (epi::view-topdown-edgels view2)
  146.          (apply #'compute-2dworld-canny-edges 
  147.             (epi::view-image view2)
  148.             boundingbox)))))
  149.     (let ((match (epi::epipolar-match-linelist
  150.           view1 linelist otherviews
  151.           :endpoint-slop endpoint-slop
  152.           :delta-theta delta-theta)))
  153.       (when filename
  154.      (epi::save-matches-to-file match filename))
  155.       (when run-canny?
  156.      (dolist (view2 otherviews)
  157.         (free-edgeimg (epi::view-topdown-edgels view2))))
  158.       match)))
  159.  
  160.