;;; -*- Mode: Lisp; Syntax: Common-lisp; Package: MU; Base: 10.; -*- (in-package :mu) ;;; Copyright (c) 1987, Massachusetts Institute of Technology ;;; Author: Mike Drumheller ;;;***************************************************************************** ;;; CHANGE HISTORY ;;; ;;; 10/12/87 WEG Changed the package to mu. Recompiled for Release 7. ;;; 3/1/88 WEG Revised completely to use lxb-color. ;;; 6/5/92 PAO Revised completely to use the generic framegrabber, GRAB. ;;;***************************************************************************** ;;; This file contains code for dealing with the weird 576.-by-454. arrays returned by the frame-grabber. ;;; This file contains the incredibly useful function FORCE-GRABBED-IMAGE-INTO-A-SQUARE ;;; (to be distinguished from MOVE-FRAMES in b:>mike>cm>starlisp>stereo>grabber-utils.lisp, which is ;;; customized to the stereo domain). MOVE-FRAMES takes the bizarre 576-by-454 arrays used by Noble ;;; Larson's frame grabber and puts them into nice 512x512, 256x256, 128x128 or 64x64 arrays. #+symbolics (defun draw-crosshairs (&optional (window (spe:color-window)) x y (alu tv:alu-xor)) (let ((width (scl:send window :width)) (height (scl:send window :height))) (or x (setq x (floor width 2))) (or y (setq y (floor height 2))) (send window :draw-line 0 y (1- width) y alu t) (send window :draw-line x 0 x (1- height) alu t))) (defvar *width-of-top-and-bottom-void* (floor (- 512. 454.) 2)) (defvar *width-of-left-and-right-lossage* (floor (- 576. 512.) 2)) ;;; to avoid paging, don't create these arrays unless necessary (defvar *grabber-512* nil) (defvar *grabber-256* nil) (defvar *grabber-128* nil) (defvar *grabber-64* nil) (defun special-256-sample-from-grabber-no-averaging (frame-grabber-576-by-454 256-by-256) ;;; ;;; Main feature of this: It's fast. ;;; ;;; Takes one of the weird frame-grabber 576-454 arrays and samples it down to 256-by-256, ;;; putting into a new array that you pass. It samples without averaging, so you can ;;; expect severe aliasing. Similarly-named functions in this file do basically the same ;;; thing, but some of them turn the image upside-down too. Why? Because that makes it ;;; possible to mount the cameras "out front" where everyone can see them during demos, ;;; yet still have the images come out right-side-up on the color monitor. Why did you ;;; think? ;;; (loop for i from 0 below 512 by 2 for x from *width-of-left-and-right-lossage* by 2 for new-x from 0 do (loop for y from 0 below 454. by 2 for new-y from (floor *width-of-top-and-bottom-void* 2) do (setf (aref 256-by-256 new-x new-y) (aref frame-grabber-576-by-454 x y)))) 256-by-256) (defun special-256-upside-down-sample-from-grabber-no-averaging (frame-grabber-576-by-454 256-by-256) (loop for i from 0 below 512. by 2 for x from *width-of-left-and-right-lossage* by 2 for new-x from 255 by -1 do (loop for y from 0 below 454. by 2 for new-y from (- 255. (floor *width-of-top-and-bottom-void* 2)) by -1 do (setf (aref 256-by-256 new-x new-y) (aref frame-grabber-576-by-454 x y)))) 256-by-256) (defun special-128-sample-from-grabber-no-averaging (frame-grabber-576-by-454 128-by-128) (loop for i from 0 below 512. by 4 for x from *width-of-left-and-right-lossage* by 4 for new-x from 0 do (loop for y from 0 below 454. by 4 for new-y from (floor *width-of-top-and-bottom-void* 4) do (setf (aref 128-by-128 new-x new-y) (aref frame-grabber-576-by-454 x y)))) 128-by-128) (defun special-128-upside-down-sample-from-grabber-no-averaging (frame-grabber-576-by-454 128-by-128) (loop for i from 0 below 512. by 4 for x from *width-of-left-and-right-lossage* by 2 for new-x from 127 by -1 do (loop for y from 0 below 454. by 4 for new-y from (- 127. (floor *width-of-top-and-bottom-void* 4)) by -1 do (setf (aref 128-by-128 new-x new-y) (aref frame-grabber-576-by-454 x y)))) 128-by-128) ;;; ;;; Always keep in mind that the arrays used by the frame-grabber are 576(horiz) by 454(vert). ;;; ;;; DESCRIPTION OF ARGUMENTS: ;;; ;;; FROM-SIZE is the size of the chunk that you want to read out of the frame-grabber-size array. ;;; IT MUST BE 512, 256, 128, or 64. ;;; ;;; EXAMPLE 1: ;;; Suppose you specify FROM-SIZE = 512. Then the function will read out of a 512x512 chunk centered over the ;;; f.g. arrays, like this: ;;; ;;; ___________512______ ;;; |********************| ;;; ----|----576-------------|---- ;;; |////| |////| ;;; |////| |////| ;;; |////| |////| ;;; 454///| 512///| ;;; |////| |////| ;;; |////| |////| ;;; |____|____________________|____| ;;; |********************| ;;; -------------------- ;;; ;;; the main point being, of course, that there IS no 512x512 chunk that you can take out of the middle of a ;;; 576x454 array. So it does the best it can. If you specify 512 as the FROM-SIZE argument you will get ;;; blank strips on the top and the bottom, and you will lose information on both sides. The areas marked ;;; with ///// will be lost and the areas marked with ***** will be filled in with zeroes. ;;; ;;; EXAMPLE 2: ;;; Suppose you specify FROM-SIZE = 256. Then the function will read out of a 256x256 chunk centered over the ;;; f.g. arrays, like this: ;;; ;;; ---------576------------------ ;;; |//////////////////////////////| ;;; |////////|----256----|/////////| ;;; |////////| |/////////| ;;; 454///////| |/////////| ;;; |////////| 256////////| ;;; |////////| |/////////| ;;; |////////|-----------|/////////| ;;; |//////////////////////////////| ;;; ------------------------------ ;;; ;;; If these examples don't suffice to get the point across, I suspect that you have not had enough to drink ;;; yet. ;;; ;;; TO-ARRAY is the array that you want to dump the frame-grabber's 576-454's into. ;;; IT MUST BE 512x512, 256x256, 128x128, or 64x64 and less than FROM-SIZE. ;;; ;;; (If you have specified 512 for FROM-SIZE, then you will get blank strips on the top and bottom and you lose ;;; the sides, no matter what you specify for TO-SIZE.) ;;; ;;; If TO-SIZE < FROM-SIZE, then the function automatically sub-samples accordingly. ;;; ;;; WITH-AVERAGING? lets you specify whether you want the sub-sampling to be done with or without averaging (a ;;; simple, linear average). Averaging before downsampling reduces aliasing. ;;; ;;; UPSIDE-DOWN? lets you specify whether you want the pictures to be rotated 180 degrees before being ;;; inserted into the new arrays. This bizarre feature was added because the cameras happen to be mounted ;;; upside down with respect to the normal viewing position of a persion watching the demonstration. ;;; ;;; SOURCE-ARRAY is the array you're getting the data from ;;; ;;; Known bugs: ;;; Does not do averaging if you specify UPSIDE-DOWN? = non-nil AND TO-SIZE < FROM-SIZE. Is a complete hack in ;;; the 64x64 case. ;;; (defun force-grabbed-image-into-a-square-sanity-checks (source-array-xdim source-array-ydim from-size dest-array-xdim dest-array-ydim) (cond ((not (and (= source-array-xdim *frame-width*) (= source-array-ydim *frame-height*))) (error "SOURCE-ARRAY must be 576x454, not ~ax~a" source-array-xdim source-array-ydim))) (cond ((not (or (= from-size 512) (= from-size 256) (= from-size 128) (= from-size 64))) (error "FROM-SIZE (~a) must be 512, 256, 128 or 64." from-size))) (cond ((not (= dest-array-xdim dest-array-ydim)) (error "DEST-ARRAY must be square, not ~ax~a" dest-array-xdim dest-array-ydim)) ((not (<= dest-array-xdim from-size)) (error "XDIM of DEST-ARRAY (~a) must be less-or-equal to FROM-SIZE (~a)." dest-array-xdim from-size)) ((not (or (= dest-array-xdim 512) (= dest-array-xdim 256) (= dest-array-xdim 128) (= dest-array-xdim 64))) (error "XDIM of DEST-ARRAY must be 512, 256, 128 or 64: ~a" dest-array-xdim)))) (defun force-grabbed-image-into-a-square (source-array dest-array &optional with-averaging? upside-down? (from-size 512)) (multiple-value-bind (source-array-xdim source-array-ydim) (vu:decode-raster-array source-array) (multiple-value-bind (dest-array-xdim dest-array-ydim) (vu:decode-raster-array dest-array) (force-grabbed-image-into-a-square-sanity-checks source-array-xdim source-array-ydim from-size dest-array-xdim dest-array-ydim) (let ((sample-rate (/ from-size dest-array-xdim))) (ecase dest-array-xdim (512 (vu:zero-raster dest-array) #+lucid (progn (assert (and (= *frame-height* 512) (= *frame-width* 512) (= (vu:array-element-size source-array) 8))) (let ((dd (sys:underlying-simple-vector dest-array)) (ss (sys:underlying-simple-vector source-array))) (declare (type (simple-array (unsigned-byte 8)) dd ss)) (dotimes (i (array-total-size source-array)) (setf (aref dd i) (aref ss i))))) #+symbolics (zl-user:bitblt tv:alu-seta 512 *frame-height* source-array (floor (- *frame-width* 512) 2) 0 dest-array 0 (floor (- 512 *frame-height*) 2))) (256 (vu:zero-raster dest-array) (cond ((and with-averaging? (not upside-down?)) (format t "~%Moving 576x454 array into 256x256 array, sampling with averaging...") (sample-raster source-array :linear-factor 2 :average? t :sampled-raster dest-array)) (upside-down? (format t "~%Moving 576x454 array into 256x256 array, rotating 180 degrees, no averaging...") (special-256-upside-down-sample-from-grabber-no-averaging source-array dest-array)) (t (format t "~%Moving 576x454 array into 256x256 array, no averaging...") (sample-raster source-array :linear-factor 2 :average? nil :sampled-raster dest-array)))) (128 (vu:zero-raster dest-array) (cond ((and with-averaging? (not upside-down?)) (format t "~%Moving 576x454 array into 128x128 array, sampling with averaging...") (sample-raster source-array sample-rate t dest-array)) (upside-down? (format t "~%Moving 576x454 array into 128x128 array, rotating 180 degrees, no averaging...") (special-128-upside-down-sample-from-grabber-no-averaging source-array dest-array)) (t (format t "~%Moving 576x454 array into 128x128 array, no averaging...") (special-128-sample-from-grabber-no-averaging source-array dest-array)))) (64 (vu:zero-raster dest-array) (sample-raster source-array sample-rate with-averaging? dest-array)))))))