
program kurv2;  {zeichnet Kurven in ein PIC-file, das
                mit TeXcad und LaTeX bearbeitet werden kann}

{$N+,E+}

uses crt,formel;

const punktoffset:integer=0; {Nummerierung der \emline-Punkte
                              beginnt mit diesem Wert}
      strichlaenge:real=1.0; {L„nge einer Linie im Bild in mm}
      xgross:integer=0;      {Bildgr”áe X- und Y-Wert}
      ygross:integer=0;
      masstab:real=10;       {Vergr”áerung: 10 entspricht 1mm pro Einheit}
      phasemax:array [1..4] of integer=(1,0,0,0);
                             {L„ngen von abwechselnd gezeichneten und nicht
                              gezeichneten Strichelementen}
      paramstart: real= 0.0; {Anfangswerte der Parametrisierungen}
      paramend:   real= 0.0; {Endwerte der Parametrisierungen}

var picfile:text;
    name:string[12];
    punktnr:integer;

    FormelX,FormelY: FormelPtr;
    Fnr,Fpos: INTEGER;
    q: EXTENDED;
    XEingabe,YEingabe:STRING;


function x(p:extended):extended;
begin
   x:=Berechne(FormelX,p,q);
end;

function y(p:extended):extended;
begin
   y:=Berechne(FormelY,p,q);
end;


procedure prolog;
begin
   writeln('This is Kurv, Version 2.0.'); writeln;

   writeln('Parameterbereich eingeben:');
   write('Von p = '); readln(paramstart);
   write('Bis p = '); readln(paramend);

   writeln; writeln('x=f(p) eingeben:');
   Fnr:=0;
   XChar:='p';
   repeat
     write('x = '); readln(XEingabe);
     FormelX:=Baueformel(XEingabe,Fpos,Fnr);
     IF Fnr>0 THEN Writeln('Fehler in der Formel');
   until Fnr=0;

   writeln('y=f(p) eingeben:');
   Fnr:=0;
   XChar:='p';
   repeat
     write('y = '); readln(YEingabe);
     FormelY:=Baueformel(YEingabe,Fpos,Fnr);
     IF Fnr>0 THEN Writeln('Fehler in der Formel');
   until Fnr=0;

   name:='';
   writeln; write('Name des Bildes: [.pic]: '); readln(name);
   if pos('.',name)=0 then name:=name+'.pic';
   assign(picfile,name);
   rewrite(picfile);
   writeln(picfile,'\unitlength 1mm');
   writeln(picfile,'\begin{picture}(',xgross,',',ygross,')');
   punktnr:=punktoffset;
end;  {prolog}

procedure epilog;
begin
   writeln(picfile,'\end{picture}');
   close(picfile);
end;  {epilog}


procedure zeichne;

var fertig,schrittok,phaseok:boolean;
    disthilf,distalt,schritthilf,
    xplotalt,xplotneu,yplotalt,yplotneu,
    xalt,yalt,xneu,yneu,
    schritt,schrittalt,para,paraneu:real;
    schrittzaehler,phase,phasenzaehler:integer;

function dist(delta:real):real;  {berechnet den Abstand zum letzten Punkt}
begin
   paraneu:=para+delta;
   xneu:=x(paraneu);
   yneu:=y(paraneu);
   dist:=masstab*sqrt((xneu-xalt)*(xneu-xalt)+(yneu-yalt)*(yneu-yalt));
end;  {dist}

begin {zeichne}
   phase:=1;
   phasenzaehler:=0;
   schritt:=0.1;
   para:=paramstart;
   xalt:=x(para);
   yalt:=y(para);
   xplotalt:=xalt*masstab;
   yplotalt:=yalt*masstab;
   fertig:=false;
   schrittalt:=0.0;

   repeat
      schrittzaehler:=0;
      while abs(dist(schritt)-strichlaenge) > 0.1*strichlaenge do begin
         schritthilf:=schritt;
         disthilf:=dist(schritthilf);
         distalt:=dist(schrittalt);
         schritt:=schrittalt+
            (strichlaenge-distalt)/(disthilf-distalt)*(schritthilf-schrittalt);
         schrittzaehler:=schrittzaehler+1;
         if schrittzaehler>50 then begin
            writeln('Regula Falsi konvergiert nicht in Funktion ');
            writeln('x = ',xalt:1:2,'y = ',yalt:1:2);
            halt(2);
         end;
         schrittalt:=schritthilf;
      end;

      write('.');
      para:=para+schritt;
      if para>paramend then begin
         para:=paramend;
         fertig:=true;
      end;

      xneu:=x(para);
      yneu:=y(para);
      xplotneu:=xneu*masstab;
      yplotneu:=yneu*masstab;

      phaseok:=false;    {Phasenzaehler erh”hen}
      repeat
         if phasenzaehler < phasemax[phase] then begin
            phasenzaehler:=phasenzaehler+1;
            phaseok:=true
         end else begin
            phasenzaehler:=0;
            if phase=4 then phase:=1 else phase:=phase+1;
         end;
      until phaseok;

      if (phase=1) or (phase=3) then begin
         writeln(picfile,'\emline{',xplotalt:5:2,'}{',yplotalt:5:2,'}{',
            punktnr,'}{',xplotneu:5:2,'}{',yplotneu:5:2,'}{',punktnr+1,'}');
         punktnr:=punktnr+2;
      end;

      xalt:=xneu;
      yalt:=yneu;
      xplotalt:=xplotneu;
      yplotalt:=yplotneu;

      if abs(para-paramend)<0.001 then fertig:=true;
   until fertig;
   writeln;
end; {zeichne}

procedure glatt;
begin
   phasemax[1]:=1;
   phasemax[2]:=0;
   phasemax[3]:=0;
   phasemax[4]:=0;
end;

procedure stricheln1;
begin
   phasemax[1]:=1;
   phasemax[2]:=1;
   phasemax[3]:=1;
   phasemax[4]:=1;
end;

procedure stricheln2;
begin
   phasemax[1]:=3;
   phasemax[2]:=1;
   phasemax[3]:=1;
   phasemax[4]:=1;
end;


begin {kurv}

   prolog;
   glatt;
   zeichne;
   epilog;
   writeln(punktnr,' Punkte benutzt');

end.
