PROGRAM AnalysatorII;

USES Intuition, Graphics;

{$ opt b- }

LABEL 99,Loop;

CONST
  inputlen = 80;
  histlen  = 1000;
  BackSpace = chr(8);
  LF        = chr($0a);
  CrsrUp    = chr($0b);
  CR        = chr($0d);
  CSI       = chr($9b);
  CrsrDown  = LF;
  CrsrLeft  = chr($81);
  CrsrRight = chr($82);

  Unsichtbar = #e'0 p';
  Sichtbar   = #e' p';

TYPE
  atyp  = Double;
  MyStr = STRING[inputlen];
  p     = Ptr;
  Buffer = RECORD s: MyStr; p: integer END;

VAR f:          ARRAY['f'..'h',0..99] OF p; IMPORT;
    x,y:        atyp;
    hi,lo,step: atyp;
    v:          ARRAY['a'..'d',0..99] OF atyp; IMPORT;
    c1:         char;
    c:          char;            IMPORT;
    i:          integer;
    fx:         p;
    prt:        Boolean;         IMPORT;
    b,prev:     Boolean;
    everr:      Boolean;         IMPORT;
    pr:         FILE OF char;    EXPORT;
    filename:   String[50];
    win:        ^Window;
    Ein:        Buffer;          EXPORT;
    Rast:       Ptr;
    Con:        Ptr;             IMPORT;
    breit,hoch: integer;
    MinX,MaxX,MinY,MaxY: atyp;
    History:    String[histlen]; IMPORT;
    histptr:    integer;         IMPORT;

PROCEDURE InitAnalysis;                         IMPORT;
PROCEDURE GetC;                                 IMPORT;
FUNCTION  GetNum(Var t: Buffer; Var c:Char):integer; IMPORT;
PROCEDURE Inp(Var t:Buffer; Var f:p);           IMPORT;
FUNCTION  konstant(f:p):boolean;                IMPORT;
FUNCTION  eval(f:p; r:atyp):atyp;               IMPORT;
PROCEDURE Forget(Var f:p);                      IMPORT;
PROCEDURE InFix(f:p; i:integer);                IMPORT;
PROCEDURE ReadKonst(Var r:atyp; Var b:Boolean); IMPORT;
FUNCTION  sgn(r:atyp):integer;                  IMPORT;

PROCEDURE WriteC(s:Str);                        IMPORT;
PROCEDURE WriteP(s:Str);                        IMPORT;
PROCEDURE WriteR(r:atyp; f:integer);            IMPORT;
PROCEDURE WriteRF(r:atyp; l,f:integer);         IMPORT;
FUNCTION GetKey: char;                          IMPORT;
PROCEDURE ToHistory(s: MyStr);                  IMPORT;
PROCEDURE FromHistory(VAR s:MyStr; i: integer); IMPORT;
PROCEDURE ReadEin(Var b:Buffer);                IMPORT;


PROCEDURE CalcSize;
  { Fenstergröße ermitteln und in "breit" und "hoch" ablegen }
  BEGIN
    WITH win^ DO
      BEGIN breit := width-28; hoch := height-30 END;
  END;


PROCEDURE KoordSyst;
  { lösche Bildschirm und zeichne Koordinatensystem }
  VAR x, y, x0, y0, xs, ys: integer;
      xf, yf, xt, yt: atyp;
      i: integer;
      s: String;
      er: Boolean;

  FUNCTION Log10(x:atyp): atyp;
    BEGIN Log10 := ln(x)/ln(10) END;

  FUNCTION Skalierung(range: atyp; dots:integer):atyp;
    VAR r,s,t: atyp;
    BEGIN
      r := range * 30 / dots;  { Anzahl Einheiten auf 30 Bildpunkten }
      s := Log10(r);
      IF s >= 0 THEN t:=  Frac(s)
                ELSE t:=1-Frac(s);
      IF t < 0.3 THEN Skalierung := 5*DbPwr10(Trunc(s))
                 ELSE Skalierung :=   DbPwr10(Trunc(s))
    END;

  BEGIN
    CalcSize;
    FOR i:=0 TO hoch div 8 DO writeC(LF);
    writeC( CrsrUp );
    writeC( Unsichtbar );
    xf := breit/(MaxX-MinX);
    yf := hoch/(MaxY-MinY);
    SetAPen(Rast,1);
    y0 := Round (hoch*MaxY/(MaxY-MinY));
    IF MaxY < 0 THEN ys := 2
    ELSE
    IF MinY > 0 THEN ys := hoch-2;
      BEGIN
        ys := y0;
        Move (Rast,0,y0);
        Draw(Rast,breit-1,y0)
      END;
    x0 := Round (-breit*MinX/(MaxX-MinX));
    IF MaxX < 0 THEN xs := breit-3
    ELSE
    IF MinX > 0 THEN xs := 3
    ELSE
      BEGIN
        xs := x0;
        Move (Rast,x0,0);
        Draw (Rast,x0,hoch-1)
      END;
    xt := Skalierung(MaxX-MinX, breit);
    FOR i:=Round(MinX/xt) TO Round(MaxX/xt) DO
      BEGIN
        x := x0+Round(xf*i*xt);
        Move (Rast, x, ys-2 );
        Draw (Rast, x, ys+2 );
        s := RealStr(i*xt,0);
        IF s[1]=' ' THEN
          Delete(s,1,1);
        IF ys+12 < hoch THEN
          Move (Rast, x-4*Length(s), ys+12)
        ELSE
          Move (Rast, x-4*Length(s), ys-4);
        IF i<>0 THEN
          er := GfxText (Rast, s, Length(s))
      END;
    yt := Skalierung(MaxY-MinY, hoch*2);
    FOR i:=Round(MinY/yt) TO ROUND(MaxY/yt) DO
      BEGIN
        y := y0-round(yf*i*yt);
        Move (Rast, xs-3, y);
        Draw (Rast, xs+3, y);
        s := RealStr(i*yt,0);
        IF s[1]=' ' THEN
          Delete(s,1,1);
        IF xs > 4+8*Length(s) THEN
          Move (Rast, xs-4-8*Length(s), y+4)
        ELSE
          Move (Rast, xs+6, y+4);
        IF i<>0 THEN
          er := GfxText (Rast, s, Length(s))
      END;
    writeC( Sichtbar )
  END;


PROCEDURE Graph(fx: p);
  VAR x, y, xfact, yfact: atyp;
      x0, y0, xs, ys: integer;
  BEGIN
    xfact := breit/(MaxX-MinX);
    yfact := hoch/(MaxY-MinY);
    SetAPen(Rast, 3);
    writeC( Unsichtbar );
    y0 := Round (hoch*MaxY/(MaxY-MinY));
    x0 := Round (-breit*MinX/(MaxX-MinX));
    x := MinX;
    step := 0.5*(MaxX-MinX)/breit;
    prev := false;
    WHILE ReadCon(Con) <> '' DO;
    REPEAT
      everr := false;
      y := eval(fx,x);
      IF everr or (y>MaxY) or (y<MinY) THEN
        prev := false
      ELSE
        BEGIN
          xs := x0 + round( xfact*x );
          ys := y0 - round( yfact*y );
          IF not prev THEN move(Rast,xs,ys);
          draw(Rast,xs,ys);
          prev := true;
        END;
      x := x+step
    UNTIL (x>=MaxX) or (ReadCon(Con)<>chr(0));
    writeC( Sichtbar )
  END;

PROCEDURE SynErr;
  BEGIN
    writeC(#10'???');
    GOTO 99
  END;


BEGIN  { Hauptprogramm }
  x := 0+0; { Öffnet mathieeedoubbas.library }
  InitAnalysis;
  breit := 640;
  hoch := 255;
  WBenchToFront;
  win := Open_Window (0, 0, 640, 255, 1, _CLOSEWINDOW,
         GIMMEZEROZERO+ACTIVATE+WINDOWSIZING+WINDOWDRAG+WINDOWDEPTH+WINDOWCLOSE,
         'Analysator II', Nil, breit shr 1, hoch shr 1, breit, hoch);
  con := OpenConsole(win);
  WriteC( #10#e'1m                                 Analysator'\10\10\e'0m'\&
                 '                          Version 2.01 vom 21.02.90'\10\10\&
                 'Geschrieben von '#e'1;33mJens Gelhar'#e'0;31m mit Maxon''s KICK-Pascal - (c) Himpelsoft 1990.'\10\10);
  Rast := win^.RPort;
  FOR i:=0 TO 99 DO
    BEGIN
      FOR c:='f' TO 'h' DO f[c,i]:=Nil;
      FOR c:='a' TO 'd' DO v[c,i]:=0
    End;
  MinX := -10;
  MaxX := +10;
  MinY := -5;
  MaxY := +5;
  filename := 'prt:';
  prt:=false;
  HistPtr := 0;
  REPEAT
    loop:
    writeC(#10'--> ');
    ReadEin(Ein);
    IF Ein.s <> '' THEN ToHistory(Ein.s);
    getc;
    if c<' ' then goto loop;
    CASE c OF
      'a','b','c','d':
          BEGIN
            c1:=c; getc; i:=Getnum(Ein,c);
            IF c<>'=' THEN SynErr;
            Inp(ein,fx);
            IF fx<>NIL THEN
              BEGIN
                IF konstant(fx) THEN
                  BEGIN
                    y:=eval(fx,0);
                    IF everr THEN writeln('Error!')
                    ELSE
                      BEGIN
                        v[c1,i]:=y;
                        writeR(y,0)
                      END
                  END
                ELSE writeC('Variables must be constant expressions.'\n);
                forget(fx)
              END
          END
      'f','g','h':
          BEGIN
            c1:=c; getc; i:=Getnum(Ein,c);
            IF c<>'=' THEN SynErr;
            Inp(ein,fx);
            IF fx<>NIL THEN
              BEGIN
                Forget(f[c1,i]); f[c1,i]:=fx;
                Infix(fx,0);
              END
          END
    '?':  BEGIN
            Inp(ein,fx);
            If fx<>Nil Then
              IF konstant(fx) THEN
                BEGIN
                  everr:=false;
                  y:=eval(fx,0);
                  IF everr THEN writeC('Error'\n)
                  ELSE
                    BEGIN
                      writeR(y,0);
                      IF prt THEN writeln(pr,y)
                    END
                END
              ELSE
                BEGIN
                  Infix(fx,0);
                  IF prt THEN writeln(pr);
                END;
            Forget(fx);
          END
    't':  BEGIN
            Inp(ein,fx);
            IF fx<>NIL Then
              Begin
                writeC('Wertetabelle von ');
                IF prt THEN write(pr,'f(x) = ');
                Infix(fx,0);
                IF prt THEN writeln(pr,LF);
                writeC(#n'untere Grenze: ');readkonst(lo,b);
                if b then goto loop;
                writeC('obere Grenze:  ');readkonst(hi,b);
                if b then goto loop;
                REPEAT
                  writeC('Schrittweite:  ');readkonst(step,b);
                  if b or (step=0) then goto loop;
                  IF abs(hi-lo)/abs(step)>=1e4 THEN
                    writeC('So viel Zeit hast Du bestimmt nicht.'\n)
                UNTIL abs(hi-lo)/abs(step)<1e4;
                i:=0;
                x:=lo;
                writeP('          x           |        f(x)    '\n\&
                       '----------------------|--------------------'\n);
                IF sgn(hi-lo)=sgn(step) THEN
                Repeat
                  everr:=false;
                  y:=eval(fx,x);
                  IF everr THEN
                    BEGIN
                      WriteRF(x,20,0);
                      writeC('  |  ?'\n);
                      IF prt THEN writeln(pr,x:20,'  |  ?')
                    END
                  ELSE
                    BEGIN
                      WriteRF(x,20,0);
                      writeC('  | ');
                      WriteR(eval(fx,x),0);
                      WriteC(LF);
                      IF prt THEN writeln(pr,x:20,'  | ',eval(fx,x))
                    END;
                  i:=i+1;
                  x:=lo+i*step
                Until sgn(step)*(x-hi)>1e-5*abs(step);
                Forget(fx);
             End
          END;
    'l':  BEGIN
            getc;
            CASE c OF
              '+':IF Not prt THEN
                    BEGIN
                      rewrite(pr,filename);
                      IF IoResult<>0 THEN
                        writeC('File Error!'\n)
                      ELSE
                        prt:=true
                    END;
              '-':IF prt THEN
                    BEGIN
                      close (pr);
                      prt := false
                    END;
              '=':BEGIN
                    readln(filename);
                    IF prt THEN
                      BEGIN
                        close (pr);
                        rewrite(pr,filename);
                        IF IoResult<>0 THEN writeC(#10'File Error!'\10)
                      END
                  END
            OTHERWISE writeC(#10'?'\10)
            End
          END;
    'r': BEGIN
           WriteC('MinX: '); readkonst(MinX,b);
             IF b THEN
               BEGIN
                 MinX:=MaxX-2*abs(MaxX)-1;
                 GOTO Loop
               END;
           WriteC('MaxX: '); readkonst(MaxX,b);
             IF b or (MaxX <= MinX) THEN
               BEGIN
                 IF not b THEN writeC('MinX>=MaxX !!!'\n);
                 MaxX:=MinX+2*abs(MinX)+1;
                 GOTO Loop
               END;
           WriteC('MinY: '); readkonst(MinY,b);
             IF b THEN
               BEGIN
                 MinY := MaxY-2*abs(MaxY)-1;
                 GOTO Loop
               END;
           WriteC('MaxY: '); readkonst(MaxY,b);
             IF b or (MaxY <= MinY) THEN
               BEGIN
                 IF not b THEN writeC('MinY>=MaxY !!!'\n);
                 MaxY:=MinY+2*abs(MinY)+1;
                 GOTO Loop
               END;
         END;
    'p': BEGIN
           Inp (Ein,fx);
           IF fx=Nil THEN GOTO Loop;
           KoordSyst;
           Graph (fx);
           Forget (fx);
           WHILE Ein.s[Ein.p-1]=',' DO
             BEGIN
               Inp(Ein,fx);
               IF fx=Nil THEN GOTO Loop;
               Graph (fx);
               Forget(fx)
             END;
         END;
    'q':  writeC('See you later, Aligator!')
    OTHERWISE
      SynErr
    END;
   99:
  UNTIL c='q';
  FOR i:=0 TO 99 DO
    FOR c:='f' TO 'h' DO Forget(f[c,i]);
  IF prt THEN close(pr);
  Close_Window(Win);
END

{$ link "analysis.o", "anaio.o" }