AU619402B2

AU619402B2 - Measuring dimensions of out-of-focus images

Info

Publication number: AU619402B2
Application number: AU54205/90A
Authority: AU
Inventors: Leslie John Barry; Hendrik Franciscus Van Schie
Original assignee: AUSTRALIAN WOOL TESTING AUTHOR
Current assignee: AUSTRALIAN WOOL TESTING AUTHORITY Ltd
Priority date: 1989-10-24
Filing date: 1990-04-10
Publication date: 1992-01-23
Anticipated expiration: 2010-04-10
Also published as: AU5420590A

Description

IMAGE ANALYSIS

TECHNICAL FIELD

This invention relates to image analysis techniques. It has particular application to the measurement of widths or other dimensions of visual images which may be out of focus; without the need to bring the images into sharper focus. The invention has arisen from a program to develop equipment for automatically measuring the mean fibre diameter of wool samples by an image analysis technique but the invention is not limited to that particular application and it may be appli.ed in other fields where out of focus images are to be analyzed or

enhanced.

The average fibre diameter of raw wool has long been recognized as an important price determining characteristic. The two most widely used methods of measuring the mean fibre diameter of wool are the air flow and the projection microscope techniques. Diameter testing of auction lots prior to sale is almost exclusively carried out using the air flow technique which requires a skilled operator and is generally slow. ASTM standard D35010-92, 1981 is an established standard for the measurement of mean fibre diameter of wool using commercially available image analysis equipment. The equipment specified in this standard requires a high level of operator intervention and is of high capital cost. The present invention has arisen from a program to develop alternative equipment which is cheaper and requires minimum operator intervention during measurement.

DISCLOSURE OF THE INVENTION

According to the invention the degree of focus or "visual sharpness" of an image is measured using information about the magnitude and shape of the light intensity profile which corresponds to a transect through a boundary or edge of the image. More specifically the rate of change and the total magnitude of the change in light intensity across the boundary is measured as an indication of the degree of focus or "visual sharpness" of the image.

The invention is particularly applicable to the

measurement of a dimension of a recorded visual image between a pair of image boundary segments. In this application the invention may provide a method for measuring a dimension of a captured visual image between a pair of image segments, comprising:

measuring the rate of change and magnitude of change of recorded light intensity across one or both of the boundary segments as a measure of the sharpness of focus of the image; measuring a dimension of the image between selected light intensity values at said boundary segments; and

correcting the measured dimension according to the

measured sharpness of focus and the magnitude of the measured dimension.

The captured image may be the image of a fibre and said dimension may be a width of the image in a direction transverse to the longitudinal direction of the fibre image. In that case, the measured width of the image may be further corrected according to the angle between said transverse and longitudinal directions to derive a corrected width indicative of the diameter of the fibre.

The invention further provides image capture and analysis apparatus comprising:

image capture means to capture a visual image as a series of light intensity values derived from an array of pixels; and image processing means to scan the captured light

intensity values derived from a line of pixels transecting a pair of boundary segments of a captured image, to measure the rate of change and magnitude of change of light intensity values across one or both of the image boundary segments as a measure of the sharpness of focus of the captured image, to measure a dimension of the image between selected light intensity values at the two boundary segments, and to correct the measured dimension according to the measured sharpness of focus and the magnitude of the measured dimension.

BRIEF DESCRIPTION OF DRAWINGS

In order that the invention may be more fully explained its application to a fibre image display and measurement

(FIDAM) system will now be described in some detail with reference to the accompanying drawings, in which:- Figure 1 is a diagrammatic illustration of the essential components of the system;

Figures 2 and 3 illustrate the manner in which an image captured by the system is analysed;

Figure 4 is a diagram of a fibre image crossing pixels in a camera sensor In the system;

Figure 5 is a diagrammatic representation of the light sensing elements in the camera sensor;

Figure 6 illustrates how only a "window" of the whole sensor image is loaded into a computer memory in the system;

Figure 7 illustrates how the computer memory is addressed; Figure 8 is a video memory map illustrating the sequence for clocking the selected image "window" into the computer memory;

Figure 9 illustrates how the image is viewed by the software of the system;

Figure 10 shows a sequence of routines/checks carried out by the software; and

Figure 11 illustrates how a boundary of a fibre image is detected and analysed.

BEST MODE OF CARRYING OUT THE INVENTION

The illustrated apparatus is designed to measure the mean fibre diameter of wool samples by an image analysis technique. The apparatus comprises an optical microscope 1 which is used to view fibres which have been air mounted upon a microscope slide 2 and illuminated by a lamp 10. A CCD (charge coupled device) camera 3 is used to view the image produced by the microscope and the output from the camera is linked to a computer 4 via an interface 5 and a flash Analogue-to- Digital Convertor (ADC) 6. This allows the image seen by the camera to be stored by software in the computer.

The image is stored in memory and software routines are used to examine the two dimensional array of numbers which correspond to recorded light intensity levels. The detailed operation of the software to analyze the recorded image will be described later in this specification following a general outline of the manner in which the apparatus operates. The recorded image stored as a two-dimensional array of numbers is examined for the presence of fibres. Mathematical algorithms are used to separate and reject images arising from non-fibrous particles, such as dirt, vegetable matter etc. Once a fibre has been detected the software estimates the width of the fibre in arbitrary units, the slope relative to the

camera's raster scan and the sharpness of focus. The

explanation of how the sharpness of focus and width of fibre is calculated is simplified here to highlight some of the key features. Figure 2 shows the light intensity profile for a single line in memory showing transects through two separate fibres.

The sharpness of focus is calculated as (W2-W1). The widths W2 and Wl are calculated using linear interpolation between the pixels immediately above and immediately below the selected threshold values (60% for W1 and 85% for W2). This permits an accuracy of better than one whole pixel unit.

The widths of the light intensity profiles for the two fibres are calculated at a variable threshold W3 which is dependent upon the minimum of the cubic spline fitted through the profile as shown in Figure 3. Other 'mathematical

techniques have been found to be equally satisfactory in the measurement of the width of fibres and the reference to cubic splines in this application is not to be understood as

including other methods.

The actual threshold is set at a level equal to half-way between the minimum light level (determined by the cubic spline not the individual pixel) and the initial level (100 in this example).

The measurement of width is interpolated from the curve rather than by linear interpolation.

By considering the midpoints of the focus widths Wl and W2, in fractions of pixels, for 4 consecutive lines in the two dimensional image it is possible to calculate the slope of the leading boundary relative to the pixel array (as shown

diagramatically in Figure 4). Only slopes within -45% and +45% of the vertical are used for further processing. The widths W1, W2 and W3 are corrected trigonometrically to their equivalent widths for an intersect being perpendicular to the pixel array.

The magnitude of the slope corrected width W3 will depend upon the true width of the object being measured and the sharpness of the focus. To determine the true width it is necessary to determine the relationship between true width, measured width, and measured focus.

This can be achieved mathematically by determining the function

TW = f (MW, F)

where TW = True Width

MW = Measured Width

F = Focus

An alternative is to prepare a two dimensional table showing the True Width for a given measured width and focus. The latter approach has been adopted for speed of computation purposes.

The table is prepared by measuring the "Measured Width" and "Focus" of an etched line on a graticule as the focus is varied by adjusting the stage height of the microscope. The graticule contains 12 lines of varying thickness from

approximately 8 micron to 320 micrometers.

The "True Widths" of these lines is known. The data collected allows a table to be prepared relating the true width to focus and measured width.

The microscope stage is also controlled by the computer software through stepper motors 7. Typically 4000 to 6000 measurements are made in a matter of minutes. The mean fibre diameter and standard deviation of diameter are calculated and printed by the computer printer 8.

The detailed operation of the apparatus to record and analyze an image generated by the camera will now be described with reference to Figures 5 to 11.

Sensor & Pixel & Memory Relationships

The camera sensor consists of an array of light sensing elements (pixels) arranged in columns and rows as illustrated in Figure 5. The light level sensed by each pixel is sampled and digitized in sequence and stored in an array of 8 bit memory cells on the video acquisition board. A complete scan of the sensor consists of a scan of each even horizontal row of pixels, followed by a scan of each odd horizontal row. This is called "interlacing" and is the normal method of scanning in TV/Video systems.

The following camera output signals are used to control video acquisition:- Pixel Clock (pclk): 1 pulse per pixel on horizontal line.

Horizontal Drive (HD): 1 pulse at the start of each

horizontal line.

Vertical Drive (VD): 1 pulse at the start of each

vertical scan (odd or even).

Field Index (Fl): 1 pulse at the start of each odd vertical scan.

Video memory consists of 32K of 8bit Random access memory starting at computer address 9000 hex. Preset counters control the acquisition of video data so that only a "window" of the whole sensor image is loaded into memory as illustrated in Figure 6. Every second pixel clock pulse is discarded by a + 2 circuit so that only every second pixel on each horizontal scan line is stored.

The X and Y notation refers to the image as perceived by the computer software and does not coincide with the H and V notation of the video signal from the camera. Figure 6 shows the relationship between X, Y co-ordinates and H, V

co-ordinates.

From the point of view of the memory address circuitry on the video acquisition card, the memory is addressed by 15 lines as shown in Figure 7 and runs from 0000 hex to 7FFF hex. (32K).

When addressed by computer the higher order address lines (16 and above) select this block of memory as starting at 9000 hex.

Sequence Of Clocking Selected Window Into Memory

Figure 8 is a video memory map which illustrates the sequence for clocking the selected image window into the computer memory. Assume the first line (H direction) in the window is an even line so ADO = 0. X = 0, Y = 0 will select the top L.H. byte in block 0 as shown in Figure 8.

As the line is scanned from left to right, every second pixel clock pulse will increment the Y address counter, selecting the same byte in each block. When the next even line is reached, the X address counter will increment and the left hand byte of the second word in each block will be selected as the line is scanned. When all even lines have been scanned, address 0 is changed to 1 and the odd lines are scanned. Thus the first odd row of pixels will be put into the top right hand byte of each block. When the complete scan is finished, the result of this process is that each block contains in order the 256 pixel values of 1 vertical (X) column within the window.

Memory Image As Seen By Software

The software selects an offset into the image memory using a 16 bit address. As there is only 32K to address, the top bit will never be used. For software purposes, the image is considered rotated as shown in Figure 9.

As a result of the loading sequence, the bottom (least significant) byte of the 16 bit image address will select a pixel number of (0 to 255) while the top byte will select a line number (0 to 127). These bytes are manipulated

independently by the image processing software.

Measurement Process

The system steps to 256 positions on a slide, in a 16 x 16 array. At each position a video frame is loaded into memory as previously described and then analysed.

The frame in memory is examined in slices of 4 consecutive lines, looking for possible fibres on line 1 and then checking through the sequence of steps shown in Figure 10 to see if it is a valid fibre crossing all four lines. If a fibre is accepted, data on it is accumulated for later processing.

Totals are also accumulated on the number of fibres passing each step of the checking process.

When all possible fibres on the 4 line slice have been examined, the next 4 lines are processed and this continues until the whole frame has been examined. The examination of one frame is carried out by a single call to an assembly language procedure called Analyse_Frame.

After examination of all slide positions the accumulated data is processed to produce mean, standard deviation,

histogram and debugging information as required.

Summary Of Per Fibre Analysis

Pixels are examined in pairs on line 1 of the current four line group. A possible start is flagged by a pair of pixels with a drop in light value from the first to the second of 10 or more units.

The pixels prior to this pair are examined for an area of uniform light value. From this value and the light value under the dark tape at the start of the line, a focus threshold and a light threshold are calculated.

The first pixels with light values less than these

thresholds on the leading edge of the fibre and the last pixels with light values below the thresholds on the trailing edge of the fibre are found for each of the four lines. While this is done, a rough check for uniformity of width over four lines is done and fibres which fail this check or are outside the maximum limits for slope, focus or width are rejected.

High resolution starts, finishes and widths (in 1/256ths of a pixel) are found for each threshold on all four lines by linear interpolation between the pixels immediately above and below the threshold values. These are checked for uniformity of width by calculation of the coefficient of variation of width over four lines at each threshold. Mean width values at each threshold are also calculated.

The angle (slope) of the fibre relative to the pixel array is calculated in high resolution units per vertical line by a line of best fit using the least squares method with all eight high resolution starts and finishes. The mean widths at focus and light thresholds are corrected trigonometrically for slope.

The "fibre focus" is calculated as the difference between corrected mean widths at the two thresholds, expressed in units of l/32nd of a pixel and the fibre is accepted/rejected after comparison with upper and lower focus limits. A cubic spline method is used to fit a smoothed curve of light value versus horizontal position through the pixel values for line 1. From this a true minimum light value for the fibre is found by considering derivatives and a "spline threshold" is set half way between this minimum and the average light value before the fibre. The width of the spline curve at this threshold is calculated in l/32nds of a pixel and corrected for slope (called spline width).

Calibrated fibre width is obtained by using the fibre focus and spline width values to access an externally generated lookup table and the appropriate "bucket" in a width histogram array is incremented if the fibre has passed all stages of the analysis.

DETAILED DESCRIPTION OF THE DETECTION AND ANALYSIS

OF EACH FIBRE CROSSING

In this section, line 1 to line 4 refer to the group of four lines currently being examined. Pixel numbers on each line range from 0 to 255 and the light level of individual pixels ranged from 0 to 127, 0 representing dark.

The first two pixels on a line are assumed to have light levels of a, b respectively and are under the black tape on the edge of the sensor.

GET START advances along line 1, two pixels at a time, checking the light values until a pair is found with values f, g such that f-g ≥ 10. When such a pair is found debug_data [01, representing the total possible number of fibres, is

incremented. The numbre of the pixel after the pair found (value h) is temporarily stored as a possible fibre start.

GET AVERAGE LIGHT checks groups of 3 pixels, starting with the group immediately before the pair found in GET_START, and stepping back one pixel at a time (i.e. each new group overlaps the last group by 2 pixels) until a group is found with light values c, d and e meeting the following criteria: ≤ light diff

and ≤ light diff

and c ≥ h (h is value and 85 ≤ c ≤ 125 and 170 ≥ [(c+d) - (a+bH < 230.

If a group of pixels meeting the above are found within 16 steps (unless the beginning of the line is encountered) debug_data [1] is incremented and the following values are calculated and stored:

True_light = [(c+d) - (a+b)] DIV 2

Light_value = (c+d) DIV 2

Light_threshold = Trunc [(c+d)-round (0.4(c+d-(a+b)))]/2

Focus_threshold = Trunc [(c+d)-round (0.15(c+d-(a+b)))]/2

The purpose of these calculations is to obtain threshold values for accurate determination of fibre edge positions.

Light_value is the average light level before the fibre and True_light is the difference between this average and the light levels under the black tape on the sensor. Figure 11 shows the effect of these calculations.

PIXELS_1 Starts at pixel 4 steps back from temporary start stored by GET_START and looks forward up to 14 steps (or to end of line) for the first pixel with light value <

focus_threshold. This pixel number is stored as [line_1 + focus_start].

This value minus two is stored as [spline_start].

The routine then steps back 1 pixel and looks forward up to 6 steps for a pixel with light value < light_threshold.

This pixel number is stored as [line_1 + light_start].

The routine continues to look forward up to

(max_pixel_width) steps for a pixel with light value ≥

light_threshold. It then steps back one and stores the pixel number as [line_1 + light_end]. The difference between start and end is stored as [line_1 + light_width].

Min_width = (3 * width) DIV 4

and

width_range - 1 + (5 * (width + 2)) DIV 4 - min_width are calculated and stored for use on other lines.

Finally, the routine looks foward up to 6 steps (from light_end) to find a pixel with light value ≥ focus_threshold.

The pixel number before this one is stored as [line_1 + focus_end] and the difference between focus_start and focus_end is stored as [line_1 + focus_width]. The 2nd pixel after

[focus_end] is stored as [spline_end].

If the four starts and ends are found successfully

Debug_data [2] is incremented.

PIXELS_2 Finds start and end pixels below focus and light thresholds (4 pixels found) on line 2.

[focus_start] is looked for in the range of ± 6 pixels from

[line_1 + focus_start].

[light_start] is then looked for within the following ± 6 pixels.

[light_end] is looked for over [light_range] steps, starting at [light_start] + [min_width].

[Focus_end] is looked for within the following 6 pixels.

The routine stores the following:

[line_2 + focus_start]

[line_2 + light_startl

[line_2 + light_end]

[line_2 + light_width]

[line_2 + focus_end]

[line_2 + focus_width]

If the four starts and ends are found successfully,

Debug_data 131 is incremented.

PIXELS_3 Looks for [line_3 + focus_start] in the range of ± 3 pixels from the pixel given by:

2 * [line_2 + focus_startl - [line_1 + focus_start].

The other three starts and ends are then looked for in the same manner as those on line 2, and the widths calculated. If successful, Debug_data [4] is incremented.

PIXELS_4 Finds the same information for line 4, using lines 2 and 3 focus starts. If successful, Debug_data[5] is

incremented.

LHIRES_WIDTHS Calls subroutine INTERPOLATE_LIGHT once for each line to get high resolution starts, finishes and widths and then calls subroutine MEAN_CofV to get the mean and coefficient of variation of the four widths. These are stored as

[Lfibre_widthl and [CofV_L]. If the coefficient of variation is acceptable (see description of MEAN_CofV) Debug_data[6] is incremented.

INTERPOLATE_LIGHT (subroutine)

Finds start and end points where light intensity profile crosses light threshold in hires units (l/256ths of a pixel) by linear interpolation between the pixel on or above the

threshold and the pixel below the threshold.

If pixel numbers and values are:

Pixel on or above threshold at start: pixel no.

(A-1) VALUE (i)

Pixel below threshold at start: pixel no. A value

(j)

Pixel below threshold at end: pixel no. B value

(k)

Pixel on or above threshold at end: pixel no. (B +

1) value (m)

then the hires values are:

thires_start] = 256* (A-1) + (256-round (256*(light_threshold - j) /(i-j)))

[hires_end] = 256*C + round (256*(light_threshold-k/(m-k)) NOTE: 256*1 = 0 and (256-x) = 2's complement x i.e., Negative x [hires_width] = [hires_endl - thires_start].

These values are stored with a line number index which is passed when the subroutine is called.

MEAN_CofV

This subroutine is called from LHIRES_WIDTHS and

FHIRES_WIDTHS with an index to indicate light_threshold values or focus threshold values. The mean and coefficient of variation of the appropriate four hires widths are calculated using the maths coprocessor and stored. The coefficient of variation is compared to the limit passed from turbo_pascal and a flag is set if the limit is exceeded.

FHIRES_WIDTHS operates identically to LHIRES_WIDTHS, using focus_threshold and calling INTERPOLATE_FOCUS and MEAN_CofV to calculate and store hires starts, ends, widths, mean and coefficient of variation for four lines. If the coefficient of variation is acceptable, Debug_data[7] is incremented.

SLOPE_CORRECT Calculates the angle of the fibre, relative to the sensor array in terms of offset in high resolution units in the X direction per vertical scan line. This means that a fibre parallel to the Y direction has a slope of zero.

The slope is calculated from a line of best fit through the high resolution starts and finishes at light and focus thresholds on all four lines.

Slope (hires units/line) = (3*sum(4) + sum (3)-3* sum (1) - sum(2))/40

where

sum(x) = sum of hires starts and finishes at light and focus thresholds for line x. (four values)

Fibres with slopes greater than 854 hires units/line

(equivalent to 45°) are rejected.

The hires widths at the two thresholds are corrected for slope according to:

corrected width = uncorrected width/SQRT(1+(3*Slope/2560)²) and the results stored as:

[Fcorr_width3 and [Lcorr_width].

If the fibre is accepted after slope checking,

Debug_data[8] is incremented.

FOCUS is calculated according to

[fibre_focus] = ([Fcorr_width]-[Lcorr_width])/8 and is compared with the upper and lower focus limits passed from turbo_pascal. If the focus value is accepted, Debug_data [9] is incremented. SPLINE Calculates the appropriate factors for each pixel interval from [spline_start] to [spline_end] on line 1 to fit a cubic spline to the light intensity profile.

Each interval is then examined for a minimum value and thus the minimum value of the overall curve is found and stored as [MinPixYR].

A spline threshold is calculated from

[spline_thrh3=[MinPixYR]+([light_value3-[MinPixYR])/2 i.e. half-way between the average light level before the fibre and the minimum value across the fibre.

The width of the spline curve is calculated at the spline threshold and stored as [spline_width]. This value is divided by the slope correction factor from SLOPE_CORRECT and stored as [Corr_spline_width] (real value) and also as [SW] (integer value).

No acceptance/rejection decision is made in the spline routine, so no debug flags are affected by it.

MICRON_STORE [Lcorr_width] and [Fcorr_width] are divided by 8, rounded and stored respectively as [fibre_width] and

focus_width]. These values are not currently used to determine diameter.

[SW] (spline width) and [fibre_focus] are used to obtain the fibre diameter from a lookup table.

The lookup table is an externally generated table of real number micron values with columns in multiples of 8 width units and rows in multiples of 4 focus units.

Undefined or unacceptable values have zero for a micron value. The table is loaded from disc into memory at system start-up and remains resident until the program is terminated.

For each fibre, lookup indices are calculated as follows:

Foclook = ([fibre_focus] DIV 4)*512(= Si register) Widelook = ([SW] DIV 8) * 4 (= BX register) and four micron values, called [pointl3, [point2], [point3] and [point4 ] are read from the table. [Point 13 is the value accessed by the indices and the other 3 points are those in a square to the right and below [pointl]. The final micron value is obtained by 2 dimensional linear interpolation between these four points as follows: u = ([SW] MOD 8)/8

t = ([fibre_focus] MOD 4)/4

[micron] = [Pointl] (1-t) (1-u) + [Point2] (t) (1-u) + [Point3] (t) (u) + [Point4] (1-t) (u).

[micron] is rounded to an integer value when stored. The fibre is accepted at this point only if all four points do not contain zero and 5 ≤ [micron] ≤ 200.

[micron_bin] consists of an array of integers with indices 0 to 200 corresponding to the histogram of accepted fibre diameters. At this point the [micron_bin] integer with an index

corresponding to [micron] is incremented.

If the fibre has been accepted and the data_base is not full, the following values are added to the data base:

[line_1_address] (current line 1 number)

[line_1+light_start] [fibre_focus]

[fibre_width] [fibre_slope]

[focuswidth] [SW]

[light_threshold]

[focus_thresholdl [micron]

If the fibre is accepted by MICRON_STORE, Debug_data [10] is incremented.

STORE_CROSSING Accumulates the following values for all accepted fibres in the current frame to allow processing of overall image when all fibres in frame have been examined.

[line_1_address]

[line_1+light_start]

ISW]

as well as the light value of the start pixel (below light threshold) and the real (unrounded) value of the micron value from the lookup table.

The other routines, LINK and BIN_GROUPS are used in conjunction with the information stored by STORE_CROSSING.

They are called after all fibres in the frame have been

processed, prior to return from the ANALYSE_FRAME procedure to turbo pascal.

The source code programs necessary to carry out the above described operations are provided in the succeeding pages of this specification. {FIDAM.PAS ***** ** *************** ** *********}

{ VER 5.01 6/6/89 }

PROGRAM fidam ;

{$R-} {Range checking off}

{$B+} {Boolean complete evaluation on}

{$S+} {Stack checking on}

{$l+} {l/0 checking on}

{$N+} {numeric coprocessor on}

{$M 65500,16384,655360} {Turbo 3 default stack and heap}

Uses

Crt,Dos,Printer,fidvar,fidio,fidinit,fidriver,fidrun,fidiag,fidasm;

CONST Version = 5.01 ;

Checkbreak = FALSE;

{------------------------------------------------------------------------------------------------------}

PROCEDURE Test ; { dummy procedure to allow uncoded procedures to

be in place without actually doing anything ! }

BEGIN

WRITELN('Hello ...Testing'):

Delay(1500)

END ; { of dummy Proc Test }

{-------------------------------------------------------------------------------------------------------}

PROCEDURE MainMenu ;

BEGIN

VERS := '5.01 ';

ClrScr;

NormVideo ;

Menud(1,30,3, 'FIDAM Main Menu') ;

Menu (1,30, 4, '------------------ ') ;

GotoXY(30,6) ;

WRITE('Version : ',Version:4:2) ;

GotoXY(30,7) ;

WRITE ("Fidam Serial No : ',Serial_String) ;

Menud(1,30,10,'1. Run FIDAM ') ;

Menu(1,30,12,'2. Diagnostics') ;

Menud(1,30,14,'3. Closedown') ;

IF Simulation THEN

BEGIN

Menud( 1,30,16,'4. Specify Simulation Filee);

UserRequest('4') ;

END

ELSE

UserRequest('3');

END; { of MainMenu }

{---------------------------------------------------------------------------------------------------------} PROCEDURE CloseDown;

BEGIN

Option := StepBack ;

Finish:=TRUE ;

END ; { of Closedown }

{--------------------------------------------------------------------------------------------------------- -}

PROCEDURE NewFile;

VAR

Testchar : char;

BEGIN REPEAT

CIrscr;

User_Message ( ' ',' ','Please specify new image filespec ',4);

Readln(Filespec);

IF Exist(Filespec) THEN

BEGIN

SimFileSpec := FileSpec;

Assign(lmageFile,Filespec);

Reset(Imagefile);

WITH Image^ DO

Read(lmagefile, Image^);

Simulation : = True;

User_message (' ','Image now resident', { } ' Press <F2> to proceed', 2);

Testchar := 'X';

END

ELSE

BEGIN

CIrscr;

User_message('Help','File ' + Filespec + ' not found ', { }

'Do you wish to select another ( Y / N ) ; ',4);

REPEAT

Testchar := ReadKey

UNTIL (Upcase(Testchar) = 'Y') OR (Upcase(Testchar) = 'N');

Write(Testchar);

END;

UNTIL (Testchar = 'X') OR (Upcase (Testchar) = 'N');

END; {of Newfile}

BEGIN

Data_Segment := DSEG ; { Setup DSeg save for code location }

Test_For_Simulation ; { Check DOS command line for /s from user }

Load_Instrument_Configuration ; { load FXX.CNF file containing calibration data } Configure_Environment ; { Define memory areas for dbase and simulate }

Debugl : = FALSE ; Debug2 := FALSE ; Debug3 := FALSE ; Debug4 := FALSE ;

Print := TRUE ;

Finish:=FALSE ;

FileType := 'None' ; {no FDF file selected}

Initialize_Assembly_Language_Data ; { setup p.i.b table for assembler code } Init_Hardware ; { init capture card on-board timer/s }

Reset_Stepper_Controllers ; { hardware reset stage motor controllers } Set_Inte rrupts ; { configure DOS vector table to include capture interrupts } Load_Lookup_Table ; {put table on disc into array }

Initialize_Run ; { initializes run data for tidy program entry } Init_Screen ; { clear screen , setup windows }

REPEAT REPEAT

Main Menu ; { display user options }

CASE Option OF

1 : Run_Time_Options ;

2 : Diags ; { load Diags from FIDAM.000 file on disk } 3 : Closedown ; { Exit gracefully , may close files etc then exit } 4 : Newfile ; {get new simulation filκ }

END UNTIL Option = StepBack ;

UNTIL Finish

END. {of fidam}

maximum_pixel : BYTE ; { highest value as above }

stat_pixel_squares : ^ DOUBLE ; { pointer to pascal real var for sums of squares } stat_pixel_sums : ^ DOUBLE ; { pointer to real var for sums of pixels } pixel_mean : ^ DOUBLE ; { pointer to real var for pixel mean } siide_position : BYTE { defines which image in slide run }

{ is being processed }

slide_fibre_counter : ARRAY[0..255] of WORD { array of integer counters }

{ which accumulates fibre totals } { as slide steps progress } { From this , slide position } { related data may be extracted } { from individual fibre values }

{ debug counter locations accessed by pascal }

debug_count : ARRAY[0..15,0..3] of BYTE ;

{ ' analyse frame ' scratch pad area }

quad_line_data : ARRAY[1..1,1..18] of BYTE ; { summary data for }

{ A scan lines }

line_1_address : BYTE ; { start of 4 line image }

counter_offset : WORD ; { offset into fibre totals by frame table }

Lfibre_width : WORD ; { data for an individual fibre ends }

Lcorr_width : WORD ;

Ffibre_width : WORD ;

Fcorr_width : WORD ;

fibre_slope :WORD ; { up here before being transfered } fibre_focus : BYTE ; { into the memory data base (array) } fibre_width : WORD ; { width in 32ndths of a pixel}

light_threshold : BYTE ; { fibre data i.e. sum of widths etc } light_value : BYTE ;

focιis_threshold : BYTE ;

true_light : BYTE ;

{ image process algorithm control values }

light_diff : BYTE ; { difference between adjacent light pixels } light_range : BYTE ; { range := 2 ^ diff + 1 }

{ N.B. BOTH MUST be set up by pascal }

CofVLimit : WORD ; { threshold for parallelism of fibre }

{ ' stats ' scratch pad area }

pixel_val : ARRAY[0..3] of BYTE ; { four byte memory areas .. } divisor : ARRAY[0..3] of BYTE ; { .. for 8087 long integer loads }

{ edge detection look-up tables }

END ;

data_base_B = RECORD

focus : ARRAY[0..8000] of BYTE ;

slope : ARRAY[0..8000] of WORD ;

spwidth : ARRAY[0..8000) of WORD ;

micron : ARRAY[0..8000] of WORD ;

END ;

DiameterTableType = RECORD

DiaTable : ARRAY[0..63 , 0..127] OF SINGLE ;

END:

VAR

HistFile : TEXT ;

HistFileName : STRING{32] ; {file name for output of histogram data}

LookUpName : STRING(50] ; { file name for table }

Dia_Seg : WORD ;

DiameterTable : ^DiameterTableType ;

Table_rejects : WORD ;

BinMin : BYTE s {fixed cut off for micron bins}

binthreshold : REAL ; {% micron bin cutoff}

diam,LightWidth,FocusWidth,SplineWidth,FocusAcc : STATS ; {accumulators for results }

{used by process_image} timer : word;

FileType : STRING[9];

FD_FileName : STRING[12];

Vers : STRING[15];

FlagCount : BYTE ;

DbF : ARRAY[1..10] of BOOLEAN;

INPUT,OUTPUT : WORD;

wait_time : WORD ;

Seri al_String : STRINGI12] ; { serial number read of stepper card input port }

GoBack,

Simulation : BOOLEAN ;

Average_Dark ,

Light_ Set : DOUBLE ;

Light_ Control : BYTE ;

Option :WORD ;

Print,

Debugl , Debug2 , Debug3 , Debug4 ,

Finish ,

Grab _Complete : BOOLEAN ;

Regs : Registers ;

Step_Port ,

X_Count ,

Y_Count : WORD ;

Stat : BYTE ;

SumPix,SumSq : DOUBLE ;

MeanPix : DOUBLE;

task_type : BYTE ;

Done ,

HomeX ,

HomeY : BOOLEAN ;

InitString : Display ; Test_Bits : DOUBLE ;

Sid_String : STRING[80] ;

Image : ^ CaptureRam ;

TestChar : CHAR ;

FileSpec,simfilespec ; Name ;

Pixel : BYTE ;

ImageFile : ImageData ;

PixelCounter : WORD ;

Fibre_Total ,

Total_Batch_Fibres : DOUBLE ;

Acceptance_Ratio : DOUBLE ;

pib : ^ pib_data ;

pib_segment , pib_offset : WORD ;

fibre_A : ^ data_base_A ;

fibre_B : ^ data_base_B ;

{ interpolation lookup table segment (base) }

TableSeg : WORD ;

d_base : BOOLEAN ;

{ globals for final data processing and calcs }

slope , count : BYTE ;

width, width1,groupwidth, focus,

light, true_light, linkwidth : STATS ;

siide_fibres : WORD ;

width_pre_focus :DOUBLE ;

micron , std_dev_micron :DOUBLE ;

{ calibration terms for micron and std dev loaded from FXX.CNF for each }

{ instrument } micron_term_0 , { micron = term_2 " width^2 + term_1 " width + term_0 } micron_term_1 ,

micron_term_2 ,

std_dev_term_0 , { std dev micron = term_2 ' (std dev width)^2 + etc } std_dev_term_1,

std_dev_term_2 : DOUBLE ;

{ Counter values for capture card timer chip } vertical_delay , { These values are loaded from FXX.CNF and so } horizontal_delay : WORD ; { allow adjustment for different cameras }

HaxPixelWidth : WORD ; { loaded from fXX,CNF this value defines the }

{ maximum pixel width at slope 0 and so limits } { the fibre measurement width }

Total_Debug : Debug_Data ;

Total_Batch_Debug : Debug_Data ;

Check_Width_Array : ARRAY[0..8,0..50] of DOUBLE ;

END;

Close(LookUpFile);

User :='X';

END

ELSE

BEGIN

ClrScr;

User_Message('HELP' , 'File '+ LookUpName + ' not found ',{

}'Do you wish to select another (Y/N) : ',4);

REPEAT

User := ReadKey;

write(User);

UNTIL (Upcase(User) ='Y') OR (Upcase (User ) = 'N');

END;

UNTIL (User = 'X') OR (Upcase (User ) = 'N');

IF UpCase(User) = 'N' THEN Halt ;

END; {of Load_Lookup_Table)

{----------------------------------------------------------------------------------------}

PROCEDURE Init_Screen;

BEGIN

ClrScr ;

Window (1,1,80,23) ;

GotoXY (1, 1) ;

END ;

{------------------------------------------------------------------------------------------}

PROCEDURE Load_Parameter_Table_Constants ;

VAR Index1,Index2, Index : BYTE ;

BEGIN

pib^ . image_segment := Seg(lmage ^) ; { load pib pointer for }

{ base of memory image }

pib^ . interpolate_segment := TableSeg ;

pib^.DiaSeg := Dia_Seg ;

pib^ .d_ibase_exists := d_base ; { flag assembler code whether dbase mem, avail } IF d_base THEN

BEGIN

pib^.fibre_set_A_seg ;= Seg(fibre_A^) ; { segment register for d_base A } pib^.start_line_offset := Ofs(fibre_A^ . line) ; { " line " } pib^.start_column_offset : - Ofs(fibre_A^ .column) ;

pib^.Lwidth_offseι : = Ofs(fibre A^.Lwidth) { dbase A offset to Lwidth array } pib^.Fwidth_offset : = Ofs(Fibre_A^.Fwidth);

pib^.light_fhreshold_offset := Ofs(fibre_A^ light_threshold);

pib^. focus_threshold_offset := Ofs(f ibre_A^ .focus_threshold);

pib^. fibre_set_B_seg := Seg(fibre_B") ;

pib^. focus_offset := Ofs(fibre_B^ . focus) ;

pib^. slope_offset := Ofs (fibre_B^ .slope) ;

pib^.spwidth_offset := Ofs(Fibre_B^.spwidth);

FOR index1 := 0 10 3 DO

debug_count[index, index1] := 0 ;

siide_position : = 0 ;

FOR index := 0 TO 255 DO

BEGIN

siide_fibre_counter[index] := 0 ;

focus_bin[index] := 0 ;

END;

dbasefull := FALSE ;

dbasecount := 0 ;

FOR index := 0 TO 200 DO

BEGIN

m icron_bin[index] := 0 ;

groupbin[index] := 0 ;

linkbin[index] := 0 ;

END;

END ;{of with pib^ do}

END {of Initial ise Run}

{---------------------------------------------------------------------------------------------} END.

BEGIN

WRITELN('Press <Return> to continue ; ' ) ;

READLN ;

END ; { of Pause }

{---------------------------------------------------------------------------------------}

PROCEDURE Pause_For(Function_Key : BYTE);

Key_Data : CHAR ;

Done : BOOLEAN ;

BEGIN

Done := FALSE ;

REPEAT

IF KeyPressed THEN

BEGIN

Key_Data := ReadKey ;

IF ( Key_Data = #0 ) AND KeyPressed THEN { if first data <esc> and }

{ another char in keyboard } { buffer then function key is } { likely - test for <F1> to <F10> } BEGIN

Key_Data :- ReadKey ; { the second character in function key press }

{ will have ORD value of 59 to 68 so .. }

IF ( ORD(Key_Data) - 58 ) = Function_Key THEN Done := TRUE ;

{ set exit flag }

END ;

UNTIL Done ;

END ; { of Pause_For }

PROCEDURE Menu(Vid,Xpos,Ypos : INTEGER ; User_Message : Display) ;

BEGIN

IF Vid = 0 THEN LowVideo ;

GotoXY(Xpos,Ypos) ;

WRITELN(User_Message) ;

IF Vid = 0 THEN HighVideo

END ;

{-----------------------------------------------------------------------------------------}

PROCEDURE User_Nessage (Attention_Msg , Msg_1 ,Msg_2 : Message ; Msg_Level : BYTE) ;

VAR

LastX, LastY : BYTE ; { cursor position X , Y prior to entering routine }

{ will return with cursor here if 'message' not extreme }

BEGIN LastX := WhereX ; { save current cursor position }

LastY := WhereY ;

Window (1,22,80,23) ;

ClrScr ; { clear message window }

IF Msg_Level > 0 THEN { Msg_Level = 0 only does clear and returns }

BEGIN

Display_Error(Attention_Msg,Msg_1,Msg_2) ; { uses Display_Error in ERRHANDL.PAS } CASE Msg_Level OF { Message_Level = 1 displays and returns immediately }

2 : Pause_For(2) ; { wait for user to press <F2> (continue) }

3 : Pause_For(1) ; { wait for user to press <F1> (stepback) }

END ;

Window(1,1,80,23) ;

IF Msg_Level <> 4 THEN { Level 4 leaves cursor at end of this message }

GotoXY(LastX, LastY) ; { restore cursor to position on entry }

END ; { of User_Nessage }

PROCEDURE GetOpt ion(Range : CHAR) ;

VAR

Ch : CHAR ;

Code : INTEGER ;

BEGIN

Option := NoQueue ; { init Option value }

IF KeyPressed THEN

BEGIN

Ch := ReadKey;

IF (Ch = #0) AND KeyPressed THEN { if <esc> and more chars in queue .}

{ most likely a function key } BEGIN

Ch,:= ReadKey ; { get second character from queu e }

IF (Ch = #59) THEN { if ORD(Ch)=59 then function <F1> }

Option :=StepBack { ..so set option to stepback Fing }

END ELSE IF ( ORD(Ch) > 32 ) AND ( ORD(Ch) < 126 ) THEN { check for asc ii }

BEGIN

WRITE(Ch) ; { display option }

IF (Ch >= '1') AND (Ch <= Range) THEN { check option within range } Val (Ch, Option, Code) { convert to numeric for CASE index }

ELSE

Option : = BadOption { otherwise return with option out-of-range } END END END;

PROCEDURE UserRequest(MenuRange : CHAR) ;

BEGIN

LowVideo;

User_message('','','Please enter a menu number > ',4) ; NormVideo;

REPEAT REPEAT BEGIN

GoToXY(35,23);

GetOption(MenuRange);

END:

UNTIL Option<>NoQueue ;

IF Option=BadOpιion THEN

BEGIN

User_Message('Note','The option selected must be a number 1 thru ' +MenuRange, {

}'Please enter a menu number > ',4) ;

END UNTIL Option<>BadOption

END ; { of UserRequest }

FUNCTION FlagCh{FlagBool : BOOLEAN) : CHAR ;

BEGIN

IF FlagBool THEN FlagCh := 'Y'

ELSE FlagCh := 'N'

END ; { of FlagCh }

PROCEDURE Fetchflag(Xposi, Yposi : INTEGER ; VAR NewFlag : BOOLEAN ) ;

VAR Ch : CHAR ;

BEGIN

GotoXY(Xposi ,Yposi) ;

REPEAT

Ch := ReadKey ;

UNTIL (UpCase(Ch) = 'Y') OR (UpCase(Ch) - 'N') OR (Ch= #13) ;

IT (Ch <> #13) THEN

IF UpCase (Ch) 'Y' THEN NewFlag = TRUE

ELSE NewFlag FALSE

WRlTELN(FlagCh(NewFlag))

END ; { of Fetch F lag }

PROCEDURE TestSpace(Scan : BOOLEAN ; VAR Done : BOOLEAN) ;

VAR Ch : CHAR ; { Scan - TRUE allows a once only test for <F1> keypress }

{ = FALSE returns when a <SPACE> or <F1> is keyed }

BEGIN

Ch := 'Z' ; {Init to NOT <SPACE>}

REPEAT

IF KeyPressed THEN

BEGIN

Ch := ReadKey ;

IF (Ch = #0) AND KeyPressed THEN

{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}

(FIDRIVER.PAS)

{ VER 5.01 11/5/89 }

{$N+}

UNIT FIDRIVER;

INTERFACE

USES Printer,Crt, Dos, FIDVAR,FID10, FIDASM;

PROCEDURE Reset_Stepper_Controllers;

FUNCTION Test_Bit(Test_Port ; INTEGER; Test_Value : INTEGER) : BOOLEAN;

PROCEDURE Send_Stepper Data(Command ; CHAR ; Stepper_Port : INTEGER);

PROCEDURE Init_Stepper_Driver(Initstring : Display ; Stepper : INTEGER);

PROCEDURE Toggle_Wait_Bit(Stepper : INTEGER):

PROCEDURE DeEnergise_Motors;

PROCEDURE Home_Stage;

PROCEDURE Move_To_Clear_Area;

PROCEDURE Move_To_Slide;

PROCEDURE Stage_Step_Program;

PROCEDURE Test_Stepper;

PROCEDURE Sensor_Monitor;

PROCEDURE Get_Frame;

PROCEDURE Set_interrupts;

PROCEDURE Get_Average_Dark;

PROCEDURE Set_Light;

PROCEDURE Auto_Light_Adjust;

IMPLEHENTATION

PROCEDURE Reset_Stepper_Controllers ;

BEGIN

PORT[StepperX] : = 166 ;

PORT[StepperY] := 166 ;

Delay(1) ; { see CY525 data p.91 reset time for 2Mhz clock }

PORT(StepperX) := 182 ;

PORT(StepperY) := 182 ;

END ;

FUNCTION Test_Bit(Test_Port : INTEGER; Test_Value : INTEGER) : BOOLEAN;

{ This function returns TRUE if bit is HIGH and FALSE if LOW

Inputs are a test PORT and a VALUE representing the test BIT i.e To tet bit 3 of 0..7 , value is 8 }

BEGIN

IF (PORT[Test_Port) AND Test_Value) = Test Value THEN Test_Bit : = TRUE ELSE Test_ Bit : = FALSE ;

END ;

PROCEDURE Send_Stepper_Data(Command : CHAR ; Stepper_Port : INTEGER);

VAR Count : INTEGER ;

BEGIN

IF NOT Simulation THEN

BEGIN

Count := 0 ;

REPEAT

Count := Count + 1 ; { wait for run completed }

UNTIL (Test_Bϊt(Stepper_Port .37)) OR (Count = 32766) ; { or timeout errur } IF Count = 32766 THEN

WRITELN('Error : Stepper controller timed out in run mode')

ELSE BEGIN

PORT[Stepper_Port] := 182 ;

Count := 0 ;

REPEAT

Count := Count + 1 ; { wait for data ready }

UNTIL Test_Bit(Stepper_Port, 128) OR (Count = 32766) ; { or timeout error } IF Count = 32766 THEN

WRITELN('Error : Stepper controller is not responding to request') ELSE BEGIN

PORT[Stepper_ Data] := INTEGER(Command) ; { output data to pcb } IF PCRT[Stepper_Data) <> lNTEGER(Command) THEN { check for collision }

WRIlELNCError : Stepper data collision')

ELSE BEGIN

Count := 0 ;

PORTIStepper_Port) ;= 51 ; { lower I/O handshake }

REPEAT

Count := Count + 1 ;

UNTIL NOT Test_Bit(Stepper_Port,128) OR (Count = 32766) ;

IF Count = 32766 THEN

WRITELN('Error : Stepper not responding to data') ELSE BEGIN

PORT[Stepper_Port) := 182 ;

END ;

END ; { of Send_Stepper_Data }

PROCEDURE Init_Stepper_Driver (InitString : Display ; Stepper : INTEGER);

{ A character string is passed to here and is strobed out to the CY525 .

When a '.' is found in string a <CR> is sent ( '.' is not used by CY525

so it is used here lo indicate <CR> in string ) }

VAR TestCh : CHAR ;

Count : INTEGER :

BEGIN

Count : = 0 ;

REPEAT

Count : = Count + 1 ;

TestCh := InitString[Count] ;

IF TestCh = '.' THEN TestCh : = CHR($OD) ;

Send_Slepper_Data (TestCh, Stepper) ;

UNTIL Count = Length(InitString) ;

END ;

PROCEDURE Toggle_Wait_Bit(Stepper : INTEGER);

BEGIN

PORT(Stepper) : = 178 ;

REPEAT UNTIL (NOT (Test_Bit(Stepper,16))) OR Simulation ;

{ The above loop provides the ainiaua delay needed to overcome the }

{ execution latency of the CY525 so a WAIT bit toggle is always detected }

{ (see PROCEDURE Stage_Step_Program ) : }

{ . .r_Driver('R 1.S 1.F 1.Z l.N 7.E. A$+ .B.U.C.G. D 10.L 15.A.B$- ...etc }

{ The lime from here ^ }

{ ... to here ' is a period where a toggle }

{ may be missed by the ' CY525 so handshaking is }

{ }

provided by examining ' the control bit and

{ releasing the toggle ' }

' after the

{ Clearbit ' command has executed . }

PORT[Stepper] : = 182 ;

END ;

PROCEDURE DeEnergise_Motors ;

BEGIN

Init_Stepper_Driver('I.E.G.O.Q',StepperX) ;

Init_ Stepper_Driver('I .E.G. O.O',StepperY) ;

END ;

PROCEDURE Home_Stage ;

VAR Step_Limit_X ,

Step_Limit_Y : INTEGER ; { bombs out stepper aotion if steps exceed total table size }

BEGIN

IF NOT Simulation THEN

BEGIN

Reset_Stepper_Controllers ;

Set_L ight ;

END

ELSE WRITELN('Light Control not applicabl e in simulation environment'); Pause ;

END ;

END.

{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}

{FIDPROC.PAS}

{VER 5.01 27/6/89 }

{$N+)

UNIT FIDPROC;

INTERFACE

USES Graph,Printer,Crt,Dos,FIDVAR,FIDASM,FIDIO,FIDRIVER,FIDINIT;

FUNCTION Std_Dev(Data_Record : Stats) : REAL;

FUNCTION Hean(Data_Record : Stats) : REAL;

PROCEDURE Init_Stat(VAR Data_Record : Stats);

PROCEDURE Ace_Record(VAR Data_Record : Stats ; Data_Record_In : Stats);

PROCEDURE Ace_Sum(VAR Data_Record : Stats ; Sumln. SumSqln, CountIn : REAL);PROCEDURE Acc_Val(VAR Data_Record : Stats; Value : REAL);

PROCEDURE Accumulate_Batch_Debug_Totals;

PROCEDURE Extract_pib_Debug_Totals;

PROCEDURE Extract_pib_Results;

PROCEDURE Calc(VAR LMin,LMax : INTEGER ; VAR LMean, LStdDev : REAL);

PROCEDURE CIear_Debug_Totals(VAR Debug_Array : Debug_Data);

PROCEDURE Duap_Debug_Values(VAR Debug_Array : Debug_Data);

PROCEDURE Display_Results;

PROCEDURE Process_Slide;

PROCEDURE View_Analysis(Slide_Index : BYTE);

PROCEDURE Link_View;

PROCEDURE Stats_Task;

PROCEDURE Execute_Task;

PROCEDURE Run_Test_Sample;

IMPLEMENTATION

{--------------------------------------------------------------------------------------}

FUNCTION Std_Dev(Data_Record : Stats) : REAL;

{ This function accesses the data set passed to it and returns

the standard deviation derived from the three accumulated values laportant NOTE ! The routine traps all bad calcs (e.g. sqr root

of -ve ) and returns with std dev set to 0 no error condition is currently reported }

BEGIN

WITH Data_Record DO

BEGIN

IF Count > 10E-6 THEN

IF ( SumSq > Sqr (Sum)/Count ) AND ( Count > 1.5 ) THEN

Std_ Dev := Sqrt(( 1/(Count-1) )'( SumSq - Sqr (Sum)/Count )) ELSE Std_Dev ;= 0.0 ;

END ;

FUNCTION Mean(Data_Record : Stats) : REAL;

{ This function accesses the data set passed to it and returns

the mean derived from the three accumulated values

lmportant NOTE ! The routine traps all bad calcs (e.g. Count = 0 )

and returns with mean set to 0 no error condition is

currently reported )

BEGIN

WITH Data_Record DO

BEGIN

IF Count > 0.5 THEN Mean := Sum / Count

ELSE Mean := 0.0 ;

END ;

{--------------------------------------------------------------------------------}

PROCEDURE Init_Stat(VAR Data_Record : Stats);

{ Initializes the stats record passed here ready for data accumulation }

BEGIN

WITH Data_Record DO

BEGIN

Sum := 0.0 ;

SumSq := 0.0 ;

Count : = 0.0 ;

END ;

{---------------------------------------------------------------------------------}

PROCEDURE Acc_Record(VAR Data_Record : Stats ; Data_Record_In : Stats);

{ Loads Sums ,SumSqs and Count accumulated in Data_Record_In into Data_Record }

BEGIN

WITH Data_Record DO

BEGIN

Sum := Sum + Data_Record_In. Sum ;

SumSq := SumSq + Data_Record_ln.SumSq ;

Count := Count + Data_Record_In.Count ;

END ;

{------------------------------------------------------------------------------}

PROCEDURE Acc_Sum(VAR Data_Record : Stats ; Sum n, SumSqln, Countln : REAL);

{ Loads Sums and SumSqs accumulated elsewhere into record and updates Count }

BEGIN

WITH Data_Record DO

BEGIN

Sum := Sum + Sumln ;

SumSq := SumSq + SumSqln ;

Count := Count + Countln ;

END ;

{-------------------------------------------------------------------------------}

PROCEDURE Acc_Val(VAR Data_Record ; Stats; Value : REAL);

{ Accumulates data value passed into specified stats record }

BEGIN

WITH Data_Record DO

BEGIN

Sum := Sum + Value ;

SumSq := SumSq + Sqr(Value) ;

Count : - Count + 1 ;

END ;

PROCEDURE Accumulate_Batch_Debug_Totals ;

VAR Location , Index : BYTE ;

BEGIN

FOR Location := 0 TO 15 DO

Total_Batch_Debug[Locatton] := Total_Batch_Debug[Location]

+ Total_Debug[Location] ;

END ;

PROCEDURE Extract_pib_Debug_Totals ;

VAR Location , Index : BYTE ;

BEGIN

WITH pib^ DO

FOR Location := 0 TO 15 DO

Total_Debug[Location] := debug_count[Location,0]

+ 256.0 ^ debug_count[Location,1]

+ 65536.0 ^ debug_count[Location, 2]

+ 16777216.0 ^ debug_count[Location,3] ;

END ;

PROCEDURE Extract_pib_Results ;

VAR

bincutoff : LONGINT ;

tempbin,Index : WORD ;

tempgroupwidth,Tempfocus,tempwidth,tempwidth1,

templinkwidth,Temp_Slide_Fibres : REAL ; { kludgy fix ! }

BEGIN

Init_Stat(width) ; { zeroise stats accumulators }

Init_ Stat(width1);

Init_Stat(focus) ;

Init_Stat (groupwidth) ;

lnit_Stat(linkwidth) ;

slide_fibres := 0 ;

FOR Index : = 0 TO 255 DO

BEGIN

tempfocus := pib^ . focus_bin[index];

focus. count := focus. count + tempfocus ;

focus. sum : = focus. sum + tempfocus^ index ;

focus. sumsq := focus. sumsq + sqr(index)^ tempfocus ;

END ;

FOR Index := 0 TO 200 DO

slide_fibres := slide_fibres + pib^ ,micron_bin[index];

bincutoff := Round(slide_fibres ^ binthreshold / 100);

FOR Index := 0 TO 200 DO

BEGIN

tempbin := pib^.micron_bin[index];

IF tempbin < binmin THEN tempbin := 0

ELSE tempbin := tempbin - binmin ;

tempwidth := tempbin ;

width.count := width. count + tempwidth ;

width.sum := width. sum + tempwidth ' index ;

width.sumsq := width.sumsq + sqr(index)^ tempwidth ;

tempbin := pib^ .micron_bin[index];

lF tempbin < bincutoff THEN tempbin := 0

ELSE tempbin := tempbin - bincutoff ;

tempwidth1 := tempbin ;

width1.count := widthl.count + tempwidthl ;

width1.sum := widthl.sum + tempwidthl ^ index ;

width1.sumsq := widthl. sumsq + sqr(index)' tempwidth1 ;

tempgroupwidth : = pib^.groupbin[index];

groupwidth. count := groupwidth. count + tempgroupwidth ;

groupwidth. sum := groupwidth.sum + tempgroupwidth * index ;

groupwidth. sumsq := groupwidth.sumsq + sqr(index)* tempgroupwidth ; templinkwidth := pib^. linkbin[index];

linkwidth. count := linkwidth. count + templinkwidth ;

linkwidth. sum := linkwidth. sum + templinkwidth * index ;

linkwidlh. sumsq := linkwidth. sumsq + sqr(index)* templinkwidth ;

END ;

Extract_pib_Debug_Totals ;

{ Deteraine Acceptance Ratio }

Temp_Slide_Fibres := slide_fibres ;

Acceptance_Ratio := 100.0 * Temp_Slide_Fibres / Total_Debug[0] ;

END ;

PROCEDURE Calc(VAR LMin,LMax : INTEGER ; VAR LMean, LStdDev : REAL);

VAR

I,PixVal : INTEGER ;

BEGIN

StatsCalc(pib_segment) ;

SumPix := pib^ , stat_pixel_sums^ ;

SumSq := pib^ ,stat_pixel_squares^ :

LMin := pib^ ,minimum_pixel ;

LMax := pib^ ,maximum_pixel ;

LMean : = SumPix/32767.0 ;

IF (SumSq - Sqr(SumPix)/32767.0) < 0.0 THEN LStdDev : = 0.0

ELSE LStdDev := Sqrt ((SuaSq - Sqr(SumPix)/37767.0)/32767.0) ;

END ; { of Calc }

PROCEDURE Clear_Debug_Totals(VAR Debug_Array : Debug_Data);

VAR Location , Index BYTE ;

BEGIN

FOR Location := 0 TO 15 DO

Debug_Array[location] := 0.0 ;

END ;

PROCEDURE Dump_Debug_Values(VAR Debug_Array : Debug_Data);

VAR Tracepoint ,

Index1 ,

lndex2 : BYTE ;

Temp_ Count : REAL ;

BEGIN

WRITELN(' Debug : ') ;

FOR Tracepoint := 0 TO 15 DO

WRITE(HexCh[Tracepoint], ':', Debug_Array[Tracepoint]; 7:0 ,' ') ;

WRITELN ;

WRITELN(' Decislon Table on 132 Column Printer Output Only') ;

WRITELN ;

IF Print THEN

BEGIN

WRITELN(LST) ;

WRITELN(LST,'Debug : ') ;

FOR Tracepoint := 0 TO 15 DO

BEGIN

WRITEUST,HexCh[Tracepoint],': ', Debug_ Array[Tracepoint] : 7: 0.' ') ; IF Tracepoint = 7 THEN WRITELN(LST) ;

END ;

WRITELN(LST) ;

WRITE(LST,' ') ;

FOR Tracepoint := 0 TO 14 DO

WRITEUST,' ',HexCh[Tracepoint].' ') ;

WRITELN(LST) ;

FOR Tracepoint := 1 TO 15 DO

BEGIN

WRITE (LST.' '.HexCh[Tracepoint],' ') ;

FOR Index1 := 0 TO ( Tracepoint - 1 ) DO

IF Debug_Array[Index1] > 1.DE-6 THEN

WRITE(LST,' ',(Dehug_Array[Tracepoint]/Debug_Array[Indexl]) :4:3) ELSE WRITE(LST, ' O.F. ') ;

WRITELN(LST) ;

END ;

END ; { of Dump_Debug_Values }

{---------------------------------------------------------------------------------------------}

PROCEDURE Group_Table ;

VAR

index : BYTE;

BEGIN

CloseGraph;

Window(1 ,1,80,25);

CLRSCR;

FOR Index := 0 TO 199 DO

BEGIN

IF (Index DIV 25 = 0) THEN

BEGIN

GotoXY(((Index DIV 25)'10) +1 , (Index MOD 25)+1):

Wri te( Index: 2,' ',pib^ . groupbin[Index] :5);

END ELSE BEGIN

GotoXY(((Index DIV 25)' 10) -1 , (Index MOD 25)+1);

Write( ',index:3.' ',pib^.groupbin[Index]:5);

END;

Readln;

END;

PROCEDURE Micron_Table ;

VAR

index : BYTE;

BEGIN

CloseGraph;

Window(1, 1,80,75);

CLRSCR;

FOR Index := 0 TO 199 DO

BEGIN

IF (Index DIV 25 = 0) THEN

BEGIN

GotoXY (((Index DIV 25)' 10) + 1, (lnde x MOD 25)+1);

Write(Index:2,' ', pib^ .micron_bin[Index]:5);

END ELSE BEGIN

GotoXY(((Index DIV 25)'10)-1, (Index MOD 25)+1);

Write(' ',index:3,' ',pib^ .micron_bin[Index]:5);

END;

Readln;

END'

{----------------------------------------------------------------------------}

PROCEDURE Histogramstart , finish:WORD; top:LONGINT; axis : STRING);

VAR

temp,height : LONGINT;

index,Ytic,LastYtic,Xtic,

lastXtic,NoOfBars,SizeOfBar,StartOfBar,CenterOfBar : WORD;

value : STRING[7] ;

BEGIN

InitGraph(GraphDriver,GraphMode,'');

NoOfBars := finish - start +1 ;

SizeOfBar := (530 DIV NoOfBars) ;

line(100,310,100,10) ;

SetTextStyle(0,1,2);

SetTextJustify(1,1);

OutTextXY(16,160,'COUNT');

SetTextStyle(0,1,1);

SetTextJustify(1,2);

LastXtic := 0;

FOR index := 0 TO finish - start DO

BEGIN

IF axis = 'MICRON' THEN temp := pib^.micron_bin[start + index];

IF axis = 'FOCUS' THEN temp := pib^. focus_bin[start + index];

StartOfBar := 100 + SizeOfBar : index ;

Height := 'temp + 300) DIV top :

BAR(StartOfBar,310,StartOfBar+SizeOfBur.310-Height);

Xlic := startofBar + (SizeOfBar DIV 2):

IF (Xtic - LastXtic >= 16) THEN

BEGIN

Str(start+index,value);

line(Xtic,310, Xtic,320);

OutTextXY(Xtic,324,value);

LastXtic := Xtic;

END;

SetTextStyle(0,0,2);

SetTextJustify(1,1);

OutTextXY(100+(NoOfBars DIV 2)'SizeOfBar,370,axis);

SetTextStyle(0,0,1);

SetTextJustify(2,1);

FOR Index := 0 TO 15 DO

BEGIN

Str (index '(top DIV 15), value);

line(90,310-(index'20),100,310-(index'20));

OutTextXY (82,310-(index'20),value);

END;

readln;

CloseGraph;

END;

PROCEDURE Micron_histogram(maximum : WORD);

VAR

input : STRING[20);

start,finish, index : WORD;

code : INTEGER;

top : LONGINT;

BEGIN

CloseGraph

REPEAT

ClrScr;

GoToXY(1,1);

write(' Start micron (0-199) <def 0>:');

readln(input);

{$R-}

val(input,start,code);

IF input = " THEN

BEGIN

code := 0;

start := 0;

END

UNTIL (code = 0) AND (start IN [0..199]);

REPEAT

ClrScr;

GoToXY(1 ,1);

write(' Start micron : '.start);

GoToXY(1 ,3);

write(' finish micron (' .start+1 , ' -200) <def 200>:');

readln(input);

val(input,finish,code);

IF input = " THEN

BEGIN

code := 0;

finish := 200;

END

VNTIL (code = 0) AND (finish IN [start +1..200]);

REPEAT

ClrScr;

GoToXY(1 ,1);

write(' Start micron : '.start);

GoToXY(1 ,3);

write(' finish micron :'.finish);

GotoXY(1 ,5);

write(' maximum count (0-65000) <def ',maximum, '> :'):

readln(input);

val(input,top,code);

IF input = " THEN

BEGIN

code := 0;

top := maximum;

END;

UNTIL (code = 0) ;

Histogram(start,finish,top,'MICRON');

END;

PROCEDURE Focus_h i stogram ;

VAR

input : STRING[20];

index,maximum,start,finish : WORD;

code : INTEGER;

top : LONGINT ;

BEGIP

CloseGraph;

maximum :=0;

FOR index := to 255 DO

BEGIN IF maximum < pib^.focus_bin[index) THEN

maximum := pib^ .focus_bin[index];

END;

RCPEAT

ClrScr;

GoToXY(1,1);

write('Start focus (0-254) <def 0>:');

readln(input);

{$R-}

val(input,start,code);

IF input = " THEN

BEGIN

code := 0;

start := 0;

END;

UNTIL (code = 0) AND (start IN [0..254]);

REPEAT

ClrScr;

GoToXY (1,1);

write(' Start focus : ',start);

GoToXY(1,3);

write(' finish focus (' .start+1 , '-255) <def 255>;');

readln(input);

val(input,finish,code);

IF input = " THEN

BEGIN

code : = 0;

finish := 255;

END;

UNTIL (code = 0) AND (finish IN [start +1..255]);

REPEAT

ClrScr;

GoToXY(1 ,1);

write (' Start focus : '.start);

GoToXY(1,3);

write(' finish focus :',finish);

GotoXY(1,5),

write(' maximum count (0-65000) <def ', maximum,'> :');

readln(input);

val(input,top,code);

IF input = " THEN

BEGIN

code := 0;

top := maximum;

END;

UNTIL (code = 0) ;

Histogram (start,finish, top,' FOCUS');

END;

{----------------------------------------------------------------------------------}

PROCEDURE focus_table ;

VAR

index : BYTE;

BEGIN

CloseGraph;

Window(1 ,1,80,25);

CLRSCR;

FOR Index := 0 TO 127 DO

BEGIN

IF (Index DIV 16 = 0) THEN

BEGIN

GoToXY(1 ,(Index MOD 16) +1);

write(lndex:2,' ',pib^. focus_bin[index]:5);

END

ELSE

BEGIN

GoToXY(((Index DIV 16)'10) -1 , (Index MOD 16)+1);

write(' ',index:3,' ',pib^.focus_bin[index]:5);

END;

GoTOXY(1,23);

write('<RET> for next page <SCR PRT> for hard copy');

Readln;

CLRSCR;

FOR Index := 128 TO 255 DO

BEGIN

IF ((Index-123) DIV '6 = 0) THEN

BEGIN

GoToXY(1,((Index-128) MOD 16) +1);

write(lndex:3,' ',pib^. focus_bin[index]: 5);

END

ELSE

BEGIN

GoToXY((((Index-128) DIV 16)'10), ((Index-128) MOD 16)+1);

write(' ',index:3,' ',pib^.focus_bin[index]:55;

END;

GoTOXY(1 , 25 ) ;

wri te ('<RET> to continue <SCR PRT> for hard copy'):

ReadIn;

END;

{------------------------------------------------------------------------------------}

PROCEDURE Linked_Table ;

VAR

index : BYTE;

BEGIN

CloseGraph;

Window(1,1,80,25);

CLRSCR;

FOR Index : = 0 TO 199 DO

BEGIN

IF (Index DIV 25 = 0) THEN

BEGIN

GotoXY((dndex DIV 25)' 10) + 1 , (Index MOD 25)+1);

Write (Index: 2,' '.pib^.linkbin[lndex):5);

END ELSE BEGIN

GotoXY(((Index DIV 25)'10) -1,(Index MOD 25 ) + 1);

Write ( ''.index:3.' ',pib^ .linkbin[Index]:5):

END;

Readln;

END;

{-------------------------------------------------------------------------------------}

PROCEDURE Get TableFile;

VAR

Ch : CHAR ;

TestFile : FILE ;

FileOK : BOOLEAN ;

BEGIN REPEAT

FileOK := FALSE;

ClrScr;

Write ('PIease specify filename ');

Readln(HistFileName);

IF Exist(HistFileName) THEN

BEGIN

Beep:

Writeln;

Write(' File ',HistFileName,' already exists...overwrite it ?(Y/N)'): REPEAT

Ch : = ReadKey;

UNTIL (Upcase(Ch) IN [' Y'.'N']}.

IF UpCase(Ch) = 'Y' THEN

BEGIN

FileOK := TRUE;

ASSIGN(HistFile,HistFileName);

REWRITE(HistFile);

END;

END

ELSE BEGIN

{$l-}

ASSIGN(HistFile,HistFileName);

REWRITE(HϊstFile);

{$I+}

IF (IOResult = 0) THEN FileOK := TRUE

ELSE BEGIN

Beep;

Writeln;

write('Invalid filename.. <RET> to continue');

readln;

END;

END UNTIL FileOK ;

END;

PROCEDURE file_micron_table;

VAR

Index : BYTE ;

BEGIN

CloseGraph;

GetTableFile;

FOR Index := 0 TO 200 DO

WRITELN(HistFile,Index:3,pib^.micron_bin(Index]:6);

Close(HistFile);

END;

PROCEDURE file_linked_table;

VAR

Index : Byte ;

BEGIN

CloseGraph;

GetTableFile;

FOR Index := 0 TO 200 DO

WRITELN(HistFile, Index :3,pib^.linkbin[Index] :6);

Close(HistFile);

END;

PROCEDURE file_group_table;

VAR

Index : BYTE ;

BEGIN

CloseGraph;

GetTableFile;

FOR Index := 0 TO 200 DO

WRITELN(HistFile, Index: 3 ,pib^.groupbin[Index]:6);

Close(HistFile);

END;

PROCEDURE Output_selector ;

VAR

SetTextJustify(2,1);

Line(GetMaxX-Xdiv DIV 2,GetMaxY DIV 2, GetMaxX-Xdiv DIV 2, (GetMaxY DIV 2)+4);

Out TextXV (GetMaxX, Index, value3);

SetTextJustify(0,1);

OutTextXY(0,8,'SAMPLE :'+Sid_String);

OutTextXY(0, 24, 'LOOKUP : ' +LookUpName);

Str(Total_Debug[0]:6:0,Value7);

OutTextXY(0,40.'RAW COUNT :'+Value7):

Sir(Acceptance_Ratio:3:0,Value5);

Str(Slide_fibres,Value7);

OutTextXY(0, 56, "VALID CROSSINGS : '+Value7+' ('+Value5+' %)');

Str(pib^.dBaseCount,Value7);

OutTextXY(0,72,Value7+' STORED IN DATABASE');

Str(Mean(focus): 5:2 , Value7);

Str(Std_Dev(Focus) :5:2. Value5);

OutTextXY(0.88, 'FOCUS : '+Value7+' S.D.: '+Value5);

Str(timer.Value7);

OutTextXY(0, 104. 'Processing Time : '+Value7+' seconds');

{************}

SetTextStyle(0,0,2);

Str(Mean{width) : 5: 2, Value7);

OutTextXY(280, 230, 'MICRON : '+Value7);

SetTextStyle(0,0,1);

Str(Std_Dev(width):5:2,Value6):

Str(Binoin, Value8);

Str(width.count:5:0,Value7);

OutTextXY(280,245,'S.D. : '+Value6+' Count: '+Value7+' Fixed bin th :'+ Value8); SetTextStyle(0,0,2);

Str(Mean(width1) : 5 : 2.Value7);

OutTextXY(280, 270, 'MICRON : '+Value7);

SetTextStyle(0,0,1):

Str(Std_Dev(width1):5:2,Value6);

Str(round(BinThreshold'siide_fibres/100), Value8);

Str(width1.count :5:0,Value7);

OutTextXY(280,285.'S.D. : '+Value6+' Count: '+Value7);

Str(binthreshold:5:2,Value5);

OutTextXY(280, 295, 'Scaled bin threshold : '+Value8+' '+Value5+'t of total'); {************}

SetTextSlyle(0,0,2);

Str(Mean(linkwidth) :5:2, Value7);

OutTextXY(280, 320, 'LINKED MICRON : '+Value7);

SetTextStyle(0,0,1);

Str(Std_Dev(linkwidth): 5:2,Value7);

OutTextXY(280, 335, 'linked S.D.: '+Value7);

Str(linkwidth.count:5:0.Value7);

OutTextXY(440.335. 'Count: '+Value7);

{***********}

SetTextStyle(0,0.2);

Str(Mean(Groupwidth) :5 : 2 , Value7);

OutTexιXY(280.360. 'GROUPED MICRON : '+Value7);

SetTexlStyle(0,0,1);

Str(Std_Dev(Groupwidth):5:2,Value7);

OutTextXY(280, 375. 'Grouped S.D.: '+Value7);

Str(groupwidlh.count:5:0.Value7);

OutTextXY(440,375 Count:'+Value7);

{************}

OutTextXY(0,150, 'SELECT OPTION :=');

OutTextXY(0,180, ' <F1> : Micron Histogram. ');

OutTextXY(0,200, ' <F2> : Focus Histogram,');

OutTextXY(0,220, ' <F3-> : Focus Table.');

OutTextXY(0,250, ' <F4> : Micron Table.');

OutTextXY(0,260, ' <F5> : File Micron Table. ');

OutTextXY(0,300, ' <F6> : Linked Micron Table.' );

OutTextXY(0,310, ' <F7> : File Linked Table.');

OutTextXY(0,350, ' <F8> : Group Micron Table.');

OutTextXY(0,360, ' <F9> : Fiie Grouped Tabie.');

OutTextXY(0,395, '<RET> : Run Menu (print summary)');

Ch :=Readkey ;

IF Ch = #0 THEN

BEGIN

Ch := Readkey;

Case Ch of,

#59 : Micron_histogram(maxcount);

#60 : Focus_histogram;

#61 : focus_table;

#62 : micron_table;

#63 : file_micron_table;

#64 : Linked_Table;

#65 : file_linked_table:

#66 : Group_Table;

#67 : file_group_table;

END; {of case}

END;{of IF}

UNTIL (Ch = #13);

CloseGraph;

END;

PROCEDURE Display_Results ;

VAR Answer : CHAR ;

Tracepoint : BYTE ;

Temp_Count : REAL ;

Hour,Minute,Second,Set100,

Year,Month,Day,DayofWeek : word;

BEGIN

Beep;

Output_selector ;

IF Print THE

BEGIN WRITELN(LST) ;

WRΙTELN(LST) ;

WRITELN(LST) ;

WRITE(LST,'FIDAH ',serial_string,' ');

GetTime(Hour,Minute,Second,sec100),

GetDate(Year,Month,Day,DayofWeek);

WR ITELN(LST,Hour, ':' ,Minute, " ', Day ,'/' ,Month , '/' , Year ,' VER '.VERS) ; WRITELN(LST);

WRITEUST, 'Delay : ' , wait_time. ' mS C of V limit : ',pib^ .CofVLimit);

VAR

AllDone : BOOLEAN ;

Fibre_Index .

Fibre _Index_0 ,

Fibre_Index_1 ,

X,Y,X_Start ,

X_End ,

Y_Axis ,

Temp : INTEGER ;

Chr : CHAR ;

Frame : STRING[4] ;

BEGIN

AllDone := FALSE ;

Analyse_ Frame(pib_segment ) ;

{***** **Graphics Part **********}

GraphMode : = 0 ; {set colour mode for 4 grey levels... but worse resolution} InitGraph(GraphDriver,GraphMode,'');

View(pib_segment);

SetTextStyle(0,0.1);

SetTextJustify(0,2);

OutTextXV(1,390, '<F1> to return to menu'); {display message}

IF (Task_Type = 4) THEN

BEGIN

Stnpib^.slide_position.frame);

OutTexιXY(1,10,'Frame No. '+frame);

IF pib^. slide_ position < 255 THEN

OutlextXY (1,20, '<RET:> to advance frame');

END;

{************** display successful crossings as flashing lines**********}

IF (Slide_Index <> 0) AND (pib^ .slide_fibre_counter[SIide_lndex-1] > 0) THEN

Fibre_lndex_0 : = pib^ .slide_fibre_counter[SIide_ Index - 1]

ELSE Fibre_lndex_0 := 0 ;

Fibre_Index_1 : = pib^ . slide_fibre_ counter[SIide_ Index] - 1 ;

REPEAT

FOR Fibre_Index := Fibre_lndex_0 TO Fibre_ Index_1 DO

BEGIN

SetColor(0);

X_Start : = 64 + fibre_ A^ .column[Fibre_ Index] ;

X_End := X_Start + Trunc(Fibre_A^ .Fwidth[Fibre_Index] / 32 ) ; Y_Axis := 72 + fibre_A^ . line[Fibre_Index] ;

Line(X_ Start ,Y_Axis,X_ End,Y_Axis);

END ;

delay(200);

FOR Fibre_Index := Fibre_ Index_0 TO Fibre_ Index_1 DO

BEGIN

SetColor(3):

X_Start := 64 + fibre_ A' .column[Fibre_Index] ;

X_End := X_Start + Trunc ( Fibre_A^.Fwidth[Fibre_lndex] / 32 ) ; Y_Axis := 72 + fibre_A" . line[Fibre_Index] ;

Line(X_ Start.Y_Axis.X_End,Y_Axis);

END ;

delay(200);

{************** check for key press *****************}

IF KeyPressed THFN

BEGIN

Chr : = ReadKey;

IF (Chr = #13) THEN

AllDone := TRUE;

IF (Chr = #0) AND KeyPressed THEN

BEGIN

Chr := ReadKey.

IF (Chr = #59) THEN

BEGIN

Alldone := TRUE;

Goback := TRUE;

END;

UNTIL ALLDONE ;

CloseGraph;

GraphMode := 5;

TextMode(LastMode) ;

END ;

PROCEDURE Link_View ;

VAR

AllDone : BOOLEAN ;

Fibre_Index ,

Fibre_lndex_0 ,

Fibre_Index_1 ,

X,Y,X_Start ,

X_ End ,

Y_Axis ,

Temp : INTEGER ;

Chr : CHAR ;

GroupNo : STRING[3];

Frame : STRING[4] ;

BEGIN

Initialize_Run;

AllDone := FALSE ;

Analyse_Frame(pib_segment) ;

{ ***** Graphics Part ************}

GraptiMode := 5 ; {set xolour aode for 4 grey levels... but worse resolution}

In itGraph (GraphDr iver,GraphMode,");

{*********************}

FOR X := 0 TO 255 00

FOR Y := 0 TO 127 DO

BEGIN

I F (image^.imagememory[(Y SHL 8) + X) -70) THEN putpixel(2^X+96,2^Y+68,1);

I F (image^.imagememory[(Y SHL 8) + X) >70) THEN putpixel(2^X+97,2^Y+68,1);

I F (image^.imagememory[(Y SHL 8) + X) >70) THEN putpixel(2^X+96,2^Y+69,1);

I F (image^.imagememory[(Y SHL 8) + X] >70) THEN putpixel(2^X+97,2^Y+69,1); END;

{**********************}

Set TextStyle(0,0,1);

SetTextJustify(0,2);

OutTextXY(1,390, '<F1> to return to menu'); {display message}

{********* display successful crossings as flashing lines *****************}

SetTextJustify(0,1);

Fibre_lndex_0 : = 0 ;

Fibre_Index_1 := pib^ . slide_f ibre_counter [0] - 1 ;

FOR Fibre_Index := Fibre_ Index_ 0 TO Fiber_ Index_ 1 DO

BEGIN

X_Start := 2 ^ fibre_A^ . column [Fibre_ Index] + 96 ;

X_End := X Start + Trunc(Fibre_ A^ . Fwidth [Fibre_lndex] / 16 ) ; Y_Axis := 2 ^ fibre_A^ . line[Fibre_Index] + 68 ;

SetColor (3);

Bar(X_End+3,Y_Axis+5,X_End+1 3,Y_Axis-5);

SetColor(0);

Str(pib^.frame[Fibre_ Index+1,1],GroupNo);

OutTextXY(X_End+ 4, Y_Ax is, GroupNo);

END ;

REPEAT

FOR Fibre_Index := Fibre_Index_0 TO Fibre_ Index_1 DO

BEGIN

SetColor(0);

X_Start := 2 ^ fibre_A^.column[Fibre_Index) +96 ;

X_End := X_Start + Trunc(Fibre_A^.Fwidth[Fibre_Index] / 16 ) ; Y_Axis := 2 ^ fibre_A^. line[Fibre_Index] + 68 ;

Line(X_Start,Y_Axis,X_End,Y_Axis);

Line(X_ Start, Y_Axis+1,X_ end, Y_Axis+1);

END;

delay(200);

FOR Fibre_Index : = Fibre_ Index_0 TO Fibre_Index_1 DO

BEGIN

SetColor (3);

X_Start := 2 " fibre_A".column[Fibre_Index] +96 ;

X_End := X_Start + Trunc(Fibre_A".Fwidth[Fibre_ Index] / 16 ) ; Y_Axis := 2 " fibre_ A".line[Fibre_ Index] + 68 ;

Line(X_Start, Y_ Axis,X_End,Y_Axis);

Line(X_Start,V_Axis+1,X_ end,Y_Axis+1);

END ;

delay(200);

{ ********check for key press********* }

IF KeyPressed THEN

BEGIN

Chr := ReadKey;

IF (Chr = #13) THEN

AllDone := TRUE;

IF Chr = #0) AND KeyPressed THEN

BEGIN

Chr := ReadKey;

IF (Chr = #59) THEN

BEGIN

Alldone := TRUE;

Goback := TRUE;

END;

UNTIL ALLDONE ;

CloseGraph;

GraphMode := 5;

TextMode(LastMode) ;

END ;

PROCEDURE Stats_Task ;

VAR

Min, Max : INTEGER ;

Mean,StdDev : REAL ;

BEGIN

Calc(Min,Max, Mean, StdDev) ; {and display user requested stats}

WRITE('Pos: ',Y Count.' ',X_Count,' ') ;

WRITE('Mean = ',Mean:5:2.' StdDev = '.StdDev:5:2) ;

WRITELN(' Minima = ',Min:4 ,' Maxima = '.Max:4) ;

END ;

PROCEDURE Execute_Task ;

BEGIN

CASE task_type OF

1 : View(pib_segment) ; { Display image.... Uses assembler routine 'view'}

2 : Stats_Task ;

3 : Analyse_Frame(pib_segment) ;

4 : View_Analysis(pib^.slide_ position) ;

END ;

PROCEDURE Run_Test_Sample ;

VAR Mour,Minute,second,subsec : word;

hour1,minute1,second1,subsec1 : WORD;

BEGIN

IF NOT Simulation THEN

BEGIN

Reset_Stepper_Controllers ;

Delay(10) ; { pause after hardwa a reset }

Mome_Stage ;

Get_Average_Dark ;

Move_To_Clear_Area ;

Set_Light ;

END ELSE Light_Control := 128 ;

IF Light_Control <> 255 THEN

BEGIN

Initialize_Run ;

IF NOT Simulation THEN

BEGIN

Move_To_Slide ;

Delay(100) ; { let stage settle at start of slide }

Stage_Step_Program ;

END ;

Goback : = FALSE;

Y_Count := 1;

IF task_type = 1 THEN

BEGIN

GraphMode := 0 : {set colour aode for 4 grey levels... but worse resolution} InitGraph(GraphDriver, GraphMode,");

END;

GetTime(Hour,Minute,second,subsec):

WHILE (GoBack=FALSE) AND (Y_Count < 17) DO

BEGIN

X_ Count := 1;

WHILE (GoBack = FALSE) AND (X_Count <17) DO

BEGIN

Delay(Wait_Time);

Get_Frame ;

IF X_ Count < 16 THEN Toggle_Wait_Bit(StepperX)

ELSE IF Y_Count < 16 THEN Toggle_Wait_Bit(StepperY) ;

Execute_Task ;

pib^. slide_position := pib^ .slide_position + 1 ;

REPEAT UNTR (Test_Bit(StepperX,16)) OR Simulation ;

X_Count := X_ Count + 1 ;

END ;

REPEAT UNTIL (Test_Bit(StepperY,16)) OR Simulation ;

Y_ Count := Y_Count + 1 ;

END ;

GetTime(Hour1,Hinute1,second1, subsec1);

IF task_type - 1 THEN

BEGIN

CloseGraph;

GraphMode := 5;

END;

IF second1<second then

BEGIN

Second1 := second1 +60;

minute := minute + 1;

END;

timer : = second1 - second;

IP minutel<minute then

BEGIN

Minute1 := minute1 + 60 ;

hour := hour + 1 ;

END;

timer := timer = 60^ (minutel-minute) ;

IF hour1<hour then

hour1 := hour1 = 24;

timer : = timer + 3600'(hour1 - hour);

IF NOT Simulation THEN

BEGIN

Reset_Stepper_Controllers ;

Home_Stage ;

DeEnergise_Motors ;

END ;

END ; { of Run_Test_Sample } END.

SAHF ; transfer 8087 flags from to 8086 flags

CMC ; set carry if C of V > limit

MOV AX,ES:(CofV_ temp) ; store C of V

MOV ES:[CofV_F),AX

MOV AX,ES:[fibre_width_ temp] ; store mean

MOV ES:[Ffibre_width],AX

RET

;-------------------------------------------------------------------------------------- ; Routine : INTERPOLATE_FOCUS 15/12/88

; Function : look up interpolation table for hires start and end at FT

; Inputs : line address in CH, line offset in pib (SI)

; Uses : pixel starts and ends and FT from pib

; Outputs hires start, end and width stored in pib

;

interpolate_focus:

MOV BH,CH ; put start pixel pointer

MOV BL,ES:(SI + focus_start] ; in BX

DEC BL ; step back across threshold

MOV AH,BL ; keep msbyte of start

MOV BX,DS:(BX) ; fetch pixel pair

SUB BL,BH ; difference between pixels in BL SUB BH,ES:[focus_ threshold] ; diff start pixel to threshold NEG BH ; fl ip to positive

PUSH DS ; save image base

NOV DS,ES: [interpolate] ; load interp table segment

MOV AL,DS:[BX] ; get interpolated value

POP DS ; restore image base

NEG AL ; 2S6 - interpolated value

MOV ES:(SI+Fhires_start),AX ; store hires start

MOV BH,CH ; reload line value

MOV BL ,ES: (Sl+focus_ end] ; point to end pixel

MOV AH,BL ; store msbyte of end

MOV BX,DS:(BX] ; fetch pixel pair across threshold SUB BH,BL ; diff between pixels

SUB BL,ES:[focus threshold] ; top pixel to threshold

NEG BL ; make positive

XCHG BL.,BH ; correct order for end lookup PUSH DS ; save image base

MOV DS,ES: [interpolate] ; base of interp table

MOV AL,DS:[BX] ; get interpolated value

ADD AL,O ; check for pixel on threshold JNZ Fhires_ cont ; jump if not special case

INC AH ; otherwise correct msbyte

Fhires_cont :

POP OS ; restore image base

MOV ES:[SI+Fhires_end],AX ; store hires end

SUB AX.ES: [SI+Fhires start] ; calc width

MOV ES: (SI+Fhires_width],AX ; and store

RET

; -----------------------------------------------------------------------------------; Routine : MEAN_CofV

; Function : works out mean and c of v on 4 hires widths, sets CF if CofV > limit; Uses : 8087 coprocessor

; Returns : mean and C of V stored in temporary locations in pib

; mean_cofv:

FINIT ; initialise 8087

;************** ****calculate mean width************** ********************* ********

FILD WORD PTR ES: [line_1+SI] ; load widths

FILD WORD PTR ES: [line_2+SI]

FILD WORD PTR ES : [line_ 3+SI]

FILD WORD PTR ES : [line_ 4+Sl]

FILD WORD PTR ES: [line_ 1+SI] ; accumulate total

FADD ST,ST(3)

FADD ST,ST(2)

FADD ST,ST(1)

FiDIV WORD PTR four ; divide by 4 to get mean

;************** ******** calculate standard deviation ******************

FSUB ST(1),ST ; subtract mean from widths

FSUB ST(2),ST

FSUB ST(3),ST

FSUB ST(4),ST

FLD ST(1) ; accumulate squares of differences FMUL ST,ST(2) ; from mean

FLD ST(3)

FMUL ST,ST (4)

FADD

FLD ST(4)

FMUL ST,ST(5)

FADD

FLD ST(5)

FMUL ST , ST (6)

FADD

FIDIV WORD PTR three ; divide by n-1 (3)

FSQRT ; sqrt to get sd

;************** ******** calculate C of V *************** *******************

FDIV ST,ST(1) ; divide sd by mean

FIMUL WORD PTR hundred ; times 100 for c of v

FICOM WORD PTR ES : [CofV_Limit] ; compare to limit

FSTSW ES:[fibre width temp] ; temporarily store flags

FWAIT

MOV AX,ES: [fibre_width_temp] ; move flags to AX

FIMUL WORD PTR hundred ; CofV times 100 for better resolution

FISTP WORD PTR ES : [CofV_temp] ; store c of v

FIST WORD PTR ES:[fibre_width_temp] ; store mean width

FINIT RET

;-------------------------------------------------------------------------------------- ; Routine : SLOPE_CORRECT 2/3/89

; Function : calc slope, accept/reject and correct aean widths

; Inputs : 8 hires starts and ends

; Returns : hires slope (per line), corrected hires widths, carry set if ; : slope or width outside limits

;

slope_correct :

MOV AX,WORD PTR ES:[line_1+Lhires_start] ; put starts and ends

MOV WORD PTR Hi1,AX ; into 4 byte locations

MOV AX,WORD PTR ES:[line_ 1+Lhires_end] ; so 8087 can access

MOV WORD PTR Hi1[4],AX ; positive values over

MOV AX, WORD PTR ES:[line_ 1+Fhires_start] ; 32767 MOV WORD PTR Hi1[8],AX

NOV AX, WORD PTR ES:[line_1+Fhires_ end]

MOV WORD PTR Hi1[12],AX

NOV AX, WORD PTR ES: [line_2+Fhires_start]

MOV WORD PTR Hi2,AX

MOV AX,WORD PTR ES:[line_2+Lhires_end]

MOV WORD PTR Hi2[4),AX

MOV AX, WORD PTR ES : [line_2+Fhires_start]

MOV WORD PTR Hi2[8),AX

MOV AX, WORD PTR ES : [line_2+Fhires _end]

MOV WORD PTR Hi2[12],AX

MOV AX, WORD PTR ES:[line_3+Lhires_start]

MOV WORD PTR Hi3,AX

MOV AX, WORD PTR ES : (line_3+Lhires_end]

MOV WORD PTR Hi3[4],AX

MOV AX, WORD PTR ES:[line_ 3+Fhires_start]

MOV WORD PTR Hi3[8],AX

MOV AX,WORD PTR ES:[line_3+Fhires_end]

MOV WORD PTR Hi3[12],AX

MOV AX, WORD PTR ES : [line_4+Lhires_start]

MOV WORD PTR Hi4,AX

MOV AX, WORD PTR ES : [line_4+Lhires_end]

MOV WORD PTR Hi4[4],AX

MOV AX, WORD PTR ES : [line_4+Fhires_start]

MOV WORD PTR Hi4[8),AX

MOV AX, WORD PTR ES:[line_ 4+Fhires_end]

MOV WORD PTR Hi4[12],AX

FINIT ; initialise 8087

; *******calculate slope per line in hires units (least squares) ********

FILD DWORD PTR H14[0] ; sum line 4 starts and ends

FIADD DWORD PTR Hi4[4]

FIADD DWORD PTR Hi4[8]

FIADD DWORD PTR Hi4[12]

FIHUL WORD PTR three ; times 3

FIADD DWORD PTR Hi3[0) ; add line 3 starts and ends

FIADD DWORD PTR Hi3[4]

FIADD DWORD PTR Hi3[8]

FIADD DWORD PTR Hi3[12]

FILD DWORD PTR Hi1[0] ; sum line 1 starts and ends

FIADD DWORD PTR Hi1[4]

FIADD DWORD PTR Hi1[8]

FIADD DWORD PTR Hi1[12]

FIMUL WORD PTR three ; times three

FSUB ; subtract 3' line 1 from total

FISUB DWORD PTR Hi2[0] ; subtract line 2 starts and ends

FlSUB DWORD PTR Hi2[4]

FISUB DWORD PTR Hi2[8]

FISUB DWORD PTR Hi2[12]

FIDIV WORD PTR ten ; divide by ten to get s l ope

FABS

FIDIV WORD PTR four

FIST WORD PTR ES: [fibre_slope] ; store slope

FWAIT

MOV AX,WORD PTR ES : [fibre_slope]

CMP AX,max_slope ; check slope ok JNC slope_error

;************** ******* slope correct hires widths *************** *****************

FIHUL WORD PTR three ; work out factor

FIDIV WORD PTR twofivesixo

FST ST(1)

FMUL

FLD1

FADD

FSORT

FST DWORD PTR CorrFactor

FILD WORD PTR ES:[Lfibre_ width] ; get light width

FDIV ST,ST(1) ; divide by factor

FISTP WORD PTR ES:[Lcorr_width] ; store corrected light width

FILD WORD PTR ES:[Ffibre_width] ; get focus width

FDIV ST,ST(1) ; divide by factor

FISTP WORD PTR ES:[Fcorr_width] ; store corrected focus width

FINIT

FWAIT

MOV AX,WORD PTR ES:[Lcorr_width]

CMP AX,min_hru

JC slope_error

CMP AX,max_hru

JNC slope_error

CLC

RET

slope_error:

STC

RET

;-------------------------------------------------------------------------------------- ; Routine : FOCUS 21/12/88

; Function : calc focus, accept/reject

; Inputs : corrected hires widths

; Returns : focus in 1/32ndths of a pixel, carry set if outside limits ;

focus:

MOV AX, WORD PTR ES:[Fcorr_width] ; load focus width

SUB AX, WORD PTR ES:[Lcorr_width) ; subtract light width

ADD AX,4 ; round value

SHR AX,1 ; divide by 2

CHP AX, WORD PTR ES:[Foc_Low] ; check lower limit

JC focus_error

CMP WORD PTR ES:[Foc_high],AX ; check upper limit

JC focus error

MOV ES:[fTbre_focus] ,AL ; store focus

CLC

RET

focus_error:

STC RET

;-------------------------------------------------------------------------------------- ; Routine : SPLINE 8/3/89

; Function :

; Inputs : ; Returns :

;

spline:

PUSH OS

PUSH BX

PUSH OX

MOV CH,0 ; CX = pixel count across fibre

MOV CL,E5;[spline_end]

SUB CL,ES:[spline_ start]

MOV DX,CX

INC CX ; do extra Asp value

MOV Dl,0

MOV WORD PTR HinPixY,127

MOV BH,ES:[Line_1_Address] ; pixel pointer

MOV BL,ES:[spline_start]

first_loop:

; **** **** loads Asp values and finds ainiaua pixel ******* ***

MOV AX,DS:[BX] ; AX = pixel value

MOV AH,0

MOV WORD PTR ES : [ASP] [Dl] ,AX ; into pib array

CMP MinPixY,AX

JC first_loop_1

MOV MinPixY,AX ; store lower minimum value first_loop_1:

INC BX : point to next pixel

ADD Dl,2 ; point to next Asp location

DEC CX

JNZ first_loop

MOV AX,0 ; zero one after end

MOV WORD PTR ES:[ASP][DI],AX

;********* do intermediate values *******************

MOV CX,DX ; No of intervals

MOV DI,0

MOV Sl,0

FINIT FLDZ

FST DWORD PTR Beta[0]

FST DWORD PTR Gamma[0]

FST DWORD PTR Delta[0]

FWAIT

second_loop:

ADD DI,2

ADD SI,4

FINIT

FILD WORD PTR ES:[ASP][DI +2]

FISUB WORD PTR ES:[ASP][DI)

FISUB WORD PTR ES:[ASP)[DI]

FIADD WORD PTR ES:[ASP][DI-2]

FIMUL WORD PTR three

FST DWORD PTR Alpha[SI]

FINIT

FILD WORD PTR four

FSUB DWORD PTR Gamma[S] - 4]

FST DWORD PTR Beta[SI] FLD1

FDIVR

FST DWORD PTR Gamma[SI]

FINIT

FLD DWORD PTR Alpha[SI]

FSUB DWORD PTR Delta[SI - 4]

FDIV DWORD PTR Beta[SI)

FST DWORD PTR Delta[SI]

FWAIT

DEC CX

JNZ second_loop

;************** *******do Bsp, Csp, Dsp *************** **************

MOV CX, DX

MOV DI, CX

MOV SI,CX

DEC SI SHL SI,1

DEC DI SHL DI,1

SHL DI,1 ; DI points to last value

FINIT FLDZ FST OWORD PTR ES:[CSP][4+DI]

third_loop:

FINIT

FLD DWORD PTR Delta[DI);

FLD DWORD PTR Gamma[DI]

FMUL OWORD PTR ES:[CSP][4+DI]

FSUB

FST DWORD PTR ES:[CSP][DI] ; store Csp value

FINIT

FILD WORD PTR ES:[ASP][SI+2]

FISUB WORD PTR ES:[ASP][SI]

FLD DWORD PTR ES:[CSP][DI+4]

FADD DWORD PTR ES:[CSP][DI]

FIDIV WORD PTR three

FSUB

FST DWORD PTR ES:[BSP][DI] ; store Bsp value

FINIT

FLD DWORD PTR ES:[CSP][DI+4]

FSUB DWORD PTR ES:[CSP][DI]

FIDIV WORD PTR three

FST DWORD PTR ES:[DSP][DI] ; store Dsp value

FWAIT

SUB DI,4

SUB SI,2

DEC CX

JNZ third_loop

FINIT

;

;************** * *******Find pixels on or before light thresholds *************** **************

MOV CX,0

MOV Dl,0

find_Lstart : MOV WORD PTR Lstart,CX

INC CX ADD DI,2

MOV AX,WORD PTR ES:[ASP] [DI]

CHP AL,ES:[light_threshold]

JNC find_Lstart

MOV CX,DX

MOV DI,CX

SHL Dl,1

find_Lend:

SUB DI,2

DEC CX

MOV WORD PTR Lend,CX

MOV AX, WORD PTR ES:[ASP][DI]

CHP ES: [light_threshold],AL

JC find_Lend

;************** * ******find bottom of curve *************** **************

FINIT FILD WORD PTR MinPixY

FST DWORD PTR MinPixYR

FST DWORD PTR TempMinY

FWAIT

MOV CX,WORD PTR Lend

SUB CX,WORD PTR Lstart ; range (no of steps)

MOV DI,WORD PTR Lstart

SHL DI,1 ; Asp pointer

MOV SI, WORD PTR Lstart

SHL SI,1

SHL SI,1 ; Bsp,Csp,Dsp pointer

find_ minimum:

FINIT

;**************work out Test (for real roots of dY/dX=0 ) *************** **************

FLD DWORD PTR ES:[CSP][SI]

FMUL

FILD WORD PTR four

FMUL

FLD DWORD PTR ES:[DSP][SI]

FLD DWORD PTR ES:[BSP][SI]

FMUL

FILD WORD PTR three

FMUL

FILD WORD PTR four

FMUL

FSUB

FST DWORD PTR tester

FTST

FSTSW FlagPass

FWAIT

MOV AX,FIagPass

SAHF

JNC find_roots

JMP next_interval ; no real roots in this interval

;************** * ********** *** * work out roots (dY/dX = 0) *************** ************** find_roots: FINIT

FLD DWORD PTR tester

FSORT

FLD DWORD PTR ES:[DSP][SI]

FADD DWORD PTR ES:[DSP][SI]

FIMUL WORD PTR three

FLD DWORD PTR ES:[CSP][SI]

FADD DWORD PTR ES:[CSP][SI]

FCHS

FST ST(3)

FSUB ST,ST(2)

FDIV ST,ST(1)

;*************test 0 <=root1 < 1 *************** **************

FTST

FSTSW Test1_0 ; CF clear means root1 >= 0

FLD1

FCOMP

FSTSW Testl_1 ; CF set means root1 < 1

FSTP DWORD PTR Root1

FLD ST(2)

FADD ST,ST(2)

FDIV ST,ST(1)

;*************test 0 <= root2 < 1 *************** **************

FTST

FSTSW Test2_0 ; CF clear means root2 >= 0 FLD1

FCOHP FSTSW Test2_1 ; CF set means root2 <1 FST DWORD PTR Root2

FWAIT

MOV AX,Test1_0

SAHF JNC other_test

JMP check_root2

other_ test:

MOV AX,Test1_1

SAHF JNC deriv2_1

JMP Check_root2

;***** check 2nd derivative for root1 ************* ************** deriv2_1:

FINIT

FILD WORD PTR Three

FIADD WORD PTR Three

FMUL DWORD PTR ES:(DSP](SI]

FMUL DWORD PTR Root1

FLD DWORD PTR ES:[CSP][SI]

FADD DWORD PTR ES:[CSP][SI]

FAOD

FTST

FSTSW FlagPass

FWAIT

MOV AX,FlagPass

SAHF

JC cheek_ root2 ; skip if -ve JZ check_root2 ; or zero

;**********work out value of minimum **************

FINIT

FLD DWORD PTR Root1

FMUL DWORD PTR ES:[BSP][SI]

FLD OWORD PTR Root1

FMUL OWORD PTR Root1

FST ST (2)

FMUL DWORD PTR ES:[CSP][SI]

FADD

FLD DWORD PTR ES;[DSP][SI]

FMUL DWORD PTR Root1

FMUL ST,ST(2)

FADD

FIADD WORD PTR ES:[ASP][DI]

FST DWORD PTR TempMinY

FWAIT JMP check_new_min

check_ root2:

MOV AX,Test2_0

SAHF

JNC other_root1

JMP next_interval

other_ root1:

MOV AX,Test2_1

SAHF

JNC deriv2_2

JMP next_interval

;******check 2nd derivative for root2*************** ************** deriv2_2:

FINIT

FILD WORD PTR Three

FIADD WORD PTR Three

FMUL DWORD PTR ES;[DSP][SI]

FMUL DWORD PTR Root2

FLD DWORD PTR ES:[CSP][SI]

FADD DWORD PTR ES:[CSP][SI]

FADD

FTST

FSTSW FlagPass

FWAIT

MOV AX,FlagPass

SAHF

JC next_interval ; skip if -ve

JZ next_interval ; or zero

;**********work out value of minimum*************** **************

FINIT

FLD DWORD PTR Root2

FMUL DWORD PTR ES:[BSP][SI]

FLD DWORD PTR Root2

FMUL DWORD PTR Root2

FST ST(2)

FMUL DWORD PTR ES:[CSP][SI]

FADD

FLD DWORD PTR ES:[DSP][SI]

FMUL DWORD PTR Root2

FMUL ST,ST(2)

FADD

FIADD WORD PTR ES:[ASP][DI]

FST DWORD PTR TempMinY

;***** check if new min is lower *******

check_ new_min:

FINIT

FLD DWORD PTR TeapMinY

FCOH OWORD PTR MinPixYR

FSTSW FlagPass

FWAIT

MOV AX,FlagPass

SAHF

JNC next_ interval ; skip if new min not lower

FLD DWORD PTR TempMinY

FST DWORD PTR MinPixYR

FWAIT

;************** * ******************** ************************** ************** next_ interval:

ADD DI,2

ADD SI,4

DEC CX

JZ found_minimum

JMP find_minimum

;************** * ****************** * ******************** ************************* found_ minimum:

MOV AX,0

MOV AL;ES: [light_value]

MOV FlagPass,AX

FINIT

FILD WORD PTR FlagPass

FLD DWORD PTR MinPixYR

FSUB

FIOIV WORD PTR two

FADD DWORD PTR MinPixYR

FST DWORD PTR ES:[spline_thrh]

FWAIT

;*************find pixels before or on spline threshold ************** * *******

MOV CX,0

MOV Dl,0

find_Sstart:

MOV WORD PTR Sstart,CX

INC CX

ADD DI,2

FINIT

FILD WORD PTR ES:[ASP][DI]

FCOM DWORD PTR ES:[spline_thrh]

FSTSW Flagpass

FWAIT

MOV AX,FlagPass

SAHF

JNC find_ Sstart

MOV CX,DX

MOV DI,CX SHL Dl,1

find_Send:

SUB DI,2

DEC CX

MOV WORD PTR Send,CX

FINIT FLD DWORD PTR ES:[spline_thrh]

FICOH WORD PTR ES:[ASP][DI]

FSTSW FlagPass

FWAIT MOV AX,FlagPass

SAHF JC Find_Send

;************* interpolate width at st *************** **************

MOV WORD PTR Index,0

MOV DI,WORO PTR Send

SHL DI,1

MOV SI,0

interp_end:

SHR DI,1

FINIT FILD WORD PTR ES:[ASP][DI]

FWAIT SHL DI,1

FLD DWORD PTR X1[SI]

FMUL DWORD PTR ES:[BSP][DI]

FADD FLD DWORD PTR X2[SI]

FMUL DWORD PTR ES:[CSP][DI]

FADD FLD DWORD PTR X3[SI]

FMUL DWORD PTR ES:[DSP][DI]

FADD FCOM DWORD PTR ES:[spline_thrh]

FSTSW FlagPass

FWAIT ADD SI,4

INC WORD PTR Index

CHP WORD PTR Index,33

JNC end_done

MOV AX,FlagPass

SAHF JNC end_done

JMP interp_end

end_done:

MOV AX,WORD PTR Send

SHL AX,1

ADD AX, WORD PTR Index

DEC AX

MOV WORD PTR SW,AX MOV WORD PTR Index,0

MOV DI,WORD PTR Sstart:

SHL DI,1

MOV SI,0

interp_ start:

SHR DI,1

FINIT FILD WORD PTR ES:[ASP][DI]

FWAIT SHL DI,1

FLD DWORD PTR X1[SI]

FMUL DWORD PTR ES:[BSP][DI]

FADD FLD DWORD PTR X2[SI]

FMUL DWORD PTR ES:[CSP][DI]

FADD FLD DWORD PTR X3[SI]

FMUL DWORD PTR ES:[DSP][DI]

FADD FCOM DWORD PTR ES:[spline_thrh]

FSTSW FlagPass

FWAIT ADD SI,4

INC WORD PTR Index

CHP WORD PTR Index,33

JNC start_done

MOV AX,FlagPass

SAHF JC start_done

JMP interp_start

start_ done:

MOV AX, WORD PTR Sstart

SHL AX,1

ADD AX, WORD PTR Index

DEC AX SUB WORD PTR SW,AX

FINIT FILD WORD PTR SW FST DWORD PTR ES:[spline_ width]

FDIV DWORD PTR CorrFactor

FST DWORD PTR ES:[Corr_spline_width]

FIST WORD PTR SW FINIT FWAIT

;************** * ******************** *************************** **************

POP DX POP BX POP DS RET

;-------------- - --------------------- ---------------------------- -------------- ; Routine : MICRON_STORE 14/3/89

; Function : correct width to micron, bin and put fibre data in database ; Inputs :

; Returns :

;

micron_store:

PUSH DS

PUSH BX

MOV AX, WORD PTR ES:[Lcorr_width] ; get light width

ADD AX,4 ; add to round

SHR AX,1 ; divide to get 1/32ths

SHR AX,1

MOV WORD PTR ES:[fibre_width],AX ; store mean width

MOV AX, WORD PTR ES:(Fcorr_width)

ADD AX,4

SHR AX,1

MOV WORD PTR ES:[focuswidth],AX

;**********work out indices for lookup table *************** **************

MOV DS,WORD PTR ES:[DiaSeg] ; base of table

MOV AL,ES:[f ibre_focus) ; get focus and DIV by 4

MOV AH,0

SHR AX,1 ; AX is focus index SHR AX,1

MOV BL,0

MOV BH.AL ; BX = Findex *256 SHL BX,1 ; BX = Findex * 512

MOV Sl,BX

MOV AX,SI

NOV WORD PTR ES:[FocLook],AX

MOV AX, WORD PTR SW

SHR AX,1 ; get width and DIV by 8 SHR AX,1 ;

SHR AX,1 ; AX = Windex

SHL AX,1 ; point to real value SHL AX,1

MOV BX,AX ; BX = Windex * 4

MOV WORD PTR ES:[WideLook],BX

;************** * ******* work out mods *************** ***************************

MOV AX,0

MOV AL,BYTE PTR ES:[fibre_focus]

SHR AX,1

SHR AX,1 : focus DIV 4

SHL AX,1

SHL AX,1 ; times 4

NEG AX

MOV F_F1,AX

MOV AX,0

MOV AL,BYTE PTR ES:[fibre_focus]

ADD F_F1,AX ; focus MOD 4

MOV AX,WORD PTR F_F1

MOV WORO PTR ES:[Fmod],AX MOV AX, WORD PTR SW

SHR AX,1

SHR AX,1 ; width DIV 8

SHL AX,1

SHL AX,1 ; times 8

HEG AX

MOV W_W1,AX

MOV AX,WORD PTR SW

ADD W_W1,AX ; Width MOD 8

MOV AX,WORD PTR W_W1

MOV WORD PTR ES:[Waod],AX

;*************interpolate point with 8087 *************** **************

FINIT

FILD WORD PTR F_F1 ; t = (f-f1)/(f2-f1)

FIDIV WORD PTR four

FLD1

FSUB ST,ST(1) ; 1-t

FILD WORD PTR W_W1

FIDIV WORD PTR eight ; u = (w-w1)/(w2-w1)

FLD1

FSUB ST,ST(1) ; 1-u

FLD DWORD PTR DS:[BX + SI] ; first point

FTST ; test for zero or below

FSTSW FlagPass ; and set flags

FST DWORD PTR ES: [Point1]

FMUL ST,ST(1) ; term1 = D1 * (1-t)*(1-u) FMUL ST,ST(3)

FWAIT

MOV AX,FlagPass

SAHF

JA secondpoint ; continue if point > 0 JMP not_bucketed

secondpoint :

ADD SI,512

FLD DWORD PTR DS:[BX + SI] ; second point

FTST ; test for zero or below FSTSW FlagPass ; and set flags

FST DWORD PTR ES:[point2]

FMUL ST,ST(2) ; term2 = DZ * t *(1-u) FMUL ST,ST(5)

FADD ; term1 + term2

FWAIT

MOV AX,FlagPass

SAHF JA thirdpoint ; continue if point > 0 JMP not_bucketed

thirdpoint:

ADD BX,4

FLD DWORD PTR DS:[BX + SI] ; third point

FTST ; test for zero or below FSTSW FlagPass ; and set flags

FST OWORD PTR ES:[point3]

FMUL ST.ST(3) ; term3 = D3 * u * t FMUL ST,ST(5)

FADD ; term3+(term2+term1)

FWAIT

MOV AX,FlagPass

SAHF JA fourthpoint

JMP not_bucketed

fourthpoint:

SUB SI,512

FLD DWORD PTR DS:[BX + SI) ; fourth point

FTST ; test for zero or below

FSTSW FlagPass ; and se t f l ags

FST DWORD PTR ES:[point4]

FMUL ST,ST(3) ; term4 = D 4 * (1 - t ) * u

FMUL ST,ST(4)

FADD ; term4 + (term3+ term2+ term1) FIST WORD PTR ES: [micron]

FST realmicron

FINIT FWAIT

MOV AX,FlagPass

SAHF JA allpointsOK

JMP not_bucketed

AllPointsOK:

MOV AX,WORD PTR ES: [micron] ; check if less than 5 uM CHP AX,5

JC not_ bucketed

CMP AX,201 ; check if over 200 uM JNC not_bucketed

SHL AX,1

MOV DI,AX

INC WORD PTR ES:[micron_bin][DI] ; increment appropriate bucket ;************* put focus in bin ***************** **************

MOV AH,0

MOV AL,ES:[fibre_focus]

SHL AX,1 ;point at word

MOV DI,AX

INC Word PTR ES:[focus_bin][DI] ; increment bucket

JMP bucketed

not_bucketed:

POP BX POP DS STC RET

bucketed:

MOV DI,WORD PTR ES: [counter_offset] ; get fibre total for current NOV BX,WORD PTR ES:[DI] ; slide position

INC WORD PTR ES:[DI] ; increment total for position

MOV AL,ES:[d_base_exists] ; check for creation of

OR AL,AL ; data base

JZ dontdbase ; jump if no dbase

MOV AL,ES:[d_base_ full] ; check if full

OR AL,AL JNZ dontdbase ; jump if full

INC WORD PTR ES . [d_base_count] ; increment counter

CHP WORD PTR ES: [d_base_count] ,d_base_size

JC not_ full

MOV AL,1 ; set flag if now full

MOV ES:[d_base_fun],AL ; and jump

dontdbase:

JMP bucketed_cont

not_ f ul l ;

;************** * ***** Db ase A * * * * * * ** ** * * * * ** * * * * * * * * * * * * * * * * * * *

MOV DS,WORD PTR ES:[fibre_set_A_seg] ; load dbase A pointer

MOV AL,ES:[line_1_address]

MOV DI,WORD PTR ES:[start_line_offset]

MOV BYTE PTR DS:[DI][BX],AL ; start line to dbase

MOV AL,ES:[line_1+light_start]

MOV DI,WORD PTR ES:[start_col umn_offset]

MOV BYTE PTR DS:[DI][BX],AL ; start pixel to dbase

MOV AX,ES:[fibre_width]

MOV DI,WORD PTR ES:[Lwidth_offset]

SHL BX,1 ; offset *2 for word

MOV WORD PTR DS:[DI][BX],AX ; corrected Lwidth to dbase

MOV AX,ES:[focuswidth]

MOV DI,WORD PTR ES:[Fwidth_offset]

MOV WORD PTR DS:[DI][BX],AX ; corrected Fwidth to dbase

SHR BX,1 ; offset div 2 for byte

MOV AL,ES: [light_ threshold]

MOV DI,WORD PTR ES:[light_threshold_offset]

MOV BYTE PTR DS:[DI][BX],AL ; LT to dbase

MOV AL,ES:[focus_threshold]

MOV DI,WORD PTR ES:[focus_threshold_offset]

MOV BYTE PTR DS:[DI][BX],AL ; FT to dbase

;************** * ******* pbase B *************** **************************

MOV DS,WORD PTR ES: [fibre_set_ B_ seg] ; load dbase B pointer

MOV AL,ES:[fibre_focus]

MOV DI,WORD PTR ES: [focus_offset]

MOV BYTE PTR DS:[DI][BX],AL ; focus to dbase

SHL BX,1 ; offset *2 for word

MOV AX,WORD PTR ES :[fibre_slope]

MOV DI,WORD PTR ES:[Slope_offset]

MOV WORD PTR DS:[DI][BX],AX ; slope to dbase

MOV AX, WORD PTR SW

MOV DI,WORD PTR ES:[spwidth_offset]

MOV WORD PTR DS:[DI][BX],AX ; integer spline width to dbase

MOV AX,WORD PTR ES:[micron]

MOV DI,WORD PTR ES:[micron_offset]

MOV WORD PTR DS:[DI][BX],AX

bucketed_cont :

POP BX POP OS CLC RET

;-------------- - --------------------- ---------------------------- -------------- ; Routine : STORE CROSSING 16/5/89

; Function : puts data on this crossing into frame store

; store_crossing:

PUSH BX PUSH DS

MOV DI,Framepoint

CHP Framepoint.2550

JNC

MOV endofstorecrossing ; if framestore full

DS,WORD PTR ES:[image segment]

MOV AL,ES:[line_1_ address]

MOV BYTE PTR ES:[D]+frame+lineno],AL

MOV BH,AL

MOV AL,ES: [line_1+light_start]

MOV

MOV BYTE PTR ES:[Dl+frame+column],AL

BL,AL

MOV AX,SW

MOV

MOV WORD PTR ES: [Dl+frame+CorrectWidth],AX

AL,BYTE PTR DS:[BX]

MOV BYTE PTR ES: [DI +frame+darklevel],AL

FINIT FLD realaicron

FST DWORD PTR ES: [DI +frame+micronlink]

FINIT FWAIT ADD Framepoint,10

endofstorecrossing

POP OS RET POP BX

;-------------- - --------------------- ---------------------------- ---------------- --------------

; Routine : LINK 16/5/8S

; Frunction : link groups of crossings in frame store

; Inputs : Data from frame store, Cof V limit, pixel values from image

; Returns : with group numbers in frame store... zero indicates not grouped link:

PUSH BX PUSH DS PUSH DX MOV DS,WORD PTR ES:[image_segment ]

MOV )

MOV linknumber ,1 ; SI indexes start of group start_group:

NOV BX,Sl ; find unlinked start crossing

MOV 1 inkflag,0 ; BX references last linked crossing MOV AX, SI ; flag if any links in group MOV DI,AX

ADD DI,10 ; DI indexes current crossing CMP BYTE PTR ES:[SI+frame+ roupno],0

JZ start_erossing

JMP next_group

start_crossing :

CMP BYTE PTR ES:[Dl+frame+groupno],0 ; check each subsequent

JZ crit1 ; crossing for match

JMP next_crossing

;

critl:

CMP AL,BYTE PTR ES : [DI +f rame+darklevel]

JBE darkpixel found

INC BL LOOP crit3nextpixel

POP CX JMP failedcrit3

darkpixelfound

POP CX LOOP crit3nextline

CMP BL,BYTE PTR ES: [Dl+frame+column] ;check if at start2 JZ passerit3

failedcrit3:

POP BX POP SI JMP check_flag

passcrit3:

POP BX POP SI MOV criteriaflag,1

check_flag:

CMP criteriaflag,0 ; if passed criteria, put link 32 next crossing ; number in framestore

MOV BX,DI

MOV AL , linknumber

MOV BYTE PTR ES: [DI+frame+groupno],AL

MOV BYTE PTR ES:[Sl+frame-groupno),AL

MOV linkflag,1 ; set flag for current group next_crossing:

ADD DI,10 ; set index for next crossing

CHP DI,FramePoint

JE next_group

JMP start_crossing

next_group: ; if group was linked, increaent

CHP linkflag,0 ; link number

JZ next_group_cont

MOV AH,0

MOV AL,LinkNumber

MOV FinalLinkNumber,AX

INC linknumber

next_group_cont:

ADD SI,20 set index for next group start

CMP SI,Framepoint

JE end_of_ link

SUB SI,10

JMP start_group

end_ of_link:

POP DX

POP DS

POP BX

RET

;-------------- - --------------------- ---------------------------- -------------- -------------- ; Routine : BIN_GROUPS 25/5/89

; Function : puts means of groups in frame store into micron bins

; Inputs : data from frame store, groupsire (from processing conditions); from LINK framepoint (no of crossings), linknumber (no of groups) ; Returns : group micron bins incremented

;

bin_groups:

MOV CX,finallinknumber

BinNextGroup :

MOV SI,0 ; initialise framestore pointer

MOV GroupCount,0 ; and group count

FINIT

FLDZ

FST GroupTotal ; and group total

FWAIT

CheckNextCrossing:

CMP CL,BYTE PTR ES : [Sl+frame+groupno] ; see if this one is in

JNE GetNextCrossing ; current group

INC GroupCount

FINIT ; if so increase count and

FLD DWORD PTR ES : [SI+frame+micronlink]

FADD GroupTotal ; add to total aicron

FST GroupTotal

FWAIT

GetNextCrossing :

ADD SI,10 ; point at next one

CHP SI,FramePoint ; if any left

JC CheckNextCrossing

MOV AX,GroupCount

CHP AX,WORD PTR ES:[GroupSize] ; see if group is big enough

JC GetNextGroup ; if not dont process it

FINIT

FLD GroupTotal ; work out group mean

FIDIV GroupCount

FIST GroupMean

FWAIT

MOV DI,GroupMean ; put mean into bucket

SHL Dl,1

INC WORD PTR ES:[DI+groupbin]

PUSH BX

MOV BX,0

putinlinkbin:

CMP CL,BYTE PTR ES:[BX+frame+groupno]

JNE linkbinnextone

FLD DWORD PTR ES:[BX+frame+micronlink]

FISTP linkmicron

FWAIT

MOV DI,linkaicron

SHL DI,1

INC WORD PTR ES:[DI+linkbin]

linkbinnextone:

ADD BX,10

CMP BX, Framepoint

JE linkbindone

JMP putinlinkbin

linkbindone:

FINIT

POP BX

GetNextGroup: DEC CX

JZ endbingroups

JMP BinNextGroup

endbingroups:

FINIT

RET

;-------------- - --------------------- ---------------------------- -------------- --------------

AnalyseFrame ENDP

;

;************** * ********************* **************************************** ***************** ;

view1 PROC NEAR

PUSH BP ; save regs for pascal re-entry

MOV BP,SP

PUSH DS ;save registers

PUSH Es

MOV ES,WORD PTR [BP + 4] ; fetch base address for image source ..

MOV AX,WORD PTR ES: [image_segaent] ; .. from 'parameter interface block'

MOV DS,AX ; .. and load in seg register

MOV DL,ES: [view_threshold], ; fetch view threshold

MOV AX . Ob800h ; setup destination video ram base

MOV ES.AX ; .. in seg register

First output even rows of video image

MOV DI,2896d ;top corner of displayed image (even lines)

MOV SI,00 ;start of capture ram (even lines)

CALL show ;DOIT

Next output odd rows of video image

MOV DI,11088d ;top corner of displayed image (odd lines)

MOV SI.256d ;start of capture ram (odd lines)

CALL show ;DOIT

POP ES ;restore registers

POP DS

MOV SP.BP ;get back regs for pascal

POP BP

RET 2 ;BACK TO PASCAL

;

;************** * ********************* **************************************** **************** ;

; Routine SHOW

; Function : Transfers captured video data into M24 display RAM .

; The display RAM has separate areas for odd and even lines

; so this routine handles odd OR even depending on input

; start addresses in di and si registers

; Calls : None

; Inputs : si - start of capture ram

; ds - base address of capture ram

; di - start of display ram

; es - base address of display ram

; Destroys : ax,bx,cx,dl,di,si ; Returns :None

;

show:

MOV CH,0 ; zeroize msbyte of counter

MOV CL,64d ;number of odd OR even lines

field:

MOV BL,CL ;save number of lines

MOV CL,64d ;number of bytes to be packed into line line:

MOV BH,CL ;save bytes per line

MOV CL.4 ;number of pixels per byte

bytefill :

MOV AL,DS:[Sl] ;fetch capture ram pixel byte

INC SI ;point to next " " "

SHL AX,1 ; } this code flips bits 6&7

SHL AL,1 ; } of image memory and

RCR AH,1 ; } packs 4 pixels into

ROL AX,1 ; } byte for screen mem.

RCL AH,1 ; } write

LOOP bytefill ;loop until 4 pixels in AH

MOV ES:[DI],AH ;put 4 pixels into display ram

INC DI ;point to next display location

MOV CL,BH ;unsave bytes/line counter

LOOP line ;loop until line complete

MOV AX,256d ;number of bytes to next odd/even capture line

ADD SI,AX ;move capture ram pointer to next odd/even line

MOV AX,16d ;number of bytes to start of next display loc.

ADD DI,AX ;move display ram pointer one line down

MOV CL,BL ;unsave lines/field (odd or even) counter

LOOP field ;loop until frame complete

RET ;all done

Viewl ENDP

;

;************** * ******************** ************************************** ******************* ;

statscalcl PROC HEAR

PUSH BP ;save regs for pas return

MOV BP,SP

PUSH DS PUSH ES

MOV ES,WORD PTR [BP + 4] ; fetch base address for image source ,

MOV AX,ES:[image_segment] ; .. from 'parameter interface block' MOV DS,AX ; .. and load in seg register

MOV AX,0

MOV WORD PTR ES: [pixel_val], AX ; zero pixel store area MOV WORD PTR ES:[pixel_ val + 2],AX ; ditto (4 bytes)

MOV CX,8000h ; set CX to count total pixels

MOV SI,0 ; zero pointer

FLDZ ; push 0 onto 8087 stack

FLDZ ; push second zero onto 8087 stack

MOV DX,00ffM ; init min in DL and max in DH

MOV BP,SP ;

E PUSH ES ; save registers

MOV ES,WORD PTR [BP + A] ; setup es to address p.i.b

MOV i ds to address image location BH,ES:[sl de_position] ;selectd linee

MOV BL,ES;[line_1_address] ;selected pixel

MOV ES;[line_1_address],BH ;fix up misuse of locations

MOV WORD PTR Index, 0

MOV DI,0

fill_index_tablel: ; build look up table for

FINIT ; working out spline widths

FILD WORD PTR Index

FIDIV WORD PTR thirtytwo

FST DWORD PTR X1[DI]

FMUL DWORD PTR X1[DI]

FST DWORD PTR X2[DI]

FMUL DWORD PTR X1[DI]

FST DWORD PTR X3[DI]

FWAIT

INC WORD PTR Index

ADD Dl,4

LOOP fill_index_tablel

CALL get_ start ;find drop of 10

DEC BL

CMP BL , too_near_eol ;too close to end of line

JNC end1

debug_ine 0

INC BL ;point to pixel after pair found

MOV ES:[slide_position),BL ;store location

CALL get_average_light ;stores true_light, light_threshold

;focus_threshold, light_value returns with BL

;where it was

JC end1

MOV ES: [dark_pixels],CX ;to allow working out where average was done debug_inc 1

pixels_

CALL 1 ;sets BL to pixel after light_threshold debug_ine 2

INC BH ;go to line 2

CALL pixels_2 ;sets BL to pixel after light threshold on line 2 debug_ine 3

INC BH

CALL pixels_3 ;sets BL to pixel below light thresh, on way out debug_inc 4

INC BH

CALL pixels_4 ;stores line_1+fibre_end, line_1 +pixel_width ,

JNC newbit

endl:

JMP endmicron

newbit :

debug_inc 5

DEC BH

CALL Lhires_ widths ;stores line_1,2,3,4+hires_start

JC end1

debug _inc 6

CALL Fhires_widths

JC endmicron

debug_ine 7

CALL slope_correct

JC endmicron

debug _ine 8

CALL focus

JC endmicron

debug_ine 9

CALL spline

debug_ine OAH

CALL micron_store

endmicron:

POP ES ; restore pascal registers

POP DS

MOV SP,BP

POP BP

RET 2 ; back to pascal

;

onel ine ENDP

;-------------- - --------------------- ---------------------------- -------------- -------------- code ends

END

Menu(1,20, 8, '2. Pixel Stats - Capture on <Spac e Bar>');

Menu(1, 20, 10,'3. Pixel Stats - Continuous Capture/Display');

Menu(1,20,12,'4. Pixel Stats - Current Memory Image') ;

Menu(1,20,14,'5. Dark Pixel Stats') ;

Menu(1,20,16,'6. Modify Light Source") ;

Menu(1,20,18,'7. Pixel Stats Run') ;

UserRequest('7') ;

END ; { of DiagMenu }

{-------------- - --------------------- ----------------------------- -------------- -------------}

PROCEDURE StatsDiag ;

BEGIN REPEAT

StatsMenu ;

CASE Option OF

1 : PixelStat(1) ;

2 : PixelStat(2) ;

3 : PixelStat(3) ;

4 : PixelStat(0) ;

5 : Dark_Stat ;

6 : Light_Test ;

7 : Stats_Run ;

END

UNTIL (Option=StepBack) ;

Option:=NoQueue

END ; { of StatsDiag }

{-------------- - --------------------- ---------------------------- -------------- -------------}

PROCEDURE Select_FDF;

VAR

Done : BOOLEAN ;

User : CHAR ;

BEGIN

Done := false;

FileType := 'None';

REPEAT

ClrScr;

GotoXY(5,2);

User_ Message(" , 'Please specify filename',{

}'in form "A: filename,FDF" :',4);

Readln(FD_fileName);

If (Exist(FD_Filename)) THEN

BEGIN

writeln;

REPEAT

writeln('Existing File.....Do you want to add to it ? [Y/N]'];

User := ReadKey;

UNTIL (UpCase(User)='Y' ) OR (UpCase(User)='N');

IF Upcase(User)='Y' THEN

BEGIN

FileType := 'Append' ; Done : = true ;

END ELSE BEGIN REPEAT

Writeln('Do You want to overwrite it ?[Y/N]');

User : = ReadKey;

UNTIL (UpCase(User) = 'Y') OR (UpCase(User) = 'N');

IF (UpCase(User)= 'Y') THEN

BEGIN

FileType := 'Overwrite' ;

Done := true ;

END ELSE BEGIN

REPEAT

Writeln('Do you want to select another file ?[Y/N]'):

User : = ReadKey;

UNTIL (UpCase(User)='Y') OR (UpCase(User) = 'N');

IF (UpCase(User)='N') THEN Done := true;

END;

END ELSE { not exist }

BEGIN REPEAT

Writeln('New File...OK ?[Y/N)');

User := ReadKey;

UNTIL (UpCase(User)='Y') OR (UpCase(User)='N');

IF (Upcase(User)='Y') THEN

BEGIN

FileType := 'New';

Done := true;

END ELSE BEGIN

REPEAT

Writeln('Do you want to select another file ?[Y/N]');

User : = ReadKey;

UNTIL (UpCase(User)='Y') OR (UpCase(User)= 'N');

IF (UpCase(User)='N') THEN Done := true;

END;

UNTIL Done;

END; { of Select_FDF }

;-------------- - --------------------- ---------------------------- -------------- -------------}

PROCEDURE Analysis_Menu ;

BEGIN

ClrScr ;

Menu(1,30,2, 'Image Analysis Menu');

Menu(1,30,3,'-------------- - -----------'); ;

Menu(1,30,6,'1. Single Image Analysis');

Menu(1,30,8,'2. Select FDF File');

Menu(1,30,10,'3. Single Image Analysis and Display') ;

Menu(1,30,12, '4. Image Analysis and Display Run') ;

Menu(1,30,14,'5. Update Image') ;

Menu(1,30,16, '6. Analyse Image and Print All Fibres')!

Menu(1,30,18, '7. Single Analysis and Link Dsiplay') ;

UserRequest('7') ;

END ; { of Analysis_Menu }

PROCEDURE Analysis_Diag ;

BEGIN REPEAT

Analysis_Menu ;

CASE Option OF

1 : Single_ Analysis ;

2 : Select_FDF ;

3 : Single_Analysis_View ;

4 : Analysis_Run ;

5 : Get_Frame ;

6 : Print_all_fibres ;

7 : Link_View ;

END

UNTIL (Option=StepBack) ;

Oρtion:=NoQueue

END ; { of Analysis_Diag }

PROCEDURE Check_Dark;

BEGIN

ClrScr;

Writeln('INSERT DARK PLATE');

Pause;

Get_Average_Dark;

Writeln( 'Average Dark ' ,Average_Dark:5:3);

Pause;

END; {of Check_Dark}

PROCEDURE Adjust_Light;

BEGIN

ClrScr;

Set_Light;

Pause;

END; {of Adjust_ Light}

PROCEDURE Single_Fibre_Menu;

BEGIN Cl rScr ;

Menu(1, 30, 4, 'Single Fibre Menu');

Menu(1,30,5, '-------------- - --------');

Menu(1,30,10,"1. View Image');

Menu(1,30,12,'2. Check Dark - Requires aanual insert');

Menu(1,30.14.'3. Set Light');

Menu(1,30,16,'4. Measure And Analyse');

Menu(1,30,18,'5. Image File Capture');

UserRequest('S');

END; {of Single_Fibre_Menu}

;-------------- - --------------------- ---------------------------- -------------- --------------}

PROCEDURE DrawPulse;

VAR

Xplot,Yplot,A,B,LastX,Span,Index,X,Y,Start,Finish : WORD ;

Value1,Value2,Value : STRING[6];

Xreal,Yreal : REAL;

BEGIN

Finish := pib^,spline_end; Start := pib^,spline_start;

Span := Finish - Start;

InitGraph (GraphDriver,GraphMode,");

SetTextStyle(0,1,1); {vertical for y axis label}

SetTextJustify(1,1); {centred as top just doesnt work for vert text}

OutTextXY(4,199, 'Pixel Value (A/D units)');

SetTextStyle(0,0,1); {horizontal for everything else}

SetTextJustify(2,1); {right just, vert centred for y axis values}

X := 620;

FOR Index := 0 TO 12 DO {do vertical scale}

BEGIN

Str(Index^10,Value);

IF Value = " THEN Value : = '0';

Y :=360 - Index^28;

OutTextXY(38,Y,Value); { value}

Line(40,Y,X,Y); { line}

END;

LastX := 13;

SetTextJustify(1,2);

FOR Index := 0 TO Span DO {do horizontal scale}

BEGIN

X := 40 + Round((index ^ 580)/(Span));

Line(X,24,X,360); { draw vertical line}

Y := image^. imagememory[Fibre_A^.line[0] SHL 8 + start + Index]; {actual value}

Y := 360 - round((Y"28)/10); { convert to coordinate value}

Circle(X,Y,3);Circle(X,Y,2);Circle(X,Y,1);

IF Index = 0 THEN

BEGIN

Xplot := X;

Yplot := Y;

END;

IF Index <> 0 THEN BEGIN

Line(A,B,X,Y); {join pixels}

END;

IF X - LastX > 25 THEN { put in pixel no if it fits}

BEGIN

Str(Start+ Index, Value);

OutTextXY(X, 364, Value);

Line(X,360,X,364);

LastX := X;

END;

A := X; B : = Y;

END:

MoveTo(Xplot,Yplot);

FOR Index : = 1 TO Span DO

BEGIN {plot spline curve}

FOR X := 0 TO Round(580/Span) - 1 DO

BEGIN

Xplot := 40 + Round(((Index-1)"S80)/Span + X); {actual x pixel no}

Xreal := X/(580/Span);

Yreal := pib^.ASP[index-1] + pib^. BSP[index-1] "Xreal + pib". CSP[index-1]"sqr(Xreal)

4 pib^. DSP [index-1] "Xreal "sqr(Xreal);

Yplot := 360 - round((28"Yreal)/10);

LineTo(Xplot,Yplot);

END; {of this point}

END; {of plot spline curve}

Out TextXY(330.372. 'PIXEL NUMBER');

IF Simulation THEN OutTextXY(320,4. 'IHAGE FILE : ' +simfilespec);

SetLineStyle(1,0,1);

Line(40,360-round((28"pib^.spline_thrh)/10),620.360-round((28"pib".spline_thrh)/10)); SetTextJustify(0,1);

Str(pib^.Spline_ thrh:6:2,Value1);

Str (pib^. Spline_ Width: 6:2, Value2);

Ou TextXY(216,385,'Spline Th : ' +Value1);

OutTextXY(216, 394, 'Width at ST (1/32nds): ' +Value2);

readln;

CloseGraph;

END; {of OrawPulse}

PROCEDURE Do_1_Line;

VAR SplinePoints,First_Pixel,First_Line : BYTE ;

Nua, Flag, A, B,C,D,F,F, line, Y, index : WORD;

Pixel :ARRAY[1..4.0..255] OF WORD;

CV : REAL ;

LABEL Terminate;

BEGIN

ClrScr;

Init_Stat(diam); Init_Stat(LightWidth); Init_Stat(FocusWidth);

Init_Stat (SplineWidth); Init_Stat(FocusAce);

GotoXY(10,13);

write(B);

GotoXY(16,13);

write(C);

GotoXY(22,13);

write(D);

GotoXY(26,13);

write(E) ;

GotoXY(34,13);

write(F);

IF Flag = 3 THEN

BEGIN

GotoXY(1,21);

Writeln('pixel error on line 3');

Goto Terminate;

END;

A:= pib^.quad_line_data(4,1] ;

B:= pib^.quad_line_data[4,2];

C:= pib^.quad_line_data[4,3] ;

D:= pib^.quad_line_data[4,4] ;

E:- pib^.quad_line_data[4,5] ;

F:= pib^.quad_line_data[4,6];

GotoXY(4,15);

Write(A);

GotoXY(10,15);

write(B);

GotoXY(16,15);

write(C);

GotoXY(22,15);

write(D);

GotoXY(28,15);

write(E);

GotoXY(34,15);

write(F);

IF Flag = 4 THEN

BEGIN

GotoXY(1,21);

Writeln( 'Pixel error on line 4.');

Goto Terainate;

END;

FOR Num:= 1 TO 4 DO

BEGIN

A:= pib^.quad_line_data[Num,7] + 256'pib^.quad_l ine_data(Num.8]; B:= p ib^.quad_l ine_data[Num,9) + 256'pib^.quad_line_data[Num,10]; C:= pib^. quad line data(Num,11] + 256'pib^.quad_line_data[Num,12]; GotoXY(40,742"Num);

write(A);

GotoXY(47,742"Num);

write(B);

GotoXY(54,7+2"Num);

write(C);

END;

G0toXY(26,17);

write( 'Mean light width = ' ,pib^ .Lfibre_width) ;

GotoXY(60,4);

BEGIN

GotoXY(5'(index MOD 16)+1, (index DIV 16)+3);

Write(Pixel[line, index]);

END;

Writeln;

pause;

END;

END; {of do_1_Line}

{ --------------------------------------------------------------------------------------}

PROCEDURE File_lmage;

VAR lmgfile : string[14);

answer : string[10];

LABEL Askfile;

BEGIN

ClrScr;

Profile_View(1);

Clrscr;

Askfile:

answer := 'Yes';

write('Input Filespec ');

readln(lmgfile);

IF Exist(lmgfile) THEN

BEGIN

write(lmgfile,' already exists ....overwrite ? ');

readln(answer) ;

END;

IF (Copy(answer,1,1) <> 'Y') AND (Copy(answer,1 ,1) <> 'y') THEN

goto Askfile;

writeln ('writing to file');

delay(1000);

Assign(lmageFile,lmgfile);

Rewrite(lmageFile);

Reset(lmageFile);

WITH Image' DO Write (ImageFile,Image');

Close(lmageFile);

wrilein('closed');

FND; {of File_Image)

PROCEDURE Single_Fibre;

BEGIN

Reset_ Stepper_Controllers;

REPEAT

Single_Fibre_Menu;

CASE Option OF

1 : Profile_View(1);

2 : Check_dark;

3 : Adjust_Light;

4 : Do_ 1_Line;

5 : File_Image;

END

UNTIL (Option=Stepback);

Option := NoQueue

END; [of Single_ Fibre)

PROCEDURE lmageMenu ;

BEGIN

ClrScr;

Menu (1,30,2,' Image Diagnostic Menu');

Menu (1,30,3, '-------------------- -');

Menu (1,30.6,'1. View Image');

Menu(1,30,8,'2. Pixel Value Stats');

Menu (1 ,30,10,'3. Image Analysis');

Menu (1,30.12,'4. Auto Adjust Light');

Menu (1,30,14,'5. Manual Set Light'):

Menu(1,30,16,'6. Sensor Analysis') ;

Menu (1,30,18,'7. Single Fibre') ;

UserRequest('7')

END ; { of lmageMenu }

PROCEDURE lmageDiag ;

BEGIN REPEAT

lmageMenu ;

CASE Option OF

1 : ViewDiag ;

2 : StatsDiag ;

3 : Analysis_Diag ;

4 : Auto_Light_Adjust ;

5 : Light_Test ;

6 : Test_Sensor ;

7 : Single_Fibre ;

END

UNTIL (Option'StepBack) ;

Option: =NoQueue

END ; { of diags }

PROCEDURE Move_Menu ;

BEGIN

ClrScr;

Menu (1,30,2,'Hove Stage Menu');

Menu(1,30,3,'-------------------');

Menu (1,25,6,'1. Move To Dark Area ( Home )');

Menu(1,25,8,'2. move To Clear Window') ;

Menu (1,25.10,'3. Move To Start Of Slide') ;

UserRequest('3') ; END { of Diagmenu )

PROCEDURE Move_Diag ;

BEGIN

REPEAT

Hove _Menu ;

CASE Option OF

1 : Home_Stage ;

2 : Hove_To_Clear_Area ;

3 : Move_To_Slide ;

END

UNTIL (Option=Step Back) ;

Option: =NoQueue

END ; { of StageDiag }

PROCEDURE Sequence_Menu ;

BEGIN

ClrScr;

Menud,30, 2, 'Sequence Stage Menu');

Menu (1,30, 3.'-------------------- ');

Menud, 30, 6, '1. Home then Clear Window Move');

Menu (1, 30, 8, '2. Home then Slide Move') ;

Menu (1,30, 10, *3. Left - Right Slide Boundaries') ;

Menu (1,30, 12, '4. Front - Back Slide Boundaries') ;

UserRequest ('4') ;

END ; { of DiagMenu }

PROCEDURE Sequence_Diag ;

BEGIN REPEAT

Sequence_Menu ;

{ CASE Option OF

1 : Home_to_Window_Sequence ;

2 : Home_ to_SIide_Sequence ;

3 : Test ;

4 : Back_Front_ Stage_Sequence ;

END }

UNTIL (Option-StepBack) ;

Option:=NoQueue

END ; { of StageDiag }

PROCEDURE StageMenu ;

BEGIN

REPEAT

DiagMenu ;

CASE Option OF

1 : ImageDiag ;

2 : StageDiag ;

3 : Set_Debug_Flags ;

4 : Print := NOT Print ;

5 : Adjust_Assembly_Language_Data ; END

UNTIL (Uption-StepBack)

Option: =NoQueue

END ; { of diags }

END.

{FIDASM.PAS}

{VER 5.01 11/5/89 }

{$N+}

UNIT FIDASM;

INTERFACE

USES FIDIO,FIDVAR,crt ;

PROCEDURE Analyse_Frame (pib_segment : INTEGER) ;

PROCEDURE View(pib_segment : INTEGER);

PROCEDURE StatsCalc (pib_segment : INTEGER);

PROCEDURE Pixel_Mean (pib_segment : INTEGER);

PROCEDURE One_Line (pib_segment : INTEGER);

IMPLEMENTATION

{$L PASIF}

PROCEDURE AnalyseFrame(A : INTEGER); EXTERNAL;

PROCEDURE View1(A : INTEGER); EXTERNAL;

PROCEDURE StatsCalc1(A : INTEGER); EXTERNAL;

PROCEDURE PixelMean(Y : INTEGER); EXTERNAL;

PROCEDURE OneLine(Y : INTEGER) ; EXTERNAL;

PROCEDURE Analyse_Frame;

begin

Anal yseFrame(pib_segment);

end;

PROCEDURE View;

begin

Viewl (pib_segment);

end;

PROCEDURE StatsCalc;

begin

StatsCalcl (pib_segment);

end;

PROCEDURE Pixel_Mean;

begin

PixelMean(pib_segment);

end;

PROCEDURE One_Line;

begin

OneLine(pib_segment);

end;

END. ;*** PASIF,ASM ***

;

;VER 5.01 2/6/89

;

CODE segment public byte public

ASSUME cs:code

PUBL IC Ana yseFrame,View1,StatsCalc1,PixelMean,oneline

light_drop EQU 1C ; size ut pixel change for fibre start too_near_eol EQU OF6H ; end of line one limit .. to look for

; a stait. When reached, drops 4 lines back_point EQU 4 ; pixels from start back to light region back_range EQU 16 ; limit of distance to valid light pixels light_minιmum EQU 85 ; lower limit of valid light value light_maximum EQU 115 ; upper limit of valid light value max_slope EQU 854 ; max slope per line in hires units min_hru EQU 284 ; 5 uM in hires units (1 pix = 4.5 uM) max_hru EQU 11378 ; 200 uM in hires units

step_forward EQU 6 ; advance increment along line d_base_size EQU 8000

two DW 2

three DW 3 ; constants used by 8087 for

four DW 4 ; various calculations

fivepointfiveeight DD 5.58

eight DW 8

ten DW 10

thirtytno DW 32

hundred DW 100

twofivesixo DW 2560

Hi1 DD 4 DUP (0) ; 4 byte storage for hires starts and

Hi2 DD 4 DUP (0) ; ends in slope_correct

Hi3 DD 4 DUP (0)

Hi4

; DD 4 DUP (0)

F_F1 DW ?

W_W1 DW ?

Alpha DD 100 DUP (0) ; variables used in spline

Beta OD 100 DUP (0) ; procedure

Gamma DD 100 DUP (0)

Delta DD 100 DUP (0)

Root1 DD 0

Root2 DD 0

Tester DD 0

Lstart DW 0

Lend DW 0

Sstart DW 0

Send OW 0

SW DW 0

MinPixV DW 127

MinPixYR DD 0

TempMinY DO 0

Foe_Low EQU 1249 ; lower focus limit

Foe_High EQU 1251 ; upper focus limit

d_base_full EQU 12S3 ; flag to prevent overflow of dbase d_base_count EQU 1254 ; number stored in dbase

width_term EQU 1256 ; calibration terms from cnf file focus_term EQU 1260 ; used to calculate micron min_width EQU 1264 ;used in pixels 1-4 for finding width_range EQU 1266 ; light ends

focus_lo EQU 1268 ; to accumulate mean focus

focus_hi EQU 1270

micron EQU 1272 ; cal ibrated width

splinc_start EQU 1274

spline_end EQU 1275

focuswidth EQU 1276

DiaSeg EQU 1278 ; base address of dia lookup table micron_bin EQU 1280 ; 201 words for micron tallies

focus_bin EQU 1682 ; 256 words for focus tallies

spline_thrh EQU 2194

spline_width EQU 2198

corr_spline_width EQU 2202

FocLook EQU 2206

WideLook EQU 2208

Fmod EQU 2210

Wmod EQU 2212

Point1 EQU 2214

Point2 EQU 2218

Point3 EQU 2222

Point4 EQU 2226

ASP EQU 2230 ; spline coefficients stored

BSP EQU 2330 ; here for one line access

CSP EQU 2530

DSP EQU 2730

Frame EQU 2930

grmopno EQU 0

lineno EQU 1

column EQU 2

correctwidth EQU 3

darklevel EQU 5

micronlink EQU 6

groupsize EQU 5490

groupbin EQU 5491

linkbin EQU 5893

;

;***************** *** end of pib structure****************** ****************** * ;

debug_inc MACRO location

LOCAL here ; local jump label for macro

ADD WORD PTR ES;[debug + 4'locationj,1 ; increment debug counter

JNC here

INC WORD PTR ES: (debug + 4'location + 2) ; should be no carry up here ; here:

ENDM

;----------------------------------------------------------------------------------------- ; analyseframe PROC NEAR

PUSH BP ; save regs for pascal reentry

MOV BP,SP ;

PUSH DS ; save registers

PUSH ES ;

MOV ES,WORD PTR [BP + 4] ; setup es to address p.i.b

MOV DS,WORD PTR ES:[image_segment] ; setup ds to address image location XOR BX,BX ; zero pointer

MOV AX,BX ; zero accumulator

ADD BL,ES, [slide_position] ; fetch current slide position

JZ analyze_cont_1 ; if zero then first frame - branch

DEC BX ; point back to previous frame count

SHL BX,1 ; double count to provide word offset

MOV AX,WORD PTR ES:[BX + fibre_counter] get previous frame fibre count ADD BX,2 ; advance to current frame fibre counter analyze_cont_1:

ADD BX,fibre_counter

MOV WORD PTR ES:[BX],AX ; load previous fibre count

MOV WORD PTR ES: [counter_offset],BX ; save away pointer for current CALL build_fibre_table ; analyse image collected

POP ES restore pascal registers

POP DS

MOV SP,BP

POP BP RET 2 ; back to pascal

;

;-----------------------------------------------------------------------------------------; Routine : BUlLD_FIBRE_TABLE 30/11/88

; Function : finds, checks and stores all fibres in current stored image

; Calls : 12 image analysis routines

; Inputs : es:base segment of pib. ds: base segment of image

; Destroys : ax , bx , ex , dx , di , flags (at least)

; Returns : fibres added to micron bins and database and counts and

; : debugs incremented

;

build_ fibre_table:

MOV CX,33

MOV WORD PTR Index.0

MOV DI,O

fill_index_ table: ; build look up table for

FINlT ; working out spline widths

FILD WORD PTR Index

FIDIV WORD PTR thirtytwo

FST DWORD PTR X1[DI]

FMUL DWORD PTR X1[DI]

FST DWORD PTR X2[DI]

FMUL DWORD PTR X1[DI]

FST DWORD PTR X3[DI]

FWAIT INC WORD PTR Index

ADD DI,4

LOOP fill_ index_ table

MOV BX,OO ; setup for video pointer

MOV FramePoint,O

line_1_advance_frame:

MOV ES:[line_1_address],BH ; store start of 4 line image new_line_1_start :

MOV BH,ES:[line_1_address] ; set upper addr. byte to line 1

CALL get_start ; find valid start

DEC BL ; decrement pointer gives FF for

; for returned error (00)

CHP BL , too_near_eol ; error or eol too near ..

JC build_cont_1

JMP next_quad_line ; .. advance to next line set build_cont_1:

INC BL ; realign to valid start

MOV ES: [line_1+light_start],BL ; save possible fibre edge (start) debug_inc 0

CALL get_average_light ; get light level before start

JC line_1_next_start_cont ; next start if no stable light found debug_inc 1

CALL pixels_1 ; look for line 1 starts & ends & widths

JC line_1_next_start_cont ; if error look for next start debug_inc 2

INC BH ; advance to line_2

CALL pixels_2 ; look for line 2 starts, ends & widths

JC line_1_next_start_cont ; if error look for next start debug_inc 3

INC BH ; advance to line 3

CALL pixels_3 ; look for line 3 starts, ends & widths

JC line_1_next_start_cont ; if error look for next start debug_inc 4

INC BH ; advance to line 4

CALL pixels_4 ; look for line 4 starts, ends & widths

JNC build_cont_2

line_1_next_start_cont :

JMP line_1_next_start ; if error look for next line 1 start bu i l d_cont_2 :

debug_inc 5

DEC BH ; step back to line 1

DEC BH

CALL Lhires_widths ; work out light hires widths, aean & C of V

JC line_1_next_start_after_end ; if fail look for next start debug_inc 6

CALL Fhires_widths ; work out focus hires widths, mean & C of V

JC line_1_next_start_after_end

debug_inc 7

CALL slope_correct ; find slope & correct means, reject on slope and width

JC line_1_next_start_after_end ; if fail look for next start debug_inc 8

CALL focus ; find focus & reject

JC line_1_next_start_after_end ; look for next start

debug _ine 9

CALL spline

CALL micron_store ; calculate aicron and bin result

JC line_1_next_start_after_end ; build fibre data base debug_inc OAh CALL store_crossing

JMP line_1_next_start_after_end ; look for next start

line_ 1_next_start:

MOV BL,ES:[line_1+light_start] get back last start detected , line 1 JMP next_start_cont ; branch

line_1_next_start_after_end:

MOV BL,ES: [line_1+light_end] ; get back end of fibre on line 1. next_start_cont

ADD BL,step_forward ; move ahead of start

JC next_quad_line ; if past end of line then next line set JMP new_line_1_start ; else loop for next test

next_quad_line:

MOV BL,00 ; get back to line start

MOV BH,ES: [line_1_address] ; get back to correct line

ADD BH.4 ; advance line pointer to next 4 line set

CHP BH,80H ; test for end of video frame

JNC leavenow

JMP line_1_advance_frame ; if not end then loop

leavenow:

CHP Framepoint ,10

JLE the_ end

CALL link ; put crossings into groups

CALL bin_groups

the end:

RET ; all done

;

;----------------------------------------------------------------------------------------- ; **

------------- Raw image processing routines **

;--- ----------------------------------------------------------------------- ; Routine : GET_START 30/11/88

; Function : Locates start of a fibre on scan line by pixel level drop greater ; : than or equal to light_drop (const)

; Inputs : ds: address of image, bx: address of line/current pixel pair

; Destroys : ax , bl , flags

; 'Returns : bl* first pixel after pair with drop or bl = 0 if e.o.l reached ;

ge t _ sta rt :

AND BL,OFEH ; mask off bit 0 (even pixel boundaries) ge t_start _ cont :

MOV AX,DS:[BX] ; fetch two pixel values

INC BL ; advance video pointer ..

INC BL ; .. to next pixel pair

JZ end_get_start ; return if end of line

SUB AL.AH ; else get diff. between adjacent pixel

JC get_star _cont ; loop if not falling pixels

CHP AL,light_drop ; test magnitude of difference

JC get_start_cont ; loop if only small change

end_get_ start:

RET ; task done

;

;---------------------------------------------------------------------------------------

; Routine : GET_AVERΛGE_LIGHT 30/11/88

; Function : Gets light value before start and determines light & focus

; : thresholds

; Inputs : es: pib base, ds: image base, bx: pixel after drop pair

SUB BL,ES:[line_1+focus_start] ; calc focus width

MOV ES:(line_1+focus_width],BL ; and store

CLC ; clear error flag

RET------ --------;--a-n-d--r-e--t-u-r-n

;---------- --------------------- ----------------------------- ; Routine : PIXELS_2 5/1/89

; Function : find start and end pixels below threshold for LT and FT on line 2 ; Inputs : BH = line 2 address, line 1 focus start pixel

; Returns : pixel starts and ends for FT and LT on line 2, carry set if error;

pixels_ 2:

MOV BL,ES:[line_ 1+ focus_star ] ; set pointer to start from line 1

MOV AL,BL

SUB BL,6 ; step back 6 (arbitrary .. from original)

JNC pixel s_2_cont ; check for step over start of line

MOV 8L,1 ; set to pixel 1 if req'd

pixels_ 2_cont:

ADD AL,7 ; set range to +7 from line 1 start

JNC l ine_2_range ; check for eol

MOV AL,OFEH ; set to eol if over

line_2_ range:

SUB AL,BL ; put range into loop counter

MOV CL,AL

MOV CCH,O

MOV AH,ES: [focus_threshold] fetch threshold

line_2_prestart :

CHP DS:[BX],AH ; check pixel is before fibre

JNC find_ focus_2_start ; jump if pixel >= FT

INC BL ; advance 1 pixel

LOOP line_2_prestart ; try again

JMP pixel_2_error

find_focu_ 2 _start:

INC BL ; else advance pointer

JZ pixel_2_error ; check for eol wrap

CHP DS:[BX],AH ; compare pixel with threshold

JC found_focus_2_start ; jump if pixel < threshold

LOOP find_focus_2_start ; and try again

JMP pixel_2_error : error if not found in range

found_focus_ 2_start:

MOV ES:[line_2+focus_start],BL ; ok so store focus start

DEC BL ; back over threshold

MOV CX.0006 ; range for valid focus + 2

MOV AH.ES:[light_threshold]

find_light_2 _start:

CHP DS:[BX],AH ; compare pixel with threshold

JC found_light_2_start ; jump if pi xel < threshold

INC BL ; else advance pointer

JZ pixel_2_error ; check for eol wrap

LOOP f ind_l ight_2_start ; and try again

pixel_ 2_ error

STC ; set error flag

RET ; and return

found_light_2_start:

MOV ES:[line_ 2+light_start],BL ; ok so store light start

MOV CH,O ; set range for maximum width ADD BL,ES: [min_width] ; start for finding end

JC pixel_2_ error ; if over eol

MOV CL,ES:[width_ range] ; how far to look

CHP DS:[BX),AH ; check pixel is dark

JNC pixel_2_error ; if not then too narrow

find_light_2_end:

INC BL ; advance pointer

JZ pixel_2_error ; check for eol wrap

CHP DS:[BX],AH

JNC found_light_2_end ; jump if pixel >= threshold

LOOP find_light_2_end ; and try again

JMP pixel_2_error ; too wide

found_light_2_end:

DEC BL ; step back to last pixel below LT

MOV ES:[line_2+llght_end),BL ; ok so store light end

MOV AL,BL

SUB AL,ES:[line_2+light_start] ; calc width

MOV ES:[line_ 2+light_width], AL ; and store

MOV CX,0006 ; rough focus range for end

MOV AH,ES: [focus_ threshold] ; fetch focus threshold again find_focus_2_end:

CHP DS:[BX),AH ; compare pixel with FT

JNC found_focus_2_end ; jump if pixel >= threshold

INC BL ; else advance pointer

JZ pixel_2_error ; check for eol wrap

LOOP find_focus_2_end ; and try again

JMP pixel_2_error ; rear end out of focus

found_focus_2_end:

DEC BL ; step back to last pixel below FT

MOV ES: [line_2+focus_end] ,BL ; ok so store focus end

SUB BL.ES: [line_2+focus_start] ; calc focus width

MOV ES:[line_2+focus_width],BL ; and store

CLC ; clear error flag

RET ; and return

;------------------------------------------------------------------------------------ ; Routine : PIXELS_3 14/12/88

; Function : find start and end pixels below threshold for LT and FT on line 3 ; Inputs : starts from 1 and 2, thresholds, BH = line 3 address

; Returns : pixel starts and ends for line 3, carry set if error

;

pixels_ 3:

MOV CX,0005 ; set range to look for start

MOV AH,ES: [focus_threshold] ; fetch threshold

MOV BL,ES: [line_2+focus_start] ; get line 2 start

SUB BL,ES: [line_1+focus_start] ; calc offset

ADD BL,ES: [line_2+focus_start] ; get approx line 3 start

SUB BL,3 ; back up 3

JC pixel _3_error ; check for sol wrap

CHP AH,DS:[BX) ; see if already dark

JNC pixel_3_error

find_focus_3_start:

INC BL ; step forward

JZ pixel_3_error ; check for eol wrap

CHP DS:[BX],AH ; is pixel < threshold

JC found_focus_3_start

LOOP find_focus_3_start ; if not loop

JMP pixel_3_error ; error if out of range

found_ focus_3 _start:

MOV ES:[line _3+focus_start],BL ; store focus 3 start

DEC BL ; step back over threshold

MOV CX,0006 ; set range for valid focus

MOV AH,ES:[light_threshold]

find_light_3_start :

CHP DS:[BX],AH ; compare pixel with threshold

JC found light 3 start ; jump if pixel < threshold

INC 8L ; else advance pointer

JZ pixel_3_error ; check for eol wrap

LOOP find_light_3_start ; try again

JMP pixel_3_error ; out of focus

found_light_ 3_start:

MOV ES:[line_ 3+light_start], BL ; store light start

MOV CH,O ; set range for maximum width

ADD BL , ES : [m i n_wi dth] ; start for finding end

JC pixel_3_ error ; if over eol

MOV CL,Es:[width_range] ; how far to look

CHP DS:[BX],AH ; check pixel is dark

JNC pixel_3_error ; if not then too narrow

find_light_3_end:

INC BL ; step forward

JZ pixel_3_ error ; check for eol wrap

CHP DS:[BX],AH

JNC found_light_3_end ; jump if pixel >= threshold

LOOP find_light_3_end ; try again

JMP pixel_3_error ; too wide

found_ light_3_end:

DEC BL ; step back below threshold

MOV ES:[line_3+light_end],BL ; store end

MOV AL,BL

SUB AL,ES: [line_3+light_start] ; calc width

MOV ES:[line_3+light_width],AL ; and store

MOV CX,0006 ; focus range for end

MOV AH,ES:[focus_threshold] ; get threshold

find_focus_ 3_ end:

CHP DS:[BX],AH

JNC found_focus_ 3_end ; jump if pixel >= threshold

INC BL ; step forward

JZ pixel_3_error ; check for eol wrap

LOOP find_focus_3_end ; try again

pixel_3 _error

STC ; set error flag

RET ; and return

found_focus_3_end:

DEC BL ; step back below threshold

MOV ES:[line_3+focus_end],BL ; store end

SUB BL,ES: [line_3+focus_start] ; calc focus width

MOV ES: [line_3+focus_width),BL ; and store

CLC ; cl ear error fl ag

----- RET ; and return

; --------------------------------------------------------------------------------------------; Rout ine : PIXELS_4 H/12/86

; Function : find start and end pixels below threshold for LT and FT on line 4 ; Inputs :

; Returns :

;

pixels_4:

MOV CX,0005 ; set range to look for start

MOV AH,ES: [focus_threshold] ; fetch threshold

MOV BL,ES: [line_3+focus_start] ; get line 3 start

SUB BL,ES: [line_2+focus_start] ; calc offset

ADD BL,ES:[line 3+focus_start] ; get approx line 4 start

SUB 8L,3 ; back up 3

JC pixel _4_ error ; check for sol wrap

CHP AH,DS:[BX] ; see if already dark

JNC pixel_4_error

find_ focus_4_start:

INC BL ; step forward

JZ pixel _4_error ; check for eol wrap

CHP DS:[BX],AH ; is pixel < threshold

JC found_focus_4_start

LOOP find_focus_4_start ; if not loop

JMP pixel_4_error ; error if out of range found_focus_4 _start:

MOV ES:[line_ 4+focus_start], BL ; store focus 4 start

DEC BL ; step back over threshold

MOV CX.0006 ; sot range for valid focus

MOV AH,ES: [light_threshold)

find_light_4_start:

CHP DS:[BX),AH ; compare pixel with threshold

JC found_light_4_ start ; jump if pixel < threshold

INC BL ; else advance pointer

JZ pixel_4_error ; check for eol wrap

LOOP find_light_4_start ; try again

JMP pixel_4_error ; out of focus

found_light_4_start:

MOV ES: [line_4+light_start], BL ; store light start

MOV CH,0 ; set range for maximum width

ADD BL.ES: [min_width] ; start for finding end

JC pixel_4_error ; if over eol

MOV CL,ES:[width_range] ; how far to look

CHP DS:(BX],AH ; check pixel is dark

JNC pixel_4_error ; if not then too narrow

find_light_4_end:

INC BL : step forward

JZ pixel _4_error ; check for eol wrap

CHP DS:[BX],AH

JNC found_light_4_end ; jump if pi xel > = threshol d

LOOP f ind_l ight_4_end ; try again

JMP pixel_4_error ; too wide

found_light_4_end:

DEC BL ; step back below threshold

MOV ES:[line_ 4+light_end],BL ; store end

MOV AL,BL

SUB AL,ES:[line_4+light_ start] ; calc width

MOV ES:[line_4+light_width], AL ; and store

MOV CX.0006 ; focus range for end MOV AH,ES: [focus_threshold] ; get threshold

find_focus _4_end:

CHP DS:[BX],AH

JNC found_focus_4_end ; jump if pixel >= threshold

INC BL ; step forward

JZ pixel_4_error ; check for eol wrap

LOOP find_focus_4_end ; try again

pixel_4_error:

STC ; set error flag

RET ; and return

found_focus_4_end:

DEC BL ; step back below threshold

MOV ES: [line_4+focus_end],BL ; store end

SUB BL,ES:[line_4+focus_start] ; calc focus width

MOV ES:[line_ 4+focus_width],BL ; and store

CLC ; clear error flag

RET ; and return

;-----------------------------------------------------------------------------------------

; Routine : LHIRES_WIDTHS 15/12/88

; Function : hires widths, mean and CofV at light threshold

; Calls : Interpolate_light, mean_CofV

; Inputs :

; Returns :

;

Lhires_widths:

NOV CH,ES:[line_1_address] ; lst line

MOV SI,line_1 ; index for subroutine

CALL interpolate_light ; get hires values

INC CH ; next line

MOV SI,line_2 ; index for subroutine

CALL interpolate_light ; get hires values

INC CH ; next line

MOV SI,line_3 ; index for subroutine

CALL interpolate_light ; get hires values

IHC CH ; next line

MOV SI,line_4 ; index for subroutine

CALL interpolate_light ; get hires values

MOV SI,Lhires_width

CALL mean_CofV ; calculate mean and C of V SAHF ; transfer 8087 flags from AX to 8066 flags CKC ; set carry if C of V > limit

MOV AX.ES:tCofV_temp] ; store C of V

MOV ESl[CofV_L],AX

MOV AX,ES:[fibre_width_temp] ; store mean

MOV ES:[Lfibre_wiuth],AX

RET

;---------------------------------------------------------------------------------------- ; Routine : INTERPOLATE_LIGHT 15/12/88

; Function : look up interpolation table for hires start and end at LT

; Inputs : line address in CH, line offset in pib (SI)

; Uses : pixel starts and ends and LT from pib

; Outputs : hires start, end and width stored in pib

;

interpolate_light:

MOV BH,CH ; put start pixel pointer MOV BL,ESs[SI + light_start] ; in BX

DEC BL ; step back across threshold

MOV AH,BL ; keep msbyte of start

MOV BX,DS:[BX] ; fetch pixel pair

SUB BL,BH ; difference between pixels in BL SUB BH,ES: [l ight_threshold] ; diff start pixel to threshold NEG BH ; fl ip to positive

PUSH DS ; save image base

MOV DS,ES: [interpolate] ; load interp table segment

MOV AL,DS:[BX] ; get interpolated value

POP DS ; restore image base

NEO AL ; 256 - interpolated value

MOV ES:[Sl+Lhires_start],AX ; store hires start

MOV BH,CH ; reload line value

MOV BL,ES:tSI+light_end] ; point to end pixel

MOV AH.BL ; store msbyte of end

MOV BX,OS:[BX] ; fetch pixel pair across threshold SUB BH,BL ; diff between pixels

SUB BL,ES:[l ight_threshold] ; top pixel to threshold

NEC BL ; make positive

XCHG BL,BH ; correct order for end lookup PUSH DS ; save image base

MOV DS,ES: [interpolate] ; base of interp table

MOV AL,DS:[BX) ; get interpolated value

ADD AL,O ; check for pixel on threshold JNZ Lhires_cont ; jump if not special case INC AH ; otherwise correct msbyte

Lhires_cont:

POP DS ; restore image base

MOV ES: [Sl+Lhires_ end], AX ; store hires end

SUB AX,ES:[Sl+Lhires_start] ; calc width

MOV ES:[SI+Lhires_width),AX ; and store

RET

;----------------------------------------------------------------------------------------- ; Routine : FHIRES_WIDTHS 15/12/88

; Function : hires widths, mean and CofV at focus threshold

; Calls : lnterpolate_focus

; Inputs :

; Returns :

;

Fhires_widths:

MOV CK,ES:[line 1 address] ; lst line

MOV SI,line_1 ; index for subroutine

CALL interpolate_ focus ; net hires values

INC CH ; next line

MOV SI,line_2 ; index for subroutine

CALL interpolate_focus ; get hires values

INC CH ; next line

MOV SI,line_3 ; index for subroutine

CALL interpolate_focus ; get hires values

INC CH ; next line

MOV SI,line_4 ; index for subroutine

CALL interpolate_focus ; get hires values

MOV SI,Fhires_width

CALL mean_ CofV ; calculate mean and C of V

{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}

{FIDIAG.PAS}

{ VER 5.01 27/6/89 }

{$N+}

{$R-}

{$B+}

{$S+}

{$l+}

{$H 65500,16384,655360)

UHIT FIDIAG;

INTERFACE

USES FIDVAR,FIDINIT,FIDIO,FIDRIVER,FIDPROC,FIDASH,Crt,Dos,Printer,Graph;

PROCEDURE Diags;

IHPLEHENTATION

PROCEDURE Adjust_Assembly_Language_Data ;

VAR

Index : BYTE ;

InChar : CHAR ;

BEGIN

WRITELN ;

WRITELNCKey in values when proapted') ;

WRITELN ;

WRITE( 'light_diff ['.pib^. light_diff,') :') ;

READLN(pib^.light_diff) ;

pib^. light_ range := (2 ' pib^. light_diff ) + 1 ;

WRITELN ;

WRITE( 'Horizontal scan delay [',Horizontal_Delay,'] :') ;

READLN(Horizontal_Delay) ;

WRITELN ;

WRITE( 'Vertical scan delay [',Vertical_ Delay,'] :') ;

READLN(Vertical_Delay) ;

WRITELN ;

WRITE( 'C of V limits [',pib^.CofVLimit.') :') ;

READLN(pib^.CofVLimit) ;

NRITE( 'Delay Time (ms) ['.wait_ time.'] :');

READLN(wait_ time);

WRITE( 'Focus lower limit [',pib^.FocLow.'] :');

READLN(pib^.FocLow) ;

WRITE( 'Focus upper limit ['.pib^.FocHigh,') :');

READLN(pib^.FocHigh) ;

WRITE( 'micron bin fixed cutoff value(0 - 255) ['.Binain,'] :');

READLN(Binmin);

WRITE( 'micron bin scaled cutoff value(0 - 99.991) ['.binthreshold:6:2.'%] :');

READLN(binthreshold);

WRITE( 'Acceptable group size ['.pib^.groupsize,'J :');

READLN(pib^.groupsize) ;

Init_ Hardware ;

Mean_Dark := Sum_Dark / 240.0 ;

IF Sum_Sq_Dark > Sqr(Sum_Dark) /240.0 THEN

Std_Dev_Dark := Sqrt (Sum_Sq_Dark/240.0 - Sqr(Sum_Dark/240.0))

ELSE Std_Dev_Dark : = 0.0 ;

Sum_Mean_Acc[Index) := Mean_Dark ;

Sum_20_Mean := 0.0 ;

Sum_Sq_20 Mean := 0.0 :

FOR Index2 := 1 TO 20 DO

BEGIN

Sum_20_Mean := Sum_20_Mean + Sum_Mean_Acc[Index2] ;

Sum_Sq_20_Mean := Sum_Sq_20_Mean + (Sum_Mean_Acc[ Index2] ' Sum_ Mean_Acc[ Index2]) ; END ;

Mean_20_Mean := Sun_20_Mean / 20.0 ;

IF Sum_Sq_20_Mean > Sqr (Sum_20_Mean)/20.0 THEN

Std Dev_20_Mean := Sqrt (Sum_Sq_20 Mean/20.0 - Sqr(Sum 20_Mean/20.0))

ELSE Std_Dev_20_Mean : = 0.0 ;

GotoXY(3, WhereY) ;

WRITE(Mean_Dark:5:2) ;

GotoXY(13, WhereY) ;

WRITE(Std_Dev_Dark:5:2) ;

GotoXY(23, WhereY) ;

WRITE(Mean_20 Mean:5:2) ;

GotoXY(33, WhereY) ;

WRITE(Std_Dev_20_Mean:5:2) ;

Hor_Sum_Dark := 0.0 ;

Hor_ Sum_Sq_Dark := 0.0 ;

FOR Pixel := 0 TO 511 DO

BEGIN

Hor_Sum_Dark := Hor_Sum_Dark + Mem[$9000: Pixel] ;

Hor_Sum_Sq_Dark := Hor_Sum_Sq_Dark + Sqr(Mem[$9000:Pixel]) ;

END ;

Hor_Mean_Dark := Hor_Sum_Dark / 512.0 ;

IF Hor_Sum_Sq_Dark > Sqr(Hor_Sum_Dark)/512.0 THEN

Hor_Std_Dev_Dark := Sqrt (Hor_Sum_Sq_Dark/512.0 - Sqr(Hor Sum_Dark/512.0))

ELSE Hor_Std_Dev_Dark := 0.0 ;

Hor_Sum_Mean_Acc[Index] := Hor_Mean_Dark ;

Hor_Sum_20_Mean := 0.0 ;

Hor_Sum_Sq_20_Mean := 0.0 ;

FOR Index2 := 1 TO 20 DO

BEGIN

Hor_Sum_20_Mean := Hor_Sum_20_Mean + Hor_Sum_Mean_Acc[Index2] ;

Hor_Sum_Sq_20 Mean := Hor Sum_Sq_20 Mean + Sqr(Hor_Sum Mean_Acc [Index2]) ;

END ;

Hor_Mean 20 Mean := Hor Sum 20 Mean / 20.0 ;

IF Hor_Sum_Sq_20_Mean > Sqr(Hor_Sum_20_Mean)/20.0 THEN

Hor_Std_Dev_20_Mean := Sqrt (Hor_Sum Sq_20_Mean/20.0 - Sqr(Hor_Sum_20_Mean/20.0)) ELSE Hor_Std_Dev_20_Mean := 0.0 ;

GotoXY(43,WhereY) :

WRITE(Hor_Mean_Dark:5:2) ;

GotoXY(53, WhereY) ;

WRITE(Hor_Std_ Dev_Dark:5:2) ;

GotoXY(63, WhereY) ;

WRITE(Hor_Mean _20_Mean:5:2) ;

GotoXY(73, WhereY) :

Pixval : STRING[3] ;

ChangeX ,

ChangeY ,

Odd,Step_Back : BOOLEAN ;

Profile_Now , { pointers to arrays of profiles }

Last_Profile ,

Temp_Pointer : ' Profile_Array ;

FUNCTION Get_Cursor : BYTE ;

VAR Key_Data : CHAR ;

BEGIN

IF KeyPressed THEN

BEGIN

Key_Data := ReadKey ;

IF ( Key_Data = #0 ) AND KeyPressed THEN { if first data <esc> and }

{ another char in keyboard }

{ buffer then special function }

{ key likely }

BEGIN

Key_Data := ReadKey ; { get char from keyboard }

Get_Cursor := ORD(Key_Data) ; { convert to numeric }

END ;

END ELSE Get_Cursor := 0 ; { if no key return 0 }

END ; { of Get_Cursor }

BEGIN

Odd := true ;

New(Last_Profile) ; { set up arrays for quick delete of last }

New(Profile_Now) ; { profile written to screen }

GraphMode := 0 ; {set colour mode for 4 grey levels... but worse resolution} In itGraph(GraphDriver, GraphMode,'');

FOR Index := 0 TO 255 DO Last_Profile^ .Pixel [Index] := 1 ;

X := 128 ; Y := 64 ; { set cursor up to aiddle of image }

LastX := X ; LastY := Y : { LastX and LastY allow quick delete of crosshairs }

Line(63,0 ,63 ,63) ; { draw profile reference axis }

Line(60, 0,62,0) ;

Line(60,15.62.15) ;

Line(60,31,62,31) ;

Line(60,47,62,47) ;

Line(60,63,62,63) ;

SetTextStyle(0,1,1);

SetTextJustify(1,1);

OutTextXY(10,31, 'PROFILE');

Cl oseGraph ;

GraphMode : = 5;

TextMode(LastMode) ;

Dispose(Last_Profile) : { kill off arrays }

Dispose(Profile_ Now) :

END ;

PROCEDURE Light_Test

VAR Al T une :

Light : ;

New_Light

bar t :

Index

BEGIN

Set_lnterrupts ;

WRITELN ;

AllDone := FALSE ;

REPEAT

WRITE('Input Light Value [current value :' Light_Control.' ] 999 to end '' ; READ: N(New_Light) ;

IF New_Light = 999 THEN AllDone := TRUE

ELSE IF (New_Light := 0) AND (New_Light <= 255) THEN

BEGIN

Light_Control := New_Light ;

PORT[Light_Port] : = Light_Control ; { set up Light D/A }

Delay(100) ; { wait approx. 100 as for light to settle }

Get_Frame ; { fetch image }

pib^ . dark_pixel_threshold := 30 ;

Pixel_Mean(pib_segment) ;

Light := pib^ , pixel_mean ;

Dark : = pib^ , dar k_pixels

WRITELN(' Pixel Mean : ' . Light : 5 : 3 ,' Dark Pixels : ',Dark) ;

END

ELSE WRITELN('l a valid Light Set , Must be 0 .. 255') ;

UNTIL AllDone ;

END ; { of Light_left }

PROCEDURE Light_Port_Output :

VAR AllDone : BOOLEAN ;

New_l ight : INTEGER ;

BEGIN

WRITELN ;

AllDone := FALSE ;

REPEAT

WRITE('Input Light Value (current value :' Light_Control,') 999 to end ') ; READLN(New_Light) ;

WRITELN ('Fairchild F3000 specification. Pixels of Type 1 have outputs') ;

WRITELN(' which deviate from any mean by not more than 350 mV and not less') ;

WRITELN('than 50 mV. These are defined as not exceeding 20 pixels in number') ;

WRITELN('Type 2 pixels deviate from the mean by greater than 350 mV.') ;

WRITELN(' The sensor should have no Type 2 pixels. ( Fairchild describe') ;

WRITELN('these as blemishes)') ;

WRITELN ;

WRITELNC To use the utility adjust the manual light setting and') ;

WRITELN(' lamp offset pot to the light level under which sensor') ;

WRITELN('will be tested and return to this utility') ;

WRITELN ;

WRITELN ('Bad Pixel summary is output to the printer') ;

WRITELN ;

WRITE('Press <F2> to continue : ') ;

Pause_For (2) ;

IF MaxAvail < 0 THEN Temp_Max 65536.0 - MaxAvail

ELSE Temp_hax : = MaxAvail ;

IF Temp_Max < 1096 THEN { space for two 32K word (INTEGER) arrays }

BEGIN

User_Message (' Warning ',' Insufficient Memory For Data Accumulators', {

}'Press <F1> to exit',1) ;

Pause_For(1) ;

END ELSE BEGIN

New(A) ; { allocate 16k eleeent array of integers (32k of Memory) }

New(B) ; { ditto }

Save_V_Delay := Vertical_Delay ;

Save_H_Delay := Horizontal_Delay ;

WRITELN ;

WRITE('List Type 1 Pixels ? [Y/N] : ') ;

REPEAT In_Char := Readkey UNTIL (UpCase ( ln_Char) = 'Y') OR (UpCase ( In_Char) = 'N') ;

WRITELN(In_Char) ;

IF UpCase(In_Char) = 'Y' THEN Type_1_Enable := TRUE

ELSE Type_ 1_Enable := FALSE ;

WRITE('List Type 2 Pixels ? [Y/N] : ') ;

REPEAT In_Char := ReadKey UNTIL (UpCase (In_Char) = 'Y') OR (UpCase (ln_ Char) = 'N') ;

WRITELN(In_Char) ;

IF UpCase(In_Char) = 'Y' THEN Type 2_Enable := TRUE

ELSE Type_2_Enable := FALSE :

Bad_Countcr[1] := 0 ; { initialize bad pixel counters }

Bad_Counter[2) := 0 ; { for bad pixel types 1 and 2 }

FOR Quadrant := 1 TO A DO

FOR Field := 0 TO 1 DO

BEGIN

WRITELN ;

WRITELN('Running ..') : CASE Quadrant OF

1 : BEGIN

Horizontal_Delay := Base_H_Delay + Field ;

Vertical_Delay : = Base_V_Delay ;

H_Offset := 0 ;

V_Offset := 0 ;

END ;

2 : BEGIN

Horizontal_Delay : = Right_H_Delay + Field ;

Vertical_Delay := Base_V_Delay ;

H_Offset : = H_Field_Offset ;

V_Offset := 0 ;

END ;

3 : BEGIN

Horizontal_Delay : = Base_H_Delay + Field ;

Vertical_Delay : = Bottom_V_Delay ;

H_Offset : = 0 ;

V_Offset : = V_Field_Offset ;

END ;

4 : BEGIN

Horizontal_Delay : = Right_H_Delay + Field ;

Vertical_Delay : = Bottom_V_Delay ;

H_Offset := H_Field_Offset ;

V_Offset := V_Field_Offset ;

END ;

Init_Hardware ; { set counter values to access 32K "quadrant" of video }

FOR Index := 0 TO 16383 DO { clear accumulators }

BEGIN

A^. Pixel [Indexl := 0 ;

B^.Pixel [lndex] := 0 ;

END :

FOR Frames : = 1 TO 16 DO { gather 16 frames for sum and average }

BEGIN

Get_Frame ; { fetch image }

FOR Index := 0 TO 16383 DO { accumulate pixel values }

BEGIN

A^ . Pixel [Index] : = A^ .Pixel [Index) + Image^ . ImageMemory [Index] ; B^. Pixel [Index] := B^ .Pixel [Index] < Image^ . ImageMemory [Index + 16384]; END ;

END ;

Total_Pixel := 0.0 ;

FOR Index := 0 TO 16383 DO

BEGIN

Total_Pixel := Total_ Pixel + A^ ,Pixel [Index] + B^ , Pixel [Index] ;

END ;

Pix_Mean := Round(Total_Pixel / 32768.0) ;

WRITELN(LST) ;

WRITELN(LST, 'Quadrant : ' ,Quadrant : 1 , ' Field : ',Field:1.{

IF (index-20) OR (index=40) OR (index=60) OR (index=80) THEN

BEGIN

GoToXY(1,23);

write('<RET> for next page');

readln;

ClrScr;

writeln('index group line column width dark');

END;

END { of if any fibres }

ELSE BEGIN

ClrScr;

writeln ('NO FIBRES DETECTED ');

END;

GoToXY (1,23);

write ('<RET> to continue');

readln;

END; {of Process_Image}

PROCEDURE Accumulate_Single_Frame_Stats ;

VAR

Index : WORD ;

BEGIN

Init_Stat(Diam); Init_Stat (LightWidth); Init_Stat (Focuswidth);

Init_Stat (SplineWldth); Init_Stat (FoeusAce);

IF pib'.slide_fibre_counter[0] > 0 THEN

BEGIN

FOR Index : = 0 TO pib^ ,slide_fibre_counter [0] - 1 D0

BEGIN

Diam.sum : = Diam.sum + Fibre_B^ . micron [Index];

Diam. sumsq := Diam. sumsq + Sqr (Fibre_B^ . micron[Index]);

Diam. count : = Diam. count + 1 ;

LightWidth.sum : = LightWidth. sum + Fibre_A^ .Lwidth [Index];

LightWidth. sumsq : = LightWidth. sumsq + Sqr (Fibre_A^ . Lwidth [Index]);

LightWidth. count : = LightWidth. count + 1 ;

FocusWidth. sum : = FocusWidth. sum + Fibre_A^ . Fwidth [Index];

FocusWidth. sumsq : = FocusWidth. sumsq + Sqr (Fibre_A^ . Fwidth[Index]);

FocusWidth. count : = FocusWidth .count + 1 ;

SplineWidth. sum := Spl ineWidth . sum + Fibre_B^. SpWidth [Index];

SplineWidth. sumsq := Spl ineWidth. sumsq + Sqr (F ibre_B^. SpWidth [Index]);

SplineWldth. count := SplineWidth. count + 1 ;

FocusAcc.sum : = FocusAcc.sum + Fibre_B^ . Focus [Index];

FocusAcc. sumsq : = FocusAcc .sumsq + Sqr (F ibre_B^ . Focus[Index]);

FocusAcc.count :- FocusAcc . count + 1 ;

END;

END; (of IF no fibres)

END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE Single_Analysis ; VAR Hour , Minute, second, subsec : word;

hourl, minutel, secondl, subsecl : WORD;

BEGIN

IF Simulation THEN Sid_String : = simfilespec

ELSE Sid_String :='Single Analysis';

ClrScr;

Initialize_Run ;

Clear_debug_totals (Total _Debug);

pib". slide_fibre_counter [0] := 0;

Table_Rejects := 0;

Get Time (Hour, Hinute, Second, subsec);

Analyse_Frame(pib_segment) ;

Get Time (Hour1, Hinute1, second1, subsec1);

IF secondl<second then

BEGIN

Second1 := second1 +60;

minute := minute + 1;

END;

timer := second1 - second;

IF minute1<minute then

BEGIN

Minutel := minute1 + 60 ;

hour : = hour + 1 ;

END;

timer : = timer 4- 60" (minute1 -minute) ;

IF hour1<hour then

hour1 := hour1 + 24;

timer : = timer + 3600" (hour1 - hour);

Accuaulate_Single_Frame_Stats ;

Process _Image ;

END ;

PROCEDURE Print_All_Fibres ;

VAR

Index, Hour, Minute, second , sec100,

year, month, day, dayofweek : word;

percent_ok : REAL;

BEGIN

IF Simulation THEN Sid_String := simfilespec

ELSE Sid_String :='Single Analysis';

Initialize_Run ;

Clear_debug_totals(Total_Debug) ;

Table_rejects := 0;

{**********************display heading***********************************************}

ClrScr;

Window (1,1,25,80);

Write ('FIDAM ', serial_string,' .');

GetTime (hour, minute, second, sec100); GetDate (year, month, day, dayofweek); INDUSTRIAL APPLICABILITY

The above described fibre image display and measurement system has been used successfully to measure the mean fibre diameter of wool samples and it is expected that the invention will have particular application in this field. The invention is not limited to this particular application however and it can be applied in other fields where recorded images are to be analyzed.

The algorithms derived for the current application have been designed to seek out parallelograms as fibres whereas alternative procedures could be defined for circles or

ellipses.

For example International Patent Application

PCT/JB87/00761 describes an image analysis system in which the image of a depression or indentation generated by a static indentation hardness testing machine is analysed to obtain a hardness measurement. The present invention could be applied to the equipment of this kind in order to obviate the need for accurate focusing of the image to be analysed. In fact the invention may be applied to the analysis of any captured images. Such images may be recorded in permanent form or may be captured in a transitory form. For example, the invention could be applied to a robotics vision system so as

instantaneously to analyse continuously captured visual images whereby to avoid the need for accurate focusing.

It is accordingly to be understood that the invention is in no way limited by the details of the equipment specifically described in this specification and that many modifications and variations will fall within the scope of the appended claims.

Claims

1. A method of measuring a dimension of a captured visual image between a pair of image boundary segments, comprising: measuring the rate of change and magnitude of change of recorded light intensity across one or both of the boundary segments as a measure of the sharpness of focus of the image; measuring a dimension of the image between selected light intensity values at said boundary segments; and

correcting the measured dimension according to the

measured sharpness of focus and the magnitude of the measured dimension.

2. A method as claimed in claim 1, wherein the captured image is elongate and said dimension is a width of the image in a direction transverse to the longitudinal direction of the image.

3. A method as claimed in claim 2, wherein the image is an image of a fibre and the measured width of the image is further corrected according to the angle between said transverse and longitudinal directions to derive a corrected width indicative of the diameter of the fibre.

4. A method as claimed in any one of the preceding claims wherein the measured dimension is measured at the light

intensity values selected between a maximum value and a minimum value calculated by fitting a spline to the changing light intensity values across the boundary segments.

5. Image capture and analysis apparatus, comprising:

intensity values derived from a line of pixels transecting a pair of boundary segments of a captured image, to measure the rate of change and magnitude of change of light intensity values across one or both of the image boundary segments as a measure of the sharpness of focus of the captured image, to measure a dimension of the image between selected light

intensity values at the two boundary segments, and to correct the measured dimension according to the measured sharpness of focus and the magnitude of the measured dimension.

6. Apparatus as claimed in claim 5, wherein the image capture means comprises an optical microscope and a camera to view the image produced by the microscope and linked to the image processing means via an analogue-to-digital convertor to supply to the image processing means digital signals indicative of said light intensity values.

7. Apparatus as claimed in claim 6, wherein the image

processing means comprises memory means to store the digital signals indicative of said light intensity values and

programmed data processing means to scan the stored light intensity values derived from said line of pixels transecting a pair of boundary segments of a captured image, to measure the rate of change and magnitude of change of light intensity values across one or both of the image boundary segments as a measure of the sharpness of focus to measure a dimension of the image between selected light intensity values at the two boundary segments and to correct the measured dimension

according to the measured sharpness of focus and the magnitude of the measured dimension.

8. Apparatus as claimed in claim 7, wherein the programmed data processing means is operative to fit a spline to the changing light intensity values across the boundary segments, and to measure said dimension at a light intensity value selected between a maximum value and minimum value determined by the spline.

9. Apparatus as claimed in claim 7 or claim 8, wherein the image processing means has memory storing correction factors to be applied according to varying measurements of the sharpness of focus and magnitude of the measured dimension and the programmed data process means is operative to compare the measured sharpness of focus and dimension magnitude with the stored factors and to apply the appropriate factor to correct the measured dimension.

10. Apparatus as claimed in any one of claims 7 to 9, wherein the image processing means is operative to recognise an

elongate fibre image, to measure said dimension as the width of the image in a direction transverse to the longitudinal

direction of the image, to measure the angle between said transverse and longitudinal directions, and to correct the measured width according to the angle as measured.