program funktion;
{Programm zeichnet Funktionen, Name: Stefan Ziegler}
uses crt, graph;

var gd, gm, i, anzfunk : integer;
    weiter : boolean;
    string1, weistring : string;
    links, rechts, oben, unten : real;

procedure null;
  begin
    i:=0; gd:=0; gm:=0; weiter:=false; links:=0; rechts:=0; string1:='';
    oben:=0; unten:=0; weistring:=''; anzfunk:=0;
  end;

procedure starteingabe;
  begin
    write('Linke Eingrenzung: '); readln(links);
    write('Rechte Eingrenzung: '); readln(rechts);
    write('Obere Eingrenzung: '); readln(oben);
    write('Untere Eingrenzung: '); readln(unten);
    repeat
      write('Anzahl der Funktionen ( < 11): '); readln(anzfunk);
    until anzfunk<11;
  end;

procedure zeichnen;

  function len(k : string):integer;
    begin
      len:=textwidth(k);
    end;

  function hoch(k : string):integer;
    begin
      hoch:=textheight(k);
    end;

  function arccos(x: real):real;
    begin
      if (x<>1) then arccos:=-arctan(x/sqrt(-x*x+1))+Pi/2
                else arccos:=0;
    end;

  procedure gitter;
    begin
      setcolor(8);
      for i:=1 to round(getmaxy/40-1) do line(0, i*40, getmaxx, i*40);
      for i:=1 to round(getmaxx/40-1) do line(i*40, 0, i*40, getmaxy);
      setcolor(15);
      line(0, round(getmaxy/2), getmaxx, round(getmaxy/2));
      line(round(getmaxx/2), 0, round(getmaxx/2), getmaxy);
      outtextxy(getmaxx-len('>')+1, round((getmaxy-hoch('>'))/2)+1, '>');
      outtextxy(round((getmaxx-len('^'))/2)+1, 0, '^');
      for i:=1 to round(getmaxx/40-1) do
        begin
          str((links+i*(rechts-links)/16):0:2, string1);
          outtextxy(i*40-round(len(string1)/2), round(getmaxy/2)+5, string1);
        end;
      for i:=1 to round(getmaxy/40-1) do
        begin
          str((unten+i*(oben-unten)/12):0:2, string1);
          if i<>round(getmaxy/80) then
            outtextxy(round((getmaxx-len(string1))/2), getmaxy-i*40-round(hoch(string1)/2), string1);
        end;
    end;

  procedure funkzeich(anzfunk2: integer);

    var j, farbe, maxxh, t : integer;
        x, y, yz, z, s : real;
        xs, ys : string;

    begin
      z:=0; 
      for t:=-35 to 35 do
        begin
          farbe:=abs(t div 3)+1;
          maxxh:=round(getmaxx/2);
          z:=z*z+0.25;
          moveto(0, 240);
          for j:=-maxxh to maxxh do
            begin
              x:=links+(rechts-links)/getmaxx*(maxxh+j);
              if (t < 0) then y:=t*sin(x)         {Funktionsgleichung}
                 else         y:=t*sin(x);
              yz:=(oben-y)*getmaxy/(oben-unten);
              setcolor(farbe);
              if (j>-maxxh) then if abs(gety-yz)<320
                                    then lineto(320+j, round(yz))
                            else begin
                                   putpixel(0, round(yz), farbe);
                                   moveto(0, round(yz));
                                 end;
            end;
        end;
    end;

  begin
    settextstyle(0, 0, 1);
    gitter;
    for i:=1 to anzfunk do funkzeich(i);
  end;

procedure endeingabe;
  begin
    repeat
      write('Weiter(e) Funktion(en) zeichnen (j/n) ? '); readln(weistring);
      for i:=1 to length(weistring) do weistring[i]:=upcase(weistring[i]);
    until (weistring='J') or (weistring='JA') or (weistring='N') or (weistring='NEIN');
    if (weistring='J') or (weistring='JA') then weiter:=true;
  end;

begin
  repeat
    null;
    clrscr;
    starteingabe;
    gd:=9; gm:=2;
    initgraph(gd, gm, 'd:\tp\bgi');
    cleardevice;
    zeichnen;
    readln;
    cleardevice;
    closegraph;
    endeingabe;
    delay(500);
  until weiter=false;
end.
{Prozedur funkzeich weiterbearbeiten}