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