Date: Tue, 23 Jun 87 11:22:22 edt From: David Krowitz Subject: Latest HP7475 software, part 2 #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # hpplot.pas # This archive created: Tue Jun 23 11:16:25 1987 export PATH; PATH=/bin:$PATH if test -f 'hpplot.pas' then echo shar: will not over-write existing file "'hpplot.pas'" else cat << \SHAR_EOF > 'hpplot.pas' {***************************************************************************** ***** ***** ***** HPPLOT.PAS ***** ***** ***** ***** Program to Translate GMR Vector Output Files into HP-GL Plotter ***** ***** Command Files that can be Spooled to the HP 7475A, HP 7550A ***** ***** and HP 7570A Plotters. ***** ***** Version 12 ***** ***** David M. Krowitz June 5, 1987. ***** ***** ***** ***** Copyright (c) 1987 ***** ***** David M. Krowitz ***** ***** Massachusetts Institute of Technology ***** ***** Department of Earth, Atmospheric, and Planetary Sciences ***** ***************************************************************************** } PROGRAM HPPLOT; %NOLIST; %INSERT '/sys/ins/base.ins.pas'; %INSERT '/sys/ins/ms.ins.pas'; %INSERT '/sys/ins/pgm.ins.pas'; %INSERT '/sys/ins/error.ins.pas'; %LIST; CONST {Program version number - should be same as in file header above} version_number = 12; {Definitions of some standard ascii control characters} nul = chr(0); {null character} etx = chr(3); {etx (control-C) character} bs = chr(8); {backspace (control-H)} tab = chr(9); {tab (control-I)} lf = chr(10); {line feed (control-J)} vt = chr(11); {vertical tab (control-K)} ff = chr(12); {form feed (control-L)} cr = chr(13); {carriage return (control-M)} sub = chr(26); {sub (control-Z)} esc = chr(27); {escape} rs = chr(30); {rs} {Hewlitt Packard 7475A Plotter Parameters} HP7475_A_minimum_x = 0; {minimum x-axis plotting range, A size paper} HP7475_A_maximum_x = 10365; {maximum x-axis plotting range, A size paper} HP7475_A_minimum_y = 0; {minimum y-axis plotting range, A size paper} HP7475_A_maximum_y = 7962; {maximum y-axis plotting range, A size paper} HP7475_B_minimum_x = 0; {minimum x-axis plotting range, B size paper} HP7475_B_maximum_x = 16640; {maximum x-axis plotting range, B size paper} HP7475_B_minimum_y = 0; {minimum y-axis plotting range, B size paper} HP7475_B_maximum_y = 10365; {maximum y-axis plotting range, B size paper} HP7475_plotter_units = 1016.0; {number of plotter units per inch (40 per mm.)} HP7475_number_pens = 6; {number of pen colors in pen carousel} {Hewlitt Packard 7550A Plotter Parameters} HP7550_A_minimum_x = 0; {minimum x-axis plotting range, A size paper} HP7550_A_maximum_x = 10170; {maximum x-axis plotting range, A size paper} HP7550_A_minimum_y = 0; {minimum y-axis plotting range, A size paper} HP7550_A_maximum_y = 7840; {maximum y-axis plotting range, A size paper} HP7550_B_minimum_x = 0; {minimum x-axis plotting range, B size paper} HP7550_B_maximum_x = 16450; {maximum x-axis plotting range, B size paper} HP7550_B_minimum_y = 0; {minimum y-axis plotting range, B size paper} HP7550_B_maximum_y = 10170; {maximum y-axis plotting range, B size paper} HP7550_plotter_units = 1016.0; {number of plotter units per inch (40 per mm.)} HP7550_number_pens = 8; {number of pen colors in pen carousel} {Hewlitt Packard 7570A Plotter Parameters} HP7570_C_minimum_x = -10576; {minimum x-axis plotting range, C size paper} HP7570_C_maximum_x = 10576; {maximum x-axis plotting range, C size paper} HP7570_C_minimum_y = -7556; {minimum y-axis plotting range, C size paper} HP7570_C_maximum_y = 7556; {maximum y-axis plotting range, C size paper} HP7570_D_minimum_x = -16192; {minimum x-axis plotting range, D size paper} HP7570_D_maximum_x = 16192; {maximum x-axis plotting range, D size paper} HP7570_D_minimum_y = -10576; {minimum y-axis plotting range, D size paper} HP7570_D_maximum_y = 10576; {maximum y-axis plotting range, D size paper} HP7570_AC_minimum_x = -11592; {minimum x-axis plotting range, architectual C size paper} HP7570_AC_maximum_x = 11592; {maximum x-axis plotting range, architectual C size paper} HP7570_AC_minimum_y = -8064; {minimum y-axis plotting range, architectual C size paper} HP7570_AC_maximum_y = 8064; {maximum y-axis plotting range, architectual C size paper} HP7570_AD_minimum_x = -17208; {minimum x-axis plotting range, architectual D size paper} HP7570_AD_maximum_x = 17208; {maximum x-axis plotting range, architectual D size paper} HP7570_AD_minimum_y = -11592; {minimum y-axis plotting range, architectual D size paper} HP7570_AD_maximum_y = 11592; {maximum y-axis plotting range, architectual D size paper} HP7570_plotter_units = 1016.0; {number of plotter units per inch (40 per mm.)} HP7570_number_pens = 8; {number of pen colors in pen carousel} {Some numerical constants} pi = 3.1415926; screen_width = 1024.0; {Width of B/W landscape screen} screen_height = 800.0; {Height of B/W landscape screen} screen_diagonal = SQRT(SQR(screen_width)+SQR(screen_height)); {Used to approximate text size} {Number of bytes requested to be mapped into memory from the GMR vector command file by the MS_$MAPL and MS_$REMAP routines.} mapsize = 8192; {Request 8K bytes at a time} TYPE HP_plotter_t = (HP7475,HP7550,HP7570); {Type of Hewlitt Packard Plotter for which the output is destined} file_name_t = packed array[1..80] of char; {Input and output file name types} xy_pair = packed RECORD x: pinteger; {x coordinate of pair} y: pinteger; {y coordinate of pair} END; signed_xy_pair = packed RECORD x: integer16; {x coordinate of pair} y: integer16; {y coordinate of pair} END; xy_pair_real = packed RECORD x: real; {x coordinate of pair} y: real; {y coordinate of pair} END; xy_point_array = array [1..254] of xy_pair; paper_t = packed RECORD x: integer32; {max. x coord of paper being used} y: integer32; {max. y coord of paper being used} min_x: integer32; {minimum x value of paper in plotter units} max_x: integer32; {maximum x value of paper in plotter units} min_y: integer32; {minimum y value of paper in plotter units} max_y: integer32; {maximum y value of paper in plotter units} END; {Pointer to the buffer of GMR vector commands mapped into memory by the MS_$MAPL and MS_$REMAP routines.} byte_ptr_t = ^byte_array; byte_array = array[0..(mapsize-1)] of char; {Pointer types for the data records used by the various GMR commands} polyline_ptr_t = ^polyline_location; polyline_location = packed RECORD command: pinteger; {the GMR command} pairs: pinteger; {number of (x,y) pairs} data: array[1..1024] of xy_pair; {up to 1024 (x,y) coordinate pairs allowed by GMR} END; rectangle_ptr_t = ^rectangle_location; rectangle_location = packed RECORD command: pinteger; {the GMR command} data: array[1..2] of xy_pair; {2 (x,y) coordinate pairs} END; circle_ptr_t = ^circle_location; circle_location = packed RECORD command: pinteger; {the GMR command} center: xy_pair; {(x,y) of circle center} radius: pinteger; {circle radius} END; curve_ptr_t = ^curve_location; curve_location = packed RECORD command: pinteger; {the GMR command} ctype: pinteger; {curve type} pairs: pinteger; {number of (x,y) pairs} parameters: pinteger; {number of curve parameters} data: xy_point_array; END; pixel_ptr_t = ^pixel_location; pixel_location = packed RECORD command: pinteger; {the GMR command} location: xy_pair; {text location} rotation: real; {text rotation} parameters: pinteger; {number of bytes of text} data: packed array[1..1012] of char END; draw_value_ptr_t = ^draw_value_location; draw_value_location = packed RECORD command: pinteger; {the GMR command} value: linteger; {draw value} END; draw_style_ptr_t = ^draw_style_location; draw_style_location = packed RECORD command: pinteger; {the GMR command} value: pinteger; {draw style} replication: pinteger; {replication factor} bit_count: pinteger; {# of bits in the pattern} data: array[1..4] of pinteger; {the bit pattern} END; draw_rasterop_ptr_t = ^draw_rasterop_location; draw_rasterop_location = packed RECORD command: pinteger; {the GMR command} operation: pinteger; {draw raster operation} END; plane_mask_ptr_t = ^plane_mask_location; plane_mask_location = packed RECORD command: pinteger; {the GMR command} mask: pinteger; {plane mask} END; fill_value_ptr_t = ^fill_value_location; fill_value_location = packed RECORD command: pinteger; {the GMR command} value: linteger; {fill value} END; fill_pattern_ptr_t =^fill_pattern_location; fill_pattern_location = packed RECORD command: pinteger; {the GMR command} scale: pinteger; {pattern scale} size: xy_pair; {# bits in each row and column} data: array[1..32] of linteger; END; text_value_ptr_t = ^text_value_location; text_value_location = packed RECORD command: pinteger; {the GMR command} value: linteger; {text value} END; text_size_ptr_t = ^text_size_location; text_size_location = packed RECORD command: pinteger; {the GMR command} size: pinteger; {text size} END; font_family_ptr_t = ^font_family_location; font_family_location = packed RECORD command: pinteger; {the GMR command} id: pinteger; {font family id number} END; VAR {Definitions of input and output files} gmr_file_name: file_name_t; {GMR input file} hp_file_name: file_name_t; {HP-GL output file} gmr_name_length: pinteger; {length of GMR_FILE_NAME} hp_name_length: pinteger; {length of HP_FILE_NAME} hpfile: TEXT; {HP-GL plotter file variable for output} tempfile: array[1..8] of TEXT; {temporary files for sorting commands into by pen color} {Defintions of variables for mapping the input file into memory} mapl_ptr: UNIV_PTR; {pointer to first byte returned by MS_$MAPL or MS_$REMAP} data_ptr: UNIV_PTR; {pointer to first byte of GMR command in buffer} bytes_mapped: linteger; {number of bytes actually read by MS_$MAPL or MS_$REMAP} bytes_used: linteger; {number of bytes actually used from current buffer} byte_count: linteger; {number of bytes read from command portion of the GMR file} bytes_total: linteger; {length of command portion of GMR file in bytes} byte_ptr: byte_ptr_t; {pointer for calculating offset of next GMR command in buffer} {Definitions of pointers to GMR commands mapped into memory by MS_$MAPL} polyline_ptr: polyline_ptr_t; rectangle_ptr: rectangle_ptr_t; circle_ptr: circle_ptr_t; curve_ptr: curve_ptr_t; pixel_ptr: pixel_ptr_t; draw_value_ptr: draw_value_ptr_t; draw_style_ptr: draw_style_ptr_t; draw_rasterop_ptr: draw_rasterop_ptr_t; plane_mask_ptr: plane_mask_ptr_t; fill_value_ptr: fill_value_ptr_t; fill_pattern_ptr: fill_pattern_ptr_t; text_value_ptr: text_value_ptr_t; text_size_ptr: text_size_ptr_t; {Defintions of global variables} i,j: pinteger; {counters} plotter_type: HP_plotter_t; {Which HP plotter (HP 7475A, HP 7550A, or HP 7570A)} number_pens: pinteger; {number of pens available in this plotter} plotter_units: real; {number of plotter units/inch for this plotter} plot_size: xy_pair; {dimensions of GMR vector file being plotted} paper_size: paper_t; {dimensions of paper in plotter units} rotate: pinteger; {Rotate plot by either 0 or 90 degrees} plot_area: xy_pair_real; {Desired size of plot in inches} plot_origin: xy_pair_real; {Desired origin of plot in inches (0.0,0.0) in lower left corner} plot_ok: boolean; {Flag for plot orgin and area fit on paper ok} outline_plot: boolean; {Flag for outlining plotting area} answer: char; {One character answer to questions} size: array[1..2] of char; {Size on paper being used} status: integer32; {status returned by OPEN calls} eof_flag: boolean; {TRUE when GMR End-Of-File command processed} eof_error_flag: boolean; {TRUE if attempted to read beyond end of GMR file} gmr_size: pinteger; {length of the GMR command in bytes} gmr_command: pinteger; {GMR command code} hpcommand: array[1..256] of char; {HP-GL command line being copied during pen-color sorting} penlocation: array[1..8] of xy_pair; {current pen location} lostpen: array[1..8] of boolean; {TRUE if current pen location is unknown} pencolor: pinteger; {current pen color for sorting commands by pen color} draw_value: linteger; {pen color for lines being drawn} fill_value: linteger; {pen color for filled areas} text_value: linteger; {pen color for pixel-text} text_size: pinteger; {size of text in display pixels (scaled by PLOT_SIZE)} {Definitions of counters for number of unimplemented GMR commands ignored.} user_primative_cnt: linteger; {Number of GMR user-defined-primative commands ignored} draw_raster_cnt: linteger; {Number of GMR draw-raster commands ignored} plane_mask_cnt: linteger; {Number of GMR plane-mask commands ignored} fill_background_cnt:linteger; {Number of GMR fill-background commands ignored} text_background_cnt:linteger; {Number of GMR text-background commands ignored} font_family_cnt: linteger; {Number of GMR font-family commands ignored} PROCEDURE READ_GMR_HEADER ( IN file_name: file_name_t; IN name_length: pinteger; OUT max_size: xy_pair ); TYPE header_pointer_t = ^header_location; header_location = packed RECORD command_size: linteger; {# of bytes in command portion of file} x_size: pinteger; {max. x-dimension of GMR plotting area} y_size: pinteger; {max. y-dimension of GMR plotting area} unused: packed array[1..24] of char; END; VAR header_ptr: header_pointer_t; {GMR vector file header of 32 bytes} status: status_$t; {status returned by MS_$MAPL} i,j: INTEGER; {counters} BEGIN {Read first 32 bytes of file and check for errors. Note that MAPL_PTR has a data-type of UNIV_PTR, and that it must be copied to another pointer-variable with a regular Pascal record data-type before any of the data can be referenced.} mapl_ptr := MS_$MAPL (file_name,name_length,0,32,MS_$NR_XOR_1W, MS_$R,FALSE,bytes_mapped,status); IF status.all <> 0 THEN BEGIN WRITELN ('**** READ_GMR_HEADER: Error - bad file status returned reading GMR vector command file header ****'); PGM_$EXIT; END; header_ptr := mapl_ptr; {Set pointer so data can be accessed} max_size.x := header_ptr^.x_size; max_size.y := header_ptr^.y_size; bytes_total := header_ptr^.command_size; {Check that file header has a legal format.} j :=0; FOR i := 1 TO 24 DO j := j+ORD(header_ptr^.unused[i]); IF (j <> 0) OR (bytes_total = 0) OR (max_size.x =0) OR (max_size.y = 0) THEN BEGIN WRITELN ('**** READ_GMR_HEADER: Error - bad file header format for GMR vector command file ****'); PGM_$EXIT; END; {Advise operating system on how we will be accessing this file. (We will be getting variable length records from the file in a sequential manner).} MS_$ADVICE (mapl_ptr,bytes_mapped,MS_$SEQUENTIAL,[],mapsize,status); IF status.all <> 0 THEN BEGIN WRITELN ('**** READ_GMR_HEADER: Error - bad status while advising file access method ****'); PGM_$EXIT; END; byte_count := 0; {Haven't read any GMR commands yet} bytes_used := 32; {Used 32 bytes from header} byte_ptr := mapl_ptr; END; {End of Procedure READ_GMR_HEADER.} PROCEDURE CLOSE_GMR_FILE; VAR status: status_$t; {status returned by MS_$UNMAP} BEGIN MS_$UNMAP (mapl_ptr,bytes_mapped,status); IF status.all <> 0 THEN BEGIN WRITELN ('**** CLOSE_GMR_FILE: Error - bad file status returned closing GMR file ****'); PGM_$EXIT; END; END; {End of Procedure CLOSE_GMR_FILE.} PROCEDURE CHECK_GMR_FILE ( IN file_name: file_name_t; IN name_length: pinteger; OUT open_status: INTEGER32 ); VAR status: status_$t; {status returned by MS_$MAPL} BEGIN {Try to map in the vector file to see if it exists.} mapl_ptr := MS_$MAPL (file_name,name_length,0,32,MS_$NR_XOR_1W, MS_$R,FALSE,bytes_mapped,status); open_status := status.all; MS_$UNMAP (mapl_ptr,bytes_mapped,status); END; {End of Procedure CHECK_GMR_FILE.} PROCEDURE READ_GMR_COMMAND ( OUT command: pinteger; OUT data_ptr: UNIV_PTR; OUT error_flag: BOOLEAN ); TYPE command_ptr_t = ^pinteger; VAR pairs: pinteger; {number of (x,y) pairs in command} parameters: pinteger; {number of parameters in command} bytes: pinteger; {number of bytes used by command} command_ptr: command_ptr_t; {16-bit integer GMR command} status: status_$t; {status returned by MS_$MAPL} BEGIN {Read in GMR vector command (a 16-bit integer) and a pointer to the command plus its corresponding parameters. We map a full 8192 bytes into memory at once, and pass a universal pointer to the data block back to the main program. The command type can then be used to determine which kind of pointer variable must be used to access the parameters in the data block.} {Make sure we have enough of the GMR command mapped into memory so that we can calculate the length of the complete command. The GMR pixel-text command requires that at least the first 12 bytes of the command be in memory in order to calculate the total length of the command (including the data portion of the command).} IF (bytes_used+12 > bytes_mapped) THEN BEGIN mapl_ptr := MS_$REMAP (mapl_ptr,byte_count+32,8192,bytes_mapped,status); IF status.all <> 0 THEN BEGIN WRITELN ('**** READ_GMR_COMMAND: Error - bad file status returned reading GMR command ****'); WRITELN ('**** Reading byte: ',byte_count+32:10,' ****'); WRITELN ('**** Error code is: '); ERROR_$PRINT (status); WRITELN (''); PGM_$EXIT; END; bytes_used := 0; byte_ptr := mapl_ptr; END; data_ptr := ADDR(byte_ptr^[bytes_used]); {Set up universal pointer to start of current GMR command} command_ptr := data_ptr; {Set pointer so GMR command can be accessed} command := command_ptr^; {Get the GMR command type} CASE command OF {Compute the number of bytes in the GMR command} 16#0000: BEGIN {end of file} bytes := 2; END; 16#0020: BEGIN {polyline} polyline_ptr := data_ptr; pairs := polyline_ptr^.pairs; bytes := 4*(pairs+1); END; 16#0021: BEGIN {closed polyline} polyline_ptr := data_ptr; pairs := polyline_ptr^.pairs; bytes := 4*(pairs+1); END; 16#0022: BEGIN {filled polyline} polyline_ptr := data_ptr; pairs := polyline_ptr^.pairs; bytes := 4*(pairs+1); END; 16#0030: BEGIN {rectangle} bytes := 10; END; 16#0031: BEGIN {filled rectangle} bytes := 10; END; 16#0040: BEGIN {circle} bytes := 8; END; 16#0041: BEGIN {filled circle} bytes := 8; END; 16#0050: BEGIN {curve} curve_ptr := data_ptr; pairs := curve_ptr^.pairs; parameters := curve_ptr^.parameters; bytes := 8+4*(pairs+parameters); END; 16#0060: BEGIN {user-defined primative} curve_ptr := data_ptr; pairs := curve_ptr^.pairs; parameters := curve_ptr^.parameters; bytes := 8+4*(pairs+parameters); END; 16#0070: BEGIN {pixel text} pixel_ptr := data_ptr; parameters := pixel_ptr^.parameters; bytes := 12+parameters; IF ODD(parameters) THEN bytes := bytes+1; END; 16#0080: BEGIN {draw value} bytes := 6; END; 16#0081: BEGIN {draw style} bytes := 16; END; 16#0082: BEGIN {draw raster op} bytes := 4; END; 16#0083: BEGIN {plane mask} bytes := 4; END; 16#0090: BEGIN {fill value} bytes := 6; END; 16#0091: BEGIN {fill background value} bytes := 6; END; 16#0092: BEGIN {fill pattern} bytes := 136; END; 16#00A0: BEGIN {text value} bytes := 6; END; 16#00A1: BEGIN {text background value} bytes := 6; END; 16#00A2: BEGIN {text size} bytes := 4; END; 16#00A3: BEGIN {font family} bytes := 4; END; END; {If data for the GMR command is not already mapped into memory then remap the file into memory starting at the current GMR command.} IF (bytes_used+bytes > bytes_mapped) THEN BEGIN mapl_ptr := MS_$REMAP (mapl_ptr,byte_count+32,8192,bytes_mapped,status); IF status.all <> 0 THEN BEGIN WRITELN ('**** READ_GMR_COMMAND: Error - bad file status returned reading GMR command ****'); WRITELN ('**** Reading byte: ',byte_count+32:10,' ****'); WRITELN ('**** Error code is: '); ERROR_$PRINT (status); WRITELN (''); PGM_$EXIT; END; bytes_used := 0; byte_ptr := mapl_ptr; data_ptr := ADDR(byte_ptr^[bytes_used]); END; {Update the buffer pointer counter (BYTES_USED) and the EOF error counter (BYTE_COUNT) and check if we have tried to read beyond the end of the data in the GMR vector command file.} bytes_used := bytes_used+bytes; byte_count := byte_count+bytes; IF (byte_count > bytes_total) THEN BEGIN error_flag := TRUE; END; END; {End of Procedure READ_GMR_COMMAND.} PROCEDURE INIT_HPGL_FILE ( IN GMR_plot_size: xy_pair; IN paper_size: paper_t; IN plot_area: xy_pair_real; IN plot_origin: xy_pair_real; IN rotation: pinteger; IN outline_area: boolean ); VAR p1: signed_xy_pair; {lower left corner of plotting area in HP units} p2: signed_xy_pair; {upper right corner of plotting area in HP units} BEGIN {Make certain that the plotter is set up correctly. Reset the plotter to its default status. Setup the plotter to automatically scale the GMR plotting units to fit in the default plotting area (ie. set (0,y_max) to P1 (lower left corner of paper) and set (x_max,0) to P2 (upper right corner of paper). Note that we have flipped the plot upside down. GMR has (0,0) in the lower left corner of the screen and (x_max,y_max) in the upper right corner. The HP plotter also has the same coordinate convention. *HOWEVER* WHEN GMR WRITES THE VECTOR OUTPUT FILE, IT FLIPS THE PLOT UPSIDE DOWN. APPARENTLY THIS IS DONE BECAUSE THE SAME GMR OUTPUT CALL ALSO DOES BITMAP OUTPUT COMPATIBLE WITH GPR AND THE GPR COORDINATE SYSTEM HAS (0,0) IN THE UPPER LEFT CORNER. "It's not a bug, it's a feature!".} WRITE (hpfile,'DF;'); {Init. the plotter status} WRITE (hpfile,'RO',rotation:1,';'); {Set rotation 0 or 90 degrees} p1.x := ROUND(plot_origin.x*plotter_units); {Set P1 and P2 to mark edges of plotting area} p1.y := ROUND(plot_origin.y*plotter_units); p2.x := ROUND((plot_area.x+plot_origin.x)*plotter_units); p2.y := ROUND((plot_area.y+plot_origin.y)*plotter_units); IF (rotation = 0.0) THEN BEGIN {Compensate for rotation and origin of plotter} p1.x := p1.x+paper_size.min_x; p1.y := p1.y+paper_size.min_y; p2.x := p2.x+paper_size.min_x; p2.y := p2.y+paper_size.min_y; END ELSE BEGIN p1.x := p1.x+paper_size.min_y; p1.y := p1.y+paper_size.min_x; p2.x := p2.x+paper_size.min_y; p2.y := p2.y+paper_size.min_x; END; {Draw outline around plotting area} IF outline_area = TRUE THEN BEGIN WRITE (hpfile,'IP',p1.x:1,',',p1.y:1,',',p2.x:1,',',p2.y:1,';'); WRITE (hpfile,'SP1;PU',p1.x:1,',',p1.y:1,';EA',p2.x:1,',',p2.y:1,';'); END; {Set scale factors and P2 so that plot will fit inside the box defined by the plotting area without distorting the shape of the plot as defined by the GMR plot size. Also note that the scale factors flip the y-axis to correct for the GMR coordinate system.} IF (plot_area.x/GMR_plot_size.x) > (plot_area.y/GMR_plot_size.y) THEN BEGIN p2.x := p1.x+ROUND(plot_area.y*plotter_units*GMR_plot_size.x/GMR_plot_size.y); END ELSE BEGIN p2.y := p1.y+ROUND(plot_area.x*plotter_units*GMR_plot_size.y/GMR_plot_size.x); END; {Move P1 and P2 to actual edges of plot} WRITE (hpfile,'IP',p1.x:1,',',p1.y:1,',',p2.x:1,',',p2.y:1,';'); WRITELN (hpfile,'SC0,',GMR_plot_size.x:1,',',GMR_plot_size.y:1,',0;'); END; {End of Procedure INIT_HPGL_FILE.} PROCEDURE WRITE_HPGL_COMMAND ( IN command: pinteger; IN data_ptr: UNIV_PTR ); VAR i: pinteger; {counter} width: real; {width of pixel text characters} height: real; {height of pixel text characters} line_len: real; {length of dashed lines for draw-style (percentage of screen diagonal)} solid_len: pinteger; {length of soild portion of dashed line (pixels)} blank_len: pinteger; {length of blank portion of dashed line (pixels)} rep_factor: pinteger; {replication factor for each bit in patterned lines} pattern_len: pinteger; {length of patterned line (pixels)} arc_center: xy_pair; {center of 3-point arc for curve command} arc_angle: pinteger; {angle of arc length for curve command (degrees)} PROCEDURE move_pen_to ( IN location: xy_pair ); BEGIN IF (location.x <> penlocation[pencolor].x) OR (location.y <> penlocation[pencolor].y) OR (lostpen[pencolor]) THEN BEGIN WRITE (tempfile[pencolor],'PU',location.x:1,',', location.y:1,';'); END; penlocation[pencolor].x := location.x; penlocation[pencolor].y := location.y; lostpen[pencolor] := FALSE; END; {End of procedure MOVE_PEN_TO.} PROCEDURE leave_pen_at ( IN location: xy_pair ); BEGIN penlocation[pencolor].x := location.x; penlocation[pencolor].y := location.y; END; {End of procedure LEAVE_PEN_AT.} PROCEDURE lost_pen_position; BEGIN lostpen[pencolor] := TRUE; END; {End of procedure LOST_PEN_POSITION.} FUNCTION set_pencolor ( IN gmr_color_value: linteger ): INTEGER; BEGIN IF (gmr_color_value = 0) THEN BEGIN set_pencolor := number_pens; END ELSE BEGIN set_pencolor := ((gmr_color_value-1) mod number_pens)+1; END; END; {End of function SET_PENCOLOR.} FUNCTION float ( IN value: pinteger ): REAL; {Return a floating-point value from a non-negative 16-bit integer.} BEGIN float := value; END; {End of function FLOAT.} FUNCTION atan2 ( IN x: REAL; IN y: REAL ): REAL; {Caculate the arc whose tangent is Y/X, returning a value in the range 0 to 2*PI. The Pascal function ARCTAN returns a value in the range -PI/2 to +PI/2.} BEGIN {Check for division by 0 before computing the tangent.} IF x = 0.0 THEN IF y > 0.0 THEN atan2 := pi/2.0 ELSE atan2 := pi*3.0/2.0 ELSE IF (x > 0.0) AND (y >= 0.0) THEN atan2 := ARCTAN(y/x) ELSE IF (x < 0.0) AND (y >= 0.0) THEN atan2 := ARCTAN(y/x)+pi ELSE IF (x < 0.0) AND (y < 0.0) THEN atan2 := ARCTAN(y/x)+pi ELSE IF (x > 0.0) AND (y < 0.0) THEN atan2 := ARCTAN(y/x)+2*pi; END; {End of funtion ATAN2.} PROCEDURE find_arc_center ( IN points: xy_point_array; OUT center: xy_pair ); {Calculate the coordinates of the center of a circle given the (x,y) coordinates of three points on the circle. We do this by noting that the line which perpendicularly bisects any chord of the circle will pass through the center of the circle. We compute the lines y=a*x+b which connect the points on the circle (the chords defined by the 3 points), then we find the lines y=c*x+d which perpendicularly bisect the chords. The center of the circle is at the intersection of the bisecting lines.} VAR i: pinteger; {counter} a: array[1..2] of real; {slope of chords of the circle} b: array[1..2] of real; {y-axis intersection of chords of the circle} c: array[1..2] of real; {slope of bisecting lines of the chords} d: array[1..2] of real; {y-axis intersection of bisecting lines of the chords} x: array[1..3] of integer32; y: array[1..3] of integer32; {copies of the (x,y) points so can do full precision arithmetic (POINTS is an array of PINTEGER - only positive integers!)} BEGIN FOR i := 1 TO 3 DO BEGIN x[i] := points[i].x; y[i] := points[i].y; END; {Compute lines y=a*x+b between points on the circle.} a[1] := (y[1]-y[2])/(x[1]-x[2]); b[1] := y[1]-a[1]*x[1]; a[2] := (y[2]-y[3])/(x[2]-x[3]); b[2] := y[2]-a[2]*x[2]; {Compute the perpendicular bisecting lines y=c*x+d.} c[1] := -1.0/a[1]; d[1] :=(y[1]+y[2])/2.0-c[1]*(x[1]+x[2])/2.0; c[2] := -1.0/a[2]; d[2] :=(y[2]+y[3])/2.0-c[2]*(x[2]+x[3])/2.0; {Compute intersection of the bisecting lines y=c*x+d.} center.x := ROUND((d[2]-d[1])/(c[1]-c[2])); center.y := ROUND(c[1]*center.x+d[1]); END; {End of procedure FIND_ARC_CENTER.} PROCEDURE evaluate_spline ( IN points: xy_point_array; IN n: pinteger ); VAR i,j: pinteger; dx: array[1..254] of real; dy: array[1..254] of real; ux: array[1..254] of real; uy: array[1..254] of real; wx: array[1..254] of real; wy: array[1..254] of real; px: array[1..254] of real; py: array[1..254] of real; t: real; spline_value_x: pinteger; spline_value_y: pinteger; BEGIN {Compute parametric cubic spline parameters, PX[I] and PY[I].} FOR i := 2 TO n-1 DO BEGIN dx[i] := 2*(float(i+1)-float(i-1)); END; FOR i := 1 TO n-1 DO BEGIN ux[i] := float(i+1)-float(i); END; FOR i := 2 TO n-1 DO BEGIN wx[i] := (float(points[i+1].x)-float(points[i].x))/ux[i] -(float(points[i].x)-float(points[i-1].x))/ux[i-1]; END; FOR i := 2 TO n-2 DO BEGIN wx[i+1] := wx[i+1]-wx[i]*ux[i]/dx[i]; dx[i+1] := dx[i+1]-ux[i]*ux[i]/dx[i]; END; px[1] := 0.0; px[n] := 0.0; FOR i := n-1 DOWNTO 2 DO BEGIN px[i] := (wx[i]-ux[i]*px[i+1])/dx[i]; END; FOR i := 2 TO n-1 DO BEGIN dy[i] := 2*(float(i+1)-float(i-1)); END; FOR i := 1 TO n-1 DO BEGIN uy[i] := float(i+1)-float(i); END; FOR i := 2 TO n-1 DO BEGIN wy[i] := (float(points[i+1].y)-float(points[i].y))/uy[i] -(float(points[i].y)-float(points[i-1].y))/uy[i-1]; END; FOR i := 2 TO n-2 DO BEGIN wy[i+1] := wy[i+1]-wy[i]*uy[i]/dy[i]; dy[i+1] := dy[i+1]-uy[i]*uy[i]/dy[i]; END; py[1] := 0.0; py[n] := 0.0; FOR i := n-1 DOWNTO 2 DO BEGIN py[i] := (wy[i]-uy[i]*py[i+1])/dy[i]; END; {Evaluate the spline at each spline point and at 9 points in between each pair of adjacent spline points.} move_pen_to (points[1]); WRITE (tempfile[pencolor],'PD'); FOR i := 1 TO n-1 DO BEGIN FOR j := 1 TO 9 DO BEGIN t := 0.1*j; spline_value_x := ROUND(t*float(points[i+1].x)+(1-t)*float(points[i].x) +ux[i]*ux[i]*((t*t*t-t)*px[i+1]+((1-t)*(1-t)*(1-t)-(1-t))*px[i])); spline_value_y := ROUND(t*float(points[i+1].y)+(1-t)*float(points[i].y) +uy[i]*uy[i]*((t*t*t-t)*py[i+1]+((1-t)*(1-t)*(1-t)-(1-t))*py[i])); WRITE (tempfile[pencolor],spline_value_x:1,',',spline_value_y:1,','); END; WRITE (tempfile[pencolor],points[i+1].x:1,',',points[i+1].y:1); IF i <> n-1 THEN WRITE (tempfile[pencolor],',') ELSE WRITELN (tempfile[pencolor],';'); END; leave_pen_at (points[n]); END; {End of procedure EVALUATE_SPLINE.} {Start of main body of WRITE_HPGL_COMMAND.} BEGIN CASE command OF 16#0000: BEGIN {END-OF-FILE COMMAND} eof_flag := true; {Signal to close files} END; 16#0020: BEGIN {POLYLINE COMMAND} polyline_ptr := data_ptr; pencolor := set_pencolor(draw_value); move_pen_to(polyline_ptr^.data[1]); WRITE (tempfile[pencolor],'PD',polyline_ptr^.data[2].x:1, ',',polyline_ptr^.data[2].y:1); IF polyline_ptr^.pairs > 2 THEN BEGIN FOR i := 3 to polyline_ptr^.pairs DO BEGIN WRITE (tempfile[pencolor],',',polyline_ptr^.data[i].x:1, ',',polyline_ptr^.data[i].y:1); END; END; WRITELN (tempfile[pencolor],';'); leave_pen_at (polyline_ptr^.data[polyline_ptr^.pairs]); END; 16#0021: BEGIN {CLOSED POLYLINE COMMAND} polyline_ptr := data_ptr; pencolor := set_pencolor(draw_value); move_pen_to(polyline_ptr^.data[1]); WRITE (tempfile[pencolor],'PD',polyline_ptr^.data[2].x:1, ',',polyline_ptr^.data[2].y:1); IF polyline_ptr^.pairs > 2 THEN BEGIN FOR i := 3 to polyline_ptr^.pairs DO BEGIN WRITE (tempfile[pencolor],',',polyline_ptr^.data[i].x:1, ',',polyline_ptr^.data[i].y:1); END; END; WRITELN (tempfile[pencolor],',',polyline_ptr^.data[1].x:1, ',',polyline_ptr^.data[1].y:1,';'); leave_pen_at (polyline_ptr^.data[1]); END; 16#0022: BEGIN {FILLED POLYLINE COMMAND} polyline_ptr := data_ptr; pencolor := set_pencolor(fill_value); move_pen_to(polyline_ptr^.data[1]); WRITE (tempfile[pencolor],'PM0;'); WRITE (tempfile[pencolor],'PD',polyline_ptr^.data[2].x:1, ',',polyline_ptr^.data[2].y:1); FOR i := 3 to polyline_ptr^.pairs DO BEGIN WRITE (tempfile[pencolor],',',polyline_ptr^.data[i].x:1, ',',polyline_ptr^.data[i].y:1); END; WRITE (tempfile[pencolor],',',polyline_ptr^.data[1].x:1, ',',polyline_ptr^.data[1].y:1,';'); WRITELN (tempfile[pencolor],'PM2;FP;EP;'); leave_pen_at (polyline_ptr^.data[1]); END; 16#0030: BEGIN {RECTANGLE COMMAND} rectangle_ptr := data_ptr; {Note: can't use the HPGL command 'EA' to} pencolor := set_pencolor(draw_value); { just edge a rectangle - the 'LT' command} move_pen_to (rectangle_ptr^.data[1]); { used to set the draw-style doesn't work} WRITELN (tempfile[pencolor],'PD',rectangle_ptr^.data[2].x:1, { with the 'EA' command!!!} ',',rectangle_ptr^.data[1].y:1,',',rectangle_ptr^.data[2].x:1, ',',rectangle_ptr^.data[2].y:1,',',rectangle_ptr^.data[1].x:1, ',',rectangle_ptr^.data[2].y:1,',',rectangle_ptr^.data[1].x:1, ',',rectangle_ptr^.data[1].y:1,';'); leave_pen_at (rectangle_ptr^.data[1]); END; 16#0031: BEGIN {FILLED RECTANGLE COMMAND} rectangle_ptr := data_ptr; pencolor := set_pencolor(fill_value); move_pen_to (rectangle_ptr^.data[1]); WRITE (tempfile[pencolor],'RA',rectangle_ptr^.data[2].x:1, {Note: RA will define and fill the} ',',rectangle_ptr^.data[2].y:1,';'); { rectangle, EP will outline it. No WRITELN (tempfile[pencolor],'EP;'); { FP is needed to fill the outline.} leave_pen_at (rectangle_ptr^.data[1]); END; 16#0040: BEGIN {CIRCLE COMMAND} circle_ptr := data_ptr; pencolor := set_pencolor(draw_value); WRITE (tempfile[pencolor],'PU',circle_ptr^.center.x:1, ',',circle_ptr^.center.y:1,';'); WRITELN (tempfile[pencolor],'CI',circle_ptr^.radius:1,',5;'); END; 16#0041: BEGIN {FILLED CIRCLE COMMAND} circle_ptr := data_ptr; pencolor := set_pencolor(fill_value); move_pen_to (circle_ptr^.center); WRITE (tempfile[pencolor],'PM0;'); WRITE (tempfile[pencolor],'CI',circle_ptr^.radius:1,',5;'); WRITELN (tempfile[pencolor],'PM2;FP;EP;'); leave_pen_at (circle_ptr^.center); END; 16#0050: BEGIN {CURVE COMMAND} curve_ptr := data_ptr; pencolor := set_pencolor(draw_value); CASE curve_ptr^.ctype OF 0: BEGIN evaluate_spline (curve_ptr^.data,curve_ptr^.pairs); END; 1: BEGIN find_arc_center(curve_ptr^.data,arc_center); arc_angle := ROUND(atan2((float(curve_ptr^.data[1].x)-float(arc_center.x)), (float(curve_ptr^.data[1].y)-float(arc_center.y))) *180.0/pi) -ROUND(atan2((float(curve_ptr^.data[3].x)-float(arc_center.x)), (float(curve_ptr^.data[3].y)-float(arc_center.y))) *180.0/pi); move_pen_to (curve_ptr^.data[1]); WRITELN (tempfile[pencolor],'PD;AA',arc_center.x:1,',', arc_center.y:1,',',arc_angle:1,';'); leave_pen_at (curve_ptr^.data[3]); END; END; END; 16#0060: BEGIN {USER-DEFINED PRIMATIVE COMMAND} IF (user_primative_cnt = 0) THEN BEGIN writeln ('GMR user-defined primative command not implemented'); END; user_primative_cnt := user_primative_cnt+1; END; 16#0070: BEGIN {PIXEL TEXT COMMAND} pixel_ptr := data_ptr; pencolor := set_pencolor(text_value); width := text_size/plot_size.x*100.0*0.55; {Calculate text size in terms of} height := text_size/plot_size.x*(plot_size.x/plot_size.y)*100.0*0.90; { percentage of maximum-x value.} move_pen_to (pixel_ptr^.location); WRITE (tempfile[pencolor],'SR',width:7:3, ',',height:7:3,';'); WRITE (tempfile[pencolor],'DR',COS(-(pixel_ptr^.rotation*pi/180.0)):7:5, ',',SIN(-(pixel_ptr^.rotation*pi/180.0)):7:5,';'); WRITE (tempfile[pencolor],'DT',etx,';'); WRITE (tempfile[pencolor],'LB'); FOR i := 1 TO pixel_ptr^.parameters DO BEGIN WRITE (tempfile[pencolor],pixel_ptr^.data[i]); END; WRITELN (tempfile[pencolor],etx); lost_pen_position; {We have lost the current pen position during} { writing of text. Setup a new one.} END; 16#0080: BEGIN {DRAW VALUE COMMAND} draw_value_ptr := data_ptr; draw_value := draw_value_ptr^.value; END; 16#0081: BEGIN {DRAW STYLE COMMAND} pencolor := set_pencolor(draw_value); draw_style_ptr := data_ptr; CASE (draw_style_ptr^.value) OF 0: WRITELN (tempfile[pencolor],'LT;'); {0 = solid line} 1: BEGIN solid_len := draw_style_ptr^.replication; blank_len := draw_style_ptr^.bit_count; line_len := (solid_len*2)/screen_diagonal*100.0; CASE plotter_type OF HP7475: WRITELN (tempfile[pencolor],'LT2,',line_len:7:3,';'); HP7550: WRITELN (tempfile[pencolor],'LT-2,',line_len:7:3,';'); HP7570: WRITELN (tempfile[pencolor],'LT-2,',line_len:7:3,';'); END; END; 2: BEGIN rep_factor := draw_style_ptr^.replication; pattern_len := draw_style_ptr^.bit_count; line_len := pattern_len/screen_diagonal*100.0; CASE plotter_type OF HP7475: WRITELN (tempfile[pencolor],'LT',((rep_factor mod 6)+1):1,',',line_len:7:3,';'); HP7550: WRITELN (tempfile[pencolor],'LT',-((rep_factor mod 6)+1):1,',',line_len:7:3,';'); HP7570: WRITELN (tempfile[pencolor],'LT',-((rep_factor mod 6)+1):1,',',line_len:7:3,';'); END; END; END; END; 16#0082: BEGIN {DRAW RASTER OP COMMAND} IF (draw_raster_cnt = 0) THEN BEGIN writeln ('GMR draw raster op command not implemented'); END; draw_raster_cnt := draw_raster_cnt+1; END; 16#0083: BEGIN {PLANE MASK COMMAND} IF (plane_mask_cnt = 0) THEN BEGIN writeln ('GMR plane mask command not implemented'); END; plane_mask_cnt := plane_mask_cnt+1; END; 16#0090: BEGIN {FILL VALUE COMMAND} fill_value_ptr := data_ptr; fill_value := fill_value_ptr^.value; END; 16#0091: BEGIN {FILL BACKGROUND VALUE COMMAND} IF (fill_background_cnt = 0) THEN BEGIN writeln ('GMR fill background value command not implemented'); END; fill_background_cnt := fill_background_cnt+1; END; 16#0092: BEGIN {FILL PATTERN COMMAND} fill_pattern_ptr := data_ptr; pencolor := set_pencolor(fill_value); IF fill_pattern_ptr^.scale = 0 THEN BEGIN WRITELN (tempfile[pencolor],'FT1;'); END ELSE BEGIN WRITELN (tempfile[pencolor],'FT', (((fill_pattern_ptr^.scale - 1) mod 4)+1):1, ',',ROUND((fill_pattern_ptr^.size.x/1024.0)*plot_size.x):1 ,',',fill_pattern_ptr^.size.y:1,';'); END; END; 16#00A0: BEGIN {TEXT VALUE COMMAND} text_value_ptr := data_ptr; text_value := text_value_ptr^.value; END; 16#00A1: BEGIN {TEXT BACKGROUND VALUE COMMAND} IF (text_background_cnt = 0) THEN BEGIN writeln ('GMR text background value command not implemented'); END; text_background_cnt := text_background_cnt+1; END; 16#00A2: BEGIN {TEXT SIZE COMMAND} text_size_ptr := data_ptr; text_size := text_size_ptr^.size; END; 16#00A3: BEGIN {FONT FAMILY COMMAND} IF (font_family_cnt = 0) THEN BEGIN writeln ('GMR font family command not implemented'); END; font_family_cnt := font_family_cnt+1; END; END; END; {End of Procedure WRITE_HPGL_COMMAND.} PROCEDURE CLOSE_HPGL_FILE; BEGIN {Make certain that the HP plotter is reset.} WRITE (hpfile,'RO0;'); {Reset coordinate rotation} WRITE (hpfile,'IP;'); {Reset P1 and P2 locations} WRITE (hpfile,'SP0;'); {Put pen away} WRITELN (hpfile,'DF;'); {Reset plotter status} CLOSE (hpfile); {Close the output file} END; {End of Procedure CLOSE_HPGL_FILE.} PROCEDURE CONVERT_TO_UPPERCASE ( IN OUT character: char ); BEGIN {Convert a single ascii character to uppercase} IF (character >= 'a') AND (character <= 'z') THEN BEGIN character := CHR(ORD(character)&16#DF); END; END; {End of Procedure CONVERT_TO_UPPERCASE.} BEGIN {Type initial greetings to user.} WRITELN ('This is HPPLOT Version ',version_number:-1,'.'); WRITELN; {Get the names of the input and output files and open the output file for writting the HP-GL plotter commands into it. The input file is an unstructured data object, and must be accessed with the MS_$MAPL system call which opens the file, locks it, and reads a specified number of bytes into memory.} REPEAT WRITE ('Enter name of GMR vector file for input: '); READLN (gmr_file_name); gmr_name_length := 80; check_gmr_file (gmr_file_name,gmr_name_length,status); IF status <> 0 THEN BEGIN WRITELN ('**** HPPLOT: Error - unable to open input file: ', gmr_file_name:-1,' ****'); END; UNTIL status = 0; WRITE ('Enter name of HP-GL file for output: '); READLN (hp_file_name); hp_name_length := 80; OPEN (hpfile,hp_file_name,'UNKNOWN',status); REWRITE (hpfile); {Get the type of HP plotter to receive the output.} REPEAT WRITELN ('Enter HP plotter type'); WRITE('(''7475'', ''7550'', or ''7570''): '); READLN (i); UNTIL (i = 7475) OR (i = 7550) OR (i = 7570); CASE i OF 7475: plotter_type := HP7475; 7550: plotter_type := HP7550; 7570: plotter_type := HP7570; END; {Get the size of the plotting area available. Use A or B size paper only for the HP 7475A and HP 7550A plotters. Use C or D size paper only for the HP 7570A plotter. Note that maximum sizes of A and B size paper (in plotter units) are slightly different for the HP 7475A and the HP 7550A plotters.} IF (plotter_type = HP7475) THEN BEGIN number_pens := HP7475_number_pens; plotter_units := HP7475_plotter_units; REPEAT WRITELN ('Enter paper size to use'); WRITE('(''A'' for 8 1/2" by 11" or ''B'' for 11" by 17"): '); READLN (answer); convert_to_uppercase (answer); UNTIL (answer = 'A') OR (answer = 'B'); IF answer = 'A' THEN BEGIN paper_size.min_x := HP7475_A_minimum_x; {min x size using A size paper} paper_size.max_x := HP7475_A_maximum_x; {max x size using A size paper} paper_size.min_y := HP7475_A_minimum_y; {min y size using A size paper} paper_size.max_y := HP7475_A_maximum_y; {max y size using A size paper} END ELSE BEGIN paper_size.min_x := HP7475_B_minimum_x; {min x size using B size paper} paper_size.max_x := HP7475_B_maximum_x; {max x size using B size paper} paper_size.min_y := HP7475_B_minimum_y; {min y size using B size paper} paper_size.max_y := HP7475_B_maximum_y; {max y size using B size paper} END; END ELSE IF (plotter_type = HP7550) THEN BEGIN number_pens := HP7550_number_pens; plotter_units := HP7550_plotter_units; REPEAT WRITELN ('Enter paper size to use'); WRITE('(''A'' for 8 1/2" by 11" or ''B'' for 11" by 17"): '); READLN (answer); convert_to_uppercase (answer); UNTIL (answer = 'A') OR (answer = 'B'); IF answer = 'A' THEN BEGIN paper_size.min_x := HP7550_A_minimum_x; {min x size using A size paper} paper_size.max_x := HP7550_A_maximum_x; {max x size using A size paper} paper_size.min_y := HP7550_A_minimum_y; {min y size using A size paper} paper_size.max_y := HP7550_A_maximum_y; {max y size using A size paper} END ELSE BEGIN paper_size.min_x := HP7550_B_minimum_x; {min x size using B size paper} paper_size.max_x := HP7550_B_maximum_x; {max x size using B size paper} paper_size.min_y := HP7550_B_minimum_y; {min y size using B size paper} paper_size.max_y := HP7550_B_maximum_y; {max y size using B size paper} END; END ELSE IF (plotter_type = HP7570) THEN BEGIN number_pens := HP7570_number_pens; plotter_units := HP7570_plotter_units; REPEAT WRITELN ('Enter paper size to use'); WRITELN ('(''C'' for 17" by 22", ''D'' for 22" by 34"),'); WRITE ('(''AC'' for 18" by 24" or ''AD'' for 24" by 36"): '); READLN (size); convert_to_uppercase (size[1]); convert_to_uppercase (size[2]); UNTIL (size = 'C ') OR (size = 'D ') OR (size = 'AC') OR (size = 'AD'); IF size = 'C ' THEN BEGIN paper_size.min_x := HP7570_C_minimum_x; {min x size using C size paper} paper_size.max_x := HP7570_C_maximum_x; {max x size using C size paper} paper_size.min_y := HP7570_C_minimum_y; {min y size using C size paper} paper_size.max_y := HP7570_C_maximum_y; {max y size using C size paper} END ELSE IF size = 'D ' THEN BEGIN paper_size.min_x := HP7570_D_minimum_x; {min x size using D size paper} paper_size.max_x := HP7570_D_maximum_x; {max x size using D size paper} paper_size.min_y := HP7570_D_minimum_y; {min y size using D size paper} paper_size.max_y := HP7570_D_maximum_y; {max y size using D size paper} END ELSE IF size = 'AC' THEN BEGIN paper_size.min_x := HP7570_AC_minimum_x; {min x size using architectural-C size paper} paper_size.max_x := HP7570_AC_maximum_x; {max x size using architectural-C size paper} paper_size.min_y := HP7570_AC_minimum_y; {min y size using architectural-C size paper} paper_size.max_y := HP7570_AC_maximum_y; {max y size using architectural-C size paper} END ELSE IF size = 'AD' THEN BEGIN paper_size.min_x := HP7570_AD_minimum_x; {min x size using architectural-D size paper} paper_size.max_x := HP7570_AD_maximum_x; {max x size using architectural-D size paper} paper_size.min_y := HP7570_AD_minimum_y; {min y size using architectural-D size paper} paper_size.max_y := HP7570_AD_maximum_y; {max y size using architectural-D size paper} END; END; {Read and translate GMR vector files until the user is done.} REPEAT REPEAT WRITE ('Enter plot rotation (0 or 90 degrees): '); READLN (rotate); UNTIL (rotate = 0) OR (rotate = 90); IF rotate = 0 THEN BEGIN paper_size.x := paper_size.max_x-paper_size.min_x; paper_size.y := paper_size.max_y-paper_size.min_y; END ELSE BEGIN paper_size.x := paper_size.max_y-paper_size.min_y; paper_size.y := paper_size.max_x-paper_size.min_x; END; REPEAT plot_ok := TRUE; WRITELN ('Enter desired origin of plot in inches (0.0,0.0)'); WRITE ('is located in lower left corner of the paper: '); READLN (plot_origin.x,plot_origin.y); IF (plot_origin.x >= 0.0) AND (plot_origin.y >= 0.0) THEN BEGIN WRITELN ('Enter desired size of plot in inches.'); WRITE ('(Maximum size possible is ',((paper_size.x/plotter_units) -plot_origin.x):2:1,' by ',((paper_size.y/plotter_units) -plot_origin.y):2:1,') : '); READLN (plot_area.x,plot_area.y); IF ((plot_area.x+plot_origin.x)*plotter_units > paper_size.x) OR ((plot_area.y+plot_origin.y)*plotter_units > paper_size.y) THEN BEGIN WRITELN ('**** HPPLOT: Error - Plot will not fit on page ****'); WRITELN ('**** Try new orign and size ****'); plot_ok := FALSE; END; END ELSE BEGIN WRITELN ('**** HPPLOT: Error - Plot origin is not on the page ****'); plot_ok := FALSE; END; UNTIL plot_ok; {See if user wants an outline drawn around the plotting area.} REPEAT WRITE ('Outline the plotting area? (Y or N): '); READLN (answer); convert_to_uppercase (answer); UNTIL (answer = 'Y') OR (answer = 'N'); WRITELN (''); IF answer = 'Y' THEN BEGIN outline_plot := TRUE; END ELSE BEGIN outline_plot := FALSE; END; {Read the GMR file header (first 32 bytes of file).} read_gmr_header (gmr_file_name,gmr_name_length,plot_size); {Initialize the HP plotter.} init_HPGL_file (plot_size,paper_size,plot_area, plot_origin,rotate,outline_plot); {Open temporary files for sorting commands into according to the current pen color. Set the default pen color to 1. Set the pen location to 'LOST'.} FOR i := 1 TO number_pens DO REWRITE (tempfile[i]); draw_value := 1; fill_value := 1; text_value := 1; pencolor := 1; FOR i := 1 TO number_pens DO lostpen[i] := TRUE; {Read GMR commands from the GMR vector file and translate them it HP-GL commands. Continue until a GMR end-of-file command code is found. Check that number of bytes read from vector file does not exceed the number of bytes in the command portion of the file given by the file header.} eof_flag := false; eof_error_flag := false; user_primative_cnt := 0; draw_raster_cnt := 0; plane_mask_cnt := 0; fill_background_cnt := 0; text_background_cnt := 0; font_family_cnt := 0; REPEAT read_GMR_command (gmr_command,data_ptr,eof_error_flag); {read GMR vector command byte} IF (eof_error_flag = false) THEN BEGIN write_HPGL_command (gmr_command,data_ptr); {translate it to HP-GL} END ELSE BEGIN WRITELN ('**** HPPLOT: Error - Attempted to read more GMR command bytes than are ****'); WRITELN ('**** specified in GMR vector command file header. ****'); END; UNTIL (eof_flag = TRUE) OR (eof_error_flag = TRUE); {All done translating the GMR commands. Now append the temporary pen-color files together with the HP plotter initialization already in the output file to create the HP-GL command file sorted by pen color.} FOR i := 1 TO number_pens DO BEGIN RESET (tempfile[i]); IF NOT EOF(tempfile[i]) THEN WRITELN (hpfile,'SP',i:1,';'); WHILE NOT EOF(tempfile[i]) DO BEGIN READLN (tempfile[i],hpcommand); WRITELN (hpfile,hpcommand:-1); END; END; {All done for this vector file. Close the GMR input file and the temporary files. They will be deleted as they are closed.} close_gmr_file (); FOR i := 1 TO number_pens DO CLOSE (tempfile[i]); {Report number of unimplemented GMR commands which had to be thrown away because they deal soley with raster operations or (in the case of the font-family id) they don't provide any useful information to the program.} WRITELN (''); IF (user_primative_cnt <> 0) THEN BEGIN WRITELN (user_primative_cnt,' GMR User-Defined-Primative commands were discarded.'); END; IF (draw_raster_cnt <> 0) THEN BEGIN WRITELN (draw_raster_cnt,' GMR Draw-Raster-Op commands were discarded.'); END; IF (plane_mask_cnt <> 0) THEN BEGIN WRITELN (plane_mask_cnt,' GMR Plane-Mask commands were discarded.'); END; IF (fill_background_cnt <> 0) THEN BEGIN WRITELN (fill_background_cnt,' GMR Fill-Background-Value commands were discarded.'); END; IF (text_background_cnt <> 0) THEN BEGIN WRITELN (text_background_cnt,' GMR Text-Background-Value commands were discarded.'); END; IF (font_family_cnt <> 0) THEN BEGIN WRITELN (font_family_cnt,' GMR Font-Family commands were discarded.'); END; WRITELN (''); {See if user wants to put another GMR plot on the same page.} REPEAT WRITE ('Add another GMR vector file to the plot? (Y or N): '); READLN (answer); convert_to_uppercase (answer); UNTIL (answer = 'Y') OR (answer = 'N'); IF answer = 'Y' THEN BEGIN REPEAT WRITE ('Enter name of GMR vector file for input: '); READLN (gmr_file_name); gmr_name_length := 80; check_gmr_file (gmr_file_name,gmr_name_length,status); IF status <> 0 THEN BEGIN WRITELN ('**** HPPLOT: Error - unable to open input file: ', gmr_file_name:-1,' ****'); END; UNTIL status = 0; END; {End of read and translate loop. If no more GMR vector files to read and translate, then close the HPGL output file and we're done.} UNTIL answer = 'N'; close_HPGL_file; {***** End of Program HPPLOT.PAS *****} END. SHAR_EOF chmod +x 'hpplot.pas' fi # end of overwriting check # End of shell archive exit 0 .