home *** CD-ROM | disk | FTP | other *** search
/ Graphics 16,000 / graphics-16000.iso / msdos / viewers / hpglvu10 / hpglview.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-18  |  33KB  |  999 lines

  1. program HPGLVIEW;
  2. {-----------------------------------------------------------------------------}
  3.  (*                          An HPGL viewer
  4.  
  5.     The viewer takes a file of HPGL commands and displays the plot commands
  6.     on the screen.
  7.  
  8.     It always represents the page (A3 or A4) lying sideways on the
  9.     screen, to preserve the maximum resolution, and ignores the aspect ratio
  10.     of the screen for the same reason.
  11.  
  12.     Its designed to show you what the plot looks like on the page not be
  13.     an absolute mimic of a plot.  If you need absolute precision, plot it.
  14.  
  15. -------------------------------------------------------------------------------
  16.             HPGLVIEW - a on-screen Previewer for HPGL files
  17.     
  18.                 Copyright (C) 1991 Giovanni S. Moretti
  19.  
  20.     This program is free software; you can redistribute it and/or modify
  21.     it under the terms of the GNU General Public License as published by
  22.     the Free Software Foundation; either version 1, or (at your option)
  23.     any later version.
  24.  
  25.     This program is distributed in the hope that it will be useful,
  26.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  27.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  28.     GNU General Public License for more details.
  29.  
  30.     You should have received a copy of the GNU General Public License
  31.     along with this program; if not, write to the Free Software
  32.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  33.  
  34. -----------------------------------------------------------------------------
  35.     Giovanni Moretti                    | EMAIL:  G.Moretti@massey.ac.nz
  36.     Computer Centre,  Massey University |  
  37.     Palmerston North, New Zealand       |
  38. -----------------------------------------------------------------------------
  39.  
  40.    Please send me a copy of any major hacks/improvements so I can coordinate
  41.    any new releases.
  42.  
  43.    HP-GL is (probably) a trademark of Hewlett-Packard Company.
  44.  
  45. *)
  46. {-----------------------------------------------------------------------------}
  47. { RCS Control Information
  48.   $Author: Giovanni_Moretti $
  49.   $Date: 91/04/18 15:57:59 $
  50.   $Revision: 1.1 $
  51.   $Log:    hpglview.pas $
  52. Revision 1.1  91/04/18  15:57:59  ROOT_DOS
  53. Initial revision
  54.  
  55. uses graph, dos, crt, smalfont, { Like FONTS.PAS with only SMALLFONT left}
  56.      drivers;
  57.  
  58. const A3_char_width  = 0.285; {cm}
  59.       A3_char_height = 0.375;
  60.  
  61.       A4_char_width  = 0.187;
  62.       A4_char_height = 0.269;
  63.  
  64.       unknown_max    = 100;
  65.  
  66. var pen_down     : boolean;
  67.     cmd          : string;          {Current HPGL command being done}
  68.     x, y, x1,y1  : real;            {and the numeric arguments to this cmd}
  69.     lbl          : string;          {or a character string arg for LB cmd }
  70.  
  71.     filename     : string;
  72.     inf          : text;            {Input file}
  73.  
  74.     screen_max_X : integer;         {No of dots across screen -1}
  75.     screen_max_Y : integer;         {and number down            }
  76.  
  77.     Graphics_Driver  : integer;     { for BGI - may be set manually with /G }
  78.     Graphics_mode    : integer;     { for BGI - may be set manually with /G }
  79. {-----------------------------------------------------------------------------}
  80.     use_plotter_units : boolean;    {If TRUE => NO Scaling, FALSE => Scale}
  81.  
  82.     x_max        : real;            {Maximum and Minimum values as defined}
  83.     x_min        : real;            {by the SC (Scale) command            }
  84.     y_max        : real;
  85.     y_min        : real;
  86.  
  87.     x_p1, y_p1   : integer;
  88.     x_p2, y_p2   : integer;
  89. {-----------------------------------------------------------------------------}
  90.     Paper_size     : integer;         {Either a 3 or 4 (A3 or A4) }
  91.     X_plot_area_mm : integer;
  92.     Y_plot_area_mm : integer;
  93.     args           : boolean;
  94.     hard_clip_X    : integer;
  95.     hard_clip_Y    : integer;
  96.  
  97.     colour         : integer;         {Current colour from video palette}
  98. {-----------------------------------------------------------------------------}
  99.     char_height    : real;         {Currently set Character Height and Width}
  100.     char_width     : real;         {Always defined - used by SI and DI cmds }
  101.  
  102.     text_direction : word;         {Used by DI cmd }
  103. {-----------------------------------------------------------------------------}
  104.     symbol_mode    : boolean;      {Whether a symbol is drawn on a PA or PR }
  105.     symbol_char    : char;         {command - used by the SM instruction    }
  106. {-----------------------------------------------------------------------------}
  107.     {Remember unimplemented commands in this array for later }
  108.  
  109.     unknown_cmds   : array [1..unknown_max] of string;
  110.     unknown_count  : integer;
  111.  
  112.     cnt          : integer;
  113.     pause        : char;
  114.  
  115.     ch           : char;
  116.     debug        : boolean;
  117.     digits       : set of char;
  118.     i            : integer;      {General Purpose Integer}
  119.     finished     : boolean;
  120.  
  121.     initialise_cmd_count : integer;  {Used to pause on 2nd, 3rd ... IN cmd}
  122.     IP_cmd_count         : integer;  {Used to change colours on 2nd .. IP cmd}
  123.     auto_detect_graphics : boolean;  {altered be /G command line option }
  124. {-----------------------------------------------------------------------------}
  125.  
  126. procedure SET_DEFAULT_TEXT_DIRECTION;
  127. begin
  128.   text_Direction:= HorizDir;
  129.   SetTextJustify(LeftText,  BottomText);
  130. end;
  131.  
  132. {-----------------------------------------------------------------------------}
  133. { Set up the appropriate scaling factors to draw text of the size defined by
  134.   HEIGHT and WIDTH.
  135.  
  136.   HEIGHT and WIDTH are remembered in CHAR_HEIGHT and CHAR_WIDTH so
  137.   this procedure  can be reused if TEXT_DIRECTION is redefined.
  138.  
  139.   This procedure is used whenever it is necessary to change either
  140.   text size or direction.
  141. }
  142.  
  143. procedure SET_TEXT_SIZE (width, height : real); {Arguments are in Centimetres}
  144.  
  145. var x_top, x_bottom, y_top, y_bottom : integer;
  146.     width_in_mm, height_in_mm        : real;
  147.     scale_x, scale_y                 : real;
  148.     letter_height, letter_width      : integer;
  149.  
  150. begin
  151.       {Scale ratios by 100 so as not to lose too much precision on ROUND()}
  152.       x_top:= 100; x_bottom:= 100; y_top:= 100; y_bottom:= 100;
  153.  
  154.       {This Section Gives "Approximately" the correct size lettering }
  155.       SetTextStyle(SmallFont, HorizDir, 2);
  156.       letter_height:= TextHeight('M');     {Remember Size of Standard Characters}
  157.       letter_width := TextWidth('M');
  158.  
  159.       width_in_mm := letter_width / screen_max_X * X_plot_area_mm;
  160.       scale_x:= (width*10) / width_in_mm;     { *10 as SI args are in cm}
  161.       if scale_x > 10 then scale_x:= 10;
  162.       if scale_X > 1 then x_top   := round(scale_x   *100)
  163.       else                x_bottom:= round(1/scale_X *100);
  164.  
  165.       height_in_mm:= Letter_Height / screen_max_Y * Y_plot_area_mm;
  166.       scale_y:= (height*10) / height_in_mm;   { *10 as SI args are in cm}
  167.       if scale_y > 10 then scale_y:= 10;
  168.       if scale_y > 1 then Y_top   := round(scale_Y   *100)
  169.       else                Y_bottom:= round(1/scale_Y *100);
  170.  
  171.       SetUserCharSize(x_top, x_bottom, y_top, y_bottom);
  172.       SetTextStyle(smallFont, text_direction, UserCharSize);
  173. end;
  174.  
  175. {-----------------------------------------------------------------------------}
  176.  
  177. procedure SET_DEFAULT_TEXT_SIZE;
  178. begin
  179.   if paper_size = 4 then      { A4 Paper }
  180.     begin
  181.       char_height   := A4_char_height;
  182.       char_width    := A4_char_width;
  183.     end
  184.   else                        { A3 Paper }
  185.     begin
  186.       char_width    := A3_char_width;
  187.       char_height   := A3_char_height;
  188.     end;
  189.   set_text_size(char_width, char_height);
  190. end;
  191. {-----------------------------------------------------------------------------}
  192.  
  193. procedure SET_P1_P2 (x, y, x1, y1 : integer);
  194. begin
  195.   x_p1:= x;
  196.   y_p1:= y;
  197.   x_p2:= x1;
  198.   y_p2:= y1;
  199. end;
  200. {-----------------------------------------------------------------------------}
  201.  
  202. procedure SET_DEFAULT_P1_P2;
  203. begin
  204.   if paper_size = 4 then     { A4 Paper }
  205.     begin
  206.       x_p2          := 10430;
  207.       x_p1          :=   430;
  208.       y_p2          :=  7400;
  209.       y_p1          :=   200;
  210.     end
  211.   else                        { A3 Paper }
  212.     begin
  213.       x_p2          := 15580;
  214.       x_p1          :=   380;
  215.       y_p2          := 10430;
  216.       y_p1          :=   430;
  217.     end;
  218. end;
  219. {-----------------------------------------------------------------------------}
  220.  
  221. procedure SET_PAPER_SIZE ( default :  integer);
  222. begin
  223.   if default <> 0 then paper_size:= default
  224.   else
  225.     repeat
  226.       write('A4 or A3 paper (3/4) : ');
  227.       readln(paper_size);
  228.     until paper_size in [3,4];
  229.  
  230.   if paper_size = 4 then
  231.     begin                     { A4 Paper }
  232.       X_plot_area_mm:=   270;
  233.       Y_plot_area_mm:=   190;
  234.       hard_clip_X   := 10870;
  235.       hard_clip_Y   := 7600;
  236.     end
  237.   else                        { A3 Paper }
  238.     begin
  239.       X_plot_area_mm:=   399;
  240.       Y_plot_area_mm:=   271;
  241.       hard_clip_X   := 15970;
  242.       hard_clip_Y   := 10870;
  243.     end;
  244. end;
  245.  
  246. {-----------------------------------------------------------------------------}
  247. {Search the list of already Unknown Commands to see if the current one has
  248.  already been added to the list
  249. }
  250.  
  251. function SEEN_BEFORE (cmd : string) : boolean;
  252. var i : integer;
  253.     found : boolean;
  254. begin
  255.   i:= 0;
  256.   found:= false;
  257.   while (i < unknown_count) and not found do
  258.     begin
  259.       i:= i+1;
  260.       if unknown_cmds[i] = cmd then found:= true;
  261.     end;
  262.   seen_before:= found;
  263. end;
  264. {-----------------------------------------------------------------------------}
  265.  
  266. { READARG - a version of READ-A-NUMBER that will handle numbers that start
  267.   with a decimal point (no leading digit)
  268.  
  269.   On exit skip past any trailing terminators/separators
  270. }
  271.  
  272. procedure READARG (var num: real);
  273. label 99;
  274. var seen_point : boolean;
  275.     divisor    : integer;
  276.     is_negative: boolean;
  277. begin
  278.   while not eof (inf) and not (ch in digits+['-']) do
  279.      read(inf, ch);  {Just in Case}
  280.  
  281.   if eof(inf) then goto 99;
  282.  
  283.   num:= 0;
  284.   seen_point := false;
  285.   divisor    := 1;
  286.   is_negative:= false;
  287.  
  288.   if ch = '-' then begin is_negative:= true; read(inf, ch); end;
  289.  
  290.   while ch in digits do
  291.     begin
  292.       if ch = '.' then seen_point:= true
  293.       else
  294.         begin
  295.           if seen_point then divisor:= divisor * 10;
  296.           num:= num*10 + (ord(ch)-ord('0'));
  297.         end;
  298.       read(inf, ch);
  299.     end;
  300.  
  301.   if seen_point then num:= num / divisor;
  302.  
  303.   if is_negative then num:= -num;
  304.  
  305. (*  if ch in [',',';'] then read(inf, ch);    {Skip past terminator/separator}*)
  306.   99:
  307. end;
  308. {-----------------------------------------------------------------------------}
  309. { GET THE NEXT HPGL COMMAND  into "cmd" }
  310.  
  311. {  On EXIT:     "cmd"    - contains HPGL command }
  312.  
  313. procedure GET_CMD;
  314. label 99;
  315. begin
  316.  
  317. { Skip past any non-alphabetic characters }
  318.  
  319.   while not eof(inf) and not (ch in ['A'..'Z','a'..'z']) do
  320.     read(inf, ch);  {Skip junk}
  321.  
  322.   if eof(inf) then begin cmd:= 'ZZ'; goto 99; end;
  323.  
  324.    cmd := '';
  325.    cmd:= concat(cmd, upcase(ch));
  326.    read(inf, ch);
  327.    if ch <> ';' then
  328.      begin
  329.        cmd:= concat(cmd, upcase(ch));
  330.        read(inf, ch);
  331.      end;
  332.   99:
  333. end;
  334. {-----------------------------------------------------------------------------}
  335. procedure READ_OR_RESET_ARGS (num_of_args : integer);
  336. begin
  337.   if ch = ';' then args:= false
  338.   else
  339.     begin
  340.       readarg(x);
  341.       if num_of_args >= 2 then readarg(y);
  342.       if num_of_args >= 3 then readarg(x1);
  343.       if num_of_args  = 4 then readarg(y1);
  344.       args:= true;
  345.     end
  346. end;
  347.  
  348. {-----------------------------------------------------------------------------}
  349.  
  350. { SCALE THE PARAMETERS X & Y INTO SCREEN UNITS }
  351.  
  352. {If scaling is active the incoming values should be between:
  353.  
  354.    X_min .. X_max  which is scaled to fit between x_p1 .. x_p2 and ditto for Y
  355.  
  356.  If not, then use plotter units and scale these to fit onto the screen
  357. }
  358.  
  359. procedure SCALE (var x, y : integer);
  360. begin
  361.   if use_plotter_units then
  362.     begin
  363.       x:= round( x/(hard_clip_X) * screen_max_X);
  364.       y:= screen_max_y - round( y/(hard_clip_y) * screen_max_Y);
  365.     end
  366.   else {Scaling is Active - Fit plot Using Coords P1 and P2 - defined in IP cmd}
  367.     begin
  368.       x:= round((((x-x_min)/(x_max-x_min)) * (x_p2-X_p1) + x_p1)/Hard_clip_X * Screen_max_X);
  369.       y:= round((((y-y_min)/(y_max-y_min)) * (y_p2-y_p1) + y_p1)/Hard_clip_Y * Screen_max_Y);
  370.       y:= screen_max_y - y;
  371.     end;
  372. end;
  373.  
  374. {-----------------------------------------------------------------------------}
  375.             {PU - PEN UP - Set Current co-ord if any arguments}
  376.  
  377. procedure do_PU_cmd;
  378.  
  379. var x_int, y_int: integer;
  380. begin
  381.   read_or_reset_args(2);
  382.   if args then
  383.     begin
  384.       x_int:= round(x);
  385.       y_int:= round(y);
  386.       scale(x_int, y_int);
  387.       moveTo(x_int, y_int);
  388.     end;
  389.   pen_down:= false;
  390. end; 
  391. {----------------------------------------------------------------------------}
  392.  
  393.            {PD - PEN DOWN - Move to and Draw if a co-ord present }
  394.  
  395. procedure do_PD_cmd;
  396.  
  397. var    x_int, y_int: integer;
  398. begin
  399.   read_or_reset_args(2);
  400.   if args then
  401.     begin
  402.       x_int:= round(x);
  403.       y_int:= round(y);
  404.       scale(x_int, y_int);
  405.       lineto(x_int,y_int);
  406.     end;
  407.   pen_down:= true;
  408. end; 
  409.  
  410.  
  411. {-----------------------------------------------------------------------------}
  412.  
  413.         { PA - POINT ABSOLUTE - Move to x,y, Drawing if PEN DOWN}
  414.  
  415. procedure do_PA_cmd;
  416.  
  417. var    x_int, y_int: integer;
  418.       save_x, save_y : integer;
  419. begin
  420.   read_or_reset_args(2);
  421.   if args then
  422.     begin
  423.       x_int:= round(x);
  424.       y_int:= round(y);
  425.       scale(x_int, y_int);
  426.       if pen_down then lineto(x_int,y_int)
  427.       else moveto(x_int,y_int);
  428.        if symbol_mode then {If symbol-mode then PLOT symbol Char at Destination}
  429.         begin
  430.           save_x:= getX; save_y:= getY;
  431.           outtext(symbol_char);
  432.           moveto(save_x, save_y);  {Ensure current point doesn't change}
  433.         end;
  434.     end;
  435. end;
  436.  
  437.  
  438. {-----------------------------------------------------------------------------}
  439.  
  440.          { PR - POINT RELATIVE - Moveto or Draw relative to Last position}
  441.  
  442. procedure do_PR_cmd;
  443.  
  444. var    x_int, y_int: integer;
  445.       save_x, save_y : integer;
  446. begin
  447.   read_or_reset_args(2);
  448.   if args then
  449.     begin
  450.       x_int:= round(x);
  451.       y_int:= round(y);
  452.       scale(x_int, y_int);
  453.       x:= getX;
  454.       y:= GetY;
  455.       if pen_down then lineto(GetX+x_int, GetY+y_int)
  456.       else moveto(GetX+x_int, GetY+y_int);
  457.        if symbol_mode then  {Plot symbol character at endpoint}
  458.         begin
  459.           save_x:= getX; save_y:= getY;
  460.           outtext(symbol_char);
  461.           moveto(save_x, save_y);
  462.         end;
  463.     end;
  464. end; 
  465.  
  466. {-----------------------------------------------------------------------------}
  467.  
  468.            { LB - LABEL - Output text in current SIze and DIrection}
  469.  
  470. procedure do_LB_cmd;
  471. begin
  472.   lbl:= '';
  473.   while ch <> #03 do
  474.     begin
  475.       lbl:= concat(lbl, ch);
  476.       read(inf, ch);
  477.     end;
  478.   read(inf, ch); {skip past ";"}
  479.   outtext(lbl);
  480. end; 
  481.  
  482. {-----------------------------------------------------------------------------}
  483.  
  484.                { CI - DRAW CIRCLE - centred at current point }
  485.  
  486. { This should really take into account the current scaling so you can draw 
  487.   elipses (I think). At the moment it always draws perfect circles, using the
  488.   X size as its Radius
  489. }
  490.  
  491. procedure do_CI_cmd;
  492.  
  493. begin
  494.   read_or_reset_args(1);   { read Radius }
  495.   x:=  x/(hard_clip_X) * screen_max_X;
  496.   circle(getX, getY, round(x));
  497. end; 
  498.  
  499. {-----------------------------------------------------------------------------}
  500.        { IP - Set the Initial Points for use by the SCale command }
  501.  
  502. { To display Concatenated Plots in a different colour, it swaps colours, if 
  503.   available on each IP cmd.  This is useful for viewing different layers of 
  504.   a printed circuit layout 
  505. }
  506.  
  507. procedure do_IP_cmd;
  508. begin
  509.   read_or_reset_args(4);
  510.   if not args then set_default_P1_P2
  511.   else
  512.    begin
  513.      set_P1_P2(round(x), round(y), round(x1), round(y1));
  514.      colour:= colour - 1;
  515.      if colour = 0 then colour:= GetMaxColor;
  516.      setcolor(colour);
  517.   end;
  518. end; 
  519.  
  520. {-----------------------------------------------------------------------------}
  521.  
  522.                       { SC - Define Coordinate Scale }
  523.  
  524. { If there are arguments, scale all following coordinates so that the 
  525.   ranges defined by the SCALE command lies within the PLOT AREA defined 
  526.   by the IP command coordinates.
  527.  
  528.   If no arguments the revert to using absolute plotter coordinates.
  529.  }
  530.  
  531. procedure do_SC_cmd;
  532. begin
  533.   if ch = ';' then args:= false
  534.   else
  535.    begin   {Don't use READ_AND_RESET as args in wrong order (x,x1,y,y1) }
  536.      readarg(x); readarg(x1); readarg(y); readarg(y1);
  537.    end;
  538.   if args = false then use_plotter_units:= true
  539.   else
  540.     begin          {Scale Command - from now on coords will arrive    }
  541.       x_min:= x;   {                scaled between Xmin-Xmax, Ymin-max}
  542.       y_min:= y;
  543.       x_max:= x1;
  544.       y_max:= y1;
  545.       use_plotter_units:= false;
  546.     end;
  547. end; 
  548.  
  549. {-----------------------------------------------------------------------------}
  550.                 { IN - INITIALISE - Beep and wait for a keypress}
  551.  
  552. procedure do_IN_cmd;
  553. begin
  554.   set_default_P1_P2;
  555.   pen_down:= false;
  556.   if initialise_cmd_count > 0 then
  557.     begin
  558.       write(#7);
  559.       pause:= readkey;
  560.     end;
  561.   initialise_cmd_count:= initialise_cmd_count+1;
  562. end; 
  563.  
  564. {-----------------------------------------------------------------------------}
  565.  
  566.             { SP - SET PEN - Usually used to change PEN Colour}
  567.  
  568. procedure do_SP_cmd;
  569. begin
  570.   read_or_reset_args(1);
  571.   if args then  {Display in a different colour if possible}
  572.   if trunc(x) in [1..GetMaxColor] then
  573.     setcolor(GetMaxColor - round(x) + 1)
  574.   else
  575.     begin
  576.       colour:= colour-1;
  577.       if colour = 0 then colour:= GetMaxColor;
  578.       SetColor(Colour);
  579.     end;
  580. end; 
  581.  
  582. {-----------------------------------------------------------------------------}
  583.     { SI - Define TEXT SIZE in Centimetres, or reset it to the Default size }
  584.  
  585. procedure do_SI_cmd;
  586. begin
  587.   read_or_reset_args(2);
  588.   if args = false then set_default_text_size
  589.   else
  590.     begin
  591.       set_text_size(x,y);
  592.       {Now to remember for later - for use by DI instruction}
  593.       char_width := x;
  594.       char_height:= y;
  595.     end;
  596. end;
  597.  
  598. {-----------------------------------------------------------------------------}
  599.             { SR - Set Text Size - Relative to Scaling Points }
  600.  
  601. { This bit has only been loosely tested (ie once) }
  602.  
  603. procedure do_SR_cmd;
  604.  
  605. var  actual_width, actual_height : real; {for SR cmd}
  606. begin
  607.   read_or_reset_args(2);
  608.   if args = false then set_default_text_size
  609.   else
  610.     begin
  611.       actual_width := x/100 * (x_p2 - x_p1) * 0.0025; {cm}
  612.       actual_height:= y/100 * (y_p2 - y_p1) * 0.0025; {cm}
  613.       set_text_size(actual_width, actual_height);
  614.       {Now to remember for later - for use by DI instruction}
  615.       char_width := actual_width;
  616.       char_height:= actual_height;
  617.     end;
  618. end; 
  619.  
  620. {-----------------------------------------------------------------------------}
  621.        { SM - SYMBOL MODE - Plot a symbol after each plot/move}
  622.  
  623. procedure do_SM_cmd;
  624. begin
  625.   if ch = ';' then symbol_mode:= false
  626.   else
  627.     begin
  628.       symbol_mode:= true;
  629.       symbol_char:= ch;
  630.     end;
  631.   read(inf, ch);
  632. end; 
  633.  
  634. {-----------------------------------------------------------------------------}
  635.         { DI/DR - Set Orientation to display following Text }
  636.  
  637. { Ideally we should be able to Rotate the direction of the text
  638.   (ie horizontal but upside down, but Turbo's toolbox doesn't handle this
  639.   Instead we'll use the SetTextJustify to do it in 90 degree increments
  640. }
  641.  
  642. procedure do_DI_or_DR_cmd;
  643. begin
  644.   read_or_reset_args(2);
  645.   if not args then  set_Default_Text_direction {set to Defaults}
  646.   else
  647.     begin
  648.       if abs(x) >= abs(y) then {RUN > RISE}
  649.         begin
  650.       text_Direction:= HorizDir;
  651.       if x > 0 then  SetTextJustify(LeftText,  BottomText) {  0 degrees}
  652.       else           SetTextJustify(RightText, TopText);   {180 degrees}
  653.     end
  654.       else
  655.     begin
  656.       text_direction:= VertDir;
  657.       if y >= 0 then  SetTextJustify(RightText,  BottomText) { 90 degrees}
  658.       else            SetTextJustify(LeftText,   TopText);   {270 degrees}
  659.         end;
  660.  
  661.       {Now call SET_TEXT_SIZE to alter TextDirection, using prev WIDTH&HEIGHT}
  662.       set_text_size(char_width, char_height); {Either Default or Set by SI instr}
  663.     end;
  664. end;
  665.  
  666. {-----------------------------------------------------------------------------}
  667.            {DF - Default - Reset various parameters to known state }
  668.  
  669. procedure do_DF_cmd;
  670. begin
  671.   set_default_text_direction;
  672.   symbol_mode:= false;
  673.   use_plotter_units:= true;  {Turn off scaling}
  674. end;
  675. {-----------------------------------------------------------------------------}
  676.  
  677.              { DECODE and EXECUTE the HPGL command in "cmd" }
  678.  
  679.  
  680. procedure DECODE_and_EXECUTE_HPGL_COMMAND;
  681. begin
  682.  
  683.   if      cmd = 'PU' then do_PU_cmd
  684.   else if cmd = 'PD' then do_PD_cmd
  685.   else if cmd = 'PA' then do_PA_cmd
  686.   else if cmd = 'PR' then do_PR_cmd
  687.   else if cmd = 'LB' then do_LB_cmd
  688.   else if cmd = 'CI' then do_CI_cmd
  689.   else if cmd = 'IP' then do_IP_cmd
  690.   else if cmd = 'SC' then do_SC_cmd
  691.   else if cmd = 'IN' then do_IN_cmd
  692.   else if cmd = 'SP' then do_SP_cmd
  693.   else if cmd = 'SI' then do_SI_cmd
  694.   else if cmd = 'SR' then do_SR_cmd
  695.   else if cmd = 'SM' then do_SM_cmd
  696.   else if cmd = 'DF' then do_DF_cmd
  697.   else if cmd = 'DI' then do_DI_or_DR_cmd
  698.   else if cmd = 'DR' then do_DI_or_DR_cmd
  699.   else if cmd = 'VS' then read_or_reset_args(1) {VELOCITY SET (of Pen) - Ignore}
  700.   else if cmd = 'ZZ' then {End of file Sentinel - ignore this cmd}
  701.   else  {UNIMPLEMENTED COMMAND}
  702.     if unknown_count = unknown_max then finished:= true {abort}
  703.     else
  704.       begin  {Add Unknown Command to list of unknowns}
  705.         unknown_count:= unknown_count+1;
  706.  
  707.         while (ch <> ';') and (not eof(inf)) do
  708.           begin
  709.             if (length(cmd) < 78) then cmd:= concat(cmd, ch);
  710.             read(inf, ch);
  711.           end;
  712.          unknown_cmds[unknown_count]:= cmd;
  713.       end;
  714. end;
  715. {-----------------------------------------------------------------------------}
  716.  
  717. procedure VIEW_UNKNOWN_COMMANDS;
  718. var i : integer;
  719.     ch : char;
  720. begin
  721.   clrscr;
  722.   if unknown_count = 0 then Writeln('No unimplemented HPGL commands encountered')
  723.   else
  724.     begin
  725.       writeln('                      UNIMPLEMENTED HPGL COMMANDS');
  726.       writeln;
  727.       for i:= 1 to unknown_count do
  728.         begin
  729.           writeln(unknown_cmds[i]);
  730.           if (unknown_count mod 20 ) = 0 then
  731.             begin
  732.               write('Press any key : '); ch:= readkey;
  733.             end;
  734.         end;
  735.       writeln;
  736.     end;
  737.     ch:= readkey;
  738. end;
  739. {-----------------------------------------------------------------------------}
  740.  
  741. procedure Graphics_Error(error: string);
  742. begin
  743.   Writeln(error, ': ', GraphErrorMsg(GraphResult));
  744.   Halt(1);
  745. end;
  746.  
  747.  
  748. procedure REGISTER_GRAPHICS_BITS;
  749. begin
  750.   { Register all the drivers }
  751.   if RegisterBGIdriver(@CGADriverProc)    < 0 then  graphics_error('CGA');
  752.   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then  graphics_error('EGA/VGA');
  753.   if RegisterBGIdriver(@HercDriverProc)   < 0 then  graphics_error('Herc');
  754.   if RegisterBGIdriver(@ATTDriverProc)    < 0 then  graphics_error('AT&T');
  755.   if RegisterBGIdriver(@PC3270DriverProc) < 0 then  graphics_error('PC 3270');
  756.  
  757.  
  758.   { Register SMALL Font - only one used }
  759.   if RegisterBGIfont(@SmallFontProc) < 0 then graphics_error('Small Font');
  760.  
  761.   if auto_detect_graphics then
  762.     Graphics_Driver := Detect;                { autodetect the hardware }
  763.  
  764.   InitGraph(Graphics_Driver, Graphics_Mode, '');  { activate graphics }
  765.   if GraphResult <> grOk then                     { any errors? }
  766.   begin
  767.     Writeln('Graphics init error: ', GraphErrorMsg(Graphics_Driver));
  768.     Halt(1);
  769.   end;
  770. end;
  771.  
  772. procedure OPTIONS_ERROR (msg : string);
  773. begin
  774.   writeln(msg);
  775.   writeln('Type ');
  776.   writeln('      HPGLVIEW ? ');
  777.   writeln('for a list of valid options');
  778.   writeln;
  779.   halt(1);
  780. end;
  781. {-----------------------------------------------------------------------------}
  782. {SET THE GRAPHICS DRIVER and MODE accordin to the Supplied arguments }
  783.  
  784. { Graphics Driver and Mode are set up via a command line option of the form:
  785.  
  786.   /G graphics-driver graphics-mode
  787.  
  788.   Check that the mode is valid for the indicated driver, ABORT if it isn't.
  789. }
  790.  
  791. procedure MANUAL_GRAPHICS_SETUP (driver_no, mode_no : integer);
  792. var status : integer;
  793. begin
  794.   if paramcount < mode_no then options_error ('Must define Graphics Driver & Mode')
  795.   else
  796.     begin
  797.       val(paramstr(driver_no), graphics_driver, status);
  798.       if status <> 0 then options_error('Graphics driver must be integer');
  799.  
  800.       if not (graphics_driver in [1..10]) then
  801.          options_error(concat('Invalid Graphics Driver : ', paramstr(driver_no)));
  802.  
  803.       val(paramstr(mode_no), graphics_mode, status);
  804.       if status <> 0 then
  805.          options_error(concat('Graphics mode must be integer : ',paramstr(mode_no)));
  806.  
  807.       {Check the Specified Mode is valid for Defined Driver}
  808.       case graphics_driver of
  809.        {CGA}        1 :if not (graphics_mode in [0..4]) then options_error('Graphics mode for CGA must be 0..4');
  810.        {MCGA}       2 :if not (graphics_mode in [0..5]) then options_error('Graphics mode for MCGA must be 0..5');
  811.        {EGA }       3 :if not (graphics_mode in [0..1]) then options_error('Graphics mode for EGA must be 0..1');
  812.        {EGA64}      4 :if not (graphics_mode in [0..1]) then options_error('Graphics mode for EGA64 must be 0..1');
  813.        {EGAMono}    5 :if not (graphics_mode in [3   ]) then options_error('Graphics mode for EGAMono must be  3');
  814.        {IBM8514}    6 :if not (graphics_mode in [0   ]) then options_error('Graphics mode for IBM8514 must be  0');
  815.        {HercMono}   7 :if not (graphics_mode in [0   ]) then options_error('Graphics mode for HercMono must be  0');
  816.        {ATT400}     8 :if not (graphics_mode in [0..5]) then options_error('Graphics mode for ATT400 must be 0..5');
  817.        {VGA}        9 :if not (graphics_mode in [0..2]) then options_error('Graphics mode for VGA must be 0..2');
  818.        {PC3270}    10 :if not (graphics_mode in [0   ]) then options_error('Graphics mode for PC3270 must be 0');
  819.       end; {case}
  820.     end;
  821. end;
  822.  
  823. procedure display_licence;
  824. begin
  825. clrscr;
  826. writeln('             HPGLVIEW - a on-screen Previewer for HPGL files');
  827. writeln('                Copyright (C) 1991 Giovanni S. Moretti');
  828. writeln('');
  829. writeln('    This program is free software; you can redistribute it and/or modify');
  830. writeln('    it under the terms of the GNU General Public License as published by');
  831. writeln('    the Free Software Foundation; either version 1, or (at your option)');
  832. writeln('    any later version.');
  833. writeln('');
  834. writeln('    This program is distributed in the hope that it will be useful,');
  835. writeln('    but WITHOUT ANY WARRANTY; without even the implied warranty of');
  836. writeln('    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the');
  837. writeln('    GNU General Public License for more details.');
  838. writeln('');
  839. writeln('    You should have received a copy of the GNU General Public License');
  840. writeln('    along with this program; if not, write to the Free Software');
  841. writeln('    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.');
  842. writeln('-----------------------------------------------------------------------------');
  843. writeln('    Giovanni Moretti                    | EMAIL:  G.Moretti@massey.ac.nz');
  844. writeln('    Computer Centre,  Massey University |  ');
  845. writeln('    Palmerston North, New Zealand       |');
  846. writeln('-----------------------------------------------------------------------------');
  847. writeln('Please send me copies of any major improvements so I can coordinate new');
  848. writeln('versions.');
  849. writeln;
  850. write('Press any key for help screen : '); ch:= readkey;
  851. end;
  852.  {-----------------------------------------------------------------------------}
  853. procedure QUICK_HELP;
  854. begin
  855. display_licence;
  856. clrscr;
  857. writeln('   *********  HPGLVIEW v1.0 - A Screen Previewer for HPGL files *********');
  858. writeln('');
  859. writeln('This program will display the contents of an HPGL file, normally intended for');
  860. writeln('a plotter, on the PC''s screen.  The screen is treated as an A3 or A4 page and');
  861. writeln('aspect ratio effects are ignored to maximise the available resolution.');
  862. writeln('');
  863. writeln('   HPGLVIEW  <filename> [/A3 | /A4 ] [/G graphics-driver graphics-mode ] [/D]');
  864. writeln('');
  865. writeln('  Options : /A3 /A4 - Paper size, /G - Graphics Mode, /D Show unknown HPGL cmds');
  866. writeln('  Defaults: A4 page, Autodetect graphics driver, Ignore unknown cmds');
  867. writeln;
  868. writeln('GRAPHICS DRIVERS AND (VALID MODES): Try mode 0 if unsure.');
  869. writeln('CGA    : 1(0-4)  CGA     : 2(0-5)  EGA: 3(0-1)     EGA64: 4(0-1)  EGAmono: 5(3)');
  870. writeln('IBM8514: 6(0)    HercMono: 7(0)    ATT400: 8(0-5)  VGA: 9(0-2)    PC3270: 10(0)');
  871. writeln('');
  872. writeln('Recognised HPGL Commands');
  873. writeln('  PA, PU, PD, PR, LB, CI, VS, SP, IP, SC, SM, SI, DI, IN, DR, SR, DF');
  874. writeln('');
  875. writeln('Plotter Limits: A4 - Plot area 270x190mm, Hard limits X/Y = 10870x 7600');
  876. writeln('                A3             399x271mm                    15970x10870');
  877. writeln;
  878. writeln('written by Giovanni Moretti                       Email: G.Moretti@massey.ac.nz');
  879. writeln;
  880. halt(1);
  881. end;
  882.  
  883. {----------------------------------------------------------------------------}
  884.             { Decode in execute the command line options (if any ) }
  885.  
  886. procedure SET_OPTIONS;
  887. var next : integer;
  888. begin
  889.   debug:= false;
  890.   paper_size:= 4;
  891.   auto_detect_graphics:= true;
  892.  
  893.   next:= 2;
  894.   while next <= paramcount do
  895.     begin
  896.       if (paramstr(next) = '/h') or (paramstr(next) = '/H') then quick_help
  897.       else
  898.       if (paramstr(next) = '/a3')  or (paramstr(next) = '/A3') then
  899.          paper_size:= 3
  900.       else
  901.       if (paramstr(next) = '/a4')  or (paramstr(next) = '/A4') then
  902.          paper_size:= 4
  903.       else
  904.       if (paramstr(next) = '/d')  or (paramstr(next) = '/D') then debug:= true
  905.       else
  906.       if (paramstr(next) = '/g')  or (paramstr(next) = '/G') then
  907.         begin
  908.           auto_detect_graphics:= false;
  909.           manual_graphics_setup(next + 1, next+2);
  910.           next:= next+2;
  911.         end
  912.       else options_error(concat('Unknown Option : ',paramstr(next)));
  913.       next:= next+1;
  914.     end;
  915.   set_paper_size(paper_size);
  916. end; {set_options}
  917. {----------------------------------------------------------------------------}
  918.                                 { MAINLINE }
  919. begin
  920.   digits:= ['0'..'9','.'];
  921.  
  922.   unknown_count    := 0;
  923.   for i:= 1 to unknown_max do unknown_cmds[i]:= '';
  924.  
  925.   ch:= ' ';
  926.   debug:= false;
  927.   if paramcount = 0 then quick_help;
  928.  
  929.   filename:= paramstr(1);
  930.   if filename[1] in [ '/', '?']  then quick_help;
  931.  
  932.   assign(inf, filename);
  933.   {$I-} reset(inf); {$I+}
  934.   if ioresult <> 0 then begin writeln('HPGLVIEW: ', filename, ' not found'); halt; end;
  935.  
  936.   {GOT A VALID FILENAME}
  937.  
  938.   set_paper_size(4);
  939.  
  940.   if paramcount > 1 then set_options;
  941.  
  942.   cnt:= 0;
  943.   clrscr;
  944. {---------------------------------------------------------------------------}
  945.               { Set up graphics and display Boarder }
  946.  
  947.   register_graphics_bits;   {Load appropriate graphics driver and Font }
  948.  
  949.              { Draw the Border Representing the Printed Page }
  950.   screen_max_X:= getMaxX;
  951.   screen_max_Y:= getMaxY;
  952.   moveto(0,0);
  953.   lineto(screen_max_x,0);
  954.   lineto(screen_max_x, screen_max_y);
  955.   lineto(0, screen_max_y);
  956.   lineto(0,0);
  957.  
  958.                      { Display File title at top of page }
  959.   SetColor(GetMaxColor);
  960.   colour:= GetmaxColor;
  961.   SetTextStyle(smallfont,horizdir,6);
  962.   SetTextJustify(CenterText,TopText);
  963.   OutTextXY(screen_max_x div 2, 0, concat(' *** ', filename, ' *** '));
  964. {----------------------------------------------------------------------------}
  965.  
  966.  { Set up HPGL Defaults related to Paper Size }
  967.  
  968.   text_direction      := horizDir;
  969.   use_plotter_units   := true;      {Can be changed with SCALE command }
  970.   symbol_mode         := false;
  971.   initialise_cmd_count:= 0;
  972.   IP_cmd_count        := 0;
  973.  
  974.   set_default_P1_P2;        {Define initial Scaling Points for this paper size}
  975.   set_default_text_direction;
  976.   set_default_text_size;    {As defined in HPGL manual}
  977.  
  978.  {------------------------------  Main Loop  --------------------------------}
  979.  
  980.   finished:= false;
  981.   while not eof(inf) and not finished do
  982.     begin
  983.       if keypressed then   {If ESC pressed then abort immediately }
  984.         begin
  985.           ch:= readkey;
  986.           if ch = #$1B {ESC} then finished:= true;
  987.         end;
  988.       if not finished and not eof(inf) then
  989.         begin
  990.           get_cmd;
  991.           decode_and_execute_HPGL_command;
  992.        end;
  993.     end;
  994.   if not finished then begin write(chr(7)); pause:= readkey; end;
  995.   closegraph;
  996.   if debug then view_unknown_commands;
  997. end.
  998.