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 / ascendMar8.tar / UMass / Epipolar / #epidisplay-rcde.lisp# next >
Lisp/Scheme  |  1995-11-07  |  4KB  |  117 lines
  1. ;;; EPIDISPLAY-RCDE.LISP
  2. ;;;
  3. ;;; RCDE routines for displaying epipolar search process during demos
  4. ;;;
  5. ;;; Author: Robert T. Collins
  6. ;;; Date: Mar 1, 1995
  7. ;;; based on my earlier epipolar.lisp, written Dec 28, 1993
  8. ;;;
  9. ;-----------------------------------------------------------------
  10. ; (c) Copyright 1995 by The University of Massachusetts
  11. ;------------------------------------------------------------------
  12.  
  13. (in-package 'epipolar :nicknames '(epi))
  14.  
  15.  
  16. ;;;;***************************************************************
  17. ;;;; INITIALIZE EPIPOLAR MATCHING SYSTEM DISPLAY WINDOWS
  18.  
  19. (defun install-rcde-view (epipolar-view pane)
  20.   (let ((view (car (cme::view-list 
  21.             (cme::get-2d-world-named (view-label epipolar-view))))))
  22.     (if view
  23.     (progn
  24.       (ic::copy-view-to-pane view pane)
  25.       (setf (view-window epipolar-view) (ic::top-view pane)))
  26.       (error "error installing view"))
  27.     pane))
  28.  
  29. (defun init-epipolar-screens (all-views)
  30.   (unless (and (boundp '*epipolar-display-frame*) *epipolar-display-frame*)
  31.       (setq *epipolar-display-frame* 
  32.         (cme::make-cme-frame "UMass Epipolar Matcher")))
  33.   (let ((frame *epipolar-display-frame*))
  34.     (setf *reference-pane* (ic::get-pane-named "pane-0-1" frame))
  35.     (setf *other-pane* (ic::get-pane-named "pane-1-1" frame))
  36.     (setf *current-hist-pane* (ic::get-pane-named "pane-1-0" frame))
  37.     (setf *accum-hist-pane* (ic::get-pane-named "pane-0-0" frame))
  38.     (ic::clear-view-stack *reference-pane*)
  39.     (ic::clear-view-stack *other-pane*)
  40.     (dolist (view (reverse all-views))
  41.     (install-rcde-view view *reference-pane*)
  42.     (install-rcde-view view *other-pane*))
  43.     frame))
  44.  
  45. (defun activate-window (window &key (refresh nil))
  46.   (let* ((pane (ic::view-window window))
  47.      (view-stack (ic::view-stack pane)))
  48.     (unless (find window view-stack :test #'eq)
  49.        (error "view is not available in this pane"))
  50.     (do ((top (ic::top-view pane) (ic::top-view pane)))
  51.     ((eq top window) window)
  52.       (ic::cycle-view-stack pane))
  53.     (when refresh
  54.       (ic::refresh pane))))
  55.  
  56. (defun synch-epipolar-screen (window)
  57.   (let ((frame (ic::pane-frame (ic::view-window window))))
  58.     (when frame
  59.       (xw::Xsync
  60.        (ic::xdisplay (ic::screen frame))
  61.        0))))
  62.  
  63. ;;;;****************************************************************
  64. ;;;; LINE DISPLAY ROUTINES - call out to rcde
  65.  
  66. (defun display-line-tokenset (view tks &key (color *line-color*) 
  67.                    (thickness *line-thickness*))
  68.   (cme::display-line-tokenset view tks :color color :thickness thickness))
  69.  
  70.  
  71. (defun display-line (view x1 y1 x2 y2 &key (color *line-color*)
  72.               (thickness *line-thickness*))
  73.   (cme::display-line view x1 y1 x2 y2 :color color :thickness thickness))
  74.  
  75.  
  76. ;;;;****************************************************************
  77. ;;;; DISPLAY EPIPOLAR BOUNDARIES
  78.  
  79. (defun epipolar-display (view low1 low2 high1 high2 &key (zoom nil) 
  80.                   (color  *epipolar-color*) 
  81.                   (thickness *epipolar-thickness*))
  82.   (multiple-value-bind (x1 y1) (values-list low1)
  83.   (multiple-value-bind (x2 y2) (values-list low2)
  84.   (multiple-value-bind (x3 y3) (values-list high1)
  85.   (multiple-value-bind (x4 y4) (values-list high2)
  86.     (when zoom
  87.        (cme::zoom-to-bounding-box
  88.       view
  89.       (min x1 x2 x3 x4)
  90.       (min y1 y2 y3 y4)
  91.       (max x1 x2 x3 x4)
  92.       (max y1 y2 y3 y4)))
  93.     (display-line view x1 y1 x2 y2 :color color :thickness thickness)
  94.     (display-line view x2 y2 x4 y4 :color color :thickness thickness)
  95.     (display-line view x4 y4 x3 y3 :color color :thickness thickness)
  96.     (display-line view x3 y3 x1 y1 :color color :thickness thickness))))))
  97.  
  98. #|
  99. (defun plot-histogram (window histogram &key min max (numknots 3)  (clear t)
  100.                (thickness *histogram-thickness*) (color *histogram-color*))
  101.   "  Plot histogram as a spline on the given window.  Returns as multiple values the
  102.  histogram array, its minimum, and its maximum element values."
  103.   (let ((sequence (hist:histogram-array histogram)))
  104.     (let ((max (max (if max max 0) (reduce #'max sequence)))
  105.       (min (min (if min min 0) (reduce #'min sequence)))
  106.       (size (length sequence)))
  107.       (when clear (send window :clear))
  108.       (send window :set-image-window 0 (min 0 min) size (- max min))
  109.       (dotimes (i size)
  110.     (setf (aref *spline-xarr* i) (+ 0.5 i))
  111.     (setf (aref *spline-yarr* i) (- max (aref sequence i))))
  112.       (send window :display-spline *spline-xarr* *spline-yarr* numknots  :color color :thickness thickness)
  113.       (values sequence min max))))
  114.  
  115.  
  116. |#
  117.