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
/
epidisplay-rcde.lisp
< prev
next >
Wrap
Lisp/Scheme
|
1995-07-20
|
4KB
|
116 lines
;;; EPIDISPLAY-RCDE.LISP
;;;
;;; RCDE routines for displaying epipolar search process during demos
;;;
;;; Author: Robert T. Collins
;;; Date: Mar 1, 1995
;;; based on my earlier epipolar.lisp, written Dec 28, 1993
;;;
;-----------------------------------------------------------------
; (c) Copyright 1995 by The University of Massachusetts
;------------------------------------------------------------------
(in-package 'epipolar :nicknames '(epi))
;;;;***************************************************************
;;;; INITIALIZE EPIPOLAR MATCHING SYSTEM DISPLAY WINDOWS
(defun install-rcde-view (epipolar-view pane)
(let ((view (car (cme::view-list
(cme::get-2d-world-named (view-label epipolar-view))))))
(if view
(progn
(ic::copy-view-to-pane view pane)
(setf (view-window epipolar-view) (ic::top-view pane)))
(error "error installing view"))
pane))
(defun init-epipolar-screens (all-views)
(unless (and (boundp '*epipolar-display-frame*) *epipolar-display-frame*)
(setq *epipolar-display-frame*
(cme::make-cme-frame "UMass Epipolar Matcher")))
(let ((frame *epipolar-display-frame*))
(setf *reference-pane* (ic::get-pane-named "pane-0-1" frame))
(setf *other-pane* (ic::get-pane-named "pane-1-1" frame))
(setf *current-hist-pane* (ic::get-pane-named "pane-1-0" frame))
(setf *accum-hist-pane* (ic::get-pane-named "pane-0-0" frame))
(ic::clear-view-stack *reference-pane*)
(ic::clear-view-stack *other-pane*)
(dolist (view (reverse all-views))
(install-rcde-view view *reference-pane*)
(install-rcde-view view *other-pane*))
frame))
(defun activate-window (window &key (refresh nil))
(let* ((pane (ic::view-window window))
(view-stack (ic::view-stack pane)))
(unless (find window view-stack :test #'eq)
(error "view is not available in this pane"))
(do ((top (ic::top-view pane) (ic::top-view pane)))
((eq top window) window)
(ic::cycle-view-stack pane))
(when refresh
(ic::refresh pane))))
(defun synch-epipolar-screen (window)
(let ((frame (ic::pane-frame (ic::view-window window))))
(when frame
(xw::Xsync
(ic::xdisplay (ic::screen frame))
0))))
;;;;****************************************************************
;;;; LINE DISPLAY ROUTINES - call out to rcde
(defun display-line-tokenset (view tks &key (color *line-color*)
(thickness *line-thickness*))
(cme::display-line-tokenset view tks :color color :thickness thickness))
(defun display-line (view x1 y1 x2 y2 &key (color *line-color*)
(thickness *line-thickness*))
(cme::display-line view x1 y1 x2 y2 :color color :thickness thickness))
;;;;****************************************************************
;;;; DISPLAY EPIPOLAR BOUNDARIES
(defun epipolar-display (view low1 low2 high1 high2 &key (zoom nil)
(color *epipolar-color*)
(thickness *epipolar-thickness*))
(multiple-value-bind (x1 y1) (values-list low1)
(multiple-value-bind (x2 y2) (values-list low2)
(multiple-value-bind (x3 y3) (values-list high1)
(multiple-value-bind (x4 y4) (values-list high2)
(when zoom
(cme::zoom-to-bounding-box
view
(min x1 x2 x3 x4)
(min y1 y2 y3 y4)
(max x1 x2 x3 x4)
(max y1 y2 y3 y4)))
(display-line view x1 y1 x2 y2 :color color :thickness thickness)
(display-line view x2 y2 x4 y4 :color color :thickness thickness)
(display-line view x4 y4 x3 y3 :color color :thickness thickness)
(display-line view x3 y3 x1 y1 :color color :thickness thickness))))))
#|
(defun plot-histogram (window histogram &key min max (numknots 3) (clear t)
(thickness *histogram-thickness*) (color *histogram-color*))
" Plot histogram as a spline on the given window. Returns as multiple values the
histogram array, its minimum, and its maximum element values."
(let ((sequence (hist:histogram-array histogram)))
(let ((max (max (if max max 0) (reduce #'max sequence)))
(min (min (if min min 0) (reduce #'min sequence)))
(size (length sequence)))
(when clear (send window :clear))
(send window :set-image-window 0 (min 0 min) size (- max min))
(dotimes (i size)
(setf (aref *spline-xarr* i) (+ 0.5 i))
(setf (aref *spline-yarr* i) (- max (aref sequence i))))
(send window :display-spline *spline-xarr* *spline-yarr* numknots :color color :thickness thickness)
(values sequence min max))))
|#