program pictextest;
 
uses {cb_util,}dos,crt{,mathfunc};
 
 
 
type styp = (right,left);
 
var aus                                                             : text;
    ausn,oben,unten,rechts,links,eingabe,ausgabe,
	savename,savekomm,unterschrift,labelstr,ueberschrift        : string;
    unitx,unity, xmax,xmin,ymax,ymin,dx,dy,dxsub,dysub,breite,hoehe,
	  unitry,          rymin,rymax,rdy,rdysub                   : real;
    fertig,rechteachse,xlog,ylog,rylog,xkreuz,ykreuz,rykreuz        : boolean;
    ydez,xdez,rydez                                                 : byte;
    ch,sprache                                                      : char;
    seite                                                           : styp;
    dos_major_version, dos_minor_version                            : integer;
 
 
(***********************************************************************
Received: by DEARN (Mailer R2.03B) id 8469; Wed, 14 Feb 90 18:27:58 MEZ
Date:         Wed, 14 Feb 90 01:19:57 CST
Reply-To:     Borland Pascal Discussion Group <PASCAL-L@YALEVM>
Sender:       Borland Pascal Discussion Group <PASCAL-L@YALEVM>
From:         "John M. Kelsey" <C445585@UMCVMB.BITNET>
Subject:      Cursor questions
To:           "Christian Boettger, TU Braunschweig, FRG" <I2010506@DBSTU1>
 
I finally got around to looking up the three BIOS interrupst I needed
to call and got a working package to make the cursor vanish, then restore
it to the same kind of cursor it was before.  (Otherwise, a program which
uses different cursor-sizes at different times, and uses a generic routine
to set the cursor off and back to the small cursor, may have the cursor
size change every time, say, a window is blown open.)  I'll type these two
procedures in here.
*************************************************************************)
 
Procedure Cursor_Vanish(VAR W : Word);
VAR Regs : Registers;
Begin WITH Regs DO Begin
  AH := $03;
  BH := $00;
  Intr($10,Regs);
  W  := CX;
  AH := $01;
  CL := $20;
  CH := $20;
  Intr($10,Regs);
End End;  { End procedure }
 
Procedure Cursor_Restore(VAR W : Word );
VAR Regs : Registers;
Begin WITH Regs DO Begin
  AH := $01;
  BH := $00;
  CX := W;
  Intr($10,Regs);
End End; { End procedure }
 
(*************************************************************************
These two procedures have to be compiled with the DOS unit available.
(After the Program line, put uses DOS;)
 
I've tried to be pretty careful typing these in, but I don't even pretend
to be perfect, so if you want to use these procedures, I'd recommend typing
them in, then saving them, then running a program once as a test.  (A test
program for these two should be pretty simple.)
 
Also, regarding the screen saving procedures in _Turbo Pascal, the
Complete Reference_, I've written some routines that implement a simple
stack of saved screens, so that you can simply push the present screen
state, draw your menu, then pop the last screen state off the stack.
If anyone's interested, I should be able to upload the routines from a PC
disk....
 
--John Kelsey, C445585@UMCVMB
**************************************************************************)
 
Function Zentriere (meldung : string; var status : boolean) : byte;
{Berechnet X-Position fr zentrierte Ausgabe von MELDUNG mit GotoXY}
var laenge : byte;
begin
  laenge := length(meldung);
  if ((laenge>=80) or (laenge=0)) then status := false else status := true;
  if status then Zentriere := (80-length(meldung)) DIV 2
            else Zentriere := 0;
end; {of Zentriere}
 
procedure Ende (var raus : boolean);
   var screen  : string;
       status  : boolean;
       antwort : char;
 
   BEGIN
     raus := FALSE;
     ClrScr;
     screen := 'Programm wirklich beenden (j/n) ? ';
     GotoXY(Zentriere(screen,status),12); write(screen);
     Readln(antwort);
     antwort := UpCase(antwort);
     IF antwort = 'J' THEN raus := TRUE;
   END;
 
 
procedure StandBy;
   CONST meldung1 = 'Weiter mit beliebiger Taste';
         meldung2 = '                           ';
   var x,y,x_pos : byte;
       muell     : char;
       cursor    : word;
       status    : boolean;
   begin
     Cursor_Vanish(cursor);
     x:=whereX; y:= WhereY;
     x_pos := Zentriere(meldung1,status);
     GotoXY(x_pos,25);
     HighVideo;
     write(meldung1);
     NormVideo;
     repeat until keypressed;
     muell := ReadKey;
     GotoXY(x_pos,25); write(meldung2);
     GotoXY(x,y);
     Cursor_Restore(cursor);
   end;
 
 
(************************************************************************
Received: from CUNYVM by CUNYVM.BITNET (Mailer R2.03B) with BSMTP id 6339; Tue,
 13 Feb 90 21:05:12 EST
Received: from cod.nosc.mil by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.2MX) with TCP;
 Tue, 13 Feb 90 21:05:09 EST
Received: by cod.nosc.mil (5.59/1.27)
	id AA01529; Tue, 13 Feb 90 18:06:29 PST
Date: Tue, 13 Feb 90 18:06:29 PST
From: howell@cod.nosc.mil (Susan Howell)
Message-Id: <9002140206.AA01529@cod.nosc.mil>
To: ADD.@BOETT
Cc: howell@cod.nosc.mil
Subject: Source for supporting unit ERRORCOD
 
-------
 
 
 
                               APPENDIX R
 
                    SOURCE LISTING FOR UNIT ERRORCOD
 
***********************************************************************)
(*******************************************************************)
(****                      ERRORCOD.PAS                         ****)
(****  This unit maps MS-DOS error codes returned by the        ****)
(****  operating system to strings to give the operator a       ****)
(****  human readable response.                                 ****)
(****                                                           ****)
(****  Reference:  MS-DOS Version 3 Programmer's Utility Pack   ****)
(****              MS-DOS Reference Guide Volume 1              ****)
(****              1986, pp. 4.86-4.88, 4.254-4.257.            ****)
(****                                                           ****)
(****  Developed by Nelson Ard                                  ****)
(****                                                           ****)
(****  Last modificaton Sep 89                                  ****)
(*******************************************************************)
(*********************
UNIT ErrorCod;
 
INTERFACE
 
USES Dos;
*******************)
CONST Error_Code : ARRAY [0..88] OF
      string[40] = ('No errors',
                    'Invalid function code',
                    'File not found',
                    'Path not found',
                    'No file handles left',
                    'Access denied',
                    'Invalid handle',
                    'Memory control blocks destroyed',
                    'Insufficient memory',
                    'Invalid memory block address',
                    'Invalid environment',
                    'Invalid format',
                    'Invalid access code',
                    'Invalid data',
                    'RESERVED error code',
                    'Invalid drive',
                    'Attempt to remove the current directory',
                    'Not same device',
                    'No more files',
                    'Disk is write-protected',
                    'Bad disk unit',
 
                    'Drive not ready',
                    'Invalid disk command',
                    'CRC error',
                    'Invalid length (disk operation)',
                    'Seek error',
                    'Not an MS-DOS disk',
                    'Sector not found',
                    'Out of paper',
                    'Write fault',
                    'Read fault',
                    'General failure',
                    'Sharing violation',
                    'Lock violation',
                    'Wrong disk',
                    'FCB unavailable',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'Network request not supported',
                    'Remote computer not listening',
                    'Duplicate name on network',
                    'Network name not found',
                    'Network busy',
                    'Network device no longer exists',
                    'Net BIOS command limit exceeded',
                    'Network adapter hardware error',
                    'Incorrect response from network',
                    'Unexpected network error',
                    'Incompatible remote adapt',
                    'Print queue full',
                    'Queue not full',
                    'Not enough space for print file',
                    'Network name was deleted',
                    'Access denied',
                    'Network device type incorrect',
                    'Network name not found',
                    'Network name limit exceeded',
                    'Net BIOS session time exceeded',
                    'Temporarily paused',
                    'Network request not accepted',
 
                    'Print or disk redirection is paused',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'RESERVED error code',
                    'File exits',
                    'Duplicate File Control Block',
                    'Cannot make',
                    'Interrupt 24 failure',
                    'Out of structures',
                    'Already assigned',
                    'Invalid password',
                    'Invalid parameter',
                    'Net write fault');
 
CONST Error_Class : ARRAY [1..12] OF string[40] =
                   ('Out of a resource',
                    'Temporary situation',
                    'Permission problem',
                    'Internal error in system software',
                    'Hardware failure',
                    'System software failure',
                    'Application program error',
                    'File or item not found',
                    'File or item of invalid format',
                    'File or item interlocked',
                    'Media failure - storage medium',
                    'Unknown error');
 
      Recommended_Error_Action : ARRAY [1..7] OF String[40] =
                   ('Retry, then prompt user',
                    'Retry after a pause',
                    'Reprompt user to reenter',
                    'Terminate with clean up',
                    'Terminate immediately',
                    'Observe only',
                    'Retry after correcting fault');
 
      Error_Locus : ARRAY [1..5] OF String[40] =
                   ('Unknown',
                    'Random Access block device',
                    'Related to a network',
                    'Related to serial access device',
                    'Related to RAM');
 
(************************************************
PROCEDURE Extended_Error_Code (VAR Error_Code  : INTEGER;
                               VAR Error_Class : Byte;
                               VAR Error_Locus : Byte);
 
{ Following an error code returned by an MS-DOS function call or
  I/O function, this may be called for amplification on the
  error }
 
**********IMPLEMENTATION**********************)
 
Var index : integer;
 
PROCEDURE Extended_Error_Code (VAR Error_Code  : INTEGER;
                               VAR Error_Class : Byte;
                               VAR Error_Locus : Byte);
 
Var Regs : Registers;
 
BEGIN
  Regs.AH := $59;
  Regs.BX := 0;
  Intr($21, Regs);
  Error_Code := Regs.AX;
  Error_Class := Regs.BH;
  Error_Locus := Regs.CH;
END;
(*********************
BEGIN
END.
*********************)
(***********************************************************************
-------
 
Addressees in 'BOETT.ADD' are:  I2010506%DBSTU1.bitnet@cunyvm.cuny.edu
************************************************************************)
 
{***************************************************************************}
{ Name    : GET_DOS_VERSION                                                 }
{                                                                           }
{ Purpose : To obtain the version number of DOS.                            }
{                                                                           }
{ Input   : none                                                            }
{                                                                           }
{ Output  : dos_major_ver : version of dos                                  }
{           dos_minor_ver : level of dos_major_ver                          }
{                                                                           }
{ Example : DOS 3.1 would yield [dos_major_ver = 3                          }
{                                dos_minor_ver = 10]                        }
{***************************************************************************}
procedure get_dos_version(var maj, min : integer);
var regs : registers;
begin
  with regs do begin
    ah:=$30;
    msdos(regs);
    maj := al;
    min := ah;
  end;
end;
 
 
procedure GetDOSErrorMessage (code : integer; var message : string);
  begin
    case code of
         0 : message := 'OK';
         2 : message := 'Datei nicht gefunden';
         3 : message := 'Suchweg nicht gefunden';
         5 : message := 'Zugriff verweigert';
         6 : message := 'Handle nicht definiert/ungltig';
         8 : message := 'nicht gengend Hauptspeicher frei';
        10 : message := 'Environment-Parameter ungltig';
        11 : message := 'ungltiges Befehlsformat';
        18 : message := 'keine weiteren Dateieintrge/Datei nicht vorhanden';
        else begin
               Str(code,message);
	       message := 'DOS - Fehler Nr. ' + message + ' = ' + Error_Code[code];
             end;
        end;
  end;
 
procedure GetCompleteDOSErrorMessage (code : integer;
				      var Error,error_cl,error_l : string);
  var class,locus : byte;
      fehler      : integer;
  begin
    Extended_Error_Code(fehler,class,locus);
    Error := Error_Code[fehler];
    error_cl := Error_Class[class];
    error_l  := Error_Locus[locus];
    if code <> fehler then writeln('NANUNANA!!!');
  end;
 
 
 
procedure read_value(var datei : text; var wert : extended);
 
   type  vorzeichen = (plus,minus,none);
	 zeichentyp = (trennung,sign,value,point,garbage);
 
   const o_komma = Ord(',');
	 o_space = Ord(' ');
	 o_semi  = Ord(';');
	 o_lf    = 10;
	 o_cr    = 13;
	 o_null  = Ord('0');
	 o_neun  = Ord('9');
	 o_punkt = Ord('.');
	 o_e_kl  = Ord('e');
	 o_e_gr  = Ord('E');
	 o_plus  = Ord('+');
	 o_minus = Ord('-');
	 null    = '0';
 
   var puffer1,puffer2   : char;
       weiter,raus,basic : boolean;
       akt_vorz,alt_vorz,
	vorz2            : vorzeichen;
       puffer_art,
	puffer_art_2     : zeichentyp;
 
   function CheckDelimiter(test : char) : boolean;
      var o_test : byte;
      begin
	o_test := Ord(test);
	if ((o_test=o_komma) or (o_test=o_space) or (o_test=o_semi)
			     or (o_test=o_lf)    or (o_test=o_cr))
	   then CheckDelimiter := true
	   else CheckDelimiter := false;
      end;
 
   function CheckValue(test : char) : boolean;
      var o_test : byte;
      begin
	o_test := Ord(test);
	if ((o_test>=o_null) and (o_test<=o_neun))
	   then CheckValue := true
	   else CheckValue := false;
      end;
 
   function CheckPunkt(test : char) : boolean;
      begin
	if (Ord(test)=o_punkt)
	   then CheckPunkt := true
	   else CheckPunkt := false;
      end;
 
   function CheckE(test : char) : boolean;
      var o_test : byte;
      begin
	o_test := Ord(test);
	if ((o_test=o_e_kl) or (o_test=o_e_gr))
	   then CheckE := true
	   else CheckE := false;
      end;
 
   function CheckPlus(test : char) : boolean;
      begin
	if (Ord(test)=o_plus)
	   then CheckPlus := true
	   else CheckPlus := false;
      end;
 
   function CheckMinus(test : char) : boolean;
      begin
	if (Ord(test)=o_minus)
	   then CheckMinus := true
	   else CheckMinus := false;
      end;
 
   function CheckIOResult : boolean;
      var code                     : integer;
	  error_m,error_cl,error_l : string;
      begin
	{$I-}
	code := IOResult;
	if code<>0
	 then begin
		CheckIOResult := false;
		if DOS_Major_Version >= 3     {UNIT ENV}
		  then
		   begin
		     GetCompleteDOSErrorMessage(code,error_m,error_cl,error_l);
		     writeln('I/O-Fehler ',code,' --> ',error_m);
		     writeln('I/O-Fehler-Klasse ',error_cl);
		     writeln('I/O-Fehler-Locus  ',error_l);
		   end
		  else
		   begin
		     GetDOSErrorMessage(code,error_m);
		     writeln('I/O-Fehler ',code,' --> ',error_m);
		   end;
		StandBy;
	      end
	 else CheckIOResult := true;
      end;
 
   function puffertest(puffer : char; var vorz : vorzeichen) : zeichentyp;
      begin   {of puffertest}
	puffertest := garbage;
        if CheckMinus(puffer) then vorz := minus
			     else if CheckPlus(puffer)
				    then vorz := plus
				    else vorz := none;
        if vorz<>none
	 then puffertest := sign
	 else if CheckDelimiter(puffer)
		then puffertest := trennung
		else if CheckPunkt(puffer)
		       then puffertest := point
		       else if CheckValue(puffer) then puffertest := value;
      end;   {of puffertest}
 
 
   procedure skip(var datei : text; var vorz : vorzeichen; var puffer : char;
		  var puffertyp : zeichentyp);
    begin   {of skip}
      {$I-}
      vorz := none;
      puffertyp := garbage;
      repeat
       if eoln(datei) then readln(datei);
       read(datei,puffer);
       if not CheckIOResult then begin
				   ende(raus);
				   if raus then halt(300);
				 end;
 
       puffertyp := puffertest(puffer,vorz);
       {
       case vorz of
	    plus : write('P');
	    minus: write('M');
	    none : write('n');
	   end;
       }
      until ((puffertyp<>garbage) or eof(datei));
    end;  {of skip}
 
 
   procedure PickUp(var datei : text; basic : boolean; puffer : char;
		    VAR wert : extended );
 
      var zahl            : string;
	  stop,punkt,raus : boolean;
	  puffer2         : char;
	  fehler          : integer;
      begin  {of PickUp}
	{$I-}
	zahl := '';
	punkt := false;
	stop := false;
	if basic then begin zahl := '0.'; punkt := true; end;
	zahl := zahl+puffer;
	while ((not eoln(datei) and (not stop))) do
	 begin
	   read(datei,puffer);
	   if not CheckIOResult then begin
				       ende(raus);
				       if raus then halt(300);
				     end;
	   if ((CheckPunkt(puffer) and punkt) or CheckDelimiter(puffer))
	      then stop := true
	      else if (CheckValue(puffer) or (CheckPunkt(puffer) and (not punkt)))
		      then begin
			     zahl := zahl+puffer;
			     if CheckPunkt(puffer) then punkt := true;
			   end
		      else if (not CheckE(puffer))
			      then stop := true
			      else begin
				     if (not eoln(datei))
					then begin
					       read(datei,puffer2);
					       if not CheckIOResult
						  then begin
							 ende(raus);
							 if raus then halt(300);
						       end;
					       if (CheckMinus(puffer2) or (CheckPlus(puffer2)))
						  then zahl := zahl+puffer+puffer2
						  else stop := true;
					     end
					else stop := true;
				   end;
	 end;
	Val(zahl,wert,fehler);
	if fehler<>0 then begin
			    HighVideo;
			    writeln('Fehler beim Einlesen von >',zahl,'< an Position ',fehler,' !!');
			    NormVideo;
			    StandBy;
			    ende(raus);
			    if raus then halt(301);
			  end;
      end; {of PickUp}
 
   begin {of READ_VALUE}
     {$I-}
     akt_vorz := none;
     alt_vorz := none;
 
     weiter := true;
     wert :=0;
 
     while ((not eof(datei)) and weiter) do
      begin
	basic := false;
	alt_vorz := akt_vorz;
	skip(datei,akt_vorz,puffer1,puffer_art);
	case puffer_art of
	     value    : begin
			  akt_vorz := alt_vorz;
			  PickUp(datei,basic,puffer1,wert);
			  weiter := false;
			end;
	     point    : begin
			  read(datei,puffer2);
			  if not CheckIOResult then begin
						      ende(raus);
						      if raus then halt(300);
						    end;
			  puffer_art_2 := puffertest(puffer2,vorz2);
			  case puffer_art_2 of
			       value    : begin
					    basic := true;
					    akt_vorz := alt_vorz;
					    PickUp(datei,basic,puffer2,wert);
					    weiter := false;
					  end;
			       sign     : akt_vorz := vorz2;
			       trennung : akt_vorz := none;
			       point    : akt_vorz := none;
			     end;
			end;
	     trennung : akt_vorz := none;
	     sign     : begin
                          read(datei,puffer2);
			  if not CheckIOResult then begin
						      ende(raus);
						      if raus then halt(300);
						    end;
			  puffer_art_2 := puffertest(puffer2,vorz2);
			  case puffer_art_2 of
			       value    : begin
					    basic := false;
					    PickUp(datei,basic,puffer2,wert);
					    weiter := false;
					  end;
			       sign     : akt_vorz := vorz2;
			       trennung : akt_vorz := none;
			       point    : begin
					    read(datei,puffer2);
					    if not CheckIOResult
					      then begin
						     ende(raus);
						     if raus then halt(300);
						   end;
					    puffer_art_2 := puffertest(puffer2,vorz2);
					    case puffer_art_2 of
						 value    : begin
							      basic := true;
							      PickUp(datei,basic,puffer2,wert);
							      weiter := false;
							    end;
						 sign     : akt_vorz := vorz2;
						 trennung : akt_vorz := none;
						 point    : akt_vorz := none;
						end;
					  end;
			     end;
			end;
	     end;
      end;
     if akt_vorz=minus then wert :=-wert;
     {$I+}
   end; {of READ_VALUE}
 
procedure read_value_eof(var datei : text; var wert : extended; var ende : boolean);
   begin
     ende := eof(datei);
     if not ende then begin
			read_value(datei,wert);
			ende := eof(datei);
		      end;
   end;
 
(****************************************************************************)
(* Zehner-Logarithmus von 'x':                                              *)
 
FUNCTION lg (x: extended): extended;
 
CONST rez_ln_10 = 0.4342944819;             (* rez_ln_10 = 1 / ln(10) *)
 
BEGIN
  lg :=0;
  IF x > 0.0 THEN
    lg := Ln(x) * rez_ln_10
  ELSE
    {CalcError(3, 'lg(x): x <= 0')}
    writeln('Argumentfehler: lg(x): x <= 0 !!!')
END;
 
(****************************************************************************)
(* Berechnung von 'x hoch y':                                               *)
 
FUNCTION x_hoch_y (x, y: extended): extended;
 
VAR ganz_y: INTEGER;
 
BEGIN
  IF (x <> 0.0) OR (y <> 0.0) THEN
    IF x > 0.0 THEN
      x_hoch_y := Exp(y * Ln(x))
    ELSE
      BEGIN
        ganz_y := Trunc(y);
        IF ABS(y) > ABS(ganz_y) THEN
	  {CalcError(3, 'x_hoch_y(x,y): nur ganzzahlige Exponenten zulssig bei x<0')}
	  writeln('x_hoch_y(x,y): nur ganzzahlige Exponenten zulssig bei x<0')
        ELSE
          IF x <> 0.0 THEN
            IF (ganz_y MOD 2) = 0 THEN
              x_hoch_y :=  Exp(Ln(ABS(x)) * y)
            ELSE
              x_hoch_y := -Exp(Ln(ABS(x)) * y)       (* ungerader Exponent *)
          ELSE
            x_hoch_y := 0
      END
  ELSE
    {CalcError(3, 'x_hoch_y(x,y): x = 0 und y = 0')}
    writeln('x_hoch_y(x,y): x = 0 und y = 0')
END;
 
(****************************************************************************)
 
 
(****************************************************************************)
procedure process_file(seite : styp;
		       var fertig : boolean;
		       rechteachse,xlogar,ylogar : boolean;
		       var aus : text);
 
 
    function betest(t,v : string): boolean;
	var t1 : string;
	    i : byte;
	begin
	  t1:=t;
	  for i:=1 to length(t) do t1[i]:=UpCase(t[i]);
	  while t1[1]=' ' do Delete(t1,1,1);
	  if t1=v then betest := true else betest :=false;
	end;
 
  const b1='BEGIN';
	e1='END';
 
  var einn,symbol,test : string;
      ein : text;
      f    : SearchRec;
      anzahl : longint;
      ch   : char;
      sym,linie,quadratic,clipping,ende : boolean;
      x,y,xa,ya : extended;
 
  begin {of process_file}
    writeln('Ende durch leere Eingabe !!');
    repeat
      write('Daten -Datei (TechPlot-Format!!) : ');
      readln(einn);
      if einn='' then fertig:=true;
      FindFirst(einn,Archive,F);
    until ((DOSError=0) or fertig);
 
    if not fertig then
     begin
       anzahl :=0;
       assign(ein,einn);
       repeat
	 write('mit Plotsymbol      (j/n) ? ');
	 readln(ch);
	 ch := UpCase(ch);
       until ((ch='J') or (ch='N'));
       if ch='J' then sym := true else sym := false;
       repeat
	 write('durchgezogene Linie (j/n) ? ');
	 readln(ch);
	 ch := UpCase(ch);
       until ((ch='J') or (ch='N'));
       if ch='J' then linie := true else linie := false;
       if linie then
	begin
          repeat
	    write('Quadratische Interpolation (1) oder Polygonzug (2) ? ');
	    readln(ch);
	    ch := UpCase(ch);
	  until ((ch='1') or (ch='2'));
	  if ch='1' then quadratic := true else quadratic := false;
          repeat
	    write('Clipping ntig (Achtung, das dauert LANGE) (j/n) ? ');
	    readln(ch);
	    ch := UpCase(ch);
	  until ((ch='J') or (ch='N'));
	  if ch='J' then clipping := true else clipping := false;
	end;
 
       if sym then
	begin
	  write('Plotsymbol (LaTeX-Text) : ');
	  readln(symbol);
	  reset(ein);
          writeln(aus,'%Datei ',einn,' (Symbole)');
	  repeat
	    readln(ein,test);
	    writeln(aus,'%% ',test);
	  until ((betest(test,b1)) or eof(ein));
	  ende := false;
	  if eof(ein) then ende := true;
	  write(aus,'% Daten fuer ');
	  if rechteachse then
	   if (seite=left)
	     then write(aus,'linke ')
	     else write (aus,'rechte ');
	  writeln(aus,'y-Achse ...');
	  if not ende then
	   begin
	     writeln('\multiput {',symbol,'} at ');
	     writeln(aus,'\multiput {',symbol,'} at  %');
	   end;
	  while not ende do
	    begin
	      read_value_eof(ein,x,ende);
	      read_value_eof(ein,y,ende);
	      if not ende then begin
				 readln(ein);
				 Inc(anzahl);
				 if xlogar then x:=lg(x);
				 if ylogar then y:=lg(y);
				 writeln(aus,'  ',x:8:6,' ',y:8:6,' %');
				 writeln(x:8:5,' ',y:8:4);
			       end
			  else begin
				 writeln(' /');
				 writeln(aus,' /');
			       end;
	    end;
	end;
       if linie then
	begin
	  reset(ein);
	  anzahl :=0;
          writeln(aus,'%Datei ',einn,' (Linie)');
          repeat
	    readln(ein,test);
	    writeln(aus,'%% ',test);
	  until ((betest(test,b1)) or eof(ein));
	  ende := false;
	  if eof(ein) then ende := true;
 
	  if clipping then  writeln(aus,'\inboundscheckon');
	  if quadratic then writeln(aus,'\setquadratic')
		       else writeln(aus,'\setlinear');
	  writeln(aus,'\plot ');
	  while not ende do
	    begin
	      read_value_eof(ein,x,ende);
	      read_value_eof(ein,y,ende);
	      if not ende then begin
				 readln(ein);
				 Inc(anzahl);
                                 if xlogar then x:=lg(x);
				 if ylogar then y:=lg(y);
				 xa :=x;
				 ya :=y;
				 writeln(aus,'  ',x:8:6,' ',y:8:6,' %');
				 writeln(x:8:4,' ',y:8:4);
			       end;
	    end;
	  if quadratic then
	    if not odd(anzahl) then
	      writeln(aus,xa*1.00001:8:6,' ',ya*1.00001:8:6,' %');
	  writeln(aus,'/');
	  if clipping then  writeln(aus,'\inboundscheckoff');
	end;
       close(ein);
     end;
  end; {of process_file}
 
  procedure Einheiten(var unitx,unity,unitry : real; breite,hoehe : real;
		      rechteachse,xlog,ylog,rylog : boolean);
     begin
       if xlog then unitx := breite/(lg(xmax)-lg(xmin))
	       else unitx := breite/(xmax-xmin);
       if ylog then unity := HOEHE/(lg(ymax)-lg(ymin))
	       else unity := hoehe/(ymax-ymin);
       if rechteachse then if rylog then unitry := hoehe/(lg(rymax)-lg(rymin))
				    else unitry := hoehe/(rymax-rymin)
		      else unitry :=0;
     end;
 
  procedure skala (var aus : text;
		   seite : styp;
		   unitx,unity : real;
		   xlog,ylog,rechteachse,xkreuz,ykreuz : boolean;
		   xmin,xmax,dx,dxsub,ymin,ymax,dy,dysub : real;
		   xdez,ydez :byte;
		   unten,oben,rechts,links : string);
 
     procedure Log_schrift(var aus: text; min,max : real;
			   markiere,kreuz : boolean);
     {$I float.typ}
     var ort,o2 : float;
	 expo,code : integer;
	 stellen,i : byte;
	 ex : string;
     begin
       writeln(aus,' ticks logged  ');
       if kreuz then write(aus,'andacross ');
       if markiere then writeln(aus,'numbered ') else writeln(aus,'unlabeled ');
 
       if markiere
	then
	 begin        {Zahlen dranschreiben}
	   write(aus,'withvalues ');
	   ort := min/10;
	   repeat
	     Str(lg(ort):1:0,ex);
	     Val(ex,expo,code);
	     {expo := trunc(lg(ort));}
	     o2 := (x_hoch_y(10,expo));
	     if ((o2>=min) and (o2<=max))
	      then write(aus,'$10^{',expo,'}$ ');
	     ort := 2*o2;
	     if ((ort<=max) and (ort>=min))
	      then write(aus,'{\small 2} ');
	     ort := 3*o2;
	     if ((ort>=min) and (ort<=max))
	      then write(aus,'{\small 3} ');
	     ort := 5*o2;
	     if ((ort>=min) and (ort<=max))
	      then write(aus,'{\small 5} ');
	     ort := 10*o2;
	   until ort>max;
	   writeln(aus,' /');
	 end;
 
	  {ticks setzen, normal lang}
       write(aus,' at ');
       ort := min/10;
       repeat
         Str(lg(ort):1:0,ex);
	 Val(ex,expo,code);
	 {expo := trunc(lg(ort));}
	 o2 := (x_hoch_y(10,expo));
	 if expo<0 then stellen := abs(expo) else stellen :=0;
	 if ((o2>min) and (o2<max))
	  then write(aus,x_hoch_y(10,expo):1:stellen,' ');
	 {o2 := ort;}
	 ort := 2*o2;
	 if ((ort<max) and (ort>min))
	  then write(aus,ort:1:stellen,' ');
	 ort := 3*o2;
	 if ((ort>min) and (ort<max))
	   then write(aus,ort:1:stellen,' ');
	 ort := 5*o2;
	 if ((ort>min) and (ort<max))
	  then write(aus,ort:1:stellen,' ');
	 ort := 10*o2;
       until ort>max;
       writeln(aus,' /');
 
	   {ticks, immer ohne Beschriftung, lang }
       writeln(aus,' unlabeled at ');
       ort := min/10;
       repeat
         Str(lg(ort):1:0,ex);
	 Val(ex,expo,code);
	 {expo := trunc(lg(ort));}
	 o2 := (x_hoch_y(10,expo));
	 if expo<0 then stellen := abs(expo) else stellen :=0;
	 ort := 4*o2;
	 if ((ort>min) and (ort<max))
	   then write(aus,ort:1:stellen,' ');
	 for i:=6 to 9 do
	  begin
	    ort := i*o2;
	    if ((ort>min) and (ort<max))
	     then write(aus,ort:1:stellen,' ');
	  end;
	 ort := 10*o2;
       until ort>max;
       writeln(aus,' /');
 
	 {ticks, ohne Beschriftung, kurz }
       writeln(aus,' unlabeled short at ');
       ort := min/10;
       repeat
	 Str(lg(ort):1:0,ex);
	 Val(ex,expo,code);
	 {expo := trunc(lg(ort));}
	 o2 := (x_hoch_y(10,expo));
	 if expo<=0 then stellen := abs(expo)+1 else stellen :=0;
	 for i:=1 to 9 do
	  begin
	    ort := o2*(1+i*0.2);       {1.2, 1.4, ... 2.8 }
	    if ((ort>min) and (ort<max))
	      then write(aus,ort:1:stellen,' ');
	  end;
	 ort :=3.5*o2;
	 if ((ort>min) and (ort<max))
	  then write(aus,ort:1:stellen,' ');
	 ort :=4.5*o2;
	 if ((ort>min) and (ort<max))
	  then write(aus,ort:1:stellen,' ');
	 ort := 10*o2;
       until ort>max;
       writeln(aus,' /');  {letztes "at"}
       writeln(aus,' /');  {Ende von "\axis"}
     end;
 
  var con : text;
  begin
    assign(con,'con');
    rewrite(con);
    write('\setcoordinatesystem units <',unitx:1:5,'mm,',unity:1:5,'mm> point at ');
    if xlog then write(lg(xmin):1:5,' ')
	    else write(xmin:1:5,' ');
    if ylog then writeln(lg(ymin):1:5)
	    else writeln(ymin:1:5);
 
    write('\setplotarea x from ');
    if xlog then write(lg(xmin):8:5)
	    else write(xmin:8:5);
    write(' to ');
    if xlog then write(lg(xmax):8:5)
	    else write(xmax:8:5);
    write(', y from ');
    if ylog then write(lg(ymin):8:5)
	    else write(ymin:8:5);
    write(' to ');
    if ylog then writeln(lg(ymax):8:5)
	    else writeln(ymax:8:5);
    if seite=left
     then
     begin
       write('\axis bottom shiftedto y=');
       if ylog then write(lg(ymin):8:5)
	       else write(ymin:8:5);
       write(' label {',unten,'} ');
       if xlog then Log_schrift(con,xmin,xmax,true,xkreuz)
	       else writeln(' ticks numbered  from ',
		  xmin:8:xdez,' to ',xmax:8:xdez,' by ',dx:8:xdez,
		  ' unlabeled short from ',xmin:8:xdez,' to ',
		  xmax:8:xdez,' by ',dxsub:8:xdez,' /');
 
       write('\axis top    shiftedto y=');
       if ylog then write(lg(ymax):8:5)
	       else write(ymax:8:5);
       write(' label {',oben,'} ');
       if xlog then Log_schrift(con,xmin,xmax,false,false)
	       else writeln(' ticks unlabeled  from ',
		  xmin:8:xdez,' to ',xmax:8:xdez,' by ',dx:8:xdez,
		  ' unlabeled short from ',xmin:8:xdez,' to ',
		  xmax:8:xdez,' by ',dxsub:8:xdez,' /');
 
       write('\axis left   shiftedto x=');
       if xlog then write(lg(xmin):8:5)
	       else write(xmin:8:5);
       write(' label {',links,'} ');
       if ylog then Log_schrift(con,ymin,ymax,true,ykreuz)
	       else writeln(' ticks numbered  from ',
		  ymin:8:ydez,' to ',ymax:8:ydez,' by ',dy:8:ydez,
		  ' unlabeled short from ',ymin:8:ydez,' to ',
		  ymax:8:ydez,' by ',dysub:8:ydez,' /');
       if not rechteachse then
	begin
	  write('\axis right   shiftedto x=');
	  if xlog then write(lg(xmax):8:5)
		  else write(xmax:8:5);
	  write(' label {',rechts,'} ');
	  if ylog then Log_schrift(con,ymin,ymax,false,false)
		  else writeln(' ticks unlabeled  from ',
		     ymin:8:ydez,' to ',ymax:8:ydez,' by ',dy:8:ydez,
		     ' unlabeled short from ',ymin:8:ydez,' to ',
		     ymax:8:ydez,' by ',dysub:8:ydez,' /');
	end;
     end
    else
     begin
	  write('\axis right   shiftedto x=');
	  if xlog then write(lg(xmax):8:5)
		  else write(xmax:8:5);
	  write(' label {',rechts,'} ');
	  if ylog then Log_schrift(con,ymin,ymax,true,ykreuz)
		  else writeln(' ticks numbered  from ',
		     ymin:8:ydez,' to ',ymax:8:ydez,' by ',dy:8:ydez,
		     ' unlabeled short from ',ymin:8:ydez,' to ',
		     ymax:8:ydez,' by ',dysub:8:ydez,' /');
	end;
    close(con);
    write(aus,'\setcoordinatesystem units <',unitx:1:5,'mm,',unity:1:5,'mm> point at ');
    if xlog then write(aus,lg(xmin):1:6,' ')
	    else write(aus,xmin:1:6,' ');
    if ylog then writeln(aus,lg(ymin):1:6)
	    else writeln(aus,ymin:1:6);
 
    write(aus,'\setplotarea x from ');
    if xlog then write(aus,lg(xmin):1:6)
	    else write(aus,xmin:1:6);
    write(aus,' to ');
    if xlog then write(aus,lg(xmax):1:6)
	    else write(aus,xmax:1:6);
    write(aus,', y from ');
    if ylog then write(aus,lg(ymin):1:6)
	    else write(aus,ymin:8:5);
    write(aus,' to ');
    if ylog then writeln(aus,lg(ymax):1:6)
	    else writeln(aus,ymax:1:6);
    if seite=left
     then
     begin
       write(aus,'\axis bottom shiftedto y=');
       if ylog then write(aus,lg(ymin):1:6)
	       else write(aus,ymin:1:6);
       write(aus,' label {',unten,'} ');
       if xlog then Log_schrift(aus,xmin,xmax,true,xkreuz)
	       else begin
		      write(aus,' ticks ');
		      if xkreuz then write(aus,'andacross ');
		      writeln(aus,'numbered  from ',
				   xmin:1:xdez,' to ',xmax:1:xdez,' by ',dx:1:xdez,
				   ' unlabeled short from ',xmin:1:xdez+3,' to ',
				   xmax:1:xdez+3,' by ',dxsub:1:xdez+3,' /');
		    end;
 
       write(aus,'\axis top    shiftedto y=');
       if ylog then write(aus,lg(ymax):1:6)
	       else write(aus,ymax:1:6);
       write(aus,' label {',oben,'} ');
       if xlog then Log_schrift(aus,xmin,xmax,false,false)
	       else writeln(aus,' ticks unlabeled  from ',
		  xmin:1:xdez+2,' to ',xmax:1:xdez+2,' by ',dx:1:xdez+2,
		  ' unlabeled short from ',xmin:1:xdez+3,' to ',
		  xmax:1:xdez+3,' by ',dxsub:1:xdez+3,' /');
 
       write(aus,'\axis left   shiftedto x=');
       if xlog then write(aus,lg(xmin):1:6)
	       else write(aus,xmin:1:6);
       write(aus,' label {',links,'} ');
       if ylog then Log_schrift(aus,ymin,ymax,true,ykreuz)
	       else begin
		      write(aus,' ticks ');
		      if ykreuz then write(aus,'andacross ');
		      writeln(aus,'numbered  from ',
				  ymin:1:ydez,' to ',ymax:1:ydez,' by ',dy:1:ydez,
				 ' unlabeled short from ',ymin:1:ydez+3,' to ',
				 ymax:1:ydez+3,' by ',dysub:1:ydez+3,' /');
		    end;
       if not rechteachse then
	begin
	  write(aus,'\axis right   shiftedto x=');
	  if xlog then write(aus,lg(xmax):1:6)
		  else write(aus,xmax:1:6);
	  write(aus,' label {',rechts,'} ');
	  if ylog then Log_schrift(aus,ymin,ymax,false,false)
		  else writeln(aus,' ticks unlabeled  from ',
		     ymin:1:ydez+2,' to ',ymax:1:ydez+2,' by ',dy:1:ydez+2,
		     ' unlabeled short from ',ymin:1:ydez+3,' to ',
		     ymax:1:ydez+3,' by ',dysub:1:ydez+3,' /');
	end;
     end
    else
     begin
	  write(aus,'\axis right   shiftedto x=');
	  if xlog then write(aus,lg(xmax):1:6)
		  else write(aus,xmax:1:6);
	  write(aus,' label {',rechts,'} ');
	  if ylog then Log_schrift(aus,ymin,ymax,true,ykreuz)
		  else begin
			 write(aus,' ticks ');
			 if ykreuz then write(aus,'andacross ');
			 writeln(aus,'numbered  from ',
				     ymin:1:ydez,' to ',ymax:1:ydez,' by ',dy:1:ydez,
				     ' unlabeled short from ',ymin:1:ydez+3,' to ',
				     ymax:1:ydez+3,' by ',dysub:1:ydez+3,' /');
		       end;
	end;
 
  end;
 
 
 
begin
  writeln;
  writeln('          Datei-Konverter Daten -->PiCTeX input ...  ');
  writeln('(c) Christian Bttger, Inst. f. Metallphysik, TU Braunschweig');
  writeln('                Version 1.0, 3.7.1991 ');
  writeln;
  Get_Dos_Version(dos_major_version,dos_minor_version);
 
  write('PiCTeX-Datei                     : ');readln(ausn)  ;
  assign(aus,ausn);
  rewrite(aus);
 
  writeln;
  write('X-Achse : Minimum = ');readln(xmin);
  write('X-Achse : Maximum = ');readln(xmax);
  repeat
    write('x-Achse logarithmisch (j/n) ? ');
    readln(ch);
    ch := UpCase(ch);
  until ((ch='N') or (ch='J'));
  if ch='J' then xlog := true else xlog := false;
  if not xlog
   then begin
	  write('X-Achse : Schrittweite = ');readln(dx);
	  write('X-Achse : Schrittweite Sub-Unterteilungen = ');readln(dxsub);
	  write('X-Achse : Dezimalstellen der Beschriftung = ');readln(xdez);
	end;
 
  repeat
    write('x-Achse Markierungen durchziehen (Gitter) (j/n) ? ');
    readln(ch);
    ch := UpCase(ch);
  until ((ch='N') or (ch='J'));
  if ch='J' then xkreuz := true else xkreuz := false;
 
  writeln;
  writeln('Eingabe der Daten fr die (linke) Y-Achse ...');
  write('y-Achse : Minimum = ');readln(ymin);
  write('y-Achse : Maximum = ');readln(ymax);
  repeat
    write('(linke) y-Achse logarithmisch (j/n) ? ');
    readln(ch);
    ch := UpCase(ch);
  until ((ch='N') or (ch='J'));
  if ch='J' then ylog := true else ylog := false;
  if not ylog
   then begin
	  write('y-Achse : Schrittweite = ');readln(dy);
	  write('y-Achse : Schrittweite Sub-Unterteilungen = ');readln(dysub);
	  write('y-Achse : Dezimalstellen der Beschriftung = ');readln(ydez);
	end;
  repeat
    write('(linke) y-Achse Markierungen durchziehen (Gitter) (j/n) ? ');
    readln(ch);
    ch := UpCase(ch);
  until ((ch='N') or (ch='J'));
  if ch='J' then ykreuz := true else ykreuz := false;
 
  writeln;
  repeat
    write('zweite unabhngige Skala auf rechter y-Achse (j/n) ? ');
    readln(ch);
    ch := UpCase(ch);
  until ((ch='N') or (ch='J'));
  if ch='J' then rechteachse :=true else rechteachse:=false;
  if rechteachse then
   begin
     writeln;
     write('rechte y-Achse : Minimum = ');readln(rymin);
     write('rechte y-Achse : Maximum = ');readln(rymax);
     repeat
       write('rechte y-Achse logarithmisch (j/n) ? ');
       readln(ch);
       ch := UpCase(ch);
     until ((ch='N') or (ch='J'));
     if ch='J' then rylog := true else rylog := false;
     if not rylog
      then begin
	     write('rechte y-Achse : Schrittweite = ');readln(rdy);
	     write('rechte y-Achse : Schrittweite Sub-Unterteilungen = ');readln(rdysub);
	     write('rechte y-Achse : Dezimalstellen der Beschriftung = ');readln(rydez);
	   end;
     repeat
       write('rechte y-Achse Markierungen durchziehen (Gitter) (j/n) ? ');
       readln(ch);
       ch := UpCase(ch);
     until ((ch='N') or (ch='J'));
     if ch='J' then rykreuz := true else rykreuz := false;
     writeln;
   end;
  write('Beschriftung Unterkante : ');readln(unten);
  write('Beschriftung Oberkante  : ');readln(oben);
  write('Beschriftung rechts     : ');readln(rechts);
  write('Beschriftung links      : ');readln(links);
  writeln;
 
  write('Breite des Bildes in mm = ');readln(breite);
  write('Hhe   des Bildes in mm = ');readln(hoehe);
  writeln;
  write('Unterschrift des Bildes (\caption) : '); readln(unterschrift);
  write('berschrift  des Bildes            : '); readln(ueberschrift);
  write('LaTeX-Label des Bildes : ');readln(labelstr);
  repeat
    writeln('Sprache des Textes:');
    write(' a=austrian, e=english, f=french, g=german, u=USenglish ? ');
    readln(sprache);
    sprache := UpCase(sprache);
  until sprache in ['A','E','F','G','U'];
 
  writeln;
  writeln('und nun die Zwischenspeicherung ...');
  savename :='';
  repeat
    write('Dateiname fr \savelinesandcurves bzw. \replot = ');
    readln(savename);
  until savename<>'';
  write('Kommentar im Save-File = ');
  readln(savekomm);
  Einheiten(unitx,unity,unitry,breite,hoehe,rechteachse,xlog,ylog,rylog);
 
  writeln('\begin{figure}[htb]');
  writeln('\originalTeX');
  writeln('\[ %horizontal zentrierte Ausgabe an');
  writeln('\beginpicture');
 
  writeln(aus,'\begin{figure}[htb]');
  writeln(aus,'\originalTeX');
  writeln(aus,'\[  %zentrierte Ausgabe an');
  writeln(aus,'\beginpicture');
  writeln(aus,'\savelinesandcurves on "',savename,'"');
  writeln(aus,'\writesavefile {',savekomm,'}');
 
  skala (aus,left,
	 unitx,unity,
	 xlog,ylog,rechteachse,xkreuz,ykreuz,
	 xmin,xmax,dx,dxsub,ymin,ymax,dy,dysub,xdez,ydez,
	 unten,oben,rechts,links);
 
 
  writeln(aus,'\plotheading {',ueberschrift,'}');
  writeln(aus,'%\replot "',savename,'"');
 
  fertig := false;
  repeat
    writeln;
    if rechteachse then writeln('Nur Daten fr die LINKE (!!) y- Achse jetzt !!!!');
    process_file(left,fertig,rechteachse,xlog,ylog,aus);
  until fertig;
  if rechteachse then
   begin
     skala (aus,right,
	    unitx,unitry,
	    xlog,rylog,rechteachse,xkreuz,rykreuz,
	    xmin,xmax,dx,dxsub,rymin,rymax,rdy,rdysub,xdez,rydez,
	    unten,oben,rechts,links);
 
     fertig := false;
     repeat
       writeln;
       writeln('Nur Daten fr die RECHTE (!!) y- Achse ab jetzt !!!!');
       process_file(right,fertig,rechteachse,xlog,rylog,aus);
     until fertig;
   end;
 
  writeln(aus,'\dontsavelinesandcurves');
  writeln(aus,'\endpicture');
  writeln(aus,'\]');
  writeln(aus,'\germanTeX');
  write(aus,'\selectlanguage{\');
  case sprache of
       'A' : writeln(aus,'austrian}');
       'E' : writeln(aus,'english}');
       'F' : writeln(aus,'french}');
       'G' : writeln(aus,'german}');
       'U' : writeln(aus,'USenglish}');
       end;
 
  writeln(aus,'\caption{',unterschrift,' \label{',labelstr,'}}');
  writeln(aus,'\end{figure}');
 
  writeln('\endpicture');
  writeln('\]');
  writeln('\germanTeX');
  write('\selectlanguage{\');
  case sprache of
       'A' : writeln('austrian}');
       'E' : writeln('english}');
       'F' : writeln('french}');
       'G' : writeln('german}');
       'U' : writeln('USenglish}');
       end;
 
  writeln('\caption{',unterschrift,' \label{',labelstr,'}}');
  writeln('\end{figure}');
 
  close(aus);
end.
 
 
 
 
 
 
 
