/**********************************************************************/ 
/*                                                                    */ 
/* Funktionsplotter FUNKY                                             */ 
/*                                                                    */ 
/* Dieses Modul kann beliebige Funktionen in ein Koordinatenkreuz     */ 
/* beliebiger Groesse eintragen. Bei der Eingabe der Funktion ist     */ 
/* darauf zu achten, dass es kein Abschlusszeichen, wie z.B. Semikolon*/ 
/* gibt; das Ende wird automatisch erkannt. Klammern werden           */ 
/* beruecksichtigt; die Hierarchie der Operationen eingehalten.       */ 
/* Alle zur Verfuegung stehenden Funktion (sin, cos ...) sind in der  */ 
/* PROCEDURE IFFUNKTION aufgelistet.                                  */ 
/* Die Variable der Fkt. muss ein 'X' sein.                           */ 
/* Es koennen maximal 9 Funktionen gleichzeitig dargestellt werden.   */ 
/**********************************************************************/ 

/* Start mit FKT.                                                     */ 
/*-L */ 

/* Juergen Donnerstag    */ 
/* Bachstr. 12           */ 
/* 5000 Koeln 90         */ 
/* Datum : 16.9.86       */ 

/* modifiziert für Atari ST   24.3.1987 - cp  */ 

S=5000; 
MODULE KURVEN; 
SYSTEM; 
  TY  : A1 <->; 
  KEY : A1 (TFU=1) <-; 
  VOUT:VO.FKT;    /* Virtueller Datenkanal, hier zum Umwandeln von */ 
  VIN: VI.FKT;    /* FLOAT-Zahlen in Strings verwendet  */ 

PROBLEM; 
  SPC TY   DATION INOUT ALPHIC CONTROL(ALL), 
      KEY  DATION    IN ALPHIC CONTROL(ALL); 
  SPC VIN  DATION    IN ALPHIC CONTROL(ALL); 
  SPC VOUT DATION   OUT ALPHIC CONTROL(ALL); 

/**********************************************************************/ 
/* rekursive Proceduren die vorab spezifiziert werden mussten         */ 

  SPC IFZAHL     ENTRY (() FLOAT IDENT,() FIXED IDENT, FIXED IDENT, 
                        FIXED IDENT, BIT(1) IDENT) RETURNS (BIT(1)); 
  SPC IFOPERAND  ENTRY (() FLOAT IDENT,() FIXED IDENT, FIXED IDENT, 
                        FIXED IDENT, BIT(1) IDENT) RETURNS (BIT(1)); 
  SPC IFFUNKTION ENTRY (() FLOAT IDENT,() FIXED IDENT, FIXED IDENT, 
                        FIXED IDENT, BIT(1) IDENT) RETURNS (BIT(1)); 
  SPC AUSDRUCK   ENTRY RETURNS (FLOAT); 

  /* globale Funktionen der Atari-Implementierung */ 
  SPC (SCRSET,SCRCHG,CLEAR,TEXT,SCKILL,WIDTH) ENTRY GLOBAL; 

  SPC SEITE2 ENTRY; 

  DCL STRING CHAR(70), 
      ASTRING(10) CHAR(70), 
      (STPOS,STNR) FIXED, 
      STGRR(10) FLOAT, 
      STGRL(10) FLOAT, 
      STLEN(10) FIXED,
      (XVAR,ERG) FLOAT;
  DCL (XMAX,YMAX) FIXED;
  DCL (XWIDTH,YWIDTH) FIXED,
      (VT,LF,FF,RS,HOME) CHAR(1),
      CLS CHAR(2),
      ZEILE54 CHAR (4);
  DCL (LGR,RGR,OG,UG,DXG,LK,RK,OK,UK,DKX,DKY,MASX,MASY) FLOAT,
      (XWERT,YWERT,STEP) FLOAT,
      (XO,YO,XD,YD,MOD,XOLD,YOLD) FIXED;
  DCL PI   INV FLOAT INIT(3.141592654),
      PI05 INV FLOAT INIT(1.570796327),
      LDE  INV FLOAT INIT(1.442695041),
      LGE  INV FLOAT INIT(0.434294481),
      Z FLOAT;
/*--------------------------------------------------------------------*/
ERROR: PROC (NR FIXED);
  DCL ERTEXT CHAR(22) INIT ('kein gueltiges Zeichen');
  CALL SEITE2;
  PUT CLS, 'E R R O R : ', STPOS TO TY BY SKIP,(3)A,F(3),X(1);
  CASE NR 
   ALT PUT 'nur einen Dezimalpunkt' TO TY BY A; 
   ALT PUT 'IFZAHL : ',ERTEXT TO TY BY A,A; 
   ALT PUT 'IFOPERAND : ',ERTEXT TO TY BY A,A; 
   ALT PUT 'AUSDRUCK : ',ERTEXT TO TY BY A,A; 
   ALT PUT 'Division durch Null' TO TY BY A; 
   ALT PUT 'nach einem Ausdruck : ',ERTEXT TO TY BY A,A; 
   ALT PUT 'Klammer auf erwartet' TO TY BY A; 
  FIN; 
  PUT TO TY BY SKIP; 
  TERMINATE; 
END; 
/*--------------------------------------------------------------------*/ 
/* Umwandlung von RAD -> DEG */ 
DEG: PROC (ARG FLOAT) RETURNS (FLOAT); 
  ARG = ARG * 180 / PI; 
RETURN (ARG); 
END; 
/*--------------------------------------------------------------------*/ 
/* Umwandlung von DEG -> RAD */ 
RAD: PROC (ARG FLOAT) RETURNS (FLOAT); 
  ARG = PI * ARG / 180; 
RETURN (ARG); 
END; 
/*--------------------------------------------------------------------*/ 
/* FAKULTAET BERECHNEN */ 
FAK: PROC (ARG FIXED) RETURNS (FLOAT); 
  IF (ARG > 33) OR (ARG < 0) THEN 
  CALL SEITE2; PUT '  FAK E R R O R : Argument max (0...33)',ARG 
        TO TY BY SKIP,A,F(10); 
   ELSE 
    IF ARG == 0 THEN Z = 1; 
     ELSE 
      Z = 1; 
      FOR I FROM 2 TO ARG REPEAT 
       Z = Z * I; 
      END; 
    FIN; 
  FIN; 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* Exponential-fkt. zur Basis 10 */ 
EXP10: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = EXP (ARG / LGE); 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* Exponential-fkt. zur Basis 2 */ 
EXP2: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = EXP (ARG / LDE); 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* ARCCOT FUNKTION */ 
ARCCOT: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = PI05 - ATAN (ARG); 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* SINH FUNKTION */ 
SINH: PROC (ARG FLOAT) RETURNS(FLOAT); 
  Z = (EXP (ARG) - EXP (-ARG)) / 2; 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* COSH FUNKTION */ 
COSH: PROC (ARG FLOAT) RETURNS(FLOAT); 
  Z = (EXP (ARG) + EXP (-ARG)) / 2; 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* TANH FUNKTION */ 
TANH: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = SINH (ARG) / COSH (ARG); 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* ARCSINH FUNKTION */ 
ARSINH: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = LN ( ARG + SQRT ( ARG * ARG + 1)); 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* ARCCOSH FUNKTION */ 
ARCOSH: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = LN ( ARG + SQRT ( ARG * ARG - 1)); 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
/* ARCTANH FUNKTION */ 
ARTANH: PROC (ARG FLOAT) RETURNS (FLOAT); 
  Z = ( LN (( 1 + ARG ) / ( 1 - ARG ))) / 2; 
RETURN (Z); 
END; 
/*--------------------------------------------------------------------*/ 
SEITE1: PROC;                /* Umschalten auf Grafik-Bildschirm */ 
  CALL SCRSET('FUNKY'); CALL SCRCHG('FUNKY'); 
  PUT HOME TO TY BY A; 
END; 
/*--------------------------------------------------------------------*/ 
SEITE2: PROC;                /* Umschalten auf Textbildschirm */ 
  CALL SCRCHG('MAIN'); 
  PUT CLS TO TY BY A; 

  PUT 'Funky ', 
    'Version 2.2' TO TY BY SKIP,A,SKIP,A,SKIP; 
END; 
/*--------------------------------------------------------------------*/ 
SCANNER: PROC RETURNS (CHAR(1)); /* holt das naechste Zeichen */ 
  DCL ZCHN CHAR(1); 
  ZCHN = STRING.CHAR(STPOS); 
  STPOS = STPOS + 1; 
RETURN (ZCHN); 
END; 
/*--------------------------------------------------------------------*/ 
EXPONENT: PROC (ZCHN CHAR(1) IDENT) RETURNS (FIXED); 
  DCL ASCII FIXED, /* filtert den Exponenten einer Zahl heraus und    */ 
      (EXPO,VORZ) FIXED INIT (0,1); /* gibt ihn als Integer zurueck   */ 
  ZCHN = SCANNER; 
  IF ZCHN == '+' THEN           /* Vorzeichen des Exp. */ 
    ZCHN = SCANNER; 
   ELSE 
    IF ZCHN == '-' THEN 
      VORZ = -1; 
      ZCHN = SCANNER; 
    FIN; 
  FIN; 
  ASCII = (TOFIXED ZCHN) - 48; 
  IF (ASCII >= 0) AND (ASCII <= 9) THEN 
    EXPO = ASCII; 
    ZCHN = SCANNER; 
    ASCII = (TOFIXED ZCHN) - 48; 
    IF (ASCII >= 0) AND (ASCII <= 9) THEN 
      EXPO = EXPO * 10 + ASCII; 
      ZCHN = SCANNER; 
    FIN; 
  FIN; 
  EXPO = EXPO * VORZ; 
RETURN (EXPO); 
END; 
/*--------------------------------------------------------------------*/ 
TOFLOAT: PROC (ZAHL FLOAT IDENT,NO BIT(1) IDENT); 
  DCL ZCHN CHAR(1), /* versucht eine Zahl zu interpretieren */ 
      (ASCII,KOM2) FIXED INIT (0,0), 
      (EXPO,VORZ,KOM1,END1) FIXED INIT (0,1,0,0); 
  ZCHN = SCANNER; 
  NO = '0'B; 
  IF ZAHL == 0 THEN 
    IF ZCHN == '+' THEN 
      ZCHN = SCANNER; 
     ELSE 
      IF ZCHN == '-' THEN 
        VORZ = -1; 
        ZCHN = SCANNER; 
      FIN; 
    FIN; 
  FIN; 
  ZAHL = 0; 
  IF ZCHN == 'e' THEN ZAHL = 2.718281828; 
    ZAHL = 2.718281828; NO = '1'B; 
    ZCHN = SCANNER; 
   ELSE 
    IF ZCHN == 'P' THEN 
      ZCHN = SCANNER; 
      IF ZCHN == 'I' THEN ZAHL = 3.141592654; 
        ZAHL = 3.141592654; NO = '1'B; 
        ZCHN = SCANNER; 
       ELSE 
        STPOS = STPOS - 2; 
        ZCHN = SCANNER; 
      FIN; 
     ELSE 
      IF ZCHN == 'X' THEN 
        ZAHL = XVAR; NO = '1'B; 
        ZCHN = SCANNER; 
       ELSE 
        WHILE END1 == 0 REPEAT; 
         IF ZCHN == '.' THEN 
           IF KOM1 == 0 THEN 
             KOM1 = 1; 
             ZCHN = SCANNER; 
            ELSE 
             CALL ERROR (1); 
           FIN; 
          ELSE 
           ASCII = TOFIXED ZCHN - 48; 
           IF (ASCII >= 0) AND (ASCII <= 9) THEN 
             ZAHL = ZAHL * 10 + ASCII; 
             NO = '1'B; 
             IF KOM1 /= 0 THEN 
               KOM2 = KOM2 + 1; 
             FIN; 
             ZCHN = SCANNER; 
            ELSE 
             IF (ZCHN == 'E') THEN 
               IF ZAHL /= 0 THEN 
                 EXPO = EXPONENT (ZCHN); 
                 END1 = 1; 
                ELSE 
                 ZAHL = 0; 
                 END1 = 1; 
               FIN; 
              ELSE 
               END1 = 1; 
             FIN; 
           FIN; 
         FIN; 
        END; 
        EXPO = EXPO - KOM2; 
      FIN; 
    FIN; 
  FIN; 
  ZAHL = VORZ * ZAHL; 
  WHILE EXPO > 0 REPEAT 
   ZAHL = ZAHL * 10; EXPO = EXPO - 1; 
  END; 
  WHILE EXPO < 0 REPEAT; 
   ZAHL = ZAHL / 10; EXPO = EXPO + 1; 
  END; 
  IF ZCHN == ' ' THEN 
    WHILE ZCHN == ' ' REPEAT; 
     ZCHN = SCANNER; 
    END; 
  FIN; 
  STPOS = STPOS - 1; 
END; 
/*--------------------------------------------------------------------*/ 
INPUT: PROC GLOBAL; /* Eingabe der Fkt. */ 
  DCL ENDE BIT(1) INIT ('0'B), 
      LEN FIXED INIT (1); 
  PUT 'y = ' TO TY BY SKIP,A; 
  GET STRING FROM TY BY SKIP,A; 
  FOR I FROM 70 BY -1 TO 1 WHILE NOT ENDE REPEAT; 
   IF STRING.CHAR(I) /= ' ' THEN 
     LEN = I + 1; 
     ENDE = '1'B; 
   FIN; 
  END; 
  STNR = STNR + 1; 
  STRING.CHAR(LEN) = ')'; 
  ASTRING(STNR) = STRING; 
  STLEN(STNR) = LEN - 1; 
END; 
/*--------------------------------------------------------------------*/ 
IFZAHL: PROC (ZSTACK() FLOAT IDENT, OSTACK(,) FIXED IDENT, 
              (ZSNR,OSNR) FIXED IDENT, ENDE BIT(1) IDENT) 
              RETURNS (BIT(1)); 
  DCL JA BIT(1), 
      ZAHL FLOAT; 
  IF ENDE THEN 
    ZAHL = 1; 
    IF ZSNR == 0 THEN ZAHL = 0; FIN; 
    CALL TOFLOAT (ZAHL,JA); 
    IF JA THEN 
      ZSNR = ZSNR + 1; ZSTACK(ZSNR) = ZAHL; 
      IF IFOPERAND (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
        RETURN ('1'B); 
       ELSE 
        CALL ERROR(2); 
      FIN; 
    FIN; 
  FIN; 
RETURN ('0'B); 
END; 
/*--------------------------------------------------------------------*/ 
GRRECHEN: PROC (ZSTACK() FLOAT IDENT, OSTACK(,) FIXED IDENT, 
              (ZSNR,OSNR) FIXED IDENT); 
/* berechnen eines Zwischenergebnisses bei Grundrechenarten           */ 
  DCL OPT FIXED, 
      (OPD1,OPD2,WERT) FLOAT; 
  IF (OSTACK(OSNR,2) <= OSTACK(OSNR-1,2)) AND (OSNR > 1) THEN 
    OPT = OSTACK(OSNR-1,1); 
    OPD1 = ZSTACK(ZSNR-1); OPD2 = ZSTACK(ZSNR); 
    CASE OPT 
     ALT WERT = OPD1 + OPD2; 
     ALT WERT = OPD1 - OPD2; 
     ALT WERT = OPD1 * OPD2; 
     ALT IF OPD2 == 0 THEN 
           WERT = 32000; 
          ELSE 
           WERT = OPD1 / OPD2; 
         FIN; 
     ALT IF OPD2 == 0 THEN 
           WERT = 1; 
          ELSE 
           WERT = OPD1 ** (ROUND OPD2); 
         FIN; 
    FIN; 
    ZSNR = ZSNR - 1; OSNR = OSNR - 1; 
    ZSTACK(ZSNR) = WERT; 
    OSTACK(OSNR,1) = OSTACK(OSNR+1,1); 
    OSTACK(OSNR,2) = OSTACK(OSNR+1,2); 
    CALL GRRECHEN (ZSTACK,OSTACK,ZSNR,OSNR); 
  FIN; 
END; 
/*--------------------------------------------------------------------*/ 
IFOPERAND: PROC (ZSTACK() FLOAT IDENT, OSTACK(,) FIXED IDENT, 
                 (ZSNR,OSNR) FIXED IDENT, ENDE BIT(1) IDENT) 
                 RETURNS (BIT(1)); 
  DCL ZCHN CHAR(1), 
      ZAHL FLOAT, 
      (OPT,WERT) FIXED; 
  IF ENDE THEN 
    ZCHN = STRING.CHAR(STPOS); 
    IF ZCHN == ')' THEN OPT = 0; WERT = 0; 
     ELSE 
      IF ZCHN == '+' THEN OPT = 1; WERT = 1; 
       ELSE 
        IF ZCHN == '-' THEN OPT = 2; WERT = 1; 
         ELSE 
          IF ZCHN == '*' THEN OPT = 3; WERT = 2; 
           ELSE 
            IF ZCHN == '/' THEN OPT = 4; WERT = 2; 
             ELSE 
              IF ZCHN == '^' THEN OPT = 5; WERT = 3; 
               ELSE 
                RETURN('0'B); 
              FIN; 
            FIN; 
          FIN; 
        FIN; 
      FIN; 
    FIN; 
    OSNR = OSNR + 1; OSTACK(OSNR,1) = OPT; OSTACK(OSNR,2) = WERT; 
    CALL GRRECHEN (ZSTACK,OSTACK,ZSNR,OSNR); 
    IF ZCHN == ')' THEN ENDE = '0'B; RETURN ('1'B); FIN; 
    STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
    WHILE ZCHN == ' ' REPEAT; 
     STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
    END; 
    IF IFZAHL (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
      RETURN ('1'B); 
     ELSE 
      IF IFFUNKTION (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
        RETURN ('1'B); 
       ELSE 
        IF ZCHN == '(' THEN 
          STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
          WHILE ZCHN == ' ' REPEAT; 
           STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
          END; 
          ZAHL = AUSDRUCK; 
          STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
          WHILE ZCHN == ' ' REPEAT; 
           STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
          END; 
          ZSNR = ZSNR + 1; ZSTACK(ZSNR) = ZAHL; 
          IF IFOPERAND (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
            RETURN('1'B); 
           ELSE 
            CALL ERROR (6); 
          FIN; 
         ELSE 
          CALL ERROR (3); 
        FIN; 
      FIN; 
    FIN; 
  FIN; 
RETURN ('1'B); 
END; 
/*--------------------------------------------------------------------*/ 
IFFUNKTION: PROC (ZSTACK() FLOAT IDENT, OSTACK(,) FIXED IDENT, 
                  (ZSNR,OSNR) FIXED IDENT, ENDE BIT(1) IDENT) 
                  RETURNS (BIT(1)); 
  DCL JA BIT(1) INIT ('0'B), 
      LEN FIXED INIT (1), 
      (HPOS,WERT) FIXED, 
      ZAHL FLOAT, 
      ZCHN CHAR(1), 
      HST CHAR(7) INIT ('       '); 
  IF ENDE THEN 
    HPOS = STPOS; 
    ZCHN = STRING.CHAR(HPOS); HST.CHAR(LEN) = ZCHN; 
    WHILE (ZCHN /= ' ') AND (ZCHN /= '(') AND (LEN <= 7) REPEAT 
     LEN = LEN + 1; HPOS = HPOS + 1; 
     ZCHN = STRING.CHAR(HPOS); HST.CHAR(LEN) = ZCHN; 
    END; 
    IF (ZCHN /= '(') AND (ZCHN /= ' ') THEN CALL ERROR (7); FIN; 
    WHILE ZCHN == ' ' REPEAT; 
     HPOS = HPOS + 1; ZCHN = STRING.CHAR(HPOS); 
    END; 
    IF ZCHN /= '(' THEN CALL ERROR (7); FIN; 
    LEN = STPOS; STPOS = HPOS + 1; 
    ZAHL = AUSDRUCK; 
    IF HST == 'ARCSINH' THEN ZAHL = ARSINH (ZAHL); ELSE 
    IF HST == 'ARCCOSH' THEN ZAHL = ARCOSH (ZAHL); ELSE 
    IF HST == 'ARCTANH' THEN ZAHL = ARTANH (ZAHL); ELSE 
    IF HST == 'ARCSIN'  THEN ZAHL = ASIN   (ZAHL); ELSE 
    IF HST == 'ARCCOS'  THEN ZAHL = ACOS   (ZAHL); ELSE 
    IF HST == 'ARCTAN'  THEN ZAHL = ATAN   (ZAHL); ELSE 
    IF HST == 'ARCCOT'  THEN ZAHL = ARCCOT (ZAHL); ELSE 
    IF HST == 'EXP10'   THEN ZAHL = EXP10  (ZAHL); ELSE 
    IF HST == 'EXP2'    THEN ZAHL = EXP2   (ZAHL); ELSE 
    IF HST == 'EXPE'    THEN ZAHL = EXP    (ZAHL); ELSE 
    IF HST == 'SQRT'    THEN ZAHL = SQRT   (ZAHL); ELSE 
    IF HST == 'SINH'    THEN ZAHL = SINH   (ZAHL); ELSE 
    IF HST == 'COSH'    THEN ZAHL = COSH   (ZAHL); ELSE 
    IF HST == 'TANH'    THEN ZAHL = TANH   (ZAHL); ELSE 
    IF HST == 'SIN'     THEN ZAHL = SIN    (ZAHL); ELSE 
    IF HST == 'COS'     THEN ZAHL = COS    (ZAHL); ELSE 
    IF HST == 'TAN'     THEN ZAHL = TAN    (ZAHL); ELSE 
    IF HST == 'RAD'     THEN ZAHL = RAD    (ZAHL); ELSE 
    IF HST == 'DEG'     THEN ZAHL = DEG    (ZAHL); ELSE 
    IF HST == 'FAK'     THEN ZAHL = FAK    (ROUND ZAHL); ELSE 
    IF HST == 'LG'      THEN ZAHL = LG     (ZAHL); ELSE 
    IF HST == 'LD'      THEN ZAHL = LD     (ZAHL); ELSE 
    IF HST == 'LN'      THEN ZAHL = LN     (ZAHL); ELSE 
    IF HST == 'SIGN'    THEN WERT = SIGN   (ZAHL); ZAHL = TOFLOAT WERT; 
     ELSE 
      STPOS = LEN; 
      RETURN('0'B); 
    FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN; 
    FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN;FIN; 
    STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
    WHILE ZCHN == ' ' REPEAT; 
     STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
    END; 
    ZSNR = ZSNR + 1; ZSTACK(ZSNR) = ZAHL; 
    IF IFOPERAND (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
      RETURN ('1'B); 
     ELSE 
      CALL ERROR (2); 
    FIN; 
  FIN; 
RETURN ('1'B); 
END; 
/*--------------------------------------------------------------------*/ 
/* Ausgangspunkt einer Analyse */ 
AUSDRUCK: PROC RETURNS (FLOAT); 
  DCL ZSTACK(10) FLOAT, 
      OSTACK(10,2) FIXED, 
      (ZSNR,OSNR) FIXED INIT(0,0), 
      ENDE BIT(1) INIT('1'B), 
      ZCHN CHAR(1), 
      ZAHL FLOAT; 
  IF IFZAHL (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
    ZAHL = ZSTACK(1); 
   ELSE 
    IF IFFUNKTION (ZSTACK,OSTACK,ZSNR,OSNR,ENDE) THEN 
      ZAHL = ZSTACK(1); 
     ELSE 
      ZCHN = STRING.CHAR(STPOS); 
      IF ZCHN == '(' THEN 
        STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
        WHILE ZCHN == ' ' REPEAT; 
         STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
        END; 
        ZAHL = AUSDRUCK; 
       ELSE 
        CALL ERROR (4); 
      FIN; 
    FIN; 
  FIN; 
RETURN (ZAHL); 
END; 
/*--------------------------------------------------------------------*/ 
/* diese Proc. muss zur Berechnung einer Fkt. aufgerufen werden       */ 
FKT: PROC (X FLOAT) RETURNS (FLOAT) GLOBAL; 
  DCL ZCHN CHAR(1); 
  STPOS = 1; XVAR = X; 
  ZCHN = STRING.CHAR(STPOS); 
  WHILE ZCHN == ' ' REPEAT; 
   STPOS = STPOS + 1; ZCHN = STRING.CHAR(STPOS); 
  END; 
  ERG = AUSDRUCK; 
RETURN (ERG); 
END; 
/*--------------------------------------------------------------------*/ 
NORMALISIEREN: PROC (MAS FLOAT IDENT, EXP FIXED IDENT); 
  EXP = 0; 
  WHILE (ABS (MAS)) >= 10 REPEAT; 
   MAS = MAS / 10; EXP = EXP + 1; 
  END; 
  WHILE (ABS (MAS)) < 1 REPEAT; 
   MAS = MAS * 10; EXP = EXP - 1; 
  END; 
END; 
/*--------------------------------------------------------------------*/ 
GLEITKOMMA: PROC (MAS FLOAT IDENT, EXP FIXED); 
  WHILE EXP < 0 REPEAT; 
   MAS = MAS / 10; EXP = EXP + 1; 
  END; 
  WHILE EXP > 0 REPEAT; 
   MAS = MAS * 10; EXP = EXP - 1; 
  END; 
END; 
/*--------------------------------------------------------------------*/ 
RUNDEN: PROC (MAS FLOAT IDENT); 
  DCL EXP FIXED; 
  CALL NORMALISIEREN (MAS,EXP); 
  MAS = TOFLOAT (ROUND MAS); 
  CALL GLEITKOMMA (MAS,EXP); 
END; 

/**********************************************************************/ 
ZAHLTXT: PROC((N,NK)FIXED, ZAHL FLOAT) RETURNS(CHAR(7)); 
  DCL STR CHAR(7); 

  PUT ZAHL TO VOUT BY F(N,NK),SKIP; GET STR FROM VIN BY SKIP,A(N); 
  RETURN(STR); 
END; 

/*--------------------------------------------------------------------*/ 
ABZISSE: PROC ((X,Y) FIXED, ZAHL FLOAT); 
  DCL (CY,CX,H1,EXP) FIXED, 
      H2 FLOAT; 
    H2 = ZAHL; 
    CALL NORMALISIEREN (H2,EXP); 
    H1 = 7 - 2; 
    IF EXP >= 0 THEN H1 = H1 - EXP; FIN; 
    IF H2 < 0 THEN H1 = H1 - 1; FIN; 
    CALL TEXT(X-24,Y+8,1,ZAHLTXT(7,H1,ZAHL)); 
END; 
/*--------------------------------------------------------------------*/ 
ORDINATE: PROC ((X,Y) FIXED, ZAHL FLOAT); 
  DCL (CY,CX,H1,EXP) FIXED, 
      H2 FLOAT; 
    H2 = ZAHL; 
    CALL NORMALISIEREN (H2,EXP); 
    H1 = 6 - 2; 
    IF EXP >= 0 THEN H1 = H1 - EXP; FIN; 
    IF H2 < 0 THEN H1 = H1 - 1; FIN; 
    CALL TEXT(X-56,Y,1,ZAHLTXT(6,H1,ZAHL)); 
END; 
/*--------------------------------------------------------------------*/ 
BESCHRIFTUNG: PROC; 
  DCL (PL,MI,X1,X2,Y1,Y2,Y3) FIXED, 
      WERT FLOAT; 
  CALL SEITE1; 
  IF MOD /= 0 THEN 
    CALL CLEAR; 
  FIN; 
  Y1 = YO - 2; Y2 = YO + 2; Y3 = YO; 
  IF Y1 < 0 THEN Y1 = 0; Y2 = 2; Y3 = 0; FIN; 
  IF Y2 > YMAX THEN Y2 = YMAX; Y1 = YMAX - 2; Y3 = YMAX; FIN; 
  IF XO < 0 THEN 
    WERT = LK; 
    FOR I FROM 0 BY XD TO XMAX REPEAT; 
     CALL LINE (I,Y1,I,Y2,1); 
     CALL ABZISSE (I,Y3,WERT); 
     WERT = WERT + MASX; 
    END; 
   ELSE 
    IF XO < XWIDTH THEN 
      WERT = MASX; 
      FOR I FROM (XO+XD) BY XD TO XMAX REPEAT; 
       CALL LINE (I,Y1,I,Y2,1); 
       CALL ABZISSE (I,Y3,WERT); 
       WERT = WERT + MASX; 
      END; 
      WERT = -MASX; 
      FOR I FROM (XO-XD) BY -XD TO 0 REPEAT; 
       CALL LINE (I,Y1,I,Y2,1); 
       CALL ABZISSE (I,Y3,WERT); 
       WERT = WERT - MASX; 
      END; 
     ELSE 
      WERT = RK; 
      FOR I FROM XMAX BY -XD TO 0 REPEAT; 
       CALL LINE (I,Y1,I,Y2,1); 
       CALL ABZISSE (I,Y3,WERT); 
       WERT = WERT - MASX; 
      END; 
    FIN; 
  FIN; 
  X1 = XO - 4; X2 = XO + 4; 
  IF X1 < 0 THEN X1 = 0; X2 = 4; FIN; 
  IF X2 > XMAX THEN X2 = XMAX; X1 = XMAX - 4; FIN; 
  IF YO < 0 THEN 
    WERT = OK; 
    FOR I FROM 0 BY YD TO YMAX REPEAT; 
     CALL LINE (X1,I,X2,I,1); 
     CALL ORDINATE (XO,I,WERT); 
     WERT = WERT - MASY; 
    END; 
   ELSE 
    IF YO < YWIDTH THEN 
      WERT = -MASY; 
      FOR I FROM (YO+YD) BY YD TO YMAX REPEAT; 
       CALL LINE (X1,I,X2,I,1); 
       CALL ORDINATE (XO,I,WERT); 
       WERT = WERT - MASY; 
      END; 
      WERT = MASY; 
      FOR I FROM (YO-YD) BY -YD TO 0 REPEAT; 
       CALL LINE (X1,I,X2,I,1); 
       CALL ORDINATE (XO,I,WERT); 
       WERT = WERT + MASY; 
      END; 
     ELSE 
      WERT = UK; 
      FOR I FROM YMAX BY -YD TO 0 REPEAT; 
       CALL LINE (X1,I,X2,I,1); 
       CALL ORDINATE (XO,I,WERT); 
       WERT = WERT + MASY; 
      END; 
    FIN; 
  FIN; 
  IF (XO >= 0) AND (XO <= XMAX) THEN 
     CALL LINE (XO,0,XO,YMAX,1); 
  FIN; 
  IF (YO >= 0) AND (YO <= YMAX) THEN CALL LINE (0,YO,XMAX,YO,1); FIN; 
  PUT RS TO TY BY A; 
END; 
/*--------------------------------------------------------------------*/ 
POINT: PROC (X FIXED); 
  DCL Y FIXED, 
      H FLOAT; 
  H = YWERT; 
  IF (H >= UK) AND (H <= OK) THEN 
    IF OK <= 0 THEN 
      H = H - OK; 
     ELSE 
      IF UK >= 0 THEN 
        H = H - UK; 
      FIN; 
    FIN; 
    H = ABS (YD * H / MASY); 
    IF H > 32767. THEN Y = 32767; 
     ELSE Y = ENTIER H; 
    FIN;
    IF YWERT == 0 THEN
      Y = YO;
     ELSE
      IF YWERT < 0 THEN
        Y = YO + Y;
       ELSE
        Y = YO - Y;
      FIN;
    FIN;
    IF (Y >= 0) AND (Y<YWIDTH)
      THEN IF XOLD NE 0 AND YOLD NE 0 THEN
         CALL LINE (XOLD,YOLD,X,Y,MOD);
      ELSE XOLD=0; YOLD=0;
           FIN;
    FIN;
    XOLD=X; YOLD=Y;
  FIN;
END;
/*--------------------------------------------------------------------*/
ZEICHNEN: PROC;
  CALL SEITE1;
  YOLD=0; XOLD=0;
  IF LK >= 0 THEN
    XWERT = LK;
    FOR I TO XMAX REPEAT;
     IF (XWERT >= LGR) AND (XWERT <= RGR) THEN
       YWERT = FKT (XWERT);
       CALL POINT (I);
     FIN;
     XWERT = XWERT + STEP;
    END;
   ELSE
    IF RK <= 0 THEN
      YOLD=0; XOLD=0;
      XWERT = RK;
      FOR I FROM XMAX BY -1 TO 0 REPEAT;
       IF (XWERT >= LGR) AND (XWERT <= RGR) THEN
         YWERT = FKT (XWERT);
         CALL POINT (I);
       FIN;
       XWERT = XWERT - STEP;
      END;
     ELSE
      XWERT = 0;
      YOLD=0; XOLD=0;
      FOR I FROM XO TO XMAX REPEAT;
       IF (XWERT >= LGR) AND (XWERT <= RGR) THEN
         YWERT = FKT (XWERT);
         CALL POINT (I);
       FIN;
       XWERT = XWERT + STEP;
      END;
      XWERT = 0;
      YOLD=0; XOLD=0;
      FOR I FROM XO BY -1 TO 0 REPEAT;
       IF (XWERT >= LGR) AND (XWERT <= RGR) THEN
         YWERT = FKT (XWERT);
         CALL POINT (I);
       FIN;
       XWERT = XWERT - STEP;
      END;
    FIN;
  FIN;
END;
/*--------------------------------------------------------------------*/
KOORDINATEN: PROC;
  DCL (H1,H2) FLOAT;
  DKX = 0; DKY = 0;
  WHILE (DKX == 0) OR (DKY == 0) REPEAT;
   CALL SEITE2;
   PUT 'Grenzwerte des Koordinatenkreuzes : ' TO TY BY SKIP,A;
   PUT 'Eingabe : ',
       '  linker Rand = ' TO TY BY SKIP(2),A,SKIP,A;
   GET LK FROM TY BY SKIP,F(8);
   PUT ' rechter Rand = ' TO TY BY SKIP,A; 
   GET RK FROM TY BY SKIP,F(8); 
   PUT '  oberer Rand = ' TO TY BY SKIP,A; 
   GET OK FROM TY BY SKIP,F(8); 
   PUT ' unterer Rand = ' TO TY BY SKIP,A; 
   GET UK FROM TY BY SKIP,F(8); 
   IF LK > RK THEN 
     H1 = LK; LK = RK; RK = H1; 
   FIN; 
   IF UK > OK THEN 
     H1 = UK; UK = OK; OK = H1; 
   FIN; 
   DKX = ABS (RK - LK); DKY = ABS (OK - UK); 
   IF DKX == 0 THEN 
     PUT 'Eingabefehler : dx = 0 !' TO TY BY SKIP,A,SKIP; 
     GET FROM TY BY SKIP; 
   FIN; 
   IF DKY == 0 THEN 
     PUT 'Eingabefehler : dy = 0 !' TO TY BY SKIP,A,SKIP; 
     GET FROM TY BY SKIP; 
   FIN; 
  END; 
  IF LK > 0 THEN 
    XO = -1; 
   ELSE 
    IF RK < 0 THEN 
      XO = XWIDTH; 
     ELSE 
      IF LK == 0 THEN XO = 0; 
       ELSE 
        IF RK == 0 THEN XO = XMAX; 
         ELSE 
          XO = ENTIER (ABS (LK) * XMAX / DKX); 
        FIN; 
      FIN; 
    FIN; 
  FIN; 
  IF OK < 0 THEN 
    YO = -1; 
   ELSE 
    IF UK > 0 THEN 
      YO = YWIDTH; 
     ELSE 
      IF OK == 0 THEN YO = 0; 
       ELSE 
        IF UK == 0 THEN YO = YMAX; 
         ELSE 
          YO = ENTIER (ABS (OK) * YMAX / DKY); 
        FIN; 
      FIN; 
    FIN; 
  FIN; 
  MASX = DKX / 7; MASY = DKY / 7; 
  H1 = MASX; H2 = MASY; 
  CALL RUNDEN (MASX); CALL RUNDEN (MASY); 
  XD = ROUND (MASX * XMAX / (7 * H1)); 
  YD = ROUND (MASY * YMAX / (7 * H2)); 
  IF XD < 93 THEN XD = XD * 2; MASX = MASX * 2; FIN; 
  IF YD < 31 THEN YD = YD * 2; MASY = MASY * 2; FIN; 
  STEP = MASX / XD; 
  PUT CLS TO TY BY A; 
END; 
/*--------------------------------------------------------------------*/ 
FUNKTION: PROC ; 
  DCL ZCHN CHAR(1); 
  CALL SEITE2; 
  PUT 'eine Funktion einlesen : ' TO TY BY SKIP(2),A; 
  IF STNR /= 0 THEN 
    PUT 'bisher eingetragene Funktionen : ' TO TY BY SKIP(2),A; 
    FOR I TO STNR REPEAT; 
     PUT I, ':  y = ', ASTRING(I) TO TY BY SKIP,F(2),A,A(STLEN(I)); 
    END; 
  FIN; 
  PUT 'bitte die neue Funktion eingeben : ' TO TY BY SKIP(2),A; 
  CALL INPUT; 
  PUT 'Ist diese Fkt. begrenzt ?  (J/N) : ' TO TY BY SKIP(2),A; 
  GET ZCHN FROM KEY BY SKIP,A; 
  LGR = -9.9E6; 
  RGR =  9.9E6; 
  IF ZCHN == 'J' OR ZCHN EQ 'j' THEN 
    LGR = RGR; 
    WHILE LGR == RGR REPEAT; 
     PUT TOCHAR 27, '=', TOCHAR 40, TOCHAR 32 TO TY BY SKIP,(4)A; 
     PUT 'bitte die Intervallgrenzen der Funktion eingeben : ', 
         '  linke Grenze = ' TO TY BY (2)(SKIP,A); 
     GET LGR FROM TY BY SKIP,F(8); 
     PUT ' rechte Grenze = ' TO TY BY SKIP,A; 
     GET RGR FROM TY BY SKIP,F(8); 
     IF LGR == RGR THEN 
       PUT 'Eingabefehler : Differenz = 0' TO TY BY SKIP,A,SKIP; 
       GET  FROM TY BY SKIP; 
     FIN; 
    END; 
  FIN; 
  STGRL(STNR) = LGR; 
  STGRR(STNR) = RGR; 
  IF LGR > RGR THEN DXG = LGR; LGR = RGR; RGR = DXG; FIN; 
  PUT CLS TO TY BY A; 
END; 
/*--------------------------------------------------------------------*/ 
LOESCHEN: PROC; 
  DCL WAHL FIXED; 
  CALL SEITE2; 
  PUT 'eine Funktion loeschen : ' TO TY BY SKIP(2),A; 
  IF STNR /= 0 THEN 
    PUT 'bisher eingetragene Funktionen : ' TO TY BY SKIP(2),A; 
    FOR I TO STNR REPEAT; 
     PUT I, ':  y = ', ASTRING(I) TO TY BY SKIP,F(2),A,A(STLEN(I)); 
    END; 
    PUT 'welche Funktion (Nr.) soll geloescht werden ?  : ' 
       TO TY BY SKIP(2),A; 
    GET WAHL FROM KEY BY SKIP,F(1); 
    IF (WAHL >= 1) AND (WAHL <= STNR) THEN 
      STRING = ASTRING(WAHL); 
      RGR = STGRR(WAHL); 
      LGR = STGRL(WAHL); 
      IF WAHL /= STNR THEN 
        FOR I FROM WAHL+1 TO STNR REPEAT; 
         ASTRING(I-1) = ASTRING(I); 
         STLEN(I-1) = STLEN(I); 
         STGRL(I-1) = STGRL(I); 
         STGRR(I-1) = STGRR(I); 
        END; 
      FIN; 
      STNR = STNR - 1; 
      MOD = 0; 
    FIN; 
    PUT CLS TO TY BY A; 
  FIN; 
END; 
/*--------------------------------------------------------------------*/ 
MENUE: PROC RETURNS (FIXED); 
  DCL WERT FIXED INIT(0); 
  WHILE (WERT <= 0) OR (WERT > 5) REPEAT; 
   CALL SEITE2; 
   PUT 'Hauptmenue : ' TO TY BY SKIP(2),A,SKIP; 
   PUT 'Auswahl : ', '1. ganz neues Bild ', 
       '2. neues Koordinatenkreuz ', '3. neue Funktion', 
       '4. eine Fkt. loeschen', 
       '5. Programm beenden', 'bitte waehlen : ' 
      TO TY BY (7)(SKIP,A); 
   GET WERT FROM KEY BY SKIP,F(1); 
  END; 
  IF WERT == 5 THEN 
    PUT 'Tschuess, bis zum naechsten mal.' TO TY BY SKIP,A,SKIP; 
    TERMINATE; 
  FIN; 
  PUT CLS TO TY BY A; 
RETURN (WERT); 
END; 
/**********************************************************************/ 
FKT: TASK; 
  DCL WAHL FIXED INIT (1); 
  VT = TOCHAR 11; LF = TOCHAR 10; FF = TOCHAR 12; RS = TOCHAR 30; 
  ZEILE54 = TOCHAR 27 CAT '=' CAT TOCHAR 54 CAT TOCHAR 32; 
  CALL WIDTH(XWIDTH,YWIDTH); 
  XMAX=XWIDTH-2;YMAX=YWIDTH-1; 
  CLS = TOCHAR 27 CAT '*'; 
  HOME= TOCHAR (30); 
  CALL SEITE2; 
  PUT CLS TO TY BY SKIP,A; 
  REPEAT; 
   CASE WAHL 
    ALT MASX = 0; STNR = 0; MOD = 1; 
        CALL KOORDINATEN; 
        CALL FUNKTION; 
        CALL BESCHRIFTUNG; 
        CALL ZEICHNEN; 
    ALT CALL KOORDINATEN; 
        CALL BESCHRIFTUNG; 
        FOR I TO STNR REPEAT; 
         STRING = ASTRING(I); LGR = STGRL(I); RGR = STGRR(I); 
         CALL ZEICHNEN; 
        END; 
    ALT CALL FUNKTION; 
        CALL ZEICHNEN; 
    ALT CALL LOESCHEN; 
        CALL ZEICHNEN; 
        CALL BESCHRIFTUNG; 
        MOD = 1; 
   FIN; 
   GET FROM TY BY SKIP; 
   WAHL = MENUE; 
  END; 
END; 
MODEND;