Program Barg; {12/11/1984 Ewb}
 Const Prmpt='Please re-enter';Grid=
 '               |+++++++++|+++++++++|+++++++++|+++++++++|+++++++++|++++++++';
 F=18; {Max bars}
 Type N=string[9];
 Var  Vh,Mn,V:array[1..F]of real; {Bar vals}
      VB,M,L,Le,Mo:real; {Value/block, Min scale and Min-Max of inputs}
      na:array[1..F]of N; {Bar names}
      T:string[52]; {Title}
      Amt:string[12];{Holds inputs until checked}
      I,J,D,A,B,E:Integer;G,Y:Byte;
      ch,ca,Cha:char; {Char inputs}
      IObyte:Byte absolute $0003; {Lst device}
Procedure Blk(X:Byte);
 begin
  For B:=1 to X do begin GotoXY(1,G+B-1);ClrEOL;end;GotoXY(1,G);
 end;
Procedure Msg;
 begin For I:=1 to 6 do begin
 GotoXY(40,24);Write('-Span too narrow-',^G);Delay(50);
 GotoXY(40,24);Write('                 ');Delay(50);end;
 end;
Procedure Title;
 begin
  Blk(2);Write('Graph title:');Read(T);
 end;
Procedure Scale;
 begin
  Blk(1);L:=Vb;Write('Value/block is now: ',Vb:8:4,' New value:');
  Readln(Amt);Val(Amt,Vb,B);If (b<>0)or(Amt='')or(Vb<0.0001)
  then begin VB:=L;write(Prmpt,^G);Scale;end;GotoXY(1,G+1);ClrEOL;
 end;
Procedure Min; {Minimum scale}
 begin
  Blk(1);Write('Define the minimum scale value:');
  Readln(Amt);Val(Amt,M,B);If (B<>0)or(Amt='')then
  begin write(Prmpt,^G);Min;GotoXY(1,G+1);ClrEOL;end;
 end;
Procedure LHbar;
 begin
  GotoXY(20,17);Write('Low--high bars ? Y/N :');
  Repeat Read(kbd,Cha);until Upcase(Cha)in['N','Y'];Cha:=Upcase(Cha);
  Write(chr(ord(Cha)+128));
 end;
Procedure Nam;
 begin
  Blk(2);write('Name of bar #',A:2,':');
  GotoXY(26,G);Write('<');GotoXY(17,G);Read(na[A]);
 end;
Procedure Minb;
 begin
  If cha='Y'then begin
  Blk(1);Write('Lowest value of ',Na[A],' :');Readln(amt);
  Val(Amt,Mn[a],B);If(B<>0)or(Amt='')or(Mn[a]<-5E4)or(Mn[A]>5E4)then
  begin GotoXY(34,G+1);Write(prmpt,^G);Minb;end;GotoXY(1,G+1);ClrEOL;end;
 end;
Procedure Value;
 begin
  GotoXY(40,G);ClrEOL;If cha='Y'then write('High ');
  Write('Value of this bar:');Readln(amt);Val(Amt,v[a],B);
  If(B<>0)or(Amt='')or(V[a]>5E4)or(V[a]<-5E4)or((Cha='Y')and
  (V[a]<Mn[a]))then begin GotoXY(40,G+1);
  Write(prmpt,^G);Value;end;GotoXY(1,G+1);ClrEOL;If(Upcase(ca)<>'C')and
  (Upcase(ca)<>'I')and(A<F)then begin Write('More? Y/N :');Repeat Read(Kbd,ch);
  Ch:=Upcase(ch);Until ch in['N','Y'];end;Vh[A]:=V[A];If cha='Y'then
  V[A]:=Vh[A]-Mn[A];Delay(50);
 end;
Procedure Auto;Var Vc:Real;
 begin
  Mo:=-1E6;Le:=1E6;For I:=1 to A do begin If (Cha='N')and(V[I]<Le)then
  Le:=V[I];If(Cha='Y')and(Mn[I]<Le)then Le:=Mn[I];If Vh[I]>Mo then
  Mo:=Vh[I];L:=Le;end;If(Le>0)and(Cha='N')then Le:=0;If(Le<0)
  and(Mo>0)or(Cha='Y')then Y:=52 else Y:=58;
  If(Mo<0)and(Cha='N')then Vb:=Abs(Le)/Y else Vb:=(Abs(Mo-Le))/Y;
  If Vb<=2000  then Vc:=2000;
  If Vb<=1000  then Vc:=1000;  If Vb<=500   then Vc:=500;
  If Vb<=200   then VC:=200;   If Vb<=100   then Vc:=100;
  If Vb<=50    then Vc:=50;    If Vb<=20    then Vc:=20;
  If Vb<=10    then Vc:=10;    If Vb<=5     then Vc:=5;
  If Vb<=2     then Vc:=2;     If Vb<=1     then Vc:=1;
  If Vb<=0.5   then Vc:=0.5;   If Vb<=0.2   then Vc:=0.2;
  If Vb<=0.1   then Vc:=0.1;   If Vb<=0.05  then Vc:=0.05;
  If Vb<=0.02  then Vc:=0.02;  If Vb<=0.01  then Vc:=0.01;
  If Vb<=0.005 then Vc:=0.005; If Vb<=0.002 then Vc:=0.002;
  If Vb<=0.001 then Vc:=0.001; If Vb<=0.0005 then Vc:=0.0005;
  If Vb<=0.0002 then Vc:=0.0002;Vb:=Abs(Vc);
  I:=Round(Mo/VB/8)*10;Repeat I:=I-10;until Le>=I*Vb-0.0011*Vb;M:=I*Vb;
 end;
Procedure Corr;
 begin
  Blk(2);Writeln('For changes, press:');
  Write('1: title, 2: scale factor, 3: min scale, 4: bar change, else <CR>');
  Repeat Read(Kbd,ch);Until ch in['1'..'4',#13];Delay(50);case ch of '1':
  Title;'2':begin Blk(2);Scale;end;'3':begin Blk(2);Min;end;'4':begin Blk(2);
  D:=A;A:=0;Write('Enter number of bar to be changed or added, else <CR>:');
  Readln(Amt);Val(amt,A,E);If(A >=1)and(A<=F)and(E=0)then begin Nam;Minb;
  Value;If A<=D then A:=D;Auto;If(Cha='Y')and(Vb<0.0002*Mo)then begin Msg;
  Corr;end;end else Write(^G);If(A<=D)or(A>F)then A:=D;end;end;
 end;
Procedure Print; Var C,L,R,R1,R2,S:Integer;K:Byte;
 begin Clrscr;Writeln('               ',T);If IObyte=2 then Writeln;
  If Vb<0.1 then E:=2 else E:=0;
  Write('      ');For J:=0 to 5 do write(M+J*VB*10:10:E);Writeln;Writeln(Grid);
  For J:=1 to A do begin {Plot `A' no. of bars}K:=Length(Na[J]);
    If IObyte=128 then begin {Plot screen bar}
     If Cha='Y'then begin  {Calc min-max bar}
  R:=Round(Abs(V[J])/Vb)+1;S:=Round((Mn[J]-M)/Vb);end;
      If cha='N'then begin
  If(M>=0)and(V[J]>=0)then begin R:=Round(V[J]/Vb-M/Vb)+1;S:=0;end;
  If(M<0)and(V[J]>=0) then begin R:=Round(V[J]/Vb)+1;S:=Round(-M/Vb);end;
  If(M<=0)and(V[J]<0) then begin R:=Round(Abs(V[J])/Vb+1);
  S:=Round(-R-M/Vb)+1;end;end;
  write(J:2,'   ',na[J]:K);For L:=1 to 10-K do Write(' ');Write('|');
  For c:=1 to S do Write(' ');Write(#8);for c:=1 to R do write('I');Writeln;
    end else begin  {Plot bar with printer graphics}
     If cha='Y'then begin
  R:=Round((Abs(V[J])/Vb)*6);S:=Round((Mn[J]/Vb-M/Vb)*6)+2;end;
      If cha='N'then begin
  If(M>=0)and(V[J]>=0)then begin R:=Round((V[J]/Vb-M/Vb)*6);S:=2;end;
  If(M<0)and(V[J]>=0) then begin R:=Round((V[J]/Vb)*6);S:=2-Round(M/Vb*6);end;
  If(M<=0)and(V[J]<0) then begin R:=Round((Abs(V[J])/Vb)*6);
  S:=2+Round((-M/Vb+(V[J]/Vb))*6);end;end;
     R1:=(R+S+1)mod 256;R2:=(R+S+1)div 256;
  Write('     ',na[J]:K);For L:=1 to 10-K do Write(' ');Write(#156#8);
  Write(#27#75,char(R1),char(R2));For c:=1 to S do Write(char(0));Write(#255);
  For c:=1 to R-1 do Write(#129);Writeln(#255#27#64);end;end;{End Epson G}
  Writeln(Grid);IObyte:=128;
 end;
Procedure Del;
 begin
  Blk(2);Write('Enter number of bar to delete:');Read(Amt);Val(Amt,J,B);
  If(B=0)and(J<=A)and(J>0)and(Amt<>'')then begin For I:=J to A-1 do begin
  Na[I]:=Na[I+1];Mn[I]:=Mn[I+1];V[I]:=V[I+1];Vh[I]:=Vh[I+1];end;A:=A-1;
  For I:=A+1 to F do begin Na[I]:='';Mn[I]:=0;V[I]:=0;Vh[I]:=0;end;
  If A>0 then Auto;end else Write(^G);
 end;
Procedure Insert;
 begin
  Blk(2);If A<F then begin Write('Enter number of bar to insert:');
  Read(Amt);Val(Amt,J,B);I:=A+1;If(B=0)and(J<=A)and(J>0)
  and(Amt<>'')then begin While I>J do begin I:=I-1;Na[I+1]:=Na[I];
  Mn[I+1]:=Mn[I];V[I+1]:=V[I];Vh[I+1]:=Vh[I];end;A:=A+1;D:=A;A:=J;Nam;
  Minb;Value;A:=D;Auto;end else Write(^G);end else Write(^G);
 end;
Procedure Pm; {Program manager}
 begin
  If ca='R'then begin clrscr;For A:=1 to F do begin
  Na[A]:='';V[A]:=0;Mn[A]:=0;Vh[A]:=0;end;
  Write('-Graph Program-  Max no of bars: ',F,'    --Use ^H as delete key--');
  G:=4;Title;GotoXY(17,15);Writeln('--Start entering bar data--');G:=23;
  A:=0;Ch:='Y';While(ch='Y')and(A<F)do begin A:=A+1;If A=1 then LHbar;
  Nam;Minb;Value;end;Auto;If(Cha='Y')and(Vb<0.0002*Mo)then begin Msg;Corr;
  ca:=' ';Auto;end;print;end;E:=0;Blk(2);
  Writeln('(P)rint--Ready printer  (D)elete bar  (I)nsert bar  (R)e-do');
  Write  ('(C)hanges-- or add bar  (A)utoscale   (S)top         ?');
  Repeat Read(Kbd,ca);Until Upcase(ca)in['A','C','D','I','P','R','S'];
  Ca:=Upcase(Ca);Case Ca of'S':begin Delay(400);Halt;end;'P':IObyte:=2;'R':Pm;
  'C':Corr;'A':Auto;'D':Del;'I':Insert;end;Print;Pm
 end;
Begin Ca:='R';Pm;end. {Main}
