CELESTIAL PROGRAMMING WITH TURBO PASCAL
The CCD camera brings astrophotography to the PC
Lars Frid-Nielsen and Alex Lane
Few things stir more interest in astronomy than the dramatic pictures of galaxies and nebulae in books at your local public library. Virtually all of these photographs are taken using large telescopes at the world's major astronomical observatories. Up until a few years ago, the amateur astronomer's enjoyment of the universe was almost entirely restricted to those images seen from the eyepiece of the telescope.
Thanks to the development of SchmidtCassegrain technology, amateur astronomers now have access to affordable, portable, large-aperture telescopes capable of capturing the universe on photographic film. As color films have increasingly become more light-sensitive, sensational pictures are a reality using nothing more than a 10-inch telescope and the local 1-hour photoshop. The technical revolution experienced by amateur astronomers in the field of astrophotography is now on the verge of another dramatic breakthrough, thanks primarily to an apparatus known as the Charge Coupled Device (CCD) camera which can be connected to a PC and used to capture images. This article describes a project using a CCD camera and Turbo Pascal to deliver a digital image to a PC where it can then be displayed, stored, and processed.
The CCD Camera
The CCD camera used contains a 640 x 518 array of light-sensitive cells. These cells convert the photons gathered by the telescope into individual electric signals. Each signal is electronically amplified, rendering light sensitivity far superior to traditional photograhic emulsions. CCD cameras have a linear response to faint light signals, eliminating a shortcoming of conventional photographic emulsions, called reciprocity failure, where the exposure time required to record faint light sources grows exponentially. Reciprocity failure translates directly into hour-long sessions guiding the eyepiece of a telescope, which is no fun at all.
The signals from the light-sensitive cells are processed by the CCD camera and are output in the form of a black-and-white NTSC television signal. The camera connects to an interface card, sampling 256 points on every other scan line, with each point having one of 64 levels of intensity.
Capturing the Image
Grabbing the image is the job of the Capture procedure in Listing One , page 106. Capture sends a reset signal to the interface card, signals the card to begin capturing information, then drops into a while loop to continue the process until the image is captured. Once captured by the interface card, the image must be tranfered to the program. The program represents the image as a variant record called pictype, which can be accessed either as a framerec record or in "raw" form. As a framerec, an array of records represents the individual lines of the image. (There is a byte reserved for synchronization both before and after this array.) A synchronization byte and an array of byte values represent each line, in turn. In raw form, image data is treated as an array of integers, which is convenient for storing the information in a file, as shown in the Save-Procedure function.
The Scan procedure transfers data in the card to a pictype record. In earlier versions of the program, Scan was coded in Pascal, but was rewritten in assembler and integrated using Turbo Pascal 6.0's built-in assembler. The original code is retained in the listing as a comment.
CPU input/outport ports are used to transfer data from the card to the pictype record, and perform necessary communication with the card. The original Pascal code makes use of the predefined Port array to access the CPU's I/0 ports, allowing about one image per second to be scanned on a 20-MHz 386SX machine equipped with a VGA display. The assembler code is much more efficient, allowing nearly eight images per second to be scanned with the same setup.
Processing the Image
Computer-enhanced photographs sent back by space probes such as Viking and Voyager underscore the importance of computers in manipulating images. While the capabilities of this program are not as advanced as those used by NASA, you still exercise a great deal of control over the appearance of CCD images. Typical manipulations include adding, subtracting, or masking images, comparing images, adding or subtracting constant values to images, establishing thresholds in images, inverting images, and filtering images. Virtually all of these manipulations do line-by-line, cell-by-cell processing of a pictype record.
Histograms play an important role in helping you process images. The HistoWindow consists of a pointer to a HistoView and a constructor, which creates a non-resizeable window and then constructs and displays its HistoView inside the window. The HistoView, in its constructor, calls its own Update method, taking a pointer to an image and distributing the image pixels into 64 intensity levels detectable by the interface card. Update then calls its ancestor's DrawView method to display the histogram.
A typical histogram, generated from an image of the moon's surface, is shown in Figure 1. We can see from the histogram that there are about 15 different intensities recorded in the image. We can increase the range of intensities in this image to nearly full range by multiplying each cell's intensity four-fold. The resulting histogram is shown in Figure 2. Figure 3 shows the "enhanced" image represented by the histogram in Figure 2.
The Evolution of the UI
As with many programs, the kernel of the program was developed fairly quickly and had a rudimentary user interface. You entered information in response to screen prompts, and because the program stored no state information, you repeatedly entered the same information. We incorporated Turbo Pascal's application framework, Turbo Vision, to improve the front end of the program. (Pull-down menus and hotkeys are important advantages when you consider that the program is often used in very dim light and in weather cold enough to require gloves!)
Turbo Vision provides a fully controllable event-driven architecture, so you only have to write code sufficient for handling events that distinguish your object type's code from its ancestor's code. As such, there are two basic steps to building an event-driven program with Turbo Vision. First, you define the actions causing events to which your program will respond. Second, you define what to do when events actually occur. The intermediate step of identifying events is done by Turbo Vision's event handler (part of the TApplication object). The event handler automatically queues events for processing.
Listing Two, page 109 presents the main file, which includes all of the Turbo Vision code for the program. A set of constants at the beginning of CCD.PAS establishes symbols representing commands. In this way, when we need to refer to the Open File command, we can use cmFOpen instead of the numerical value 1000.
Listing Two also declares three object types derived from object types in the Turbo Vision hierarchy. CCDpgm is derived from the TApplication object type, while the HistoView and HistoWindow types are derived from TView and TWindow, respectively. CCDpgm adds methods for file I/0, image display, and histogram updating, as well as providing virtual methods for initializing the menu bar and status line, and handling events.
The actions of the program are defined in the CCDpgm.InitMenuBar and CCDpgm.InitStatusLine methods. These methods use nested calls to NewItem and NewStatusKey to construct linked lists of menu bar and status line items. This syntax makes modification easy--for instance, to add a menu item, insert a call to NewItem at the appropriate spot, supply appropriate parameters, then insert a closing parenthesis at the end of the remaining nested statements.
The task of handling events as they occur is performed by the virtual method HandleEvent. This method is called any time an event is identified, so a call is first made to the ancestor TApplication.HandleEvent method, allowing the generic application to take care of routine events. If an event is user-defined, however, the case statement in this method defines how each event is handled.
For example, if the user just used a mouse (or the F3 hotkey) to select Open under the File menu bar selection, a cmFOpen command is generated, and passed to the HandleEvent method, where code associated with cmFOpen is executed.
This case statement format facilitates incremental development. For example, the code to execute for the command cmExpInteg is a call to a procedure called NotImplemented, which calls Turbo Vision's MessageBox function, informing the user that the feature in question is not yet implemented. The value returned by MessageBox can be discarded because the file CCD.PAS specifies the use of extended syntax with the $X compiler directive at the top of the file.
Of particular interest in the CCDpgm object type is the SetMenuItem method, which dynamically modifies menu item text using OnTxt and OffTxt string constants. It does this by accessing the items in the MenuBar, searching for a match and concatenating the appropriate On or Off string to the item. Here, a pulldown menu shows the user whether or not the program is set to use high-resolution VGA, do auto display, or perform a photo session.
To Graphics Mode and Back
A major challenge to developing the UI was the need to switch from text to VGA graphics mode to display an image, then to switch back to text mode. The solution is to disable or suspend Turbo Vision long enough to display the image, then to enable it again. If you don't disable Turbo Vision prior to switching to graphics mode, Turbo Vision will continue to process input as it sees fit, which will likely lead to trouble as it misinterprets events in VGA mode.
The switches are accomplished with the help of the GraphicsStart and GraphicsStop procedures. GraphicsStart shuts down Turbo Vision's error-message and event handling with calls to DoneSysError and DoneEvents, respectively, restores the initial screen mode and cursor, and frees memory with calls to DoneVideo and DoneMemory.
Once Turbo Vision is shut down, the procedure Display_Image changes the video mode to the appropriate VGA or high-resolution VGA mode as shown in Example 1. Listing Three, page 112, presents the code for displaying the CCD image in VGA mode. Finally, in returning from VGA mode, the procedure GraphicsStop reestablishes Turbo Vision by initializing its memory, video, event and error handlers, and redraws the textmode screen.
Example 1: Switching to VGA or high-resolution VGA graphics mode
if VGAhiRes then
beginb
r.AX := ($00 SHL 8) OR $61;
Intr(VideoInt,r);
mode := 1;
end
else
begin
r.AX := ($00 SHL 8) OR $13;
Intr(VideoInt,r);
mode := 0;
end
Future Directions
The program is easily enhanced, due in part to the ease with which the interface can be modified. For example, more sophisticated image processing and filtering can be added to allow user experimentation with various algorithms. The program can also be enhanced by storing files in a standard format, such as PCX or TIFF.
The system we described in this article clearly illustrates how advances in technology are bringing once-distant subjects out of books and onto our desktops. The PC and its software are the key elements to providing us evergreater possibilities.
Products Mentioned
MS-4000 Series Solid State Video Camera Sierra Scientific 605 California Ave. Sunnyvale, CA 94086 408-745-1500
Frame Grabber IDEC Inc. 1195 Doylestown Pike Quakertown, PA 18951 215-538-2600
Turbo Pascal 6.0 Borland International 1800 Green Hills Road Scotts Valley, CA 95066 408-438-8400
_CELESTIAL PROGRAMMING WITH TURBO PASCAL_ by Lars Frid-Neilson and Alex Lane[LISTING ONE]
<a name="015c_000c">
unit Video;
{*******************************************************}
interface
{*******************************************************}
{ Global constants }
CONST
{--- defaults for Supervision card setup }
Aport = $2F0; { first port on the card }
Bport = $2F1; { second port on the card }
{--- field control bytes }
fieldsync = $40; { new field! }
linesync = $41; { new line }
fldend = $42; { end of field }
rep1 = $80; { repeat x1 }
rep16 = $90; { repeat x16 }
{--- image structure }
maxbit = $3F; { bits used in pel }
maxpel = 255; { highest pel index }
maxline = 252; { highest line index }
maxbuffer = 32766; { highest "INT" index }
{ Global types }
TYPE
bitrng = 0..maxbit; { bit range }
pelrng = 0..maxpel; { pel indexes }
framerng = 0..maxline; { line indexes }
subrng = 0..maxbuffer; { raw data indexes }
pelrec = RECORD { one scan line }
syncL : BYTE;
pels : ARRAY[pelrng] OF BYTE;
END;
framerec = RECORD { complete binary field }
syncF : BYTE;
lines : ARRAY[framerng] OF pelrec;
syncE : BYTE;
END;
rawrec = ARRAY[subrng] OF INTEGER;
picptr = ^pictype; { picture ptr }
pictype = RECORD CASE INTEGER OF { picture formats}
0 : (fmt : framerec);
1 : (words : rawrec);
END;
histtype = ARRAY[bitrng] OF Word; { pel histograms }
regrec = RECORD CASE INTEGER OF
1 : (AX : INTEGER;
BX : INTEGER;
CX : INTEGER;
DX : INTEGER;
BP : INTEGER;
SI : INTEGER;
DI : INTEGER;
DS : INTEGER;
ES : INTEGER;
FLAGS : INTEGER);
2 : (AL,AH : BYTE;
BL,BH : BYTE;
CL,CH : BYTE;
DL,DH : BYTE);
END;
byteptr = ^BYTE; { general ptr }
strtype = STRING[255]; { strings }
Hextype = STRING[4];
{ Global functions and procedures }
PROCEDURE Add(pic1,pic2 : picptr);
PROCEDURE Subtract(pic1,pic2 : picptr);
PROCEDURE Mask(pic1,pic2 : picptr);
PROCEDURE Compare(pic1,pic2 : picptr);
PROCEDURE Offset(pic1 : picptr; newoffs : BYTE);
PROCEDURE Negoffset(pic1 : picptr; newoffs : BYTE);
PROCEDURE Multiply(pic1 : picptr; newscale : REAL);
PROCEDURE Threshold(pic1 : picptr; level : BYTE);
PROCEDURE Invert(pic1 : picptr);
PROCEDURE Filter1(pic1,pic2 : picptr);
PROCEDURE Edge(pic1,pic2 : picptr);
PROCEDURE Histogram(pic1 :picptr; VAR histo : histtype);
PROCEDURE PicSetup(VAR newpic : picptr);
function SavePicture(filespec : strtype; pic : picptr): integer;
function LoadPicture(filespec : strtype; pic : picptr): integer;
PROCEDURE SetSyncs(pic1 : picptr);
PROCEDURE Card;
function Capture: BOOLEAN;
PROCEDURE Scan(pic1 : picptr);
{*******************************************************}
implementation
{*******************************************************}
{ Do pic1 + pic2 into pic3 }
{ Sticks at maxbit }
PROCEDURE Add(pic1,pic2 : picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
pelval : INTEGER; { pel value }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO BEGIN
pelval := pic1^.fmt.lines[lndx].pels[pndx] +
pic2^.fmt.lines[lndx].pels[pndx];
IF pelval > maxbit THEN
pic1^.fmt.lines[lndx].pels[pndx] := maxbit
ELSE
pic1^.fmt.lines[lndx].pels[pndx] := pelval;
END;
END;
{ Do pic1 - pic2 into pic3 }
{ Sticks at zero for pic1 < pic2 }
PROCEDURE Subtract(pic1,pic2 : picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO
IF pic1^.fmt.lines[lndx].pels[pndx] >=
pic2^.fmt.lines[lndx].pels[pndx]
THEN
pic1^.fmt.lines[lndx].pels[pndx] :=
pic1^.fmt.lines[lndx].pels[pndx] -
pic2^.fmt.lines[lndx].pels[pndx]
ELSE
pic1^.fmt.lines[lndx].pels[pndx] := 0;
END;
{ Do pic1 masked by pic2 into pic3 }
{ Only pic1 pels at non-zero pic2 pels go to pic3 }
PROCEDURE Mask(pic1,pic2 : picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO
IF pic2^.fmt.lines[lndx].pels[pndx] = 0 then
pic1^.fmt.lines[lndx].pels[pndx] := 0;
END;
{ Do Abs(pic1 - pic2) into pic3 }
{ Detects changes in images }
PROCEDURE Compare(pic1,pic2: picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO
pic1^.fmt.lines[lndx].pels[pndx] := Abs(
pic1^.fmt.lines[lndx].pels[pndx] -
pic2^.fmt.lines[lndx].pels[pndx]);
END;
{ Add a constant to pic1 }
PROCEDURE Offset(pic1 : picptr;
newoffs : BYTE);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
pelval : INTEGER; { pel value }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO BEGIN
pelval := newoffs + pic1^.fmt.lines[lndx].pels[pndx];
IF (pelval AND $FFC0) = 0 THEN
pic1^.fmt.lines[lndx].pels[pndx] := pelval
ELSE
pic1^.fmt.lines[lndx].pels[pndx] := maxbit;
END;
END;
{ subtract a value from a picture }
PROCEDURE Negoffset(pic1 : picptr;
newoffs : BYTE);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
pelval : INTEGER; { pel value }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO BEGIN
pelval := pic1^.fmt.lines[lndx].pels[pndx] - newoffs;
IF (pelval AND $FFC0) = 0 THEN
pic1^.fmt.lines[lndx].pels[pndx] := pelval
ELSE
pic1^.fmt.lines[lndx].pels[pndx] := maxbit;
END;
END;
{ Multiply pic1 by a value }
{ Sticks at maximum value }
PROCEDURE Multiply(pic1 : picptr; newscale : REAL);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
pelval : INTEGER; { pel value }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO BEGIN
pelval := Trunc(newscale * pic1^.fmt.lines[lndx].pels[pndx]);
IF (pelval AND $FFC0) = 0 THEN
pic1^.fmt.lines[lndx].pels[pndx] := pelval
ELSE
pic1^.fmt.lines[lndx].pels[pndx] := maxbit;
END;
END;
{ Threshold pic1 at a brightness level }
PROCEDURE Threshold(pic1 : picptr;
level : BYTE);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO
IF pic1^.fmt.lines[lndx].pels[pndx] < level
THEN pic1^.fmt.lines[lndx].pels[pndx] := 0;
END;
{ Invert pel values }
PROCEDURE Invert(pic1 : picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO
pic1^.fmt.lines[lndx].pels[pndx] := maxbit AND
(NOT pic1^.fmt.lines[lndx].pels[pndx]);
END;
{ Filter by averaging vertical and horizontal neighbors }
PROCEDURE Filter1(pic1,pic2 : picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 1 TO (maxline-1) DO
FOR pndx := 1 TO (maxpel-1) DO
pic2^.fmt.lines[lndx].pels[pndx] :=
(pic1^.fmt.lines[lndx-1].pels[pndx] +
pic1^.fmt.lines[lndx+1].pels[pndx] +
pic1^.fmt.lines[lndx].pels[pndx-1] +
pic1^.fmt.lines[lndx].pels[pndx+1])
SHR 2;
END;
{ Edge detection }
PROCEDURE Edge(pic1,pic2 : picptr);
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR lndx := 1 TO (maxline-1) DO
FOR pndx := 1 TO (maxpel-1) DO
pic2^.fmt.lines[lndx].pels[pndx] :=
(Abs(pic1^.fmt.lines[lndx-1].pels[pndx] -
pic1^.fmt.lines[lndx+1].pels[pndx]) +
Abs(pic1^.fmt.lines[lndx].pels[pndx-1] -
pic1^.fmt.lines[lndx].pels[pndx+1]) +
Abs(pic1^.fmt.lines[lndx-1].pels[pndx-1] -
pic1^.fmt.lines[lndx+1].pels[pndx+1]) +
Abs(pic1^.fmt.lines[lndx+1].pels[pndx-1] -
pic1^.fmt.lines[lndx-1].pels[pndx+1]))
SHR 2;
END;
{ Compute intensity histogram for pic1 }
PROCEDURE Histogram(pic1 :picptr;
VAR histo : histtype);
VAR
hndx : bitrng; { histogram bin number }
lndx : framerng; { line number }
pndx : pelrng; { pel number }
BEGIN
FOR hndx := 0 TO maxbit DO { reset histogram }
histo[hndx] := 0;
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO
histo[pic1^.fmt.lines[lndx].pels[pndx]] :=
histo[pic1^.fmt.lines[lndx].pels[pndx]] + 1;
END;
{ Allocate and initialize the picture buffer }
PROCEDURE PicSetup(VAR newpic : picptr);
VAR
pels : pelrng;
lines : framerng;
BEGIN
IF newpic <> NIL { discard if allocated }
THEN Dispose(newpic);
New(newpic); { allocate new array }
END;
{ Save picture file on disk }
{ Uses the smallest number of blocks to fit the data }
function SavePicture(filespec : strtype; pic : picptr): integer;
VAR
ndx : subrng; { index into word array }
rndx : REAL; { real equivalent }
nblocks : INTEGER; { number of disk blocks }
xfered : INTEGER; { number actually done }
pfile : FILE; { untyped file for I/O }
RtnCode : integer;
BEGIN
RtnCode := 0;
Assign(pfile,filespec);
Rewrite(pfile);
ndx := 0; { start with first word }
WHILE (ndx < maxbuffer) AND { WHILE not end of pic }
(Lo(pic^.words[ndx]) <> fldend) AND
(Hi(pic^.words[ndx]) <> fldend) DO
ndx := ndx + 1;
ndx := ndx + 1; { fix 0 origin }
rndx := 2.0 * ndx; { allow >32K numbers... }
nblocks := ndx DIV 64; { 64 words = 128 bytes }
IF (ndx MOD 64) <> 0 { partial block? }
THEN nblocks := nblocks + 1;
rndx := 128.0 * nblocks; { actual file size }
BlockWrite(pfile,pic^.words[0],nblocks,xfered);
IF xfered <> nblocks then RtnCode := IOresult;
SavePicture := IOresult;
Close(pfile);
END;
{ Load picture file from disk }
function LoadPicture(filespec : strtype;
pic : picptr): integer;
var
picfile : FILE OF pictype;
RtnCode : integer;
BEGIN
Assign(picfile,filespec);
{$I- turn off I/O checking }
Reset(picfile);
RtnCode := IOresult;
{$I+ turn on I/O checking again }
IF RtnCode = 0 then
begin
{$I- turn off I/O checking }
Read(picfile,pic^); { this does the read }
RtnCode := IOresult;
{$I+ turn on I/O checking again }
{ IF NOT (IOresult IN [0,$99]) then
RtnCode := -1;}
RtnCode := 0;
end;
LoadPicture := RtnCode;
end;
{ Set up frame and line syncs in a buffer }
{ This should be done only in freshly allocated buffers }
PROCEDURE SetSyncs(pic1 : picptr);
VAR
lndx : framerng; { index into lines }
BEGIN
pic1^.fmt.syncF := fieldsync; { set up empty picture }
FOR lndx := 0 TO maxline DO BEGIN
pic1^.fmt.lines[lndx].syncL := linesync;
FillChar(pic1^.fmt.lines[lndx].pels[0],maxpel+1,0);
END;
pic1^.fmt.syncE := fldend; { set ending control }
END;
{ Test for the Supervisor card }
PROCEDURE Card;
var test: byte;
Begin
writeln ('testing for vgrab card');
Port[Bport] := 0; { reset the output lines }
Port[Aport] := 0;
test := Port[Aport]; { look for the card }
if (test and $0C0) = 0 then Begin
Port[Aport] := $03;
test := Port[Aport];
if (test and $0C0) <> $0C0 then
writeln ('No Supervision card found');
end;
Port[Bport] := 0; { reset the address lines}
end;
{ Capture routine for the Supervisor card }
function Capture: BOOLEAN;
var
TimeOut : integer;
Begin
Port[Bport] := 0; { reset everything }
Port[Aport] := $03; { start the capture }
TimeOut := 15000;
while ((Port[Aport] and $0C0) = $0C0) and (TimeOut > 0) do
TimeOut := pred(TimeOut);
Port[Bport] := 0; { reset everything }
Capture := TimeOut <> 0;
end;
{ Scan data routine for the Supervisor card }
PROCEDURE Scan(pic1 : picptr);
(*
VAR
lndx : framerng; { line number }
pndx : pelrng; { pel number }
*)
BEGIN
(* This is the original pascal code:
=================================
Port[Bport] := 0; { reset everything }
FOR lndx := 0 TO maxline DO
FOR pndx := 0 TO maxpel DO Begin
pic1^.fmt.lines[lndx].pels[pndx]
:= (Port[Aport] and $3F);
Port[Aport] := $02; { next address }
Port[Aport] := 0; { idle the lines }
end;
Port[Bport] := 0; { reset everything }
Now replaced by the following assembler code:
============================================= *)
asm
mov dx,2F1H
xor al,al
out dx,al
mov bx,maxline
les di,pic1
inc di (* skip syncF byte *)
cld
mov dx,2F0H
@ReadBoard: mov cx,maxpel+1
inc di (* skip syncL *)
@ReadLine: in al,dx
and al,3FH
stosb
mov al,2
out dx,al
xor al,al
out dx,al
loop @ReadLine
dec bx
jnz @ReadBoard
mov dx,2F1H
xor al,al
out dx,al
end
end;
{*******************************************************}
end.
<a name="015c_000d">
<a name="015c_000e">[LISTING TWO]<a name="015c_000e">
{$X+,S-}
{$M 16384,8192,655360}
uses
Crt, Dos, Objects, Drivers, Memory, Views, Menus,
StdDlg, MsgBox, App, Video, Vga, Dialogs;
const
cmFOpen = 1000;
cmFSave = 1001;
cmFSaveAs = 1002;
cmExpMon = 2000;
cmExpInteg = 2001;
cmExpGrab = 2002;
cmMrgCompare = 3000;
cmMrgAdd = 3001;
cmMrgSub = 3002;
cmMrgMask = 3003;
cmProEdge = 4000;
cmProFilter = 4001;
cmProHist = 4002;
cmProMult = 4003;
cmProInvert = 4004;
cmProOffset = 4005;
cmProThreshold = 4006;
cmDisplay = 5000;
cmOptVga = 6000;
cmOptAutoD = 6001;
cmOptPhotoS = 6002;
VgaHiResTxt : TMenuStr ='~V~GA HiRes ';
AutoDisplayTxt: TMenuStr ='~A~uto Display ';
PhotoModeTxt :TMenuStr ='~P~hoto session ';
OnTxt : string[4] =' On';
OffTxt : string[4] ='Off';
type
pHistoView = ^HistoView;
HistoView = object(TView)
histo : histtype;
constructor Init(Bounds: TRect);
procedure Draw; virtual;
procedure Update(Picture : picptr);
end;
pHistoWindow = ^HistoWindow;
HistoWindow = object(TWindow)
HistoView: pHistoView;
constructor Init;
end;
pCCDpgm = ^CCDpgm;
CCDpgm = object(TApplication)
CurPicture: PicPtr;
CurFileName: PathStr;
PictureDirty: boolean;
HistoGram: pHistoWindow;
procedure FileOpen(WildCard: PathStr);
procedure FileSave;
procedure FileSaveAs(WildCard: PathStr);
procedure DisplayImage;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitStatusLine; virtual;
procedure SetMenuItem(Item: string; Value: boolean);
procedure UpdateHistoGram;
end;
var
CCD: CCDpgm;
procedure GraphicsStart;
begin
DoneSysError;
DoneEvents;
DoneVideo;
DoneMemory;
end;
procedure GraphicsStop;
begin
InitMemory;
TextMode(3);
InitVideo;
InitEvents;
InitSysError;
Application^.Redraw;
end;
function TypeInDialog(var S: PathStr; Title:string):boolean;
var
D: PDialog;
Control: PView;
R: TRect;
Result:Word;
begin
R.Assign(0, 0, 30, 7);
D := New(PDialog, Init(R, Title));
with D^ do
begin
Options := Options or ofCentered;
R.Assign(5, 2, 25, 3);
Control := New(PInputLine, Init(R, sizeof(PathStr)-1));
Insert(Control);
R.Assign(3, 4, 15, 6);
Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
Inc(R.A.X, 12); Inc(R.B.X, 12);
Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
SelectNext(False);
end;
D := PDialog(Application^.ValidView(D));
if D <> nil then
begin
Result := DeskTop^.ExecView(D);
if (Result <> cmCancel) then D^.GetData(S);
Dispose(D, Done);
end;
TypeInDialog := Result <> cmCancel;
end;
constructor HistoWindow.Init;
var
R:TRect;
begin
R.Assign(0, 0, 68,21);
TWindow.Init(R, 'Histogram', 0);
Palette := wpCyanWindow;
GetExtent(R);
Flags := Flags and not (wfZoom + wfGrow); { Not resizeable }
GrowMode := 0;
R.Grow(-1, -1);
HistoView := New(pHistoView, Init(R));
Insert(HistoView);
end;
constructor HistoView.Init(Bounds: TRect);
begin
TView.Init(Bounds);
Update(CCD.CurPicture);
end;
procedure HistoView.Update(Picture : picptr);
begin
Histogram(Picture,histo);
DrawView;
end;
procedure HistoView.Draw;
const
barchar = $DB; { display char for bar }
halfbar = $DC; { half length bar }
maxbar = 16; { length of longest bar }
var
x,y : Integer;
binID : Integer;
maxval : Word; { the largest bin value }
maxval1 : Word; { the next largest bin }
barbase : Word; { bottom of bar }
barmid : Word; { middle of bar }
barstep : Word; { height of steps }
halfstep : Word; { half of barstep }
barctr : Integer; { character within bar }
begin
TView.Draw;
maxval := 1; { find largest value }
maxval1 := maxval;
binID := 0;
for binID := 0 to maxbit do
begin
if histo[binID] > maxval then
begin { new all-time high? }
maxval1 := maxval; { save previous high }
maxval := histo[binID]; { set new high }
end
else if histo[binID] > maxval1 then { 2nd highest? }
maxval1 := histo[binID];
end;
barstep := maxval1 div maxbar; { steps between lines }
halfstep := barstep div 2; { half of one step }
y := 0;
for barctr := maxbar downto 1 do
begin { down bars }
barbase := Trunc(barstep * barctr);
barmid := barbase + halfstep;
x := 1;
for binID := 0 TO maxbit do { for each bin }
begin
if histo[binID] > barmid then
WriteChar(x,y,Chr(barchar),7,1)
else if histo[binID] > barbase then
WriteChar(x,y,Chr(halfbar),7,1)
else WriteChar(x,y,'_',7,1);
x := succ(x);
end;
y := succ(y); { new line }
end;
for binID := 0 to maxbit do { fill in bottom }
if histo[binID] > halfstep then
WriteChar(binID+1,y,Chr(barchar),7,1)
else if histo[binID] > 0 then
WriteChar(binID+1,y,Chr(halfbar),7,1)
else WriteChar(binID+1,y,'_',7,1);
y := succ(y);
x := 1;
WriteStr(x,y, '0 1 2 3 ' +
'4 5 6 ',7);
y :=succ(y);
WriteStr(x,y,'0123456789012345678901234567890123456789' +
'012345678901234567890123',7);
end;
procedure CCDpgm.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y+1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~F~ile', 0, NewMenu(
NewItem('~O~pen ...', 'F3', kbF3, cmFOpen, 0,
NewItem('~S~ave', 'F2', kbF2, cmFSave, 0,
NewItem('Save ~A~s ...', '', kbNoKey, cmFSaveAs, 0,
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, 0, nil))))),
NewSubMenu('~E~xpose', 0, NewMenu(
NewItem('~M~onitor','F9', kbF9, cmExpMon, 0,
NewItem('~I~ntegrated Exposure ...', 'F10', kbF10, cmExpInteg, 0,
NewItem('~G~rab', 'Shift-F9', kbShiftF9, cmExpGrab, 0,nil)))),
NewSubMenu('~M~erge', 0, NewMenu(
NewItem('~C~ompare Images ...','', kbNoKey, cmMrgCompare, 0,
NewItem('~A~dd Images ...', '', kbNoKey, cmMrgAdd, 0,
NewItem('~S~ubtract Images ...', '', kbNoKey, cmMrgSub, 0,
NewItem('~M~ask Images ...', '', kbNoKey, cmMrgMask, 0,nil))))),
NewSubMenu('~P~rocess', 0, NewMenu(
NewItem('~E~dge Enhance','', kbNoKey, cmProEdge, 0,
NewItem('~F~ilter', '', kbNoKey, cmProFilter, 0,
NewItem('~H~istogram', '', kbNoKey, cmProHist, 0,
NewItem('~M~ultiply ...', '', kbNoKey, cmProMult, 0,
NewItem('~I~nvert', '', kbNoKey, cmProInvert, 0,
NewItem('~O~ffset', '', kbNoKey, cmProOffset, 0,
NewItem('~T~hreshold ...', '', kbNoKey, cmProThreshold, 0,nil)))))))),
NewItem('~D~isplay', '', kbShiftF10, cmDisplay, 0,
NewSubMenu('~O~ptions', 0, NewMenu(
NewItem(VgaHiResTxt,'', kbNoKey, cmOptVga, 0,
NewItem(AutoDisplayTxt, '', kbNoKey, cmOptAutoD, 0,
NewItem(PhotoModeTxt, '', kbNoKey, cmOptPhotoS, 0,nil)))),
nil)))))))));
end;
procedure CCDpgm.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~F10~ Expose', kbF10, cmExpInteg,
NewStatusKey('~F9~ Monitor', kbF9, cmExpMon,
NewStatusKey('~ShiftF9~ Grab', kbShiftF9,cmExpGrab,
NewStatusKey('~F3~ Open', kbF3, cmFOpen,
NewStatusKey('~F2~ Save', kbF2, cmFSave,
NewStatusKey('~AltX~ Exit', kbAltX, cmQuit,
NewStatusKey('~ShiftF10~ Display', kbShiftF10, cmDisplay, nil))))))), nil)));
end;
procedure CCDpgm.FileSaveAs(WildCard: PathStr);
var
D: PFileDialog;
begin
D := New(PFileDialog, Init(WildCard, 'Save as',
'~N~ame', fdOkButton + fdHelpButton, 100));
D^.HelpCtx := 0;
if ValidView(D) <> nil then
begin
if Desktop^.ExecView(D) <> cmCancel then
begin
D^.GetFileName(CurFileName);
FileSave;
end;
Dispose(D, Done);
end;
end;
procedure CCDpgm.FileSave;
begin
if CurFileName[0] = chr(0) then
FileSaveAs('*.CCD')
else
begin
if SavePicture(CurFileName,CurPicture) <> 0 then
MessageBox('Can''t Save File!', nil, mfError + mfOkButton);
end;
end;
procedure CCDpgm.FileOpen(WildCard: PathStr);
var
D: PFileDialog;
wkPic: PicPtr;
begin
D := New(PFileDialog, Init(WildCard, 'Open a File',
'~N~ame', fdOpenButton + fdHelpButton, 100));
D^.HelpCtx := 0;
if ValidView(D) <> nil then
begin
if Desktop^.ExecView(D) <> cmCancel then
begin
D^.GetFileName(CurFileName);
PicSetup(CurPicture);
if LoadPicture(CurFileName,CurPicture) <> 0 then
MessageBox('Error Loading File!', nil, mfError + mfOkButton)
end;
Dispose(D, Done);
end;
end;
procedure CCDpgm.DisplayImage;
begin
GraphicsStart;
Display_Image(CurPicture);
ReadKey;
GraphicsStop;
end;
procedure CCDpgm.SetMenuItem(Item: string; Value: boolean);
var
mText : TMenuStr;
function SearchItem(pI : PMenuItem): boolean;
begin
if pI = NIL then
SearchItem := true
else if Pos(mText,pI^.Name^) <> 0 then
begin
SearchItem := false;
if Value then
pI^.Name^ := Concat(mText,OnTxt)
else
pI^.Name^ := Concat(mText,OffTxt)
end
else
SearchItem := SearchItem(pI^.Next);
end;
var
pI: PMenuItem;
begin
mText := Copy(Item,1,Length(Item)-3);
pI := MenuBar^.Menu^.Items;
while pI <> NIL DO
begin
if pI^.SubMenu <> NIL then
if not SearchItem(pI^.SubMenu^.Items) then
pI := Nil
else
pI := pI^.Next
else
pI := pI^.Next;
end;
end;
procedure NotImplemented;
begin
MessageBox('This command has not been implemented yet!', nil, mfError + mfOkButton);
end;
procedure CCDpgm.UpdateHistoGram;
begin
if (HistoGram <> NIL) and (CurPicture <> NIL) then
begin
HistoGram^.HistoView^.Update(CurPicture)
end;
end;
procedure CCDpgm.HandleEvent(var Event: TEvent);
var
wkStr: PathStr;
wkI,Result: integer;
DoAutoDisplay: boolean;
wkPicture: PicPtr;
resPicture: PicPtr;
begin
DoAutoDisplay := false;
TApplication.HandleEvent(Event);
case Event.What of
evCommand:
begin
case Event.Command of
cmFOpen: begin
FileOpen('*.CCD');
UpdateHistoGram;
DoAutoDisplay := true;
end;
cmFSave: FileSave;
cmFSaveAs: FileSaveAs('*.CCD');
cmExpMon: begin
GraphicsStart;
if not Continuous(CurPicture) then
begin
GraphicsStop;
MessageBox('Camera not responding!', nil, mfError + mfOkButton);
if CurPicture <> NIL then
begin
dispose(CurPicture);
CurPicture := NIL;
end;
end
else
GraphicsStop;
end;
cmExpInteg: NotImplemented;
cmExpGrab: begin
PicSetup(CurPicture);
SetSyncs(CurPicture);
if Capture then
Scan(CurPicture)
else
MessageBox('Camera not responding!', nil, mfError + mfOkButton);
end;
cmMrgCompare: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
WkPicture := CurPicture;
CurPicture := NIL;
FileOpen('*.CCD');
Compare(WkPicture,CurPicture);
Dispose(CurPicture);
CurPicture:= WkPicture;
UpdateHistoGram;
DoAutoDisplay := true;
end;
cmMrgAdd: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
WkPicture := CurPicture;
CurPicture := NIL;
FileOpen('*.CCD');
Add(WkPicture,CurPicture);
Dispose(CurPicture);
CurPicture:= WkPicture;
UpdateHistoGram;
DoAutoDisplay := true;
end;
cmMrgSub: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
WkPicture := CurPicture;
CurPicture := NIL;
FileOpen('*.CCD');
Subtract(WkPicture,CurPicture);
Dispose(CurPicture);
CurPicture:= WkPicture;
UpdateHistoGram;
DoAutoDisplay := true;
end;
cmMrgMask: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
WkPicture := CurPicture;
CurPicture := NIL;
FileOpen('*.CCD');
Mask(WkPicture,CurPicture);
Dispose(CurPicture);
CurPicture:= WkPicture;
UpdateHistoGram;
DoAutoDisplay := true;
end;
cmProEdge: begin
if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
wkPicture:= NIL; { get output array }
PicSetup(wkPicture);
SetSyncs(wkPicture);
Edge(CurPicture,wkPicture);
Dispose(CurPicture);
CurPicture:= wkPicture;
UpdateHistoGram;
DoAutoDisplay := true;
end;
end;
cmProFilter: begin
if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
wkPicture := NIL;
PicSetup(wkPicture);
SetSyncs(wkPicture);
Filter1(CurPicture,wkPicture);
Dispose(CurPicture);
CurPicture := wkPicture;
UpdateHistoGram;
DoAutoDisplay := true;
end;
end;
cmProHist: begin
if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
HistoGram := new(pHistoWindow,Init);
Desktop^.Insert(ValidView(HistoGram));
end
end;
cmProMult: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
if TypeInDialog(wkStr,'Enter Mult Factor') then
begin
Val(wkStr,wkI,Result);
if Result = 0 then
Multiply(CurPicture,wkI);
DoAutoDisplay := true;
UpdateHistoGram;
end;
end;
cmProInvert: begin
if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else
begin
Invert(CurPicture);
DoAutoDisplay := true;
UpdateHistoGram;
end;
end;
cmProOffset: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else if TypeInDialog(wkStr,'Enter Offset') then
begin
Val(wkStr,wkI,Result);
if Result = 0 then
begin
if (wkI<0) then
begin
wkI:= abs(wkI);
Negoffset(CurPicture,wkI);
end
else
Offset(CurPicture,wkI);
DoAutoDisplay := true;
UpdateHistoGram;
end;
end;
cmProThreshold: if (CurPicture = NIL) then
MessageBox('No picture!', nil, mfError + mfOkButton)
else if TypeInDialog(wkStr,'Enter Threshold') then
begin
Val(wkStr,wkI,Result);
if Result = 0 then
Threshold(CurPicture,wkI);
DoAutoDisplay := true;
UpdateHistoGram;
end;
cmDisplay: DisplayImage;
cmOptVga: begin
VGAhiRes := not VGAhiRes;
SetMenuItem(VgaHiResTxt,VGAhiRes);
end;
cmOptAutoD: begin
AutoDisplay := not AutoDisplay;
SetMenuItem(AutoDisplayTxt,AutoDisplay);
end;
cmOptPhotoS: begin
PhotoMode := not PhotoMode;
SetMenuItem(PhotoModeTxt,PhotoMode);
end;
else
Exit;
end;
ClearEvent(Event);
if DoAutoDisplay and AutoDisplay then
DisplayImage;
end;
end;
end;
begin
CCD.Init;
CCD.CurPicture := NIL;
CCD.CurFileName := '';
CCD.SetMenuItem(VgaHiResTxt,False);
CCD.SetMenuItem(AutoDisplayTxt,False);
CCD.SetMenuItem(PhotoModeTxt,False);
VGAhiRes := FALSE;
AutoDisplay := FALSE;
PhotoMode := FALSE;
CCD.Run;
CCD.Done;
end.
<a name="015c_000f">
<a name="015c_0010">[LISTING THREE]<a name="015c_0010">
unit Vga;
{*******************************************************}
interface
USES Video, DOS, CRT;
var
VGAhiRes: boolean;
AutoDisplay: boolean;
PhotoMode: boolean;
Procedure Display_Image(pic1: PicPtr);
function Continuous(var pic1: PicPtr): boolean;
implementation
{--- Sets the VGA display planes }
Procedure Set_Plane (plane : byte);
var old : byte;
begin
Port[$01CE] := $0B2; { plane select mask }
old := (Port[$01CF] and $0E1); { get the old plane value }
Port[$01CE] := $0B2; { plane select mask }
Port[$01CF] := ((plane shl 1) or old); { new plane register value }
end;
procedure DisplayInVgaMode(pic1: PicPtr);
begin
(*
col := 32;
for row := 0 to 200 do
begin
Move(pic1^.fmt.lines[row].pels[0],MEM[$A000:col],256);
col := col + 320;
end;
*)
asm
push ds
lds si,pic1
inc si (*Sync1*)
mov bx,201
mov ax,0A000H
mov es,ax
mov di,32
cld
@LineLoop: inc si (*SyncL*)
mov cx,128
rep movsw
add di,320-256
dec bx
jne @LineLoop
pop ds
end;
end;
{--- Show picture on VGA in 320x200x256 or }
{ 640x400x256 color mode }
Procedure Display_Image(pic1: PicPtr);
var
r : registers; { BIOS interface regs }
row,col : INTEGER; { Screen coordinates }
Vmode : char;
shade : byte;
mode, i : integer;
plane : byte;
const
VideoInt : byte = $10;
Set_DAC_Reg : integer = $1010;
begin
if VGAhiRes then
begin
r.AX := ($00 SHL 8) OR $61;
Intr(VideoInt,r); { set 640x400x256 color mode}
mode := 1;
end
else
begin
r.AX := ($00 SHL 8) OR $13;
Intr(VideoInt,r); { set 320x200x256 color mode}
mode := 0;
end;
for shade := 0 to 63 do
begin
r.ax := Set_DAC_Reg;
r.bx := shade;
r.ch := shade;
r.cl := shade;
r.dh := shade;
INTR(VideoInt,r);
end;
if mode = 0 then
begin
DisplayInVgaMode(pic1);
end
else
begin
for row := 0 to 102 do
begin
col := row * 640;
Move(pic1^.fmt.lines[row].pels[0],MEM[$A000:col],256);
end;
plane := 1;
Set_Plane ( plane );
for row := 103 to 204 do
begin
col := (row - 103) * 640 + 384;
Move(pic1^.fmt.lines[row].pels[0],MEM[$A000:col],256);
end;
plane := 2;
Set_Plane ( plane );
for row := 205 to 240 do
begin
col := (row - 205) * 640 + 128;
Move(pic1^.fmt.lines[row].pels[0],MEM[$A000:col],256);
end;
end;
end;
function Continuous(var pic1: PicPtr): boolean;
var
r : registers; { BIOS interface regs }
row,col : INTEGER; { Screen coordinates }
Vmode : char;
shade : byte;
cont : boolean;
CONST
VideoInt : byte = $10;
Set_DAC_Reg : integer = $1010;
begin
PicSetup(pic1); { set up even picture array }
SetSyncs(pic1);
r.AX := ($00 SHL 8) OR $13;
Intr(VideoInt,r); { set 320x200x256 color mode }
FOR shade := 0 to 63 do begin { set VGA to gray scale }
r.ax := Set_DAC_Reg;
r.bx := shade;
r.ch := shade;
r.cl := shade;
r.dh := shade;
INTR(VideoInt,r);
End;
repeat
if capture then
begin
scan(pic1);
DisplayInVgaMode(pic1);
Cont := true;
end
else
Cont := false;
until not Cont or KeyPressed;
Continuous := Cont;
END;
end.
Copyright © 1991, Dr. Dobb's Journal
