ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/GRAPHICS/MISC/POSTOGRF.ZIP/POSTOGRF.PAS

Pascal/Delphi Source File | 1990-08-10 | 61.8 KB | 1,625 lines

{$A+,B-,D+,E-,F-,I+,L+,N-,O-,R-,S-,V-}
{$M 32000,0,655360}
Program POSTogrf;
{ (O] SCRC Z; EXIT; }
{    Written by T. B. Passin in Turbo Pascal 5.0.
     Writes labels onto graphs using Postscript laser printer.  The labels
     can be moved, sized, edited, and the font can be chosen.  This
     program takes as input the graph file from J. R. VanZandt's
     graph program GRAPHLI, which is a version of GRAPH that puts
     out a command file that drives the C. Itoh LIPS laser printer.
     POSTOGRF also can read its own output file, the output from LIPSOGRF,
     and the output from VanZandt's GRAPHPS.

     POSTOGRF interactively adds labels to the file and outputs
     a merged file containing both the graph and the labels ready to print
     on a Postscript printer.

    10 Aug 90 v6.14. Changes default font style when you change font.
    4 June 90 v6.14x5.
    31 May 90 v6.14x3 Now can also size CopyBlock automatically, or with
       mover keys.  Changed CopyBLock menu item function keys.
    25 May 90 v6.14x2.  Now has new mode: F8, moves Copyblock around
       on page. Adjusted Copyblock defaults and positions of the VG
       bar & MITRE Logo.  Most changes are to Copybloc.inc.  CopyBlock
       now described in Postscript coords relative to origin.  Added
       types Rect, ScreenRect.  Added var CopyBlock.
    21 May 90 v6.14x1.  Now rotates labels 90 deg.  2 new Postscript
       words for this: 'rs' rotates and does 's', 'rsho' rotates and does
        'show'.
     2 May 90 v6.13e.  'X' option now autosaves without requesting
        confirmation for output filename (omit save if unchanged).
     25 Apr 90 v6.13d. Now defaults to 'y' for save when quitting.  Added
        'X' exit option: automatically saves file before quitting.
     18 Apr 90 v6.13c. Minor fix for read-file message.
     17 Apr90 v6.13b. Bug fix in init:split into init + init1, init1 comes
         before ReadGRAPHLI. Initscrn now before ReadGRAPHLI;  Now new labels
         are spaced right in expanded viewing (fix AddLabel);
     28 Mar 90 v6.13.  Slightly increased default vertical spacing between
         labels.  Bug fix: after exiting a file without changing it,
         a new file (no filename) no longer incorporates the previous one
         (fixed Init, WritePrt);  New file: label background now transparent.
         Label background now defaults to most recent setting. ^-home, ^-end
         now select head, tail of linked list, Home = PF6, End = PF8.
         Now F10 to save/quit, new main menu.
     18 Jan 90. v6.12. No confirmation needed to write to LPT3, COM3.
     5 Jan 90. v 6.11.  Now uses VGA mode: changes to init, initscreen.
}

Uses Graph, CRT, DOS,
     Lipsfont,   { BGI sansserif font }
     lipsdrvr; { all the BGI drivers (except 3270) }
{$DEFINE POSTOGRF}
{$I pstrings.i}
{$I beboop.src}
{type db = array[1..100] of char;
     dbPtr = ^db;}

Type Fontlist = (Times, TimesBold, Helv, HelvBold, Symbol,
                 MitreLogo);
     paintType = (trans, opaque);
     FontRec = record
                  {POSTabrv   : string[6];}
                  FontNum  : integer;
                  LipsStyle: Fontlist;
                  FontStr  : string[80];      (* font descriptor *)
               end;                      (* for reference only: *)
     TextPtr = ^TextRec;                 (* TextSettingsType - record *)
     {String80 = string[80];}            (*   Font          : word; *)
     TextRec = Record                    (*   Direction     : word; *)
        Link:  TextPtr;                  (*   CharSize      : word; *)
        Tstr:  string[80] ;              (*   Horiz         : word; *)
        CurrText: TextSettingsType ;     (*   Vert          : word; end; *)
        PrtSize: integer; (* in points *)
        LipsFont: FontRec;
        LabelBkGround: paintType;
     end ;
     String6 = string[6];

     StyleNames = array [Times..MitreLogo] of string[20];
     StyleAbrv = array [Times..MitreLogo] of string6 ;

     Filearray = array[1..65000] of char;
     Fileptr = ^Filearray;

     ConfigRec = record
                   WriteMitreLogo: boolean;
                   DoBar: boolean;
                 end;

     ExpandoRec = record
                    SF,              {scale factor for expansion}
                    Xcent,           {new screen center in original}
                    Ycent,           {unscaled screen coordinates}
                    ScrnW,           {1/2 new screen width}
                    ScrnH: integer;  {1/2 new screen height}
                   end;

     Rect       = record
                   LLx, LLy, URx, URy, w, h: integer; end;
     ScreenRect = record
                   ULx, ULy, LRx, LRy, sw, sh: integer; end;

     PointRec = record x,y: integer; end;
     LayoutRec  = record
                  BoundingBox            : Rect;     {in points}
                  Origin                 : PointRec; {in 1/1000's}
                  Landscape, ChangeLayout: boolean;
                end;

     VideoColors = (mono,color);

     GraphFileType = (GRAPHL, LIPSGRF, POSTSCRIPT, none);

     OnOffType = (on, off);

     type CBmodeType = (move, size);

const {Yes: set of char = ['Y','y'];}
      UserDiv: byte = 100;

      POSTStyleStr : StyleNames = ('Times-Roman', 'Times-Bold', 'Helvetica',
                   'Helvetica-Bold',  'Symbol', 'MitreLogo'{'Courier-Bold'});

      UserStyleNames: StyleNames = ('Times', 'TimesBold',
                    'Helv', 'HelvBold', 'Symbol', 'MitreLogo' );

      Ver: string80 = 'POSTogrf version 6.14';
      JimDefFontStr = '/font1 /Helvetica-Bold findfont 181 scalefont def';

      CharSizeAdjX = 35;  { fudge factor to make screen label the same }
                          { width as printed label }

      defaultConfig: ConfigRec = (WriteMitreLogo: false; DoBar: false);
      defaultBarY = 5100;

      MitreLogoLabel: TextRec = (
                        Link           : nil;
                        Tstr           : 'MITRE';
                        CurrText: (
                          font         : 100;
                          Direction    : 0;
                          CharSize     : 0;
                          Horiz        : 0;
                          Vert         : 0);
                        PrtSize        : 20;
                        LipsFont: (
                          FontNum      : 100;
                          LIPSStyle    : MitreLogo;
                          FontStr      : '');
                        LabelBkGround  : opaque);

      LogoX = 3800; LogoY = -275;   {position of MITRE logo in thousandths}

   { ------------------ initial default font params -------------}
      DefaultFsize:integer = 20;
      DefaultLIPSStyle: fontlist = HelvBold;

      {ESC = #27;          BS  = #8;            CR = #13;  LF = #10;}
      Uparrow  = #72;     Downarrow  = #80;
      Leftarrow  = #75;   Rightarrow  = #77;
      Del  = #83;         Ins  = #82;
      {Home  = #71;        En  = #79;}  CNTLHome = #119; CNTLEnd = #117;
      PF1 = #59;   PF2 = #60;   PF3 = #61;   PF4 = #62;   PF5 = #63;
      PF6 = #64;   PF7 = #65;   PF8 = #66;   PF9 = #67;   PF10 = #68;
      movers: set of char = [leftarrow, rightarrow, uparrow, downarrow,
                   Home, #115, #116, #73, #81];

      { ------------------------------------------------------------- }
      pwhitespace : set of char = [#9, #10, #12, #13, ' ', ',', ';'];
      printables: set of char =
        ['('..'+', '-'..':', '<'..'}', '!', '#'..'&'] ;
      quotes: set of char = [#39,#34];
      numbers: set of char = ['0'..'9','.'];

     defaultLayout: LayoutRec = (
                  BoundingBox: (LLx: 0; LLy : 0; URx : 612; URy : 792;
                                 w: 612; h : 792); {points}
                  Origin: (x :7375; y : 1500); {1/1000s in.}
                  Landscape : true;
                  ChangeLayout : false);

Var  CurrSettings                              : TextSettingsType ;
     TempText, SaveLastTextRec                 : TextRec ;
     Theight, TWidth, Ffont                    : word ;
     Saveh, Savev                              : word;
     Ckey, curs, key                           : char ;
   GraphDriver                                 : integer ;
   Graphmode                                   : integer ;
   errorcode                                   : integer ;
     HorizScrFs, VertScrFs                     : integer ;
     HorizPrtFs, VertPrtFs                     : integer ;
     HPSScale, VPSScale                        : real ;
     HorizLIPSFs, VertLIPSFs                   : integer ;
     HorizPrinterDots, VertPrinterDots         : integer ;
     MenuLineY                                 : integer;
     HPrtScale, VPrtScale                      : real ;
     HScale, VScale                            : real;
     PrtInitStr, PrtExitStr                    : string[80] ;
   HelpStr                                   : string[80] ;
   PrtFile                                   : text ;
   PrtFileName                               : string80 ;
     PointsPerPixelH, PointsPerPixelV, Fsize     : integer;
     UserSizeX, UserSizeY                        : word{byte};
   FontTotal                                   : integer;
   TempFontRec                                 : FontRec;
   tempFontNum                                 : integer;
     GRAPHLI                                   : file;
     GRAPHLIName                               : string80;
     JimFile                                   : Fileptr;
     error, count                              : word;
   barY                                        : integer;

     CopyRight                                 : string80;

   here, JimFileStart         : word;
   mark                       : word;
   JimFileBlock               : word;
   StartLabels, EndLabels, EndProlog     : word;
   BeginSetup, EndSetup, FontDefinitions : word;
   EndFonts, SetOrigin, StartGraph       : word;
   EndGraph                              : word;
   SetOriginStr, DefaultOriginStr        : string;
   font0str, defaultFont0str             : string80;
   defaultPaintType                      : paintType;

   OnOff                                 : onofftype;  {for copybloc.inc}
   CopyBlkX, CopyBlkY                    : integer;        {""}
   CopyBlkOffsetX, CopyBlkOffsetY        : integer;        {""}
   NoShow                                : boolean;        {""}
   CopyBlock                             : rect;
   CBmode                                : CBmodeType;


   done, finished, newfile    : boolean;
   saved, fileOK              : boolean;
   InGraphMode, firsttime     : boolean;

 { ---------------------- linked list variables ----------------- }
     head, cp, select, temp   : textPtr;
 { ---------------------- video stuff --------------------------- }
   Driver, Mode                 : integer ;
   FontF                        : file;
   FontP                        : pointer;
   VidCol                       : VideoColors;
   LinesPerChar                 : integer;
   swapColors            : boolean;
  { ------------------------------------------------------------ }
   GraphFile                    : GraphFileType;

   Lconfig                      : ConfigRec;
   Expand                       : ExpandoRec;
   Layout                       : LayoutRec;
   PageRect                     : ScreenRect;

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

Procedure ChangeDirection(Tlabel:textptr) ; { vertical labels }
var xtext: TextSettingsType;
begin
     with Tlabel^.Currtext do begin
          if Direction = HorizDir then Direction := VertDir
            else direction := HorizDir;
          SetTextStyle(Font, Direction, CharSize);
          Tlabel^.LabelBkGround := opaque;
          saved := false;
      end; {with Tlabel^ do ...}
end ;

        { --------------------------------------------------------
                          change font size
        -------------------------------------------------------------- }
Procedure ChangeSize;       { changes screen and printer size in points }
var error:integer; s1, s2:string80;
begin
    write('new character size in points: ');
         saveh := TempText.CurrText.Horiz;  { need to get text settings but }
         savev := tempText.CurrText.Vert;   { they clobber H & V values }
         GetTextSettings(TempText.CurrText); { so save & restore them }
         TempText.currText.Horiz := saveh;
     TempText.CurrText.Vert := savev;
     if swapcolors then textcolor(white);
    {$I-} Readln(Fsize);{$I+} error := IOResult;
    if swapcolors then textcolor(black);
    if (error <> 0) or (Fsize > 60)
    then begin
       write('input must be an integer < 61 - no changes made'); clrEOL;
       delay(1000);
    end
    else begin
       TempFontRec := TempText.LIPSfont;
       TempText.PrtSize := Fsize;
       DefaultFsize := Fsize; { so next label will use these parameters }
       UserSizeX := {byte}((100*Fsize)Div(PointsPerPixelH*CharSizeAdjX));
       UserSizeY := {byte}((100*Fsize)Div(PointsPerPixelV*44));
       TempText.CurrText.CharSize:= UserCharSize;
       SetUserCharSize(UserSizeX, UserDiv, UserSizeY, UserDiv);
       SetTextStyle(Ffont, TempText.CurrText.Direction,
           TempText.CurrText.CharSize);
       TempText.LipsFont := TempfontRec;            { make this font }
    end; { else}
end ;

    { --------------------------------------------------------------
                       change printer font style
       ------------------------------------------------------------- }

Procedure SetLipsFont;   { change font to be used by printer }
var temp, tstyle: FontList; ans: integer; s1, s2:string[10];
begin
     Clrscr;
     for temp := Times to MitreLogo do   { the 6 possible styles }
        write(ord(temp), ': ', UserStyleNames[temp] ,'  ');
     gotoxy(1,2);
     Write('select font style (now ',
       UserStyleNames[TempText.LipsFont.LIPSstyle], '): '); clrEOL;
     if swapcolors then TextColor(white);
     {$I-} readln(ans); {$I+}
     if swapColors then Textcolor(black);
     error := IOResult;
     if (ans > ord(MitreLogo)) or (error <> 0)
     then begin write('font number must be an integer from 0 - 5: no change'); delay(1000);end
     else
        begin tstyle := fontlist(ans);   (* build font specification *)
           tempFontRec.LIPSstyle := tstyle;
           TempText.LipsFont := TempfontRec;
           DefaultLIPSStyle := tstyle;
        end ;
end;

{ ----------------------------------------------------------------
                  label editor
 ------------------------------------------------------------------ }
{moved procedure XOR_char to PSTRINGS.I}

procedure Showcursor(cursor:byte);
begin
    GoToXY(cursor,1);
    XOR_Char(curs); GoToXY(cursor,1);
end;

procedure Showit(s:string; cursor:byte);  { print string w/ cursor }
var n:integer;
  begin  clrscr; { EGA BIOS bug: clears to foreground color. }
         write(s); ShowCursor(cursor); {also won't write in new color }
  end;                                   { until after a writeln !}

procedure UpdateEOS(s:string; cursor:byte);
var n:integer;
begin GoToXY(cursor,1);
      for n := cursor to length(s)
      do write(s[n]);
end;

Procedure EditLabel;
 var str : string;            { Have to make our own cursor in graphics mode:}
     ch: char;                { can't get regular cursor in graphics mode }
     cursor :byte;            { (IBM - cursors on you !! ) }
     insrt:boolean;
begin
     str := TempText.Tstr;
     cursor := length(str)+ 1;   insrt := true; curs := curins;
     clrscr; Showit(str,cursor);
     repeat
       ch := ReadKey;
       if ch <> #0                         (* ordinary key *)
       then case ch of
             Esc: exit;                (* restore original string and quit *)
             CR: begin TempText.Tstr := str; exit; end;  (* accept changes *)
             BS:  begin if cursor = 1 then {nothing}
                        else begin
                                GoToXY(cursor,1); write(' ');
                                dec(cursor);
                                GoToXY(length(str),1); write(' ');
                                delete(str,cursor,1);
                                UpDateEOS(str,cursor);
                                ShowCursor(cursor);
                              end;
                   end;
             ELSE case insrt of
                    true: begin insert(ch,str,cursor);
                                UpDateEOS(str,cursor);
                                inc(cursor);
                                ShowCursor(cursor);
                          end;
                    false: begin if cursor > length(str)
                                 then str := str + ch
                                 else str[cursor] := ch;
                                 UpdateEOS(str,cursor);
                                 inc(cursor);
                                 ShowCursor(cursor);
                           end;
                  end; {case insrt}
           end  {case ordinary key}
       else begin ch := Readkey;          (* special key *)
           case ch of
              Leftarrow: begin if cursor <> length(str) + 1
                               then write(str[cursor]) else clreol;
                               dec(cursor);
                               if cursor < 1 then cursor := 1;
                               ShowCursor(cursor); end;
              Rightarrow: begin if cursor > length(str)-1
                                then begin if cursor = length(str)
                                           then XOR_Char(curs);
                                           GoToXY(length(str)+1, whereY);
                                           write(' ');
                                           GoToXY(whereX-1, WhereY);
                                           cursor := length(str) + 1;
                                      end
                                else begin write(str[cursor]);
                                           inc(cursor);
                                     end;
                                ShowCursor(cursor); end;
              Del: if cursor > length(str) then {nothing}
                         else begin
                                   GoToXY(length(str),1); write(' ');
                                   delete(str,cursor,1);
                                   UpDateEOS(str,cursor);
                                   ShowCursor(Cursor);
                               end; {else}
              Ins: if insrt = true then
                          begin XOR_Char(curs);
                                curs := curover;insrt := false;
                                ShowCursor(cursor);
                          end
                     else begin XOR_Char(curs);
                                curs := curins; insrt := true;
                                ShowCursor(cursor);
                          end;
        Home: begin XOR_Char(curs);
                      cursor := 1;
                      ShowCursor(cursor);
          end;
              En: begin XOR_Char(curs);
                        cursor := length(str) + 1;
                        ShowCursor(cursor);
                  end;
              PF10: begin str := TempText.Tstr; (* restore initial string *)
                          cursor := length(str) + 1;
                          Showit(str, cursor);
                     end;
           end;  {case extended keys}
         end; {else}
     until ch = Esc;
end;

{ ------------------------------------------------------------------
             convert from printer to screen coordinates
   ---------------------------------------------------------------- }
Procedure ScrConv(var x,y:integer);
begin
     with Expand do begin
       x := SF*(integer(round(x/HPrtScale)) - Xcent + ScrnW);
       y := SF *(integer(round(y/VPrtScale)) - Ycent + ScrnH);
     end;
end;

{ -------------------------------------------------------------------
            convert from screen to printer coordinates (@ 300 dpi)
 --------------------------------------------------------------------- }
Procedure PrConv(var Tlabel:TextPtr) ;
begin
      HorizPrinterDots := integer(round(HprtScale*Tlabel^.CurrText.Horiz));
      VertPrinterDots := integer(round(VprtScale*(Tlabel^.CurrText.Vert-7)));
end ;

Procedure OutPrConv(var Tlabel:TextPtr); { label position in PS coords}
begin
      PrConv(Tlabel);
      HorizPrinterDots := integer(round(HPSScale*HorizPrinterDots)) - 1000 ;
      VertPrinterDots := -integer(round(VPSScale*VertPrinterDots))  + 6370 ;
end ;

{ --------------------------------------------------------------------
  Convert from Postscript coordinates ( in 1/1000 's of an inch) to
  screen coordinates.
  -------------------------------------------------------------------- }
Procedure PStoScreen(var x,y:integer);
begin
     with Expand do begin
        x := SF*(integer(round((x + 1000)*Hscale)) - Xcent + ScrnW);
        y := 7 + SF*(integer(round((6370 - y)*VScale)) - Ycent + ScrnH);
      end;
end;

Procedure OutPrPos(var x,y:integer);  { GRAPHLI position in PS coords }
begin
     x := integer(round(HPSScale*x)) - 1000;
     y := -integer(round(VPSscale * (y-7))) + 6370;
end;

procedure SetCopyBlockDef;
const conv = 1000.0/72;
var tx1, ty: integer;
    DefBBox: boolean;
begin
   DefBBox := false;
  with DefaultLayout.BoundingBox do
      if (Layout.boundingBox.LLx = LLx) and (Layout.boundingBox.LLy = LLy)
         and (Layout.boundingBox.URx = URx) and (Layout.boundingBox.URy = URy)
       then DefBBox := true;
  with CopyBlock do begin
     if (GRAPHLIName = '') or DefBBox
     then                               {set defaults if no input file}
        if Lconfig.Dobar then begin
            LLx := -250; LLy := Layout.origin.x - 7130;
            w := 8500; h := 6250;
            URx := LLx + w; URy := LLy + h;
         end else begin
            LLx := 0; LLy := 0;
            w := 8500; h := 6250;
            URx := LLx + w; URy := LLy + h;
      end else             {set from parsed parameters from input file}
            with Layout do begin
                if Landscape then begin
                    LLx := (round(conv*BoundingBox.LLy)) - origin.y;
                    LLy := origin.x - (round(conv*BoundingBox.LLx));
                    URx := (round(conv*BoundingBox.URy)) - origin.y;
                    URy := origin.x - (round(conv*BoundingBox.URx));
                 end else begin
                    LLx := (round(conv*BoundingBox.LLx - origin.x));
                    LLy := (round(conv*BoundingBox.LLy - origin.y));
                    URx := (round(conv*BoundingBox.URx - origin.x));
                    URy := (round(conv*BoundingBox.URy - origin.y));
                 end;
             end; {with Layout do...}
            if URx < LLx then begin
                 w := URx; URx := LLx; LLx := w;
             end;
            if URy < LLy then begin
                 w := URy; URy := LLy; LLy := w;
             end;
            w := URx - LLx;
            h := URy - LLy;
   end; {with CopyBlock do...}
end;

procedure MenuLine;
begin
     if vidcol = color then SetColor(Yellow) else SetColor(white);
     SetViewPort(0,0,HorizScrFS, MenuLineY, Clipon);
     Line(0, MenuLineY, GetMaxX, MenuLineY);
     SetViewPort(0,0,HorizScrFS, MenuLineY - 1, Clipon);
end;

{ ----------------------------- parsing ----------------------- }

Procedure GetAWord(var s:string80);
var i: byte;
begin
     done := false;
     while JimFile^[here] in pwhitespace
     do begin
             if here > count then begin done := true; exit; end ;
             here := succ(here);
        end;
     i := 1;
     mark := here;
     while JimFile^[here] in printables
     do begin
             s[i] := JimFile^[here];
             here := succ(here);
             i := succ(i);
        end;
     s[0] := chr(i-1);
     here := succ(here);
end;

Procedure GetAQuote(var s:string80);
const q1 = #39;
var i: byte; q2 : char;
begin
     done := false;
     i := 1; q2 := JimFile^[here];
     here := succ(here);
     repeat
             s[i] := JimFile^[here];
             here := succ(here);
             i := succ(i);
     until JimFile^[here] {in quotes} = q2 ;  { continue past quotes til q2 }
     s[0] := chr(i-1);
     here := succ(here);
end;

{ ------------------------------------------------------------------------
  GetAWordBack scans from JimFile + offset backwards to extract the last
  previous word (delineated by whitespace).  On entry, offset points
  to a whitespace char that follows the target word.  On exit,
  dest contains the string, and offset points to the first whitespace
  char before the string.  The procdure will get one word after another
  when called repeatedly.
  ------------------------------------------------------------------------ }
procedure GetAWordBack(var dest: string80; var offset: word);
begin
     done := false; dest := '';
     while JimFile^[offset] in pwhitespace do begin
           dec(offset);
           if offset < 0 then begin
              done := true; exit; end;
     end; {while}
     while (Jimfile^[offset] in printables)
              or (Jimfile^[offset] in quotes) do begin
           dest := JimFile^[offset] + dest;
           dec(offset);
           if offset < 0 then begin
              done := true; exit; end;
     end; {while}
end; {GetAWordBack}

{ -------------------------------------------------------------------------
  ParsePSstring - parse a PostScript string to extract the string itself
  from the parentheses.  Postscript strings are delineated by a pair of
  parentheses.  Also extracts the any chars escaped using '\'.
  Keeps track correctly of embedded parens (must have matching left and
  right parens, just as for Postscript).
  Limitations: doesn't recognize octal escaped numbers.  Doesn't translate
  '\n', '\r', '\b', '\t' (doesn't pass them to dest).
  Offset refers to locations relative to JimFile (i.e., JimFile^[offset]).

  On entry, offset points to opening parens.
  On exit, offset points past end of string.
  ------------------------------------------------------------------------- }
procedure ParsePSstring(var dest: string80; var offset: word);
const escapees: set of char = ['n', 't', 'b', 'r'];
var
    parenCount: word;
    ch: char;
    n1: word;
begin
     parenCount := 1; dest := ''; n1 := offset;
     repeat
           inc(offset);
           ch := JimFile^[offset];
           case ch of
                '\': begin
                        inc(offset);
                        ch := JimFile^[offset];
                        if not (ch in escapees) then dest := dest + ch
                        else inc(offset);
                     end;
                '(': inc(parenCount);
                ')': dec(parenCount);
                else dest := dest + ch;
           end; {case}
     until (parenCount = 0) or (offset > count);
     inc(offset);
end;


{$I ScanPS}

     { -----------------------------------------------------------------
                       read input graph from GRAPHLI
        Also checks file to see if it is an original GRAPHLI file, a
        modified LIPSOGRF file, a POSTOGRF file, or the wrong file type.
        Also locates the start of the GRAPHLI file embedded in a LIPSOGRF
        file.

        For Postscript files, locates the offset within the file of a
        number of internal markers (endlabels. etc).
        ------------------------------------------------------------------ }
Procedure ReadGRAPHLI; { <CR> for filename omits reading the file }
const POSTOGRFName = 'POSTOGRF';
      GRAPHName    = 'GRAPH';
type charArray = array[1..length(POSTOGRFName)] of char;
     POSTPtr = ^charArray;
     chArray1 = array[1..length(GRAPHName)] of char;
     GRAPHPtr = ^chArray1;
var s, s1, stemp:string80; n, nn:integer;

begin if InGraphMode and not firsttime then clrscr;
     count := 0;
     if (firsttime) and (paramcount <> 0) then GRAPHLIName := paramstr(1)
     else begin
    write('input filename? ');
    if swapColors and InGraphMode then TextColor(white);
    readln(GRAPHLIName);
    if swapColors and InGraphMode then TextColor(black);
      end;
     if GRAPHLIName = '' then exit ;
     repeat
           assign(GRAPHLI,GRAPHLIName);
     {$I-} Reset(GRAPHLI,1); {$I+};
           error := IOResult;
           if error <> 0
           then begin
                     if InGraphMode then clrscr;
                     write('can''t open ' , GRAPHLIName); delay(1000);
             if InGraphMode then gotoxy(1,1) else writeln;
                     write('key new name (CR = none): '); clrEOL;
             if swapColors and InGraphMode then TextColor(white);
             readln(GRAPHLIName);
             if swapcolors and InGraphMode then TextColor(black);
                     if GRAPHLIName = '' then
                                           begin GraphFile := none;
                                                 JimFileStart := 1;
                                                 exit;
                                           end;
                end;
     until error = 0;
     {if firsttime then write('reading input file...');}
     {gotoxy(1, wherey);}
     if FileSize(GRAPHLI) > 65500 then begin    {file is too large}
        close(GRAPHLI);
        beboop;
        write('this file is too big - must be smaller than 65,500 bytes');
        GRAPHLIName := ''; delay(1500);
        exit;
     end; {if}

     JimFileBlock := 10 + FileSize(GRAPHLI);
     GetMem(JimFile, JimFileBlock); { allocate memory }
     blockread(GRAPHLI, JimFile^, JimFileBlock-10, count);
     close(GRAPHLI);
     here := 1; getaword(s);

     if pos('%!PS-', s) <> 0  then begin
         GraphFile := POSTSCRIPT;
         gotoxy(1, 1);
         write('this is a PostScript file '); clrEOL;
         JimFileStart := here;
         nn := here + 10;
         repeat                    {scan for 'POSTOGRF'}
            inc(nn);
         until (POSTptr(@Jimfile^[nn])^ = POSTOGRFName)
               or (GRAPHPtr(@Jimfile^[nn])^ = GRAPHName)
               or (nn = here + 300);
         if nn = here + 300 then begin
            writeln('but can''t use it: it''s not a POSTOGRF or GRAPH file');
            GRAPHLIName := ''; delay(1000);
            exit;
         end
         else begin
                    write('and it''s ');
                    if POSTptr(@Jimfile^[nn])^ = POSTOGRFName then
                       writeln('a POSTOGRF file')
                    else writeln('an original GRAPH file');
            ScanPsOffsets;
            if (StartGraph = count) then begin
                       StartGraph := endLabels;
                       EndGraph := StartGraph;
                    end;
                    JimFileStart := StartGraph;
            delay(500);
              end;
     end
     else begin
          if s <> '(O]'
          then begin
    write('Can''t use this file: it''s not a LIPS, POSTOGRF, or GRAPH file') ;
               {close(GRAPHLI);}
               GRAPHLIName := ''; delay(1500);
               exit;
          end;
          SetOriginStr := DefaultOriginStr;
          Layout := DefaultLayout;
          getaword(s);
          getaword(s); { skip 2nd word, test 3rd one }
          if s = 'DAM' then begin GraphFile := GRAPHL;
                             write('this is an original GRAPHLI file');
                             delay(1000);
                             JimFileStart := here;
                             EndGraph := count;
                             delay(500);
                       end
          else if s = 'DTF'
               then begin GraphFile := LIPSGRF;
                    write('this file has been modified by LIPSOGRF');
                    delay(1000);
                    here := 1;   s1 := '';
                    repeat
                          repeat GetaWord(s) until (s = 'FONT') or (s = 'PAGE');
                          if s = 'PAGE' then
                                          begin {GraphFile := none;}
                                             JimFileStart:= here - 5;
                                          end
                          else GetaWord(s1);
                    until (s1 = '2') or (s = 'PAGE'); { looking for 'FONT 2' }
                    if s1 = '2'
                    then JimFileStart := here - 8;    { found it }
                    EndGraph := count;
               end;
     { ---------------------------------------------------------
          Correct tail of GRAPHLI output to be 'EXIT,E;'
      ----------------------------------------------------------}
     n := count;        (* scan backwards to find 'EXIT'*)
     repeat n := n-1 until JimFile^[n] = 'T';
     JimFile^[n+1] := ',' ;    (* fix up tail *)
     JimFile^[n+2] := 'E' ;
     JimFile^[n+3] := ';' ;
     count := n+3;
  end;
end; {ReadGraphLI}


    { -------------------------------------------------------------
            omit header lines from original GRAPHLI output
       ------------------------------------------------------------ }

Procedure DumpJimFileHead;
var s:string80;
begin
     here := 1;
     repeat
           GetAWord(s);
     until (s = 'SPO') or (s = 'EXIT');
     if s = 'EXIT' then here := 1
     else GetAWord(s);
end;

    { ----------------------------------------------------------
                     header to set up Postscript
      ------------------------------------------------------------- }
{$I posthd3.}
{$I writelog.inc}

     { ------------------------------------------------------------
                 write merged output to file
       ------------------------------------------------------------ }
{$I writeprt.inc }

     { -------------------------------------------------------
                     open, close output file
        ------------------------------------------------------ }

{$I openprt.pas }

     { ------------------------------------------------------
                        set LIPS font size
        ------------------------------------------------------- }

Procedure SetPrtFontSize(var size:integer);
begin
         saveh := TempText.CurrText.Horiz;
         savev := tempText.CurrText.Vert;
         GetTextSettings(TempText.CurrText);
         TempText.currText.Horiz := saveh;
         TempText.CurrText.Vert := savev;
       TempText.PrtSize := size;
       UserSizeX := (Expand.SF*(100*size)Div(PointsPerPixelH*CharSizeAdjX));
       UserSizeY := (Expand.SF*(100*size)Div(PointsPerPixelV*44));
       TempText.CurrText.CharSize:= UserCharSize;
       SetUserCharSize(UserSizeX, UserDiv, UserSizeY, UserDiv);
       SetTextStyle(Ffont, TempText.CurrText.Direction,
           TempText.CurrText.CharSize);
end ;

Procedure RestorePrtFontSize(var size:integer);
begin
       TempText.PrtSize := size;
       UserSizeX := (Expand.SF*(100*size)Div(PointsPerPixelH*CharSizeAdjX));
       UserSizeY := (Expand.SF*(100*size)Div(PointsPerPixelV*44));
       TempText.CurrText.CharSize:= UserCharSize;
       SetUserCharSize(UserSizeX, UserDiv, UserSizeY, UserDiv);
       SetTextStyle(Ffont, TempText.CurrText.Direction,
           TempText.CurrText.CharSize);
end;

        { -------------------------------------------------------------
                        draw the graph on the screen
           ------------------------------------------------------------- }

procedure DrawJimFile;
var XPos, Ypos, error, temp  : integer;
    PenDia                   : word;
    n1                       : word;
    str                      : string80;
    sFlag                    : boolean;
begin
     if here > EndGraph then begin
        done := true; exit; end;
     GetAWord(str);
     case GraphFile of
          GRAPHL, LIPSGRF: begin
     if str = 'EXIT' then begin done := true; exit ; end ELSE
     if str = 'MAP' then   { move to position }
        begin GetAWord(str); Val(str,Xpos,error); (* *** ADD ERROR CHECKING *)
              GetAWord(str); Val(str,Ypos,error);
              ScrConv(XPos, YPos);
              MoveTo(Xpos,YPos);
        end ELSE
     if str = 'DAP' then   { draw to position }
        begin GetAWord(str); Val(str,Xpos,error); (* *** ADD ERROR CHECKING *)
              GetAWord(str); Val(str,Ypos,error);
              ScrConv(XPos,YPos);
              LineTo(Xpos,YPos);
        end ELSE
     if str = 'SPD' then        { set pen diameter - only an approximation }
        begin GetAWord(str); Val(str,PenDia, error); (* *** ADD ERROR CHECK *)
              PenDia := word(round(10 * PenDia/VPrtScale)) div 3;
                  SetLineStyle(0,0,PenDia);
        end ELSE
     if str = 'FONT' then { he asks for internal landscape font - fake it }
        begin GetAWord(str); if str = '3' then  begin
              temp:= 12; SetPrtFontSize(temp); end else (* nothing *);
        end ELSE
     if str = 'TEXT' then    { write the following text string }
        begin GetAQuote(str); OutText(str);
        end ELSE (* nothing *);
   end; {case GRAPHL, LIPSGRF}
   POSTSCRIPT: begin
    temp := 13; SetPrtFontSize(temp);
    if str[1] = 's' then sFlag := true else sFlag := false;
        if str[1] = '%' then
       repeat
          inc(here)
       until (JimFile^[here] = CR) or (JimFile^[here] = LF);
        if str[1] = '(' then begin       {found a label}
          ParsePSstring(str,mark);
          OutText(str);
          here := mark;
        end ELSE
       if (str[1] = 'm') then begin
         if ((str = 'm') or (str = 'moveto')) then begin
             n1 := here - 1; GetAWordBack(str,n1); GetAWordBack(str, n1);
             Val(str, YPos, error);
             if error <> 0 then exit;
             GetAWordBack(str,n1);
             Val(str,XPos,error);
             if error <> 0 then exit;
             PStoScreen(XPos, YPos);
             MoveTo(XPos, YPos);
         end;
       end ELSE
       if (str[1] = 'l') then begin
         if ((str = 'l') or (str = 'lineto')) then begin
             n1 := here - 1; GetAWordBack(str,n1); GetAWordBack(str, n1);
             Val(str, YPos, error);
             GetAWordBack(str,n1);
             Val(str,XPos,error);
             PStoScreen(XPos, YPos);
             LineTo(XPos, YPos);
         end;
       end ELSE
       if (sflag) and (str = 'setlinewidth') then begin
          n1 := here -1; GetAWordBack(str,n1); GetAWordBack(str, n1);
          Val(str,PenDia,error);
          if error = 0 then begin
             PenDia := word(round(PenDia)) div 10;
          end else PenDia := 1;
          SetLineStyle(0,0,PenDia);
       end ELSE
       if (sFlag) and (str = 'sf') then begin        {set active font size}
             {any labels here are default 13 pt labels}
          temp := 13; SetPrtFontSize(temp); end ELSE
       if (sFlag) and (str = 'setfont') then begin
          temp := 13; SetPrtFontSize(temp);
       end ELSE
       if (sFlag) and (str = 'showpage') then begin done := true; exit ;
     end; {if..ELSE}
    end; {POSTSCRIPT}
  end; {case}
end; {DrawJimFile}

procedure AddRec;                 { create & insert new record }
begin cp := head;                 { exit with cp pointing to }
      new(head);                  { new record }
      head^.link := cp;
      cp := head;
end;


procedure SetUpLabel(var Tlabel: textptr);
var t1:integer;
begin if Tlabel = nil then exit;
      t1 := Tlabel^.PrtSize;
      with Expand do begin
        UserSizeX := (SF*(100*t1)Div(PointsPerPixelH*CharSizeAdjX));
        UserSizeY := (SF*(100*t1)Div(PointsPerPixelV*44));
       end;
      SetUserCharSize(UserSizeX, UserDiv, UserSizeY, UserDiv);
      SetTextStyle(Ffont, Tlabel^.CurrText.direction,
             Tlabel^.CurrText.CharSize);
end;

procedure Showlabel( var Tlabel: textptr; wColor:word);
begin if Tlabel = nil then exit else;
      SetColor(wColor);
      SetUpLabel(Tlabel);
      with Expand do
        OutTextXY(SF*(Tlabel^.CurrText.Horiz - Xcent + ScrnW),
             SF*(Tlabel^.CurrText.Vert - Ycent + ScrnH), Tlabel^.Tstr);
end;

procedure BoxLabel(Tlabel:textptr; wColor:word);
var xt, yt: integer;
begin
     if Tlabel = nil then exit;
     SetColor(wColor);
     SetUpLabel(Tlabel);
     saveh := Tlabel^.CurrText.Horiz;
     savev := Tlabel^.CurrText.Vert;
     GetTextSettings(Tlabel^.CurrText);
     Tlabel^.currText.Horiz := saveh;
     Tlabel^.CurrText.Vert := savev;
     with Expand do begin
        xt := Tlabel^.currText.Horiz ;
        yt := Tlabel^.CurrText.Vert ;

       SetWriteMode(XORPut);
       case Tlabel^.currText.Direction of
         HorizDir:
             Rectangle(
       SF*(xt  - Xcent + ScrnW + 1) + TextWidth(Tlabel^.Tstr),
       SF*(yt  + 2 - Ycent + ScrnH) - TextHeight(Tlabel^.Tstr),
       SF*(xt - Xcent + ScrnW -1) , SF*(yt - Ycent + ScrnH + 2));
         VertDir:
             Rectangle(
       SF*(xt  - Xcent + ScrnW + 1) + TextHeight(Tlabel^.Tstr),
       SF*(yt  + 2 - Ycent + ScrnH) - TextWidth(Tlabel^.Tstr),
       SF*(xt - Xcent + ScrnW -1) , SF*(yt - Ycent + ScrnH + 2));
        end; {case}
      end; {with Expand do ...}
      SetWriteMode(CopyPut);

end;

procedure UnBoxLabel(Tlabel:textptr);
begin
     If VidCol = color then exit;
     SetWriteMode(XorPut);
     BoxLabel(Tlabel, white);
     SetWriteMode(CopyPut);
end;


procedure HighLight(Tlabel: textptr);
begin
     if VidCol = color then ShowLabel(Tlabel, yellow)
     else begin ShowLabel(Tlabel, white);
                BoxLabel(Tlabel, white);
          end;
end;

procedure UnHighLight(Tlabel: textptr);
begin
     if VidCol = color then ShowLabel(Tlabel, white)
     else begin Showlabel(Tlabel, white);
                UnBoxLabel(Tlabel);
          end;
end;

procedure SelectRec;                    { traverse list one step }
begin if head = nil then exit;          { if no labels, then quit }
      if select <> nil then             { if label is already selected, }
           begin select^ := TempText;   { then update it }
               UnHighLight(select);     { unhighlight it }
           end;
      if (select^.link  = nil) or (select= nil)  then cp := head
      else cp := select^.link ;
      HighLight(cp);
      TempText := cp^; select := cp; {select new label }
      key := #0;                     { exit code for main }
end;

procedure SelectRecBack;                { select previous label }
begin
     if head = nil then exit;
     cp := head;
     if select <> nil then begin
        select^ := TempText;
        UnHighLight(select);
     end;
     if select = head then
           while (cp^.link <> nil) do
              cp := cp^.link               { choose last one }
        else if select = nil then cp := head
        else while not (cp^.link = select) do cp := cp^.link;
     HighLight(cp);
     TempText := cp^; select := cp; {select new label }
     key := #0;                     { exit code for main }
end;

procedure selectHead;                   { select head of list of labels }
begin if head = nil then exit;          { if no labels, the quit }
      if select <> nil then             { if label is already selected, }
           begin select^ := TempText;   { then update it }
               UnHighLight(select);     { unhighlight it }
           end;
      cp := head;
      HighLight(cp);
      TempText := cp^; select := cp; {select new label }
      key := #0;                     { exit code for main }
end;

procedure selectTail;                   { move to tail of linked list}
var temp: textPtr;
begin if head = nil then exit;          { if no labels, the quit }
      if select <> nil then             { if label is already selected, }
           begin select^ := TempText;   { then update it }
               UnHighLight(select);     { unhighlight it }
           end;
      temp := head;
      while temp^.link <> nil do temp := temp^.link;
      cp := temp;
      HighLight(cp);
      TempText := cp^; select := cp; {select new label }
      key := #0;                     { exit code for main }
end;

procedure SetLabelDefaults(Tlabel: textptr);
begin Fsize := DefaultFsize;
     with Tlabel^ do
     begin  Tstr := '';
            {PrtSize := Fsize;}
            (* CurrText.horiz := 100; CurrText.vert := 100 ;*)
            CurrText.Direction := HorizDir;
            PrtSize := Fsize;
            {LIPSFont.LIPSStyle := HelvBold;}
            LIPSFont.LIPSStyle := DefaultLIPSStyle;
     end;
     UserSizeX := (100*Fsize)Div(PointsPerPixelH*CharSizeAdjX);
     UserSizeY := (100*Fsize)Div(PointsPerPixelV*44);
     Tlabel^.CurrText.CharSize:= UserCharSize;
     Tlabel^.LabelBkGround := defaultPaintType;
     SetUserCharSize(UserSizeX, UserDiv, UserSizeY, UserDiv);
end;

procedure AddLabel;            { create record, set default attributes, }
begin If select = nil then {nothing}
      else begin select^ := temptext;
                 UnHighLight(select);
           end;
      AddRec;
      SetLabelDefaults(cp);
      SetUpLabel(cp);
      cp^.CurrText.horiz := TempText.CurrText.horiz;
      cp^.CurrText.Vert := TempText.CurrText.vert +
              ((45*TextHeight(TempText.Tstr)) div 32) div expand.sf;
      TempText := cp^;
      EditLabel;
      cp^ := TempText;
      HighLight(cp);
      select := cp;
      saved := false;
end;

procedure DeleteLabel;          { delete selected label }
var temp: TextPtr;
begin if select = nil then begin beboop; exit; end ;
      cp := head;
      if cp = nil then exit;
      UnBoxLabel(select);
      ShowLabel(select, black);
      if select = head then begin
         head := head^.link ;                       { relink }
         temp := head;
      end
      else begin
           while not (cp^.link = select)
                 do cp := cp^.link;
           temp := cp;
           cp^.link := select^.link;                { relink}
      end;
      SaveLastTextRec := select^;                   { save for UnDelete }
      SaveLastTextRec.Link := @SaveLastTExtRec;
      dispose(select);                              { dump it }
      if temp <> nil then begin                   { select previous label }
         select := temp;
         temptext := select^;
         HighLight(select);
       end
       else select := nil;
      saved := false;
end;

procedure UnDelete;               {restore deleted label }
begin
     if SaveLastTextRec.link = nil then exit;
     UnHighlight(select);
     AddRec;
     SaveLastTextRec.Link := cp^.link;
     cp^ := SaveLastTextRec;
     tempText := cp^;
     select := cp;
     Highlight(cp);
     Key := #1;
     SaveLastTextRec.link := nil;
end;

procedure AddNewLogo;
var tlink: TextPtr;
    trec: textRec;
    tx, ty: integer;

begin
      trec := select^;
      AddRec;
      tlink := cp^.link;
      cp^ := MitreLogoLabel;
      cp^.link := tlink;
      tx := LogoX; ty := {LogoY}-( 8500 - 750 - Layout.origin.x);
      PStoScreen(tx,ty);
      cp^.CurrText.horiz := tx;
      cp^.CurrText.Vert := ty {+ (44*TextHeight(TempText.Tstr)) div 32};
      {ShowLabel(cp, white);}
      select^ := trec;
      saved := false;
end;

procedure AddLogoLabel;
begin
  AddNewLogo;
  ShowLabel(cp, white);
end;

procedure DeleteLogoLabel;
var temp, temp1: TextPtr;

   { ---------------------------------------------------------------------
      search through label chain starting at here.  Find next label that
      uses the MITRELogo font.  Return true if found, false otherwise.
     --------------------------------------------------------------------- }
   function findLogoLabel(var here: TextPtr): boolean;
   var tptr: TextPtr;
   begin
       if head = nil then begin
          findLogoLabel := false; exit; end;
       tptr := head;
       while (tptr^.Lipsfont.LipsStyle <> MitreLogo) and (tptr <> nil) do
          tptr := tptr^.link;
       here := tptr;
       findLogoLabel := (tptr <> nil);
   end; {findLogoLabel}

   procedure UnLinkLogoLabel(var here:TextPtr);
   var temp: TextPtr;
   begin
      if here = nil then exit;
      if here = select then begin
        if here = head then select := head^.link
         else if select^.link = nil
           then select := head
          else select := select^.link;
        TempText := select^;                {needed for correct updating}
        unHighlight(here);
        HighLight(Select);
        cp := select;
       end;
      if here = head then head := head^.link
       else begin             {traverse list to find predecessor}
         temp := head;
         repeat temp := temp^.link
          until temp^.link = here;
         temp^.link := here^.link;
        end;
       showLabel(here, black);
       dispose(here);
   end; {UnLinkLogoLabel}

begin
  while findLogoLabel(temp) do
     UnLinkLogoLabel(temp);
  saved := false;
end; {DeleteLogoLabel}

procedure DoVGBar;
const barxl = -1000 ; barxr = 9500;
var xx, yy : integer;
    tcolor: word;
begin
    tcolor := GetColor;
    if Lconfig.DoBar then setcolor(white)
     else setcolor(GetBkColor);
    barY := Layout.origin.x - 1750;
    xx := barxl; yy := bary;
    PStoScreen(xx, yy);
    MoveTo(xx, yy);
    xx := barxr; yy := bary;
    PStoScreen(xx,yy);
    LineTo(xx, yy);
    setcolor(tcolor);
end;

procedure VGFormat;
begin
    if Lconfig.DOBar and (not firsttime)
      then AddLogoLabel
     else DeleteLogoLabel;
    DoVGBar;
end;

{ Moved RePaint1 to copybloc.inc}
{ -----------------------------------------------------------------------
    procedures to show and move the box that indicates the copyblock
   ------------------------------------------------------------------------ }
{$I copybloc.inc}

{ ---Repaint, MoveLabel, and Attributes have been moved to Copybloc.inc ---- }

{$I extrlabs}

procedure PrtOutput;
begin
     repeat
        gotoxy(1,1); clrscr;
        OpenPrtFile(PrtFile, PrtFileName, GRAPHLIName,key);
        if key = ESC then exit;
        WritePrt;
        ClosePrtFile(PrtFile,PrtFileName);
     until fileOK;
     saved := true;
     if key = #0  then begin
               GoToXY(1,1); clreol;
               writeln('quit this graph (y/n)? ');
               key := readkey;
               if key in yes then begin
                   newfile := true; key := ESC;
                end else begin newfile := false; key := #0; end;
      end
     else begin newfile := true; key := ESC; end;
     if newfile then begin
                        if JimFileBlock > 0
                        then begin FreeMem(JimFile, JimFileBlock);
                        JimFileBlock := 0;
                        Jimfile := nil;
                    end;
      end;
end;

{$I extramen.inc}

procedure LabelMenu;
const HelpStr1 =
'F1 Add    F2 Attrib    F3 Delete    F4 Edit    F5 Repaint    F6 Extras ';
Helpstr2 =
'F7 Copyblock   F8 Layout  F9 Undelete   F10 save/quit   Home, End select +,-' ;
     movers: set of char = [leftarrow, rightarrow, uparrow, downarrow,
              #115, #116, #73, #81];

   procedure ShowHelpStr;
   begin
      clrscr;
      MenuLine;
      write(Helpstr1);
      gotoXY(1,2); write(Helpstr2);
      gotoxy(1,1);
   end; {ShowHelpStr}

begin repeat
        if key = #0 then ShowHelpStr;
        key := ReadKey;
        if key = #0
           then begin key := readkey;
                      case key of      {function keys}
                           PF1: begin AddLabel ; key := #0; end;
                           PF2: begin Attributes; key := #0; end;
                           PF3: DeleteLabel;
                           PF4: Begin                       { edit label }
                                    if select = nil
                                    then begin write('nothing is selected');
                                               delay(500);
                                         end
                                     else begin
                                               Select^ := TempText;
                                               EditLabel;
                                               ShowLabel(select, black);
                                               UnBoxlabel(select);
                                               Select^ := TempText;
                                               HighLight(select);
                                               saved := false;
                                          end; {else }
                                     key := #0;
                                end; {begin}
                           PF5: begin
                                  clrscr; Repaint;
                                  ShowHelpStr;
                                 end;
                           PF6: ExtraMenu;
                       PF7: CopyBlockMenu;
                           PF8: begin
                                   ChangeLayout;
                                   clrscr; Repaint;
                                   ShowHelpStr;
                                 end;
                           PF9: begin Undelete; key := #1; end;
                           PF10: begin
                                     clrscr;
                                     write(
'X quit (autosave)   Q quit   <CR> save, new file   ESC return to main menu');
                 key := upcase(readkey);
                 case key of
                     CR: begin
                           if select <> nil then select^ := TempText;
                           PrtOutput;
                           key := #0;
                         end;
                     'Q': case saved of
                             false: begin
                                beboop;
                                GoToXY(1,1); Clrscr;
                                write('Graph has been changed. ');
                                write('Save it before quitting (y/n)? [y]');
                                gotoxy(wherex-2, wherey);
                                Ckey := readkey; write(Ckey);
                                if not (Ckey in No) then begin
                                     if select <> nil then select^ := TempText;
                                     PrtOutPut;
                                  end;
                                finished := true;
                              end; {false}
                             true: begin gotoxy(1,1); clrscr;
                                         finished := true;
                                    end; {true}
                          end; {case saved}
                       'X': begin   {force writing output}
                                if select <> nil then select^ := TempText;
                                if GRAPHLIName = '' then PrtOutPut else begin
                                    case saved of
                                       false: begin
                                          PrtFileName := GRAPHLIName;
                                          Assign(PrtFIle, PrtFileName);
                                          Rewrite(PrtFile);
                                          WritePrt;
                                          ClosePrtFile(PrtFile,PrtFileName);
                                          if FileOK then finished := true else
                                             PrtOutput;
                                         end; {false}
                                       true: ;
                                     end; {case saved of}
                                  end; {if GRAPHLIName...}
                                finished := true;
                             end; {case X }
                       ESC: key := #0;
                       #0: begin key := readkey; key := #0; end;
                  end; {case key of}
                 end; {PF10 begin}

                           CNTLHOME: begin SelectHead; key := #1; end;
                           CNTLEND: begin SelectTail; key := #1; end;
                           Home: begin SelectRec; key := #1; end;
                           En: begin SelectRecBack; key := #1; end;
                      else if key in movers then MoveLabel;
                      end; {case function keys}
                end; {if}
      until finished or newfile;
end;

procedure KillList;
begin while head <> nil
      do begin cp := head^.link;
                     dispose(head);
                     head := cp;
         end;
end;


procedure init1;
begin
     { --------------- printer, screen params ----------------
     xxLIPSFs are coordinate values output from GRAPHLI.
     xxPrtFs refers to the postscript printer.
     --------------------------------------------------------- }
     HorizScrFs := GetMaxX ; HorizPrtFs := 10000 ; HorizLIPSFs := 3000;
     VertScrFs := GetMaxY - 1*linesperChar;
     VertPrtFs := 10000; VertLIPSFs := 2400;
     HPrtScale := HorizLIPSFs / HorizScrFs ;
     VPrtScale := VertLIPSFs / VertScrFs ;
     HPSScale := HorizPrtFs/HorizLIPSFs;
     VPSScale := VertPrtFs/HorizLIPSFs;
     HScale := 1/(HPSScale*HprtScale);
     VScale := 1/(VPSScale*VprtScale);
     { ------------------------------------------------------------- }
     with Expand do begin
        SF := 1;
        Xcent := HorizScrFS div 2; Ycent := VertScrFS div 2;
        ScrnW := HorizScrFS div 2;
        ScrnH := VertScrFS div 2;
      end;

     SetViewPort(0,0,HorizScrFS, MenuLineY-1, Clipon);
     PointsPerPixelH := 720 Div HorizScrFS; (* 10 in. = 720 points wide *)
     PointsPerPixelV := 576 Div VertScrFS; (* 8 in. = 576 points high *)

end;

procedure Init;
begin
     key := #0; finished := false; newfile := false; firsttime := false;
     saved := true; noshow := true;
     onoff := off;
     if GRAPHLIName = '' then begin
         JimFileBlock := 0;
         Layout := defaultLayout;
         setOriginStr := defaultOriginStr;
         barY := defaultBarY;
      end;
     SetCopyBlockDef;
     if Lconfig.doBar then barY := Layout.origin.x - 1750;
     Fsize := 20;
     TempText.PrtSize := Fsize;
     Ffont := SansSerifFont ;
     defaultPaintType := trans;

     UserSizeX := (100*Fsize)Div(PointsPerPixelH*CharSizeAdjX);
     UserSizeY := (100*Fsize)Div(PointsPerPixelV*44);
     with TempText do
          begin CurrText.horiz := 100;  CurrText.Vert := 100;
                CurrText.Direction := HorizDir;
                CurrText.CharSize:= UserCharSize;
          end;
     SetUserCharSize(UserSizeX, UserDiv, UserSizeY, UserDiv);
     SetTextJustify(lefttext, bottomtext) ;
     SetTextStyle(SansSerifFont,Horizdir,UserCHarSize);

     PrtExitStr := 'showpage grestore ' + CR + LF + 'restore' + CR + LF
                    + '%%Trailer'+ CR + LF + #4;
     defaultFont0str := '/font0 /Helvetica-Bold findfont 181 scalefont def';
     font0str := defaultFont0str;

     { --------------- linked list of labels ---------------- }
     cp := nil; select := nil; head := nil; TempText.link := nil;
     SaveLastTextRec.Link := nil;

     { --------------- misc --------------------------------- }
     here := 1;

     CopyRight :=
        'Created By T. B. Passin using Borland''s TurboPascal, June 1990';
end ;

Procedure InitScreen;
var BGIdirectory, FontFName: string[80];
    loline, hiline: word;

     procedure Abort(Msg : string);
     begin
          Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
          Halt(1);
      end;
begin
   if InGraphMode then exit;
  { Register all the drivers }
  if RegisterBGIdriver(@CGADriverProc) < 0 then
    Abort('CGA');
  if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
    Abort('EGA/VGA');
  if RegisterBGIdriver(@HercDriverProc) < 0 then
    Abort('Herc');
  if RegisterBGIdriver(@ATTDriverProc) < 0 then
    Abort('AT&T');

  { Register all the fonts }
  if RegisterBGIfont(@SansSerifFontProc) < 0 then
    Abort('SansSerif');

  DetectGraph(GraphDriver, GraphMode);      { autodetect the hardware }

   case GraphDriver of
        EGA, EGA64: VidCol := color;
        EGAMono: VidCol := mono;
        VGA: VidCol := color;
        CGA: VidCol := mono;
        MCGA: VidCol := mono{color};
        ATT400: VidCol := mono;
        HercMono: Vidcol := mono;
   ELSE begin
      writeln('sorry - can''t use this video adapter');
          halt(1);
    end;
   end; {case}
   case GraphDriver of
        CGA : LinesPerChar := 8;
        MCGA, VGA: LinesPerCHar := 16;
      else LinesPerChar := 14;
   end; {case GraphDriver}

  InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  if GraphResult <> grOk then             { any errors? }
  begin
    writeln('sorry - can''t initialize graphics mode');
    textMode(LastMode);
    Halt(1);
  end;
   InGraphMode := true;
   DirectVideo := false;
   begin
    TextColor(black);
    swapcolors := true;
      end;
     {Window(1,23,80,25);}
     hiline := GetMaxY div LinesPerChar ;
     loline := hiline - 2;
     WindMin := lo(WindMin) + $100*loline;
     WindMax := lo(WindMax) + $100*hiline;
     if VidCol = color then SetColor(yellow) else SetColor(white);
     MenuLineY := GetMaxY-3*LinesPerChar;
     MenuLine;
     Assign(output,''); rewrite(output);
end;

(* ************************************************************************
                               MAIN
   ************************************************************************ *)
begin
   InGraphMode := false; firsttime := true;
        DefaultOriginStr :=
'/setorigin { 7.375 inch 1.5 inch translate  % move to starting point' + CR + LF
+ '             90 rotate                      % landscape' + CR + LF
+ '             0 0 m  } def                   % move to new origin';
 repeat
   lConfig := defaultConfig;
   InitScreen;
   Init1;
   if firsttime then begin
     gotoxy(1,1); write(ver); gotoxy(1,2);
    end;
   ReadGRAPHLI;
   init ;
   ExtractLabels;
   if GRAPHLIName = '' then { nothing } else RePaint;
   ShowCopyBlock;
   SelectRec;
   labelMenu ;
   KillList;
   if not finished then ClearViewPort;
 until finished;
  CloseGraph;
  TextMode(LastMode);
  {Window(1,1,80,25);}
end.

{ (Z] SCRC O; EXIT; }