OVERLAY PROCEDURE HARMONIC_MENU; { This harmonic mean evaluation of a home range is an adaptation of the harmonic mean program written by John R. Cary / Department of Wildlife Ecology/ University of Wisconson-Madison. The Cary programs are written to run on the UCSD P-SYSTEM. These programs are written in TURBO PASCAL for the IBM-PC or IBM-XT running MDOS or PCDOS. Further enhancements allow the harmonic program to run in the SMITHSONIAN radio tracking ananlysis package. } PROCEDURE HARMONIC_PROCEDURE; { The actual procedures and functions of the HARMONIC MEAN program. All constants, types, records and variables used in the HARMONIC MEAN will be declared here unless they are found in the MCPAAL main program } CONST MAX_LOCATION_WARNING = 300; MIN_RESOLUTION = 0.1; MAX_DIVISIONS = 25; MAX_LOCS = 1500; MAX_CONTOURS = 40; TYPE DATA_PTR = ^DATA_VALUE; DATA_VALUE = RECORD X : REAL; Y : REAL; NEXT : DATA_PTR; END; AREA_TYPE = RECORD AREA_LABEL : STRING[8]; AREA : REAL; END; VAR FIRST_DATA : DATA_PTR; { FIRST RECORD IN THE HEAP } LAST_DATA : DATA_PTR; { LAST RECORD IN THE HEAP } NEW_DATA : DATA_PTR; { CURRENT RECORD IN THE HEAP } LAST_CONTOUR : DATA_PTR; { TAIL OF CURRENT CONTOUR LIST } HEAPTOP : ^INTEGER; { USED TO RELEASE MEMORY } FINAL_PASS : BOOLEAN; { TRUE FOR FINAL PASS THROUGH GRAPHICS } FOUND : BOOLEAN; GRAPH_QUEST : BOOLEAN; { True if to ask closing questions. } STOP_FLAG : BOOLEAN; { TRUE TO TERMINATE A PROCEDURE EARLY } NEW_CONTOUR : BOOLEAN; AREA_INDEX : INTEGER; { INDEX FOR HOME RANGE AREA ARRAY } CONTOUR_INDEX : INTEGER; { INDEX FOR PERCENTAGE CONTOURS ARRAY } CURRENT_INDEX : INTEGER; CURRENT_LINE : INTEGER; { NUMBER OF THE LINE BEING EXAMINED } FUDGE : REAL; { FACTOR TO FUDGE THE NUMBERS WITH } GPOINT_NUM : INTEGER; { NUMBER OF THE GRID LOCATION BEING PROCESSED } I : INTEGER; { A WORK VARIABLE } J : INTEGER; { A WORK VARIABLE } X1INDEX : INTEGER; { A MESS OF WORK VARIABLES } X2INDEX : INTEGER; Y1INDEX : INTEGER; Y2INDEX : INTEGER; NPOINTS : INTEGER; { NUMBER OF POINTS IN THE FILE } NPOINT : INTEGER; { INDEX VARIABLE FOR ARRAYS } NUMBER_OF_VERTICIES : INTEGER; { NUMBER OF VECTORS IN THE CONTOURS } PERCENT : INTEGER; { PERCENT VALUES FOR CONTOURS GUIDES } PREVIOUS_CONTOUR : INTEGER; { Last contour drawn and with calculated area. } PREVIOUS_LINE : INTEGER; { MARKER FOR THE LINE NUMBER JUST CHECKED } SAVEX : INTEGER; SAVEY : INTEGER; SAVELINE : INTEGER; CELL_HARMONIC_AVERAGE : REAL; { CENTRAL HARMONIC MEAN AVERAGE OF A CELL } MEAN1 : REAL; { INTERMEDIATE VALUE OF INTERPOLATION } MEAN2 : REAL; { INTERMEDIATE VALUE OF INTERPOLATION } MEMORY_NEEDED : REAL; { MEMORY NEEDED TO CONTINUE PGM } PERCENT_VALUE : REAL; { VALUE OF HAR. MEAN AT REQUESTED PERCENTAGE } PX1 : REAL; { FOUR TEMP VARIABLES USED IN PLOTTING } PY1 : REAL; PX2 : REAL; PY2 : REAL; X1VALUE : REAL; { WORK VARIABLE } X2VALUE : REAL; { WORK VARIABLE } X_OF_HARMONIC_VALUE : REAL; { X COORDINATE FOR A CONTOUR POINT } XMEDIAN : REAL; { HARMONIC MEAN AVERAGE BETWEEN TWO X VALUES } XS : REAL; XVALUE : REAL; { X VALUE AT A PARTICULAR GRID INTERSECTION } XVECTOR : REAL; { DISTANCE FROM AN OBSERVATION TO GRID PT.} XYVECTOR : REAL; { HYPOTENUSE OF THE XVECTOR AND YVECTOR } Y1VALUE : REAL; { WORK VARIABLE } Y2VALUE : REAL; { WORK VARIABLE } Y_OF_HARMONIC_VALUE : REAL; { Y COORDINATE FOR A CONTOUR POINT } YMEDIAN : REAL; { HARMONIC MEAN AVERAGE BETWEEN TWO Y VALUES } YS : REAL; YVALUE : REAL; { Y VALUE AT A PARTICULAR GRID INTERSECTION } YVECTOR : REAL; { DISTANCE FROM AN OBSERVATION TO GRID PT. } EXAMINED : ARRAY [1..MAX_DIVISIONS,1..MAX_DIVISIONS] OF BOOLEAN; CONTOUR : ARRAY [1..MAX_CONTOURS] OF DATA_PTR; CONTOUR_AREA : ARRAY [1..MAX_CONTOURS] OF REAL; CONTOUR_PERCENT : ARRAY [1..MAX_CONTOURS] OF INTEGER; PERCENT_LOCS : ARRAY [0..100] OF REAL; H : ARRAY [0..MAX_DIVISIONS,0..MAX_DIVISIONS] OF REAL; ANIMAL_LOC : ARRAY [0..MAX_LOCS] OF REAL; { MEAN VALUE FOR THE ACTUAL ANIMAL } { LOCATION. } HR : ARRAY [1..MAX_CONTOURS] OF AREA_TYPE; FUNCTION MEMORY_LEFT : REAL; { CHECKS THE AMOUNT OF MEMORY LEFT ON THE HEAP } BEGIN { MEMORY_LEFT } IF MEMAVAIL < 0 THEN MEMORY_LEFT := 65536.0 + MEMAVAIL ELSE MEMORY_LEFT := MEMAVAIL; END; { MEMORY_LEFT FUNCTION } FUNCTION INTERPOLATE(MIDDLE : REAL; LOW : REAL; HIGH : REAL; LOW1 : REAL; HIGH1 : REAL) : REAL; { RETURNS THE RESULT OF A STANDARD MATH INTERPOLATION MIDDLE - LOW UKNOWN - LOW1 -------------- = --------------- HIGH - LOW HIGH1 - LOW1 } BEGIN INTERPOLATE := LOW1 + (MIDDLE - LOW) * (HIGH1 - LOW1)/ (HIGH-LOW); END; { INTERPOLATE FUNCTION } PROCEDURE WARN(WARN_NUMBER : INTEGER); { ISSUE WARNINGS AND GET REPLY } BEGIN { WARN } CASE WARN_NUMBER OF 1 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN ('WARNING: you have ',NPOINTS,' locations in the data file. This will'); WRITELN (' cause the program to run for a long time.'); WRITELN; WRITE (' DO YOU WANT TO CONTINUE (Y|N) ? '); KEYVALUE := ' '; WHILE NOT (UPCASE(KEYVALUE) IN ['Y','N']) DO READ (KBD,KEYVALUE); KEYVALUE := UPCASE(KEYVALUE); IF KEYVALUE = 'Y' THEN KEEP_GOING := TRUE ELSE KEEP_GOING := FALSE; END; 2 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN ('ERROR: You have less than 2 points in the input file.'); WRITELN ('The HARMONIC program execution is being halted.'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; 3 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN ('ERROR: You have exhausted the heap memory. This is caused'); WRITELN (' by too many observations in your input data set.'); WRITELN; WRITELN ('The HARMONIC program execution is being halted.'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; 4 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN ('ERROR: You do not have enough memory remaining to process'); WRITELN (' all the observations in your input data set.'); WRITELN; WRITELN ('The HARMONIC program execution is being halted.'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; 5 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN('ERROR: There is insufficient memory to continue processing'); WRITELN(' your data file. This is due to too many observations'); WRITELN(' in the input data set.'); WRITELN; WRITELN('The HARMONIC program execution is being halted.'); KEEP_GOING := FALSE; END; 6 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN('ERROR: The number of contours created is greater than'); WRITELN(' the maximum of allowed contours.'); LINE_OUT(5,10,'The HARMONIC program execution is being halted.'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; 7 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN('ERROR: NUMBER 7'); LINE_OUT(5,10,'PROGRAM HALTED'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; 8 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN('ERROR : NUMBER 8'); LINE_OUT(5,10,'PROGRAM HALTED'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; 9 : BEGIN CLRSCR; GOTOXY(5,5); WRITELN('ERROR: NUMBER 9'); LINE_OUT(5,10,'PROGRAM HALTED'); KEEP_GOING := FALSE; KEYBOARD_PAUSE; END; END; { CASE WARN_NUMBER } END; { WARN } PROCEDURE GRID_LINES_; { Draws a grid line on the screen in hi res mode. } VAR INTERCEPT_ : REAL; SLOPE_ : REAL; X_POINT : REAL; Y_POINT : REAL; XD : REAL; YD : REAL; X1 : INTEGER; X2 : REAL; X3 : REAL; BEGIN XD := GRID_SPAN / 200; YD := GRID_SPAN / 90; FOR X1 := 0 TO GRIDSIZE DO BEGIN X2 := X1 * GRID_SPAN / GRIDSIZE; X3 := 0; WHILE X3 <= GRID_SPAN DO BEGIN HIRES_POINT(X3,X2,0,0,GRIDFACTOR); X3 := X3 + XD; END; X3 := 0; WHILE X3 <= GRID_SPAN DO BEGIN HIRES_POINT(X2,X3,0,0,GRIDFACTOR); X3 := X3 + YD; END; END; END; { GRID LINE } PROCEDURE FILE_INFO; { DRAWS THE FILE INFORMATION ONTO THE GRAPHIC SCREEN } BEGIN; LINE_OUT(60,4,'Data file:'); LINE_OUT(64,5,FILEOUT); IF STUDYFILE <> '' THEN BEGIN LINE_OUT(60,7,'Map file:'); LINE_OUT(64,8,STUDYFILE); END; IF REPLAYFILE <> '' THEN BEGIN LINE_OUT(60,10,'Replay file:'); LINE_OUT(64,11,REPLAYFILE); END; END; { FILE_INFO } PROCEDURE GRAPH_DISPLAY; { A SERIES OF GRAPHIC CALLS TO DISPLAY THE GRAPH AS IT EXISTS } VAR XP1 : REAL; I : INTEGER; BEGIN { GRAPH_DISPLAY } IF NOT FINAL_PASS THEN BEGIN HIRES; HIRESCOLOR(YELLOW); LINE_OUT(1,1,'Harmonic Mean Transformation:'); { FIRST PUT IN THE FILE INFORMATION } FILE_INFO; { If requested, draw in the grid. } IF GRIDCHAR = 'Y' THEN GRID_LINES_; { NEXT PUT OUT THE RAW POINTS } NEW_DATA := FIRST_DATA; WHILE NEW_DATA <> NIL DO BEGIN HIRES_POINT(NEW_DATA^.X,NEW_DATA^.Y,XOFFSET,YOFFSET,GRIDFACTOR); NEW_DATA := NEW_DATA^.NEXT; END; { IF A CONTOUR EXISTS, DRAW IT } IF CONTOUR_INDEX > 0 THEN FOR I := PREVIOUS_CONTOUR+1 TO CONTOUR_INDEX DO BEGIN NEW_DATA := CONTOUR[CONTOUR_INDEX]; PX1 := NEW_DATA^.X; PY1 := NEW_DATA^.Y; NEW_DATA := NEW_DATA^.NEXT; WHILE NEW_DATA <> NIL DO BEGIN PX2 := NEW_DATA^.X; PY2 := NEW_DATA^.Y; HIRES_VECTOR(PX1,PY1,PX2,PY2,XOFFSET,YOFFSET,GRIDFACTOR); PX1 := PX2; PY1 := PY2; NEW_DATA := NEW_DATA^.NEXT; END; END; { For I = PREVIOUS CONTOUR TO CONTOUR INDEX } IF NOT FINAL_PASS THEN KEYBOARD_PAUSE; { NOW DRAW ALL CONTOURS SO FAR } LINE_OUT(1,25,SPACE79); IF CONTOUR_INDEX > 1 THEN FOR I := 1 TO CONTOUR_INDEX DO BEGIN NEW_DATA := CONTOUR[I]; PX1 := NEW_DATA^.X; PY1 := NEW_DATA^.Y; NEW_DATA := NEW_DATA^.NEXT; WHILE NEW_DATA <> NIL DO BEGIN PX2 := NEW_DATA^.X; PY2 := NEW_DATA^.Y; HIRES_VECTOR(PX1,PY1,PX2,PY2,XOFFSET,YOFFSET,GRIDFACTOR); PX1 := PX2; PY1 := PY2; NEW_DATA := NEW_DATA^.NEXT; END; END; END; { IF NOT FINAL PASS } IF FINAL_PASS THEN IF STUDYFILE <> '' THEN BEGIN LINE_OUT(1,25,SPACE79); LINE_OUT(1,25,'Draw the study area overlay? (Y|N) '); YES_NO(STUDYDRAWN); LINE_OUT(1,25,SPACE79); IF STUDYDRAWN = 'Y' THEN BEGIN HIRES; HIRESCOLOR(YELLOW); SXLOW := XLOW; SYLOW := YLOW; SZLOW := ZLOW; SXHIGH := XHIGH; SYHIGH := YHIGH; SZHIGH := ZHIGH; LINE_OUT(1,1,'Harmonic Mean Transformation:'); FILE_INFO; { OPEN THE STUDY AREA FILE } ASSIGN(FILEVAR3,STUDYFILE); RESET (FILEVAR3); STUDYOPEN := TRUE; SEEK (FILEVAR3,1); { GET THE SECOND RECORD } READ (FILEVAR3,FILE3REC); WITH FILE3REC DO BEGIN XLOW := MIN_VAL(X1,XLOW); YLOW := MIN_VAL(Y1,YLOW); ZLOW := MIN_VAL(Z1,ZLOW); XHIGH := MAX_VAL(X2,XHIGH); YHIGH := MAX_VAL(Y2,YHIGH); ZHIGH := MAX_VAL(Z2,ZHIGH); END; { END FILE3 REC DO } GRID_CALCULATIONS; { DRAW THE STUDY AREA BOUNDRY } SEEK (FILEVAR3,2); { DATA BEGINS AT THIRD RECORD } WHILE NOT EOF(FILEVAR3) DO BEGIN READ (FILEVAR3,FILE3REC); WITH FILE3REC DO HIRES_VECTOR(X1,Y1,X2,Y2,XOFFSET,YOFFSET,GRIDFACTOR); END; { REDRAW THE RAW DATA POINTS } NEW_DATA := FIRST_DATA; WHILE NEW_DATA <> NIL DO BEGIN HIRES_POINT(NEW_DATA^.X,NEW_DATA^.Y,XOFFSET,YOFFSET,GRIDFACTOR); NEW_DATA := NEW_DATA^.NEXT; END; { REDRAW THE BOUNDRIES } NUMBER_OF_VERTICIES := 0; IF CONTOUR_INDEX > 1 THEN FOR I := 1 TO CONTOUR_INDEX DO BEGIN NEW_DATA := CONTOUR[I]; PX1 := NEW_DATA^.X; PY1 := NEW_DATA^.Y; NEW_DATA := NEW_DATA^.NEXT; WHILE NEW_DATA <> NIL DO BEGIN NUMBER_OF_VERTICIES := NUMBER_OF_VERTICIES + 1; PX2 := NEW_DATA^.X; PY2 := NEW_DATA^.Y; HIRES_VECTOR(PX1,PY1,PX2,PY2,XOFFSET,YOFFSET,GRIDFACTOR); PX1 := PX2; PY1 := PY2; NEW_DATA := NEW_DATA^.NEXT; END; { WHILE NEW DATA <> NIL } END; { FOR I = 1 TO CONTOUR INDEX } END; { IF STUDYDRAWN = 'Y' } END; { IF STUDYFILE <> '' } IF FINAL_PASS THEN IF REPLAYFILE <> '' THEN BEGIN LINE_OUT(1,25,SPACE79); LINE_OUT(1,25,'Do you want to add this graph to the replay file? (Y|N) '); YES_NO(KEYVALUE); IF KEYVALUE = 'Y' THEN BEGIN IF NOT EXIST(REPLAYFILE) THEN INIT_REPLAY_FILE; ASSIGN(FILEVAR4,REPLAYFILE); RESET (FILEVAR4); REPLAYOPEN := TRUE; { WRITE OUT THE FILE. WILL INCLUDE ALL CONTOURS, AND MAYBE THE RAW POINTS AND THE STUDYFILE. } IF STUDYDRAWN = 'Y' THEN IF NOT STUDY_IN_REPLAY THEN ADD_GRAPH('STUDYFILE'); { PUT STUDY AREA IN FILE } { UPDATE THE WHOLE FILE VALUES } SEEK (FILEVAR4,1); READ (FILEVAR4,FILE4REC); FILE4REC.X1 := MIN_VAL(FILE4REC.X1,SXLOW); FILE4REC.Y1 := MIN_VAL(FILE4REC.Y1,SYLOW); FILE4REC.Z1 := MIN_VAL(FILE4REC.Z1,SZLOW); FILE4REC.X2 := MAX_VAL(FILE4REC.X2,SXHIGH); FILE4REC.Y2 := MAX_VAL(FILE4REC.Y2,SYHIGH); FILE4REC.Z2 := MAX_VAL(FILE4REC.Z2,SZHIGH); FILE4REC.LINE_TYPE := FILE4REC.LINE_TYPE + NUMBER_OF_VERTICIES; SEEK (FILEVAR4,1); WRITE (FILEVAR4,FILE4REC); READ (FILEVAR4,FILE4REC); FILE4REC.X2 := FILE4REC.X2 + 1; { NUMBER OF GRAPHS IN FILE } SEEK (FILEVAR4,2); WRITE (FILEVAR4,FILE4REC); { NOW MODIFY GRAPH HEADERS AND WRITE OUT THE VECTORS } SEEK (FILEVAR4,FILESIZE(FILEVAR4)-1); READ (FILEVAR4,FILE4REC); FILE4REC.X1 := -6; { -6 MEANS HARMONIC CONTOURS } FILE4REC.Y1 := -10; FILE4REC.X2 := -10; FILE4REC.Y2 := -10; SEEK(FILEVAR4,FILESIZE(FILEVAR4)-1); WRITE(FILEVAR4,FILE4REC); { BUILD SECOND GRAPH HEADER } FILE4REC.X1 := SXLOW; FILE4REC.Y1 := SYLOW; FILE4REC.Z1 := SZLOW; FILE4REC.X2 := SXHIGH; FILE4REC.Y2 := SYHIGH; FILE4REC.Z2 := SZHIGH; FILE4REC.LINE_TYPE := NUMBER_OF_VERTICIES; WRITE(FILEVAR4,FILE4REC); FILE4REC.Z1 := 0.0; FILE4REC.Z2 := 0.0; FILE4REC.LINE_TYPE := 1; FOR I := 1 TO CONTOUR_INDEX DO BEGIN NEW_DATA := CONTOUR[I]; FILE4REC.X1 := NEW_DATA^.X; FILE4REC.Y1 := NEW_DATA^.Y; NEW_DATA := NEW_DATA^.NEXT; WHILE NEW_DATA <> NIL DO BEGIN FILE4REC.X2 := NEW_DATA^.X; FILE4REC.Y2 := NEW_DATA^.Y; WRITE(FILEVAR4,FILE4REC); FILE4REC.X1 := FILE4REC.X2; FILE4REC.Y1 := FILE4REC.Y2; NEW_DATA := NEW_DATA^.NEXT; END; END; { WRITE OUT THE TRAILING RECORD } FILE4REC.X1 := 0.0; FILE4REC.Y1 := 0.0; FILE4REC.X2 := 0.0; FILE4REC.Y2 := 0.0; FILE4REC.LINE_TYPE := 0; WRITE(FILEVAR4,FILE4REC); END; { IF KEYVALUE = Y } END; { IF REPLAYFILE } IF FINAL_PASS THEN BEGIN LINE_OUT(1,25,SPACE79); LINE_OUT(1,25,'Press any key to terminate the program. Graph will be cleared. '); READ (KBD,KEYVALUE); END; END; { GRAPH_DISPLAY } PROCEDURE LINE_ENDS( XBEGIN : REAL; YBEGIN : REAL; VBEGIN : REAL; XEND : REAL; YEND : REAL; VEND : REAL); { Checks if the requested harmonic mean value is between the two endpoints of a line. If the value exists, the x and y coordinates of the end point is generated by interpolation. } BEGIN { LINE_ENDS } FOUND := FALSE; IF (( PERCENT_VALUE >= VBEGIN ) AND ( PERCENT_VALUE <= VEND )) OR (( PERCENT_VALUE >= VEND ) AND ( PERCENT_VALUE <= VBEGIN )) THEN BEGIN FOUND := TRUE; X_OF_HARMONIC_VALUE := INTERPOLATE(PERCENT_VALUE, VBEGIN, VEND, XBEGIN, XEND); Y_OF_HARMONIC_VALUE := INTERPOLATE(PERCENT_VALUE, VBEGIN, VEND, YBEGIN, YEND); END; END; { LINE_ENDS } PROCEDURE PARSE_LINE(CURRENT_LINE: INTEGER); { Determines line being checked and calls the line_ends procedure with the correct parameters: the endpoint coordinates of the line, the harmonic mean being searched for, the harmonic means at the line endpoints. } BEGIN { PARSE_LINE } CASE CURRENT_LINE OF 1: LINE_ENDS( X2VALUE, Y2VALUE, H[X2INDEX,Y2INDEX], X1VALUE, Y2VALUE, H[X1INDEX,Y2INDEX] ); 2: LINE_ENDS( X2VALUE, Y2VALUE, H[X2INDEX,Y2INDEX], X2VALUE, Y1VALUE, H[X2INDEX,Y1INDEX] ); 3: LINE_ENDS( X1VALUE, Y1VALUE, H[X1INDEX,Y1INDEX], X2VALUE, Y1VALUE, H[X2INDEX,Y1INDEX] ); 4: LINE_ENDS( X1VALUE, Y1VALUE, H[X1INDEX,Y1INDEX], X1VALUE, Y2VALUE, H[X1INDEX,Y2INDEX] ); 5: LINE_ENDS( XMEDIAN, YMEDIAN, CELL_HARMONIC_AVERAGE, X1VALUE, Y2VALUE, H[X1INDEX,Y2INDEX] ); 6: LINE_ENDS( XMEDIAN, YMEDIAN, CELL_HARMONIC_AVERAGE, X2VALUE, Y2VALUE, H[X2INDEX,Y2INDEX] ); 7: LINE_ENDS( XMEDIAN, YMEDIAN, CELL_HARMONIC_AVERAGE, X2VALUE, Y1VALUE, H[X2INDEX,Y1INDEX] ); 8: LINE_ENDS( XMEDIAN, YMEDIAN, CELL_HARMONIC_AVERAGE, X1VALUE, Y1VALUE, H[X1INDEX,Y1INDEX] ); END; { CASE CURRENT_LINE } END; { PARSE_LINE } PROCEDURE CREATE_NEW_CELL; { DEFINES THE X AND Y VALUES ASSOCIATED WITH THE IHIGH, ILOW, JHIGH, AND JLOW VALUES. THE AVERAGE HARMONIC MEAN FOR THE CELL IS ALSO CALCULATED. } BEGIN { CREATE_NEW_CELL } X1VALUE := X1INDEX * GRID_SPAN / GRIDSIZE + XLOW; X2VALUE := X2INDEX * GRID_SPAN / GRIDSIZE + XLOW; Y1VALUE := Y1INDEX * GRID_SPAN / GRIDSIZE + YLOW; Y2VALUE := Y2INDEX * GRID_SPAN / GRIDSIZE + YLOW; XMEDIAN := (X1VALUE + X2VALUE) / 2; YMEDIAN := (Y1VALUE + Y2VALUE) / 2; CELL_HARMONIC_AVERAGE := ( H[X1INDEX,Y1INDEX] + H[X1INDEX,Y2INDEX] + H[X2INDEX,Y1INDEX] + H[X2INDEX,Y2INDEX] ) / 4; EXAMINED[X2INDEX,Y2INDEX] := TRUE; END; { CREATE_NEW_CELL } PROCEDURE GET_FIRST_PLOT_POINT; { SCANS THE GRID LOOKING FOR AN INTERPOLATED VALUE THAT IS EQUAL TO THE REQUESTED PERCENT HARMONIC MEAN VALUE. } BEGIN { GET_FIRST_PLOT_POINT } STOP_FLAG := FALSE; NEW_CONTOUR := FALSE; { LOOK FOR AN UNSEARCHED GRID CELL } X2INDEX := 1; WHILE (X2INDEX <= GRIDSIZE) AND (NOT STOP_FLAG) DO BEGIN Y2INDEX := 1; WHILE (Y2INDEX <= GRIDSIZE) AND (NOT STOP_FLAG) DO BEGIN IF ( NOT EXAMINED[X2INDEX,Y2INDEX] ) AND ( NOT STOP_FLAG ) THEN BEGIN X1INDEX := X2INDEX - 1; Y1INDEX := Y2INDEX - 1; { CREATE A NEW CELL DEFINITION FOR THE ABOVE CELL CORNER POINTS } CREATE_NEW_CELL; { Search each of the 8 lines of the cell for a value equal to the harmonic mean at the percentage requested. } CURRENT_LINE := 1; WHILE (CURRENT_LINE <= 8) AND (NOT STOP_FLAG) DO BEGIN PARSE_LINE(CURRENT_LINE); IF FOUND THEN BEGIN NEW_CONTOUR := TRUE; { Save the beginning indexes for this contour. } CASE CURRENT_LINE OF 1: BEGIN SAVEX := X2INDEX; SAVEY := Y2INDEX + 1; SAVELINE := 3; END; 2: BEGIN SAVEX := X2INDEX + 1; SAVEY := Y2INDEX; SAVELINE := 4; END; 3: BEGIN SAVEX := X2INDEX; SAVEY := Y2INDEX - 1; SAVELINE := 1; END; 4: BEGIN SAVEX := X2INDEX - 1; SAVEY := Y2INDEX; SAVELINE := 2; END; 5..8: BEGIN SAVEX := X2INDEX; SAVEY := Y2INDEX; SAVELINE := CURRENT_LINE; END; END; { CASE CURRENT_LINE OF } { If the coordinates are within bounds, create a new entry. } IF (SAVEX = 0) OR (SAVEY = 0) THEN BEGIN FOR X2INDEX := 1 TO GRIDSIZE DO FOR Y2INDEX := 1 TO GRIDSIZE DO EXAMINED[X2INDEX,Y2INDEX] := TRUE; FOUND := FALSE; NEW_CONTOUR := FALSE; { Let user know that a contour will not be drawn. } CLRSCR; LINE_OUT(5,10,'The contour at the requested percentage lies beyond'); LINE_OUT(5,11,'the range of the screen. Contours of this percentage'); LINE_OUT(5,12,'may be drawn if a higher gridsize is specified at the'); LINE_OUT(5,13,'beginning of the analysis.'); KEYBOARD_PAUSE; CLRSCR; END ELSE BEGIN CONTOUR_INDEX := CONTOUR_INDEX + 1; { Add this contour point as the head of a linked list. } NEW(NEW_DATA); NEW_DATA^.NEXT := NIL; NEW_DATA^.X := X_OF_HARMONIC_VALUE; NEW_DATA^.Y := Y_OF_HARMONIC_VALUE; CONTOUR[CONTOUR_INDEX] := NEW_DATA; LAST_CONTOUR := NEW_DATA; PREVIOUS_LINE := 0; STOP_FLAG := TRUE; END; { ELSE TO IF SAVEX OR SAVEY = 0 } END; { IF FOUND } IF NOT STOP_FLAG THEN CURRENT_LINE := CURRENT_LINE + 1; END; { WHILE CURRENT LINE <= 8 AND NOT STOP FLAG } END; { IF NOT EXAMINDED AND NOT STOP_FLAG } IF NOT STOP_FLAG THEN Y2INDEX := Y2INDEX + 1; END; { WHILE Y2INDEX <= GRIDSIZE AND NOT STOP FLAG } IF NOT STOP_FLAG THEN X2INDEX := X2INDEX + 1; END; { WHILE X2INDEX <= GRIDSIZE AND NOT STOP FLAG } END; { GET_FIRST_PLOT_POINT } PROCEDURE CHECK(I : INTEGER); BEGIN { CHECK } FOUND := FALSE; IF I <> PREVIOUS_LINE THEN BEGIN PARSE_LINE(I); IF FOUND THEN BEGIN PREVIOUS_LINE := CURRENT_LINE; CURRENT_LINE := I; { ADD A NODE TO THE CONTOUR LIST } NEW(NEW_DATA); NEW_DATA^.X := X_OF_HARMONIC_VALUE; NEW_DATA^.Y := Y_OF_HARMONIC_VALUE; NEW_DATA^.NEXT := NIL; LAST_CONTOUR^.NEXT := NEW_DATA; LAST_CONTOUR := NEW_DATA; END; END; END; { CHECK } PROCEDURE I_BOUNDS; BEGIN { I_BOUNDS } STOP_FLAG := FALSE; CURRENT_INDEX := Y2INDEX; Y2INDEX := 0; WHILE (Y2INDEX < GRIDSIZE) AND (NOT STOP_FLAG) DO BEGIN Y2INDEX := Y2INDEX + 1; IF Y2INDEX <> CURRENT_INDEX THEN BEGIN Y1INDEX := Y2INDEX - 1; CREATE_NEW_CELL; CHECK(CURRENT_LINE); IF FOUND THEN BEGIN PREVIOUS_LINE := 0; STOP_FLAG := TRUE; END; END; END; IF NOT FOUND THEN WARN(8); END; { I_BOUNDS } PROCEDURE J_BOUNDS; BEGIN { J_BOUNDS } STOP_FLAG := FALSE; CURRENT_INDEX := X2INDEX; X2INDEX := 0; WHILE (X2INDEX < GRIDSIZE) AND (NOT STOP_FLAG) DO BEGIN X2INDEX := X2INDEX + 1; IF X2INDEX <> CURRENT_INDEX THEN BEGIN X1INDEX := X2INDEX - 1; CREATE_NEW_CELL; CHECK(CURRENT_LINE); IF FOUND THEN BEGIN PREVIOUS_LINE := 0; STOP_FLAG := TRUE; END; END; END; IF NOT FOUND THEN WARN(9); END; { J_BOUNDS} PROCEDURE CHECK_4LINES(L1,L2,L3,L4,DI,DJ: INTEGER); { SCANS LINES ABOUT A CELL LOOKING FOR MORE POINTS ON THE CONTOUR } BEGIN CHECK(L1); IF NOT FOUND THEN CHECK(L2); IF NOT FOUND THEN IF X1INDEX + DI < 0 THEN I_BOUNDS ELSE IF Y1INDEX + DJ < 0 THEN J_BOUNDS ELSE IF X2INDEX + DI > GRIDSIZE THEN I_BOUNDS ELSE IF Y2INDEX + DJ > GRIDSIZE THEN J_BOUNDS ELSE IF (DI <> 0 ) OR (DJ <> 0 ) THEN BEGIN X1INDEX := X1INDEX + DI; X2INDEX := X2INDEX + DI; Y1INDEX := Y1INDEX + DJ; Y2INDEX := Y2INDEX + DJ; CREATE_NEW_CELL; IF CURRENT_LINE = 2 THEN CURRENT_LINE := 4 ELSE IF CURRENT_LINE = 4 THEN CURRENT_LINE := 2 ELSE IF CURRENT_LINE = 1 THEN CURRENT_LINE := 3 ELSE IF CURRENT_LINE = 3 THEN CURRENT_LINE := 1; END; IF NOT FOUND THEN CHECK(L3); IF NOT FOUND THEN CHECK(L4); IF NOT FOUND THEN WARN(7); END; { CHECK_4LINES } PROCEDURE GET_NEXT_PLOT_POINT; { Locates the next point of the requested harmonic mean value after an initial point has been located. } BEGIN { GET_NEXT_PLOT_POINT } CASE CURRENT_LINE OF 1: CHECK_4LINES(5,6,7,8,0,1); 2: CHECK_4LINES(6,7,5,8,1,0); 3: CHECK_4LINES(7,8,5,6,0,-1); 4: CHECK_4LINES(5,8,6,7,-1,0); 5: CHECK_4LINES(1,4,8,6,0,0); 6: CHECK_4LINES(1,5,2,7,0,0); 7: CHECK_4LINES(2,3,8,6,0,0); 8: CHECK_4LINES(4,5,7,3,0,0); END; END; { GET_NEXT_PLOT_POINT } PROCEDURE COMPUTE_LOCATION_HARMONIC_MEANS; { The harmonic mean at each grid intersection is now known. Compute the mean for each animal location by interpolation. } VAR I : INTEGER; { INDEX FOR ANIMAL_LOC[I] } BEGIN LINE_OUT(1,15,SPACE79); LINE_OUT(5,15,'Computing actual location mean.'); LINE_OUT(5,17,'Processing point number:'); NPOINT := 0; NEW_DATA := FIRST_DATA; WHILE NEW_DATA <> NIL DO BEGIN NPOINT := NPOINT + 1; GOTOXY(30,17); WRITE (NPOINT:5); { DETERMINE THE X AND Y COORDINATES OF THE GRID ABOUT THE ANIMAL LOCATION VALUE } X1INDEX := TRUNC((NEW_DATA^.X - XLOW) * GRIDSIZE / GRID_SPAN); X2INDEX := X1INDEX + 1; Y1INDEX := TRUNC((NEW_DATA^.Y - YLOW) * GRIDSIZE / GRID_SPAN); Y2INDEX := Y1INDEX + 1; { DETERMINE THE X AND Y VALUES OF THESE GRID INTERSECTIONS ABOUT THE ANIMAL LOCATION VALUE } X1VALUE := X1INDEX * GRID_SPAN / GRIDSIZE + XLOW; X2VALUE := X2INDEX * GRID_SPAN / GRIDSIZE + XLOW; Y1VALUE := Y1INDEX * GRID_SPAN / GRIDSIZE + YLOW; Y2VALUE := Y2INDEX * GRID_SPAN / GRIDSIZE + YLOW; { INTERPOLATE THE MEAN VALUE ALONG THE TWO X SIDES OF THE GRID CELL } MEAN1 := INTERPOLATE ( NEW_DATA^.X, X1VALUE, X2VALUE, H[X1INDEX,Y1INDEX], H[X2INDEX,Y1INDEX] ); MEAN2 := INTERPOLATE ( NEW_DATA^.X, X1VALUE, X2VALUE, H[X1INDEX,Y2INDEX], H[X2INDEX,Y2INDEX] ); { USE THE INTERPOLATED X SIDE MEANS TO DETERMINE THE Y SIDE MEAN } ANIMAL_LOC[NPOINT] := INTERPOLATE ( NEW_DATA^.Y, Y1VALUE, Y2VALUE, MEAN1, MEAN2 ); NEW_DATA := NEW_DATA^.NEXT; END; END; { COMPUTE_LOCATION_HARMONIC_MEAN } PROCEDURE LOCATION_MEAN_SORT; { Sorts the individual animal location harmonic means into ascending order. The locations at the range center will have the smallest harmonic mean; the ones at the outer edge will have the largest. } VAR I : INTEGER; { A WORK VARIABLE } J : INTEGER; { A WORK VARIABLE } PTR_MIN : INTEGER; { A WORK VARIABLE } MIN_VALUE : REAL; { A WORK VARIABLE } TEMP_VALUE : REAL; { A WORK VARIABLE } BEGIN LINE_OUT(1,15,SPACE79); LINE_OUT(1,17,SPACE79); LINE_OUT(5,15,'Sorting'); LINE_OUT(5,17,'Pass number:'); FOR I := 1 TO NPOINTS-1 DO BEGIN GOTOXY(18,17); WRITE(I:5); MIN_VALUE := ANIMAL_LOC[I]; PTR_MIN := I; FOR J := I TO NPOINTS DO IF ANIMAL_LOC[J] < MIN_VALUE THEN BEGIN MIN_VALUE := ANIMAL_LOC[J]; PTR_MIN := J; END; TEMP_VALUE := ANIMAL_LOC[I]; ANIMAL_LOC[I] := ANIMAL_LOC[PTR_MIN]; ANIMAL_LOC[PTR_MIN] := TEMP_VALUE; END; { FOR I = 1 TO NPOINTS-1 } END; { LOCATION_MEAN_SORT } PROCEDURE ESTABLISH_PERCENTAGE_LEVELS; { Takes all animal locations and divides their harmonic means into an array of 100 locations, one location for each percentage value from 1 to 100. The locations are sorted on ascending values of the harmonic means. } VAR I : INTEGER; J : INTEGER; PERCENTI : REAL; PERCENTJ : REAL; PERCENTX : REAL; BEGIN ANIMAL_LOC[0] := ANIMAL_LOC[1]; ANIMAL_LOC[NPOINTS+1] := ANIMAL_LOC[NPOINTS]; FOR PERCENT := 0 TO 100 DO BEGIN { DETERMINE NUMBER OF POINTS ARE THE Ith PERCENTILE } I := TRUNC(NPOINTS*(PERCENT/100)); J := I + 1; { USE ABSOLUTE PERCENTAGE TO DETERMINE THE NUMBER OF POINTS IN THAT PERCENTAGE. } PERCENTI := I * (100.0 / NPOINTS); PERCENTJ := J * (100.0 / NPOINTS); PERCENTX := PERCENT; PERCENT_LOCS[PERCENT] := INTERPOLATE ( PERCENTX, PERCENTI, PERCENTJ, ANIMAL_LOC[I], ANIMAL_LOC[J]); END; END; { ESTABLISH_PERCENTAGE_LEVELS } PROCEDURE GRID_HARMONIC_MEANS; VAR I : INTEGER; { A WORK COUNTER } J : INTEGER; { A WORK COUNTER } TOTGRID : INTEGER; { TOTAL NUMBER OF INTERSECTIONS } BEGIN GPOINT_NUM := 0; TOTGRID := (GRIDSIZE+1) * (GRIDSIZE+1); WRITELN ('Beginning the harmonic calculations'); WRITELN; WRITELN ('Harmonic mean distances are being calculated for all'); WRITELN ('locations to each grid intersection.'); WRITELN; WRITELN ('There are ',npoints,' observations and ',TOTGRID,' grid intersections.'); LINE_OUT(10,15,'Processing grid intersection number:'); FOR I := 0 TO GRIDSIZE DO BEGIN { XVALUE AND YVALUE HAVE THE VALUES OF X AND Y AT THE GRID INTERSECTIONS. } XVALUE := I * GRID_SPAN / GRIDSIZE + XLOW; FOR J := 0 TO GRIDSIZE DO BEGIN GPOINT_NUM := GPOINT_NUM + 1; GOTOXY(47,15); WRITE (GPOINT_NUM:5); GOTOXY(1,25); YVALUE := J * GRID_SPAN / GRIDSIZE + YLOW; { SUM THE INVERSE DISTANCES AT EACH POINT } H[I,J] := 0.0; NEW_DATA := FIRST_DATA; WHILE NEW_DATA <> NIL DO WITH NEW_DATA^ DO BEGIN XVECTOR := X - XVALUE; YVECTOR := Y - YVALUE; XYVECTOR := SQRT(XVECTOR * XVECTOR + YVECTOR * YVECTOR ); IF XYVECTOR < MIN_RESOLUTION THEN XYVECTOR := MIN_RESOLUTION; H[I,J] := H[I,J] + 1/XYVECTOR; NEW_DATA := NEXT; END; { WITH NEW_DATA } H[I,J] := NPOINTS / H[I,J]; END; { FOR J = 0 TO GRID DIVISIONS } END; { FOR I = 0 TO GRID DIVISIONS } END; { GRID_HARMONIC_MEANS } BEGIN { HARMONIC_PROCEDURE } KEEP_GOING := TRUE; { Determine if new data are to be used or if this is a restart on existing harmonic means. The restart file is in selection 6. It will be blank if a data file is given and the data file will be blank if a restart file is given. } IF FILEOUT <> '' THEN BEGIN { STARTING WITH 'RAW' DATA } CLRSCR; { DETERMINE GRID SIZE } GRIDSIZE := 0; GOTOXY(5,5); WRITE('Enter the number of grid divisions ( from 2 to ',MAX_DIVISIONS:4, ' ) '); WHILE NOT (GRIDSIZE IN [2..MAX_DIVISIONS]) DO READ (INPUT,GRIDSIZE); { GET POINTS AND DISPLAY INITIAL FACTORING } ASSIGN (FILEVAR2,FILEOUT); RESET (FILEVAR2); { LOAD THE MIN AND MAX VALUES FROM THE DATA FILE } SEEK (FILEVAR2,1); READ (FILEVAR2,FILE2REC); XLOW := FILE2REC.X; YLOW := FILE2REC.Y; ZLOW := FILE2REC.Z; NPOINTS := FILE2REC.RECORD_NO; READ(FILEVAR2,FILE2REC); XHIGH := FILE2REC.X; YHIGH := FILE2REC.Y; ZHIGH := FILE2REC.Z; MARK(HEAPTOP); RELEASE_FLAG := TRUE; FIRST_DATA := NIL; LAST_DATA := NIL; LINE_OUT(5,14,'Memory Left:'); WHILE NOT EOF(FILEVAR2) DO BEGIN READ (FILEVAR2,FILE2REC); WITH FILE2REC DO BEGIN { SET UP A HEAP ENTRY } NEW(NEW_DATA); NEW_DATA^.X := X; NEW_DATA^.Y := Y; IF FIRST_DATA = NIL THEN FIRST_DATA := NEW_DATA ELSE LAST_DATA^.NEXT := NEW_DATA; LAST_DATA := NEW_DATA; LAST_DATA^.NEXT := NIL; GOTOXY(5,15); WRITE(MEMORY_LEFT:8:0); IF MEMORY_LEFT < 10.0 THEN WARN(3); END; { WITH FILE2REC DO } END; { WHILE NOT EOF(FILEVAR2) } CLOSE(FILEVAR2); IF NPOINTS > MAX_LOCATION_WARNING THEN WARN(1); IF NPOINTS < 2 THEN WARN(2); IF NPOINTS > MAX_LOCS THEN WARN(3); IF KEEP_GOING THEN BEGIN { KEEP GOING 1 } { SET UP GRAPHING FACTORS AND SCALINGS } GRID_CALCULATIONS; FUDGE := 0.2 * GRID_SPAN; XHIGH := XHIGH + FUDGE; XLOW := XLOW - FUDGE; YHIGH := YHIGH + FUDGE; YLOW := YLOW - FUDGE; GRID_CALCULATIONS; MEMORY_NEEDED := NPOINTS * 10.0; IF MEMORY_NEEDED > (MEMORY_LEFT * 16) THEN WARN(4); END; { KEEP GOING 1 } IF KEEP_GOING THEN BEGIN { KEEP GOING 2 } CLRSCR; GRID_HARMONIC_MEANS; COMPUTE_LOCATION_HARMONIC_MEANS; LOCATION_MEAN_SORT; ESTABLISH_PERCENTAGE_LEVELS; END; { KEEP GOING 2 } IF KEEP_GOING THEN BEGIN { KEEP GOING 3 } IF RESTARTFILE <> '' THEN BEGIN ASSIGN (FILEVAR6,RESTARTFILE); REWRITE(FILEVAR6); WRITELN(FILEVAR6,'RESTART FILE FOR ',FILEOUT); WRITELN(FILEVAR6,GRIDSIZE:6); FOR I := 0 TO GRIDSIZE DO FOR J := 0 TO GRIDSIZE DO WRITELN(FILEVAR6,H[I,J]:12:8); WRITELN(FILEVAR6,NPOINTS:6); FOR I := 0 TO NPOINTS+1 DO WRITELN(FILEVAR6,ANIMAL_LOC[I]:12:8); WRITELN(FILEVAR6,' 100'); FOR I := 0 TO 100 DO WRITELN(FILEVAR6,PERCENT_LOCS[I]:12:8); WRITELN(FILEVAR6,'MINIMA AND MAXIMA'); WRITELN(FILEVAR6,XLOW:12:8,' ',XHIGH:12:8); WRITELN(FILEVAR6,YLOW:12:8,' ',YHIGH:12:8); WRITELN(FILEVAR6,ZLOW:12:8,' ',ZHIGH:12:8); WRITELN(FILEVAR6,'RAW DATA'); NEW_DATA := FIRST_DATA; WHILE NEW_DATA <> NIL DO BEGIN WRITELN(FILEVAR6,NEW_DATA^.X:12:8,' ',NEW_DATA^.Y:12:8); NEW_DATA := NEW_DATA^.NEXT; END; CLOSE (FILEVAR6); END; { IF RESTARTFILE <> ''}; END; { KEEP GOING 3 } END; { IF FILEOUT <> '' } IF FILEOUT = '' THEN BEGIN ASSIGN (FILEVAR6,RESTARTFILE); RESET (FILEVAR6); { READ THE TITLE LINE, THE GRID SIZE , AND THE HARMONIC MEANS AT THE GRID INTERSECTIONS } READLN (FILEVAR6,LINE1); LINE_OUT(10,10,LINE1); READLN (FILEVAR6,GRIDSIZE); FOR I := 0 TO GRIDSIZE DO FOR J := 0 TO GRIDSIZE DO READLN(FILEVAR6,H[I,J]); { READ THE NUMBER OF POINTS AND THE HARMONIC MEAN FOR THOSE POINTS } READLN(FILEVAR6,NPOINTS); GOTOXY(10,12); WRITE('There are ',NPOINTS,' locations in the data set.'); GOTOXY(10,14); WRITE('Initial calculations were made with a grid span of ',GRIDSIZE:6); FOR I := 0 TO NPOINTS+1 DO READLN(FILEVAR6,ANIMAL_LOC[I]); { READ A TITLE LINE AND THE PERCENTAGE VALUES } READLN(FILEVAR6,LINE1); FOR I := 0 TO 100 DO READLN(FILEVAR6,PERCENT_LOCS[I]); { READ TITLE LINE AND THE MINIMA AND MAXIMA } READLN(FILEVAR6,LINE1); READLN(FILEVAR6,XLOW,XHIGH); READLN(FILEVAR6,YLOW,YHIGH); READLN(FILEVAR6,ZLOW,ZHIGH); GOTOXY(10,16); WRITELN('The minima and maxima for the data set are:'); WRITELN('X: ',XLOW:10:7,' ',XHIGH:10:7); WRITELN('Y: ',YLOW:10:7,' ',YHIGH:10:7); WRITELN('Z: ',ZLOW:10:7,' ',ZHIGH:10:7); { READ TITLE LINE AND THE RAW DATA POINTS } READLN(FILEVAR6,LINE1); MARK(HEAPTOP); RELEASE_FLAG := TRUE; FIRST_DATA := NIL; LAST_DATA := NIL; FOR I := 1 TO NPOINTS DO BEGIN NEW(NEW_DATA); READLN(FILEVAR6,NEW_DATA^.X,NEW_DATA^.Y); IF FIRST_DATA = NIL THEN FIRST_DATA := NEW_DATA ELSE LAST_DATA^.NEXT := NEW_DATA; LAST_DATA := NEW_DATA; LAST_DATA^.NEXT := NIL; IF MEMORY_LEFT < 10.0 THEN WARN(3); END; CLOSE(FILEVAR6); GRID_CALCULATIONS; { ESTABLISH GRAPHING FACTORS } KEYBOARD_PAUSE; END; { IF FILEOUT = '' } IF KEEP_GOING THEN BEGIN { KEEP GOING 4 } CLRSCR; LINE_OUT(5,4,'You are now ready to define home range contours.'); LINE_OUT(5,5,'After each contour is developed the program displays'); LINE_OUT(5,6,'the results accumulated to date. After the results are'); LINE_OUT(5,7,'displayed, continue questions are asked. Respond to'); LINE_OUT(5,8,'these questions to draw more contours or to terminate.'); KEYBOARD_PAUSE; AREA_INDEX := 0; CONTOUR_INDEX := 0; FINAL_PASS := FALSE; FOR I := 1 TO 40 DO CONTOUR_PERCENT[I] := 0; KEYVALUE := 'Y'; WHILE (KEYVALUE <> 'N') AND (KEYVALUE <> 'E') DO BEGIN CLRSCR; TEXTMODE(3); TEXTCOLOR(YELLOW); { Develop contour verticies and contour areas. } LINE_OUT(1, 1,' N % AREA'); LINE_OUT(40,1,' N % AREA'); FOR I := 1 TO 20 DO BEGIN IF CONTOUR_PERCENT[I] > 0 THEN BEGIN GOTOXY(1,I+1); WRITE (I:3,' ',CONTOUR_PERCENT[I]:5,' ',CONTOUR_AREA[I]:8:4); END; IF CONTOUR_PERCENT[I+20] > 0 THEN BEGIN GOTOXY(40,I+1); J := I + 20; WRITE(J:3,' ',CONTOUR_PERCENT[J]:5,' ',CONTOUR_AREA[J]:8:4); END; END; LINE_OUT(65,1,'Memory Left:'); GOTOXY(65,2); WRITE(MEMORY_LEFT:8:0); KEYVALUE := 'C'; WHILE KEYVALUE = 'C' DO BEGIN LINE_OUT(1,22,SPACE79); LINE_OUT(1,23,SPACE79); LINE_OUT(5,22,'What percent of animal locations should be contained'); LINE_OUT(5,23,'in the next contour? ( 1 TO 100 ) '); PERCENT := 0; WHILE NOT (PERCENT IN [1..100]) DO BEGIN LINE_OUT(43,23,' '); GOTOXY(43,23); READLN (INPUT,PERCENT); END; LINE_OUT(1,22,SPACE79); LINE_OUT(1,23,SPACE79); PERCENT_VALUE := PERCENT_LOCS[PERCENT]; { Build a contour based on the percent_value varible's contents. First, locate an initial point at the percent_value level. } FOR I := 1 TO GRIDSIZE DO { INITIALIZE A EXAMINED MAP OF } FOR J := 1 TO GRIDSIZE DO { THE GRID TO UNEXAMINED STATUS.} EXAMINED[I,J] := FALSE; PREVIOUS_CONTOUR := CONTOUR_INDEX; NEW_CONTOUR := TRUE; WHILE NEW_CONTOUR DO BEGIN GET_FIRST_PLOT_POINT; IF NEW_CONTOUR THEN REPEAT GET_NEXT_PLOT_POINT; UNTIL (X2INDEX = SAVEX) AND (Y2INDEX = SAVEY) AND (CURRENT_LINE = SAVELINE); END; { WHILE NEW_CONTOUR } { GENERATE THE AREA OF THE CONTOUR AREA } FOR I := PREVIOUS_CONTOUR+1 TO CONTOUR_INDEX DO BEGIN CONTOUR_AREA[I] := 0.0; NEW_DATA := CONTOUR[I]; PX1 := NEW_DATA^.X; PY1 := NEW_DATA^.Y; NEW_DATA := NEW_DATA^.NEXT; WHILE NEW_DATA <> NIL DO BEGIN PX2 := NEW_DATA^.X; PY2 := NEW_DATA^.Y; CONTOUR_AREA[I] := CONTOUR_AREA[I] + PX1*PY2 - PX2*PY1; PX1 := PX2; PY1 := PY2; NEW_DATA := NEW_DATA^.NEXT; END; CONTOUR_AREA[I] := CONTOUR_AREA[I] / 2; { CONVERT AREA UNITS INTO SQUARE KILOMETERS } CONTOUR_AREA[I] := CONTOUR_AREA[I] * (METER_VALUE/1000) * (METER_VALUE/1000); { ADD ENTRIES TO THE CONTOUR PERCENT ARRAY } CONTOUR_PERCENT[I] := PERCENT; END; { I = PREVIOUS_CONTOUR TO CONTOUR_INDEX } { Redisplay the areas on the screen. } LINE_OUT(65,1,'Memory Left:'); GOTOXY(65,2); WRITE(MEMORY_LEFT:8:0); FOR I := 1 TO 20 DO BEGIN IF CONTOUR_PERCENT[I] > 0 THEN BEGIN GOTOXY(1,I+1); WRITE (I:3,' ',CONTOUR_PERCENT[I]:5,' ',CONTOUR_AREA[I]:8:4); END; IF CONTOUR_PERCENT[I+20] > 0 THEN BEGIN GOTOXY(40,I+1); J := I + 20; WRITE(J:3,' ',CONTOUR_PERCENT[J]:5,' ',CONTOUR_AREA[J]:8:4); END; END; IF DRAWCHAR = 'Y' THEN LINE_OUT(1,25,'Enter C - another contour, G - to generate a graph, or E - to exit ') ELSE LINE_OUT(1,25,'Enter C - another contour, E - to exit '); KEYVALUE := ' '; WHILE NOT (UPCASE(KEYVALUE) IN ['C','G','E']) DO READ (KBD,KEYVALUE); KEYVALUE := UPCASE(KEYVALUE); LINE_OUT(1,25,SPACE79); END; { WHILE KEYVALUE = 'C' } IF KEYVALUE = 'E' THEN BEGIN GRAPH_QUEST := FALSE; KEYVALUE := 'N'; END; IF KEYVALUE = 'G' THEN IF DRAWCHAR = 'N' THEN BEGIN CLRSCR; LINE_OUT(10,10,'Graphics mode has not been enabled.'); LINE_OUT(10,10,'No graphs can be drawn.'); END ELSE BEGIN { SHOW THE CURRENTLY GENERATED GRAPHICS } GRAPH_DISPLAY; GRAPH_QUEST := TRUE; END; { IF DRAWCHAR = 'Y' } IF (NOT FINAL_PASS) AND (GRAPH_QUEST) THEN BEGIN KEYVALUE := ' '; LINE_OUT(1,25,SPACE79); LINE_OUT(1,25,'Develop another contour? (Y|N) '); WHILE NOT (UPCASE(KEYVALUE) IN ['Y','N']) DO READ(KBD,KEYVALUE); KEYVALUE := UPCASE(KEYVALUE); END; END; { WHILE KEYVALUE <> N } IF GRAPH_QUEST THEN BEGIN FINAL_PASS := TRUE; GRAPH_DISPLAY; END; END; { KEEP GOING 4 } IF STUDYOPEN THEN CLOSE(FILEVAR3); IF REPLAYOPEN THEN CLOSE(FILEVAR4); IF RELEASE_FLAG THEN RELEASE(HEAPTOP); KEYVALUE := 'R'; END; { HARMONIC_PROCEDURE PROCEDURE } BEGIN { HARMONIC_MENU } { Display the options menu for the HARMONIC_PROCEDURE } RESTARTFILE := ''; KEYVALUE := 'R'; WHILE KEYVALUE = 'R' DO BEGIN CLRSCR; IF COLORCHAR = 'Y' THEN TEXTCOLOR(CYAN) ELSE TEXTCOLOR(WHITE); LINE_OUT(30,2,'(A) Harmonic Mean Analysis'); LINE_OUT(10,4,'1 Data file:'); LINE_OUT(10,6,'2 Study area file:'); LINE_OUT(10,8,'3 Plot replay file:'); LINE_OUT(10,10,'4 Text output displayed on:'); LINE_OUT(10,12,'5 Graphics displayed on screen (Y|N):'); LINE_OUT(10,14,'6 Restart file:'); LINE_OUT(10,16,'7 Grid overlay on screen (Y|N):'); LINE_OUT(10,18,'8 Scale of your map as meters between adjacent coordinates: '); TEXTCOLOR(YELLOW); LINE_OUT(24,4,FILEOUT); LINE_OUT(30,6,STUDYFILE); LINE_OUT(31,8,REPLAYFILE); LINE_OUT(27,14,RESTARTFILE); CASE UPCASE(PRINTCHAR) OF 'D' : PRINTSTR := 'DISPLAY ONLY'; 'P' : PRINTSTR := 'PRINTER ONLY'; 'B' : PRINTSTR := 'BOTH DISPLAY AND PRINTER'; END; LINE_OUT(39,10,PRINTSTR); IF DRAWCHAR = 'N' THEN DRAWSTR := 'NO' ELSE DRAWSTR := 'YES'; LINE_OUT(49,12,DRAWSTR); IF GRIDCHAR = 'N' THEN GRIDSTR := 'NO' ELSE GRIDSTR := 'YES'; LINE_OUT(43,16,GRIDSTR); GOTOXY(71,18); WRITE (METER_VALUE:8:4); IF COLORCHAR = 'Y' THEN TEXTCOLOR(RED) ELSE TEXTCOLOR(WHITE); LINE_OUT(7,21,'P Process Data'); LINE_OUT(37,21,'E Exit to Main Menu'); TEXTCOLOR(YELLOW); GOTOXY(1,24); KEYVALUE := ' '; WHILE NOT (UPCASE(KEYVALUE) IN ['E','R']) DO BEGIN KEYVALUE := ' '; WHILE NOT (UPCASE(KEYVALUE) IN ['1'..'8','P','E']) DO READ (KBD,KEYVALUE); KEYVALUE := UPCASE(KEYVALUE); GOTOXY(1,23); DELLINE; DELLINE; CASE KEYVALUE OF '1': MENU_CALL(1); '2': MENU_CALL(2); '3': MENU_CALL(3); '4': MENU_CALL(4); '5': MENU_CALL(5); '6': BEGIN LINE_OUT(1,23,'Enter the name of the RESTART file '); READLN (INPUT,RESTARTFILE); CAPIT (RESTARTFILE); GOTOXY(1,23); DELLINE; LINE_OUT(27,14,SPACE15); LINE_OUT(27,14,RESTARTFILE); END; '7': BEGIN LINE_OUT(1,23,'Overlay graphs with a grid? (Y|N) '); GRIDCHAR := ' '; WHILE NOT (UPCASE(GRIDCHAR) IN ['N','Y']) DO READ (KBD,GRIDCHAR); GRIDCHAR := UPCASE(GRIDCHAR); DELLINE; IF GRIDCHAR = 'N' THEN GRIDSTR := 'NO' ELSE GRIDSTR := 'YES'; LINE_OUT(43,16,SPACE15); LINE_OUT(43,16,GRIDSTR); END; '8': MENU_CALL(8); 'P': BEGIN KEEP_GOING := TRUE; RELEASE_FLAG := FALSE; STUDYOPEN := FALSE; REPLAYOPEN := FALSE; PROCESSING_VERIFY; IF (KEEP_GOING) AND (METER_VALUE <= 0.0) THEN BEGIN LINE_OUT(1,23,'The distance from 1.0 to 2.0 must be given.'); KEEP_GOING := FALSE; END; IF (KEEP_GOING) AND (DRAWCHAR = 'N') THEN BEGIN LINE_OUT(1,23,'*** WARNING *** You do not have graphics turned on.'); LINE_OUT(1,24,'Do you want to continue? (Y|N) '); KEYVALUE := ' '; WHILE NOT (UPCASE(KEYVALUE) IN ['Y','N']) DO READ (KBD,KEYVALUE); KEYVALUE := UPCASE(KEYVALUE); IF KEYVALUE = 'N' THEN KEEP_GOING := FALSE; END; IF KEEP_GOING THEN BEGIN CLRSCR; HARMONIC_PROCEDURE; END; END; { CASE P } END; { CASE KEYVALUE OF } GOTOXY(1,24); END; { WHILE NOT (KEYVALUE IN ['E','R']) } END; { WHILE KEYVALUE = 'R' } KEYVALUE := ' '; END; { HARMONIC_MENU PROCEDURE }