{*  HIRESPLT   -   Turbo-87 PASCAL Routine to interface with HIPLOT2 *    }

{   For Turbo versions 2.0 thru 3.0                                       }

{  Changes since Version 1.3:
   1.31 - Allowed user to select value for MinCount99 which adjusts speed
          for cursor as temporary fix for different speeds

}

Const
  HiResVers99 = '1.31';
  HiResDate99 = '19 Sept 86';

  Intvec99 = $64;   { This is the only place }
  NoGrid99   : Boolean = False;
  NoHeading99: Boolean = False;

Type
  HeadingText99 = Array[1..10] of String[80];
  Line99      = String[80];



Var
  org99,linx99,liny99        : Integer;
  IXcross99,IYcross99        : Integer;
  MinCount99                 : Integer;
  xm99,xb99,ym99,yb99        : Real;
  xold99,yold99              : Real;
  OptByte99                  : Byte;
  ScreenOn99,AxisGraph99     : Boolean;
  Error99                    : Boolean;
  Alpha99                    : HeadingText99;




{*****************************  PLOTTER ROUTINES *****************************}
{=============================================================================}
{*****************************************************************************}

Procedure Hcmd( Cmd: Integer; Parm1: Integer; Parm2: Integer);
{ This performs actual interrupt to plotter routine at intvec99 }

type
  regpack = record
              ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;
            end;
var
  recpack:          regpack;             {assign record}
  ah,al,bh,bl,ch,cl,dh,dl:      byte;

begin                                    {initialize registers}
  al := Cmd;     { Commands are always less than 255 }
  ah := $00;
  dl := $03;     { This indicates to HIPLOT2 that the FORTRAN call }
  dh := $00;     { convention is to be used }
  with recpack do
  begin
    ax := ah shl 8 + al;
    bx := Parm1;
    cx := Parm2;
    dx := dh shl 8 + dl;
  end;

  Intr(Intvec99,recpack);                  {call interrupt}
end;    { Hcmd }

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

Procedure Htext( Cmd : Integer;
                 Str : Line99;
                 Len : Integer);
{ This performs interrupt to plotter to write text }

Const
  Txt    = 2;

type
  Regpack = record
              ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;
            end;


Var
  MaxLen,Segment,Offset      : Integer;
  recpack                    : Regpack;             {assign record}

Begin
  If (Length(Str) < Len) Then MaxLen := Length(Str) Else Maxlen := Len;
  If (MaxLen >0) Then
  Begin
    Segment := Seg(Str);
    Offset  := Ofs(Str)+1;
    With recpack do
    Begin
      ax := Txt;
      cx := MaxLen;
      dx := 3;      { Indicates a FORTRAN-like access to HIPLOT2 }
      es := Segment;
      Si := Offset;
      Di := Si;
    End;

    Intr(Intvec99,recpack);                  {call interrupt}

  End;


End;    { Htext }

{*****************************************************************************}
{ Non-Axis }
Procedure Hdraw(ix1,iy1,ix2,iy2: Integer); { This does simple line draw }
Const
  org  = 0;               { Set origin for line draw }
  drw  = 1;               { Draw line }

Begin
  Hcmd(org,ix1,iy1);
  Hcmd(drw,ix2,iy2);
End;    { Hdraw }

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

Procedure Pattern(style:integer);  { Set line pattern }

Const
  Pat : Integer = 7;         { Set line pattern }

begin
  Hcmd(pat,style,0);
end;    { Pattern }

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

Procedure ScreenOn;  { Send plot to screen }
begin ScreenOn99 := True end;

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

Procedure ScreenOff; { Do not send plot to screen }
begin ScreenOn99 := False end;

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

Procedure ToUpper(Var S : Line99);
Var
  I  : Integer;

Begin
  For I := 1 to Length(S) Do S[I] := Upcase(S[I]);
End;    { ToUpper }

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

Procedure Beep;   { Make sound }
Begin
  Sound(440);
  Delay(500);
  NoSound;
End;    { Beep }

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

Procedure Alarm;  { Make a more alarming sound }
var
  I: integer;
begin
  for I:=1 to 7 do
  begin
    Sound(586);
    Delay(70);
    Sound(782);
    Delay(70);
    NoSound;
  end;
end;    { Alarm }

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

Procedure SetOption(Value: byte);  { This sets option byte for Hiplot only }
Const
  mde : integer = 6;

Var
  OptInt : Integer;

begin
  OptByte99 := Value;
  OptInt:= OptByte99;
  Hcmd(mde,OptInt,0);
end;    { SetOption }

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

Procedure Option(Bit: Integer; Value: Boolean);
{ This sets the option byte for the plotter }
{
  Option               Bit      False       True
  Automatic CRLF        0       off         on
  Char block width      1       8 pixels    9 pixels
  Char block height     2       12 pixels   16 pixels
  Screen enable         3       off         on
                        -       -           -
  # fraction digits     4       2           1
  Buffer write inhibit  5       no (write)  yes(inhibit)
  Not used              6
  Set CRT XOR           7       no          yes (XOR)

  Inhibit grid lines    8       grids       no grids
}

Const
  mde : Integer = 6;         { Set mode bits }

Var
  OptInt    : Integer;
  mask      : Byte;

Begin
  If (bit > -1) AND (bit < 10) then                   { Set/reset bit }
  begin
    If (bit < 8) then
    begin
      mask := Round(Exp(bit*ln(2)));
      If Value
        Then OptByte99 := OptByte99 OR mask
        Else OptByte99 := OptByte99 AND (NOT mask);
    end
    Else
    begin
      If (bit = 8) then NoGrid99 := Value;
      If (bit = 9) then NoHeading99 := Value;
    end;
  end
  Else
  begin
    Beep; WriteLn('Error in use of Option():  Bit spec must be 0..8');
  end;

  OptInt := OptByte99;
  Hcmd(mde,OptInt,0);
End;    { Option }

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

Procedure BW80;   { Go to black/white text mode }
  Begin
    If ScreenOn99 then TextMode(2);
    If ScreenOn99 then LowVideo;
  End;  { BW80 }

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

Procedure Cls;    { Clean screen }
Begin
  If ScreenOn99 then TextMode;
End;    { Cls }

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

Procedure Box(Ix1,Iy1,Ix2,Iy2: Integer);  { Draw a box with diagonal Ix1..Iy2 }

Label
  Exit;

Const
  org  = 0;               { Set origin for line draw }
  drw  = 1;               { Draw line }

Begin
  If Error99 then GoTo Exit;
  Hcmd(Org,Ix1,Iy1);
  Begin
    Hcmd(drw,Ix1,Iy2); Hcmd(drw,Ix2,Iy2);
    Hcmd(drw,Ix2,Iy1); Hcmd(drw,Ix1,Iy1);
  End;
Exit:
End;    { Box }

{*****************************************************************************}
{ Axis }
Procedure FindReal(ix,iy: Integer; Var Xval,Yval: Real);
 { Convert integer position to real number for axis type plot }

Const
  Flog   = 0.434294482;     { Conversion factor for LOG10 }

begin
    Xval := (ix - xb99)/xm99;  Yval := (iy - yb99)/ym99;
    if (linx99 <> 1) then Xval := Exp(Xval/Flog);
    if (liny99 <> 1) then Yval := Exp(Yval/Flog);
end;    { FindReal }

{*****************************************************************************}
{ Non-Axis }
Procedure SetCross(ix,iy: Integer);  { Set crosshairs to ix,iy }
Const
  IXlen  = 20;  { This is used also in Crosshair }
  IYlen  = 10;  { This is used also in Crosshair }



begin
  if (IXcross99 >= 0) and (IYcross99 >= 0) then
    begin
    Hdraw(IXcross99-IXlen,IYcross99,IXcross99+IXlen,IYcross99);
    Hdraw(IXcross99,IYcross99-IYlen,IXcross99,IYcross99+IYlen);
    end;
  Hdraw(ix-IXlen,iy,ix+IXlen,iy);
  Hdraw(ix,iy-IYlen,ix,iy+IYlen);
  IXcross99 := ix; IYcross99 := iy;

end;    { SetCross }

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

Procedure DaTime(location: integer);
           { This places the date and time at the plot corners }

type
  Regpack = record
              ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;
            end;
Const
  GetTime = $2c;
  GetDate = $2a;
  dayX    = 0;
  timX    = 551;
  Ylow    = 399;
  Yhigh   = 16;
  Org     = 0;
  Chr     = 2;

var
  recpack                 : Regpack;             {assign record}
  hour,min,sec,ampm       : String[2];
  month,day,year          : String[2];
  hr,bothY                : Integer;
  time                    : String[11];
  date                    : String[8];

begin                                    { initialize registers for time }
  recpack.ax := GetTime shl 8;
  intr($21,recpack);                     { call interrupt }
  with recpack do
  begin
    hr := cx shr 8;
    If (hr > 12) Then                    { Determine AM vs PM }
    Begin
      ampm := 'PM';
      hr := hr-12;
    End
    Else
    Begin
      ampm := 'AM'
    End;
    str(hr,hour);                  { convert to string }
    str(cx mod 256,min);                       { " }
    str(dx shr 8,sec);                         { " }
  end;
  time := hour+':'+min+':'+sec+' '+ampm;

  recpack.ax := GetDate shl 8;           { reinitialize for date }
  intr($21,recpack);
  with recpack do
  begin
    str(dx shr 8,month);
    str(dx mod 256,day);
    str(cx-1900,year);
  End;
  date := month+'-'+day+'-'+year;

  If (location = 0) then bothY := Ylow else bothY := Yhigh;
  Hcmd(Org,dayX,bothY);
  Htext(Chr,date,8);

  Hcmd(Org,timX,bothY);
  Htext(Chr,time,11);

end;    { DaTime }

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

Procedure SetTypeComputer; { This makes adjustments to agjust for different speeds }

Var
  Answer: Char;

begin
  WriteLn('Enter speed constant -');
  WriteLn('Suggestions:  PC=50   RS 3000=35   AT=500');
  WriteLn;
  Write('Enter Value:');
  ReadLn(MinCount99);
  WriteLn;
end;    { SetTypeComputer }
{*****************************************************************************}
{ Non-Axis }
Procedure Crosshair(Var ix,iy: Integer);

Label
  Exit;

Const
  CR   = #13;
  Esc  = #27;
  Home = #71;
  UArr = #72;
  PgUp = #73;
  LArr = #75;
  RArr = #77;
  KEnd = #79;
  DArr = #80;
  PgDn = #81;
  Ins  = #82;
  ixMid = 320;
  IXmax = 639;
  IYmax = 399;
  iyMid = 200;
  AlphPosit = 80;
  MaxCount = 12000;         { 12000 for IBM-AT and for IBM-PC }
  IXlen = 20;  { This is used also in SetCross }
  IYlen = 10;  { This is used also in SetCross }
  StrPos = 40;  { Position of XY coordinate string printed at top screen }
  Flog   = 0.434294482;     { Conversion factor for LOG10 }

Var
  ispeed,yspeed,count,IXold,IYold : Integer;
  ch           : Char;
  FuncKey      : Boolean;          { True means an extended code was detected }
  Moved        : Boolean;          { Flag telling if crosshair was moved }
  Xval,Yval : Real;

begin
  If Error99 then GoTo Exit;
  Pattern($FFFF);     { Want solid line }
  Option(5,True);     { Inhibit write to buffer }
  Option(7,True);     { XOR mode }
  ix := ixMid; iy := iyMid;
  GoToXY(1,1);
  Write('Crosshair mode, press ''Enter'' to end:');
  Write('                                       ');
  ch := #0;  SetCross(ix,iy); Moved := True;
  FuncKey := False;
  while ch <> CR do
    begin
    If KeyPressed then
      begin
      Read(Kbd,Ch);
      if (ch = #27) and KeyPressed then  { If escape and another char pending }
        begin
          Read(Kbd,Ch);
          FuncKey := True;
        end
      end
      Else
      begin
        count := count+1;
        if count > MaxCount then count := MinCount99 + 1;  { Prevent overflow }
        if count > MinCount99 then
        begin
          If Moved then
          begin
            Moved := False;
            GoToXY(StrPos,1);
            If AxisGraph99 then
            begin
              Xval := (ix - xb99)/xm99;  Yval := (iy - yb99)/ym99;
              if (linx99 <> 1) then Xval := Exp(Xval/Flog);
              if (liny99 <> 1) then Yval := Exp(Yval/Flog);
              WriteLn(' X: ',Xval:10,'   Y: ',Yval:10);
            end
            Else
            begin
              WriteLn('X: ',ix:4,'  Y: ',iy:4);
            end;
          end;
        end;
      end;

      if FuncKey then
      begin
        FuncKey := False;    { To prevent endless loops }
        If count < MinCount99 then ispeed := 8 else ispeed := 1;
        count := 0;
        yspeed := ispeed + 1;
        IXold := ix;  IYold := iy;
        case ch of
          UArr: iy := iy-yspeed;
          PgUp: begin iy := iy-yspeed; ix := ix+ispeed end;
          RArr: ix := ix+ispeed;
          PgDn: begin iy := iy+yspeed; ix := ix+ispeed end;
          DArr: iy := iy+yspeed;
          KEnd: begin iy := iy+yspeed; ix := ix-ispeed end;
          LArr: ix := ix-ispeed;
          Home: begin iy := iy-yspeed; ix := ix-ispeed end;
          Ins : begin ix := ixMid; iy := iyMid end;
        end;
        If ch in [UArr,PgUp,RArr,PgDn,DArr,KEnd,LArr,Home,Ins] then
          If (ix-IXlen > 0    ) and (iy-IYlen > 0    ) and
             (ix+IXlen < IXmax) and (iy+IYlen < IYmax)
          Then
          begin
            SetCross(ix,iy);
            Moved := True;
          end
          Else
          Begin
            ix := IXold ; iy := IYold;
          End;
        end;
  end;
  { Remove old crosshair, restore Alpha99 string, etc. }
  Hdraw(IXcross99-IXlen,IYcross99,IXcross99+IXlen,IYcross99);
  Hdraw(IXcross99,IYcross99-IYlen,IXcross99,IYcross99+IYlen);
  Option(7,False);
  Option(5,False);
  IXcross99 := 0;   IYcross99 := 0;   { Indicate crosshairs are off }
  GoToXY(1,1);
  Write('                                   ');
  WriteLn('                                   ');
  If AxisGraph99 and Not NoHeading99 then
  begin
    GoToXY(Round(AlphPosit/8+1),1);
    WriteLn(Alpha99[3]);
  end;
  GoToXY(1,1);
Exit:
end;    { Crosshair }

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

Procedure Hcopy(W1,W2   : Line99);
{ Pause for hardcopy if 'PAUSE' in argument.  Eject after hardcopy if 'EJECT' }

Label
  Exit;

Const
  Cpy   = 4;
  eject = 'EJECT';
  pause = 'PAUSE';

Var
 ch   : Char;
 copy : Boolean;

Begin
  If Error99 then GoTo Exit;
  Toupper(W1);
  Toupper(W2);
  copy := True;
  If (W1 = pause) Or (W2 = pause) Then
  Begin
    GotoXY(2,73);
    Write('Copy?');
    Read(ch);
    If (ch = 'y') Or (ch = 'Y') Then copy := True Else copy := False;
    If not ScreenOn99 then writeln;  { put in CRLF if no screen plot }
  End;
  If (copy = True) Then
  Begin
    Hcmd(Cpy,0,0);  WriteLn;
    If (W1 = eject) Or (W2 = eject) Then
    Begin
      Writeln(Lst,' ');
      Writeln(Lst,^L);
    End;
  End;
Exit:
End;    { Hcopy }

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

Function Vcheck: Integer;
{ This checks for the installation of HIPLOT2 at the correct location.
  It returns 0 if not installed, version number if installed }

Var
  Hoffset,Hsegment,Hdata,Version : integer;
  Hbyte : Byte;
  check : Integer;

Begin
  Hoffset  := Memw[0000:4*Intvec99];
  Hsegment := Memw[0000:4*Intvec99+2];
  If (Hoffset = 0) And (Hsegment = 0) then
    check := 0
  Else
  Begin
    Hdata  := Memw[Hsegment:Hoffset-2];
    Version := Mem[Hsegment:Hoffset-3];
    Hbyte   := Mem[Hsegment:Hoffset-4];
    If (Hdata <> $A55A) Or (Hbyte <>0) Or (Version < 0) Then
      check :=0
    Else
      check := Version;
  End;
  Vcheck := check;
  If (check = 0) Then
  Begin
    Alarm;
    writeln; writeln; writeln; writeln; writeln; writeln; writeln; writeln;
    writeln('   *************************************************************');
    writeln('   *                                                           *');
    writeln('   *  HIPLOT2 is not installed.  It is REQUIRED for plotting.  *');
    writeln('   *       Type "hiplot2" before running this program.         *');
    writeln('   *                                                           *');
    writeln('   *************************************************************');
    writeln; writeln; writeln; writeln; writeln; writeln; writeln; writeln;
    Alarm;
  End;

End;   { Vcheck }

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

Procedure FmtNum(Value : Real);  { Place formatted number in plot }

Var
  Strng    : Line99;
  V        : Real;

  Begin
    V := Abs(Value);
    If (V >= 100.0) Then Str(Value:6:0,Strng);                { For sxxx up }
    If (V < 100.0) And (V >= 10.0) Then Str(Value:6:1,Strng); { For sxx.x }
    If (V < 10.0) Then Str(Value:6:2,Strng);                  { For sx.xx }
    If (V < 0.0005) Then Strng := '  0.0';                    { For 0.0   }
    If (Value < -1000.0) Then Str(Round(Value):5,Strng);      { For -xxxx }
    If Not Error99 then Htext(2,Strng,80);
  End;  { FmtNum }

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

Function Xinit( Ifrac    : Integer ): Integer;     { Initialize plotter }

Label
  Exit;

Const
  Mode1:Integer=$04;{ Set char to 16 x 8 pixel, CRT off, use 2 frac digits }
  Mode2:Integer=$14;{ Set char to 16 x 8 pixel, CRT off, use 1 frac digit  }
  Pattern : Integer = $FFFF; { Set line pattern to all one's }
  GrafMod : Integer = 6;     { INT 10H command to go to graphics mode }
  Clr : Integer = 3;         { Clean graphics buffer }
  Pat : Integer = 7;         { Set line pattern }
  Vid : Integer = 9;         { Video setup call to INT 10}
  Zero    : Integer = 0;     { Used in Hcmd calls for null parameter }
  Gmode   : Integer = 6;     { Set video mode to BW 200x640 }

Var
  Ierr,Iscreen    : Integer;

Begin
  if Vcheck = 0 then
  begin
    Ierr := 1 ;
    goto Exit ;
  end
  else
    Ierr := 0;

  if ScreenOn99 then Iscreen := 8 else Iscreen := 0; {CRT on if bad #}
  if Ifrac = 2 then      { Set plotter mode: set character block, BCD digits }
    SetOption(Mode1+Iscreen)
  else
    SetOption(Mode2+Iscreen);

  Hcmd(Pat,Pattern,Zero);  { Set line pattern }
  If ScreenOn99 then Hcmd(Vid,Gmode,Zero);    { Set up screen for graphics }
  Hcmd(Clr,Zero,Zero);     { Clear ploter buffer }


Exit:
  Xinit := Ierr;
End;   { Xinit }

{*****************************************************************************}
{ Non-Axis }
Procedure SetPlot;
    { Setup for plotting without axis.  Use instead of Axis }

Const
  lmx : Integer = 11;    { Set x window limit }
  lmy : Integer = 12;    { Set y window limit }

Var
  I : Integer;

Begin
  IXcross99 := -1 ; IYcross99 := -1;  { Start with crosshair off }
  linx99 := 1;
  liny99 := 1;
  xm99 := 1.0;
  ym99 := 1.0;
  xb99 := 0.0;
  yb99 := 0.0;
  Org99 := 1;
  Hcmd(lmx,0,639);    { Set window to maximum }
  Hcmd(lmy,0,399);
  I := Xinit(0);
  AxisGraph99 := False;             { Indicate that Non-axis plotting is used }
  Error99 := False                  { Set flag to allow plotting }

End;    { SetPlot }


{*****************************************************************************}
{ Axis }
Procedure Axis( X1,X2,X3,Y1,Y2,Y3 : Real ;
                Alpha99 : HeadingText99 );
{ Variables: Xn and Yn above define the axis limits for x and y axis.  For
  either, X1 and Y1 are the origin of the axis.  For a LINEAR axis, X2, Y2
  are the ends of the axis and X3, Y3 are the incremental values to be added
  to X1, Y1 to reach X2, Y2.  A tic is drawn at each increment.  For a LOG
  axis, X3 and/or Y3 is ZERO.  X2 and/or Y2 will then be interpreted as the
  number of decades.  Alpha99 is an array of 80 character strings to be printed
  as the axis and heading strings. Alpha99[1] is the X-axis label, Alpha99[2]
  is the Y-axis label, Alpha99[3..8] will be printed at the top.}

Label
  Exit;

Const
  Sca : Array[1..8] of Real =
                 (0.301,0.4771,0.6021,0.699,0.7782,0.8451,0.9031,0.9542);
  org : Integer = 0;         { Set origin for line draw }
  drw : Integer = 1;         { Draw line }
  Txt : Integer = 2;         { Insert ASCII string }
  clr : Integer = 3;         { Clean graphics buffer }
  cpy : Integer = 4;         { Make hardcopy }
  hom : Integer = 5;         { Put graphics cursor at home }
  pat : Integer = 7;         { Set line pattern }
  col : Integer = 8;         { Set pixel to erase/visible }
  vid : Integer = 9;         { Set video attribute using int 10H }
  fmt : Integer = 10;        { Insert special formatted number }
  lmx : Integer = 11;        { Set X window limit }
  lmy : Integer = 12;        { Set Y window limit }
  bcd : Integer = 13;        {  }

  Get : Integer   = 0;       { Get values from common storage }
  Put : Integer   = 1;       { Put values in common storage }
  iop2            = 1;       { =0 for 6 line heading, =1 for 7 lines }

  AlphPosit = 80;            { X Position of Alpha99 string. Also in Crosshair }
  Ifrac   = 2;               { Number of fractional digits in axis label }
  Nhead   = 5;               { Number of comment lines in header }
  Zero    = 0;               { Also indicates parameter not used }
  Solid   = $FFFF;           { Pattern for a solid line }
  Dot     = $AAAA;           { Pattern for a dotted line }
  HalfDot = $1111;           { Pattern for a less dotted line }
  Itop    = 110;             { Window definition for axis }
  Ibot    = 360;             { " }
  Ilft    = 75;              { " }
  Irht    = 575;             { " }

  Flog    = 0.434294482;     { Conversion factor for LOG10 }
  Fexp    = 2.302585093;     { Conversion factor for EXP10 }

Var
  I,J,Itemp,nchr                   : Integer;
  Ixerr,Ilabx,Ipatx,Ix             : Integer;
  Iyerr,Ilaby,Ipaty,Iy             : Integer;
  Ierr,Ipix,Igrd,Ntic,Istr,Ifin    : Integer;
  Xmin,Xmax,Xinc,Xtemp,Xexp,Xlab   : Real;
  Ymin,Ymax,Yinc,Ytemp,Yexp,Ylab   : Real;
  ExpFac                           : Real;
  ch                               : Char;



Begin

  IXcross99 := -1 ; IYcross99 := -1;  { Start with crosshair off }

{ Test input for proper range, sign, ect.  }
{ Also, convert log inputs to integer      }
  { First for X: }
  Ixerr := 0;
  If (x3<>0) Then

  { X - axis is linear }
  Begin
    linx99 := 1;
    If (x1 <= x2) And (x3 <= 0) Then Ixerr := 1;
    If (x1 >= x2) And (x3 >= 0) Then Ixerr := 1;
    If (Ixerr = 1) Then
    Begin
      Writeln(' Error in AXIS: Xinc is wrong sign for values of Xorigin, Xend');
      Writeln(' Xorigin=',x1:15:10,'  Xend=',x2:15:10,'  Xinc=',x3:15:10);
      Goto Exit;    { Abort procedure on error }
    End;
    xmin := x1;
    xmax := x2;
    xinc := x3;
    ipatx := dot;
  End

  Else

  { X - axis is log }
  Begin
    linx99 := 0;
    x1 := Round(x1);
    x2 := Round(x2);
    If (x2 <= 0) Or (x2 >= 15) Then
    Begin
      Ixerr := 1;
      Writeln(' Error in AXIS: Bad value for number of X decades, 0 < Ndec < 16');
      Writeln(' Xorigin=',x1,'  Ndecades=',x2:15:0);
      Goto Exit;    {Abort procedure on error }
    End;
   { Calculate conversion factors for data to coord values }
    xmin := x1;
    xmax := xmin+x2;
    xinc := 1.0;
    ipatx := solid;
  End;

{ Then for Y: }
  Iyerr := 0;
  If (y3<>0) Then

  { Y - axis is linear }
  Begin
    liny99 := 1;
    If (y1 <= y2) And (y3 <= 0) Then Iyerr := 1;
    If (y1 >= y2) And (y3 >= 0) Then Iyerr := 1;
    If (Iyerr = 1) Then
    Begin
      Writeln(' Error in AXIS: Yinc is wrong sign for values of Yorigin, Yend');
      Writeln(' Yorigin=',y1:15:10,'  Yend=',y2:15:10,'  Yinc=',y3:15:10);
      Goto Exit;    { Abort procedure on error }
    End;
    ymin := y1;
    ymax := y2;
    yinc := y3;
    ipaty := halfdot;
  End

  Else

  { Y - axis is log }
  Begin
    liny99 := 0;
    y1 := Round(y1);
    y2 := Round(y2);
    If (y2 <= 0) Or (y2 >= 15) Then
    Begin
      Iyerr := 1;
      Writeln(' Error in AXIS: Bad value for number of Y decades, 0 < Ndec < 16');
      Writeln(' Yorigin=',y1,'  Ndecades=',y2:15:0);
      Goto Exit;    {Abort procedure on error }
    End;
    ymin := y1;
    ymax := ymin+y2;
    yinc := 1.0;
    ipaty := solid;
  End;

{ Setup graphics mode, home and set line pattern, fraction format }
  Ierr := Xinit(Ifrac);
  If (Ierr <> 0) Then
  Begin
    Writeln('Ierr <> 0 after Xinit in Axis');
    Goto Exit;
  End;

{ Set plot window to axis limits }
  Hcmd(Lmx,Zero,solid);
  Hcmd(Lmy,Zero,solid);


  xm99 := (irht-ilft)/(xmax-xmin);
  xb99 := ilft-xm99*xmin;

  ym99 := (itop-ibot)/(ymax-ymin);
  yb99 := itop-ym99*ymax;

{ Print header at top of screen, 6 for IOP2=0, 7 for IOP1=1,... options }
  If Not NoHeading99 then
  Begin
    ipix := 16-2*(iop2);
    ix := AlphPosit;
    j := nhead+3+iop2;
    for i := 3 to j do
    Begin
      iy := (i-2)*ipix+2;
      Hcmd(Org,ix,iy);
      Htext(Txt,Alpha99[i],80);
    End;
  End;

{ Draw axis on screen and in HIPLOT2 buffer }
  Hcmd(Org,Ilft,Itop);
  Hcmd(Drw,Ilft,Ibot);
  Hcmd(Drw,Irht,Ibot);
  Hcmd(Drw,Irht,Itop);
  Hcmd(Drw,Ilft,Itop);

{ Loop to draw x-axis tics and label each }
{ Calc number of tics }
  ntic := Round(abs((xmax-xmin)/xinc));

{ Now find axis scale factor }
  xtemp := abs(xinc);
  xexp := 0.;

  While (xtemp >= 100) do
  Begin
    xtemp := xtemp/1000.;
    xexp := xexp+3.0;
  End;

  While (xtemp < 0.1) And (xtemp > 0) do
  Begin
    xtemp := xtemp*1000.;
    xexp := xexp-3.0;
  End;

{ Loop to make, label x-axis tics }
  istr := ibot-4;
  ifin := ibot+3;
  igrd := ibot+1;
  ilaby := ibot+16;
  expfac := exp(-Fexp*xexp);

  For i := 0 to ntic do
  Begin
    ix := Round((xmin+i*xinc)*xm99+xb99);
    If (ix <= irht+2) Then
    Begin
      Hcmd(Pat,Solid,Zero);
      Hcmd(Org,ix,istr);
      Hcmd(Drw,ix,ifin);
      Hcmd(Pat,ipatx,Zero);
      If Not NoGrid99 then Hcmd(Drw,ix,itop);
      ilabx := ix-16;
      xlab := (xmin+xinc*i)*expfac;
      If (linx99 = 1) Then
      Begin
        Hcmd(Org,ilabx-16,ilaby);
        FmtNum(xlab);
      End
      Else
      Begin
        Hcmd(Org,ilabx,ilaby);
        Htext(Txt,'  ',2);
        Hcmd(Bcd,Round(xlab),Zero);
        Hcmd(Org,ilabx,ilaby+8);
        Htext(Txt,'10',2);
        If (i <> ntic) Then
        Begin
          For j := 1 to 8 Do
          Begin
            itemp := ix+Round(sca[j]*xm99);
            Hcmd(Pat,Dot,Zero);
            Hcmd(Org,itemp,igrd);
            Hcmd(Drw,itemp,itop);
          End;
        End;
      End;
    End;
  End;
{ Loop to draw y-axis tics and label each }
  ntic := Round(abs((ymax-ymin)/yinc));

{ Now find axis scale factor }
  ytemp := abs(yinc);
  yexp := 0.;

  While (ytemp >= 100) do
  Begin
    ytemp := ytemp/1000.;
    yexp := yexp+3.0;
  End;

  While (ytemp < 0.1) do
  Begin
    ytemp := ytemp*1000.;
    yexp := yexp-3.0;
  End;

{ Loop to make Y-axis tics }
  istr := ilft-6;
  ifin := ilft+6;
  igrd := ilft-2;
  ilabx := ilft-54;
  expfac := exp(-Fexp*yexp);

  For i := 0 To ntic do
  Begin
    iy := Round((ymin+i*yinc)*ym99+yb99);
    If (iy >= itop-2) Then
    Begin
      Hcmd(Pat,Solid,Zero);
      Hcmd(Org,istr,iy);
      Hcmd(Drw,ifin,iy);
      Hcmd(Pat,ipaty,Zero);
      If Not NoGrid99 then Hcmd(Drw,irht,iy);
      ilaby := iy+5;
      ylab := (ymin+yinc*i)*expfac;
      If (liny99 = 1) then
      Begin
        Hcmd(Org,ilabx-8,ilaby);
        FmtNum(ylab);
      End
      Else
      Begin
        Hcmd(Org,ilabx,ilaby);
        Htext(Txt,'  ',2);
        Hcmd(Bcd,Round(ylab),0);
        Hcmd(Org,ilabx,ilaby+8);
        Htext(Txt,'10',2);
        If (i <> ntic) then
        Begin
          For j := 1 to 8 do
          Begin
            itemp := iy+Round(Sca[j]*ym99);
            Hcmd(Pat,Halfdot,Zero);
            Hcmd(Org,igrd,itemp);
            Hcmd(drw,irht,itemp);
          End;
        End;
      End;
    End;
  End;


{ Write axis labels.  Vertical label spacing determined by Nchr }
  ix := 0;    { Location of label }
  iy := 399;  { ix,iy = lower left hand corner }
  Hcmd(Org,ix,iy);
  Htext(Txt,'          '+Alpha99[1],80);
  iy := 16*(Nhead+2);
  Nchr := 16;
  For i := 1 to Length(Alpha99[2]) Do
  Begin
    Hcmd(Org,ix,iy);
    ch := Alpha99[2][i];
    Htext(Txt,ch,1);
    iy := iy+Round(256.0/Nchr);
  End;

{ Place exponents if applicable }
{ First for X }
  If (xexp <> 0.0) Then
  Begin
    ix := irht-11*8;
    iy := 397;
    Hcmd(Pat,Solid,Zero);
    Box(ix-2,iy+2,ix+6*8+1,iy-16);
    Hcmd(Org,ix,iy);
    Htext(Txt,'x',1);
    Htext(Txt,' ',1);
    Htext(Txt,'E',1);
    If (xexp < 0.0) Then Htext(Txt,'-',1);
    ix := Trunc(Abs(xexp/10.0)+0.01);
    Htext(Txt,Chr(ix+48),1);
    ix := Round(abs(xexp))-10*ix;
    Htext(Txt,Chr(ix+48),1);
  End;

{ Now for Y }
  If (yexp <> 0.0) Then
  Begin
    ix := 16;
    iy := 96;
    Hcmd(Pat,Solid,Zero);
    Box(ix-2,iy+2,ix+6*8+1,iy-16);
    Hcmd(Org,ix,iy);
    Htext(Txt,'x',1);
    Htext(Txt,' ',1);
    Htext(Txt,'E',1);
    If (yexp < 0.0) Then Htext(Txt,'-',1);
    iy := Trunc(Abs(yexp/10.0)+0.01);
    Htext(Txt,Chr(iy+48),1);
    iy := Round(abs(yexp))-10*iy;
    Htext(Txt,Chr(iy+48),1);
  End;

  Hcmd(Lmx,Ilft,Irht);       { Set window limits }
  Hcmd(Lmy,Itop,Ibot);
  Hcmd(Pat,Solid,0);         { and line pattern }

  DaTime(0);                  { Place date and time }

  org99 := 1;                 { Set origin switch to true for first point }
  AxisGraph99 := True;          { Indicate that Axis-type plotting is used }
Exit:
If (Ixerr = 1) or (Iyerr = 1) then Error99 := True else Error99 := False;
End;    { Axis }


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

Procedure ReOrg;  { Set flag to indicate first call to Hplot sets origin }

Begin
  Org99 := 1;
End;    { ReOrg }


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

Procedure Interpolate(Var U1,V1: Integer; U2,V2,Uset: Integer);
                     { This is used in Hplot to reset point to edge of window
                       if it falls outside the window }

begin
  If (U1<>U2) then
  begin
    V1:= Round((V2-V1)*((Uset-U1)/(U2-U1))) + V1;
    U1:= Uset;
  end;
end;    { Interpolate }

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

Procedure Hplot(Xin,Yin : Real);
{ This performs the plotting.  If Org99=1, it sets origin else it draws
  line from previous point }

Label
  Exit;

Const
  Get : Integer   = 0;                 { Get values from common storage }
  Put : Integer   = 1;                 { Put values in common storage }
  org : Integer   = 0;                 { Set origin for line draw }
  drw : Integer   = 1;                 { Draw line }
  Itop    = 110;             { Window definition for axis }
  Ibot    = 360;             { " }
  Ilft    = 75;              { " }
  Irht    = 575;             { " }
  Flog    = 0.434294482;               { Conversion factor for LOG10 }

Var
  Ix0,Iy0,Ix1,Iy1     : Integer;
  X                   : Real;
  Y                   : Real;

Begin
  If Error99 then GoTo Exit;     { Abort on Errors }

{ Check for attemp to take LOG 0 or negative number }
  If (linx99 = 0) And (Xin <=0.0) Then
  Begin
    Writeln('Value for X must be greater than zero for Hplot of LOG');
    Goto Exit;
  End;

  If (liny99 = 0) And (Yin <=0.0) Then
  Begin
    Writeln('Value for Y must be greater than zero for Hplot of LOG');
    Goto Exit;
  End;

  If (linx99 = 1) Then X := Xin Else x := Flog*Ln(Xin);

  If (liny99 = 1) Then Y := Yin Else y := Flog*Ln(Yin);

  If (org99 = 1) Then
  Begin
    org99 := 0;
    Xold99 := x;
    Yold99 := y;
  End
  Else
  Begin
    Ix0 := Round(Xold99*xm99+xb99);
    Iy0 := Round(Yold99*ym99+yb99);

    Ix1 := Round(X*xm99+xb99);
    Iy1 := Round(Y*ym99+yb99);

    If (Ix0 < Ilft) then Interpolate(Ix0,Iy0,Ix1,Iy1,Ilft);
    If (Ix0 > Irht) then Interpolate(Ix0,Iy0,Ix1,Iy1,Irht);
    If (Iy0 < Itop) then Interpolate(Iy0,Ix0,Iy1,Ix1,Itop);
    If (Iy0 > Ibot) then Interpolate(Iy0,Ix0,Iy1,Ix1,Ibot);

    If (Ix1 < Ilft) then Interpolate(Ix1,Iy1,Ix0,Iy0,Ilft);
    If (Ix1 > Irht) then Interpolate(Ix1,Iy1,Ix0,Iy0,Irht);
    If (Iy1 < Itop) then Interpolate(Iy1,Ix1,Iy0,Ix0,Itop);
    If (Iy1 > Ibot) then Interpolate(Iy1,Ix1,Iy0,Ix0,Ibot);

    If ((Ix0 >= 0) and (Iy0 >= 0) and (Ix1 >= 0) and (Iy1 >=0)) Then
    Begin
      Hcmd(Org,Ix0,Iy0);
      Hcmd(Drw,Ix1,Iy1);
    End;

    Xold99 := X;
    Yold99 := Y;
  End;

Exit:
End;    { Hplot }

{****************************************************************************}
{ Axis }
Procedure Insert(xin,yin   : Real;
                 num       : Integer);
{ This inserts an integer at location xin,yin for numbering multiple curves }

Label
  Exit;

Const
  org  = 0;
  txt  = 2;
  Flog = 0.434294482;     { Conversion factor for LOG10 }
  Itop = 110;             { Window definition for axis }
  Ibot = 360;             { " }
  Ilft = 75;              { " }
  Irht = 575;             { " }

Var
  X,Y             : Real;
  ix,iy           : Integer;
  ch              : Line99;

Begin
  If Error99 then GoTo Exit;
  If (linx99 = 1) Then X := Xin Else x := Flog*Ln(Xin);
  If (liny99 = 1) Then Y := Yin Else y := Flog*Ln(Yin);
  ix := Round(x*xm99+xb99);
  iy := Round(y*ym99+yb99);
  Hcmd(Org,ix,iy);
  If (ix > ilft-4) and (ix < Irht+4) and (iy > Itop-4) and (iy < Ibot+360) then
  Begin
    If (num >= 0) And (num <= 10) then
    Begin
      Str(num:1,ch);
      Htext(txt,ch,1);
    End
    Else
    Begin
      Htext(txt,'?',1);
    End;
  End;
Exit:
End;    { Insert }

{*****************************************************************************}
                      { * * END OF PLOTTER ROUTINES * * }

