home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / kzr.CMD < prev    next >
OS/2 REXX Batch file  |  1999-02-18  |  25KB  |  734 lines
  1. /* REXX-Programm kzr.CMD */
  2. /* Der folgende Aufruf  "Call RxFuncAdd....." lädt die           */
  3. /* RexxUtil-Funktionen auch für alle von  kzr.CMD  aufgerufenen  */
  4. /* Funktionen wie z.B. sin(x), sqrt(x) oder auch  phi(x).        */
  5. /* Lediglich die Funktionen  b2d.CMD, b2x.CMD, d2b.CMD, d2x.CMD, */
  6. /* x2b.CMD  und  x2d.CMD  sowie  prim.CMD  haben selbst die hier */
  7. /* folgenden zwei Zeilen, da sie ohne  kzr.CMD  direkt von der   */
  8. /* Kommandozeile aufgerufen werden.                              */
  9.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  10.    Call SysLoadFuncs
  11.    
  12.    /* Wird bei der Ausführung einer REXX-Anweisung ein Syntaxfehler */
  13.    /* festgestellt, so wird zur Prozedur "Fehlermeldung" verzweigt. */
  14.    signal on syntax name Fehlermeldung
  15.  
  16.    /* Die Datei "Ergebnis.DAT" wird in dem Verzeichnis abgelegt, */
  17.    /* in dem auch die Datei "kzr.CMD" abgelegt ist.              */
  18.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  19.    lp=LastPos("\", Pfd)
  20.    Pfd=DelStr(Pfd, 1+lp)
  21.    buferg=Pfd||"Ergebnis.DAT"
  22.    bufND =Pfd||"NDZahl.DAT"
  23.    bufNDA=Pfd||"NDAZahl.DAT"
  24.    bufMsg=Pfd||"Meldung.DAT"
  25.  
  26.    z = LineIn(buferg, 1)
  27.    zv=z
  28.    if length(zv)=0 then zv="Keines"
  29.  
  30.    /* Der Befehl "Call charout(buferg)" ist erforderlich, weil sonst */
  31.    /* die Datei  Ergebnis.DAT, die über den Pfad Pfd erreichbar ist, */
  32.    /* nicht gelöscht werden kann.                                    */
  33.    Call charout(buferg);   Call SysFileDelete buferg
  34.  
  35.    parse arg str;   str=strip(str)
  36.  
  37.    if (length(str)= 0) then
  38.    do; "start /PM /MAX view.exe" Pfd||"KZR.INF"; EXIT; end
  39.  
  40.    /* Prüfung, ob das  e r s t e  Komma nach "kzr" eingegeben wurde. */
  41.    ww=word(str, 1)
  42.    l1=length(ww)
  43.    lk=Pos(",", ww)
  44.    p1=wordpos(" , ", str)
  45.  
  46.    if l1 <> lk then
  47.    do
  48.      if p1 = 0 then
  49.      do
  50.        Call charout(bufND);   Call SysFileDelete bufND
  51.        Call charout(bufMsg);  Call SysFileDelete bufMsg
  52.        Call kommav
  53.      end
  54.    end
  55.  
  56.    /* Zerlegen des Kommandozeilen-Strings nach eine Schablone.  */
  57.    /* Das "UPPER" ist wichtig, damit verschiedene Schreibweisen */
  58.    /* von "externen" Operatoren, wie z.B. divganz, DivGanz oder */
  59.    /* dIVgANZ auch richtig erkannt werden.                      */
  60.    parse value str with ND ',' st ';' v1 ',' v2
  61.    /* v1 ist die Zuweisung für die Variable 1                       */
  62.    /* und v2 die Zuweisung für die Variable 2.                      */
  63.    /* v1, v2 oder auch v1 und v2 können nach der Formulierung der   */
  64.    /* Rechenaufgabe auf der Kommandozeile, jeweils durch ein Komma  */
  65.    /* getrennt auf der Kommandozeile eingegeben werden.             */
  66.    /* v1 und v2 müssen aber nicht eingegeben werden, wenn in der    */
  67.    /* eigentlichen "Rechenaufgabe" keine Variablen vorhanden sind.  */
  68.  
  69.    /* Prüfung, ob  ND  eine gültige REXX-Zahl ist */
  70.    if Datatype(ND, 'N') <> 1 & length(ND) > 0 then
  71.    do
  72.      Call charout(bufND);   Call SysFileDelete bufND
  73.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  74.      Call FalschZahl ND
  75.    end
  76.  
  77.    /* Prüfung, ob  ND  größer als  1  ist */
  78.    if length(ND) > 0 & ND < 2 then
  79.    do
  80.      Call charout(bufND);   Call SysFileDelete bufND
  81.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  82.      Call FalschArg
  83.    end
  84.  
  85.    if length(ND) = 0 then ND = 20
  86.    Numeric digits ND
  87.    /* Die Variable ND wird an  bufND übergeben */
  88.    ret=LineOut(bufND, ND)
  89.  
  90.    v1=strip(v1)                                   
  91.    v2=strip(v2)                                   
  92.    /* Es wird überprüft, ob die Variablen-Zuweisung auf der */
  93.    /* Kommandozeile korrekt ist.                            */
  94.    if length(v1) > 0 & Pos("=", v1) = 0 then Call NoVar
  95.    if length(v2) > 0 & Pos("=", v2) = 0 then Call NoVar
  96.                    
  97.    if Pos(";", v1)>0 | Pos(":", v1)>0 then Call FalschZeichen
  98.                                   
  99.    if Pos("'", st) > 0 | Pos('"', st) > 0 | Pos("@", st) > 0 | ,
  100.       Pos("?", st) > 0 | Pos('\', st) > 0 | Pos('#', st) > 0 | ,
  101.       Pos('', st) > 0 | Pos('$', st) > 0 then
  102.    do
  103.      Call charout(bufND);   Call SysFileDelete bufND
  104.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  105.      Call QuoteFilter
  106.    end
  107.  
  108.    /* Umwandlung von st in große Buchstaben */
  109.    kl="divganzrest"; gr="DIVGANZREST"
  110.    st=translate(st, gr, kl)
  111.    st1=st
  112.    if Pos(":",   st1)     > 0 then st2=Filter2(st1); else st2=st1
  113.    if Pos("DIVGANZ", st2) > 0 then st3=Filter3(st2); else st3=st2
  114.    if Pos("DIVREST", st3) > 0 then st4=Filter4(st3); else st4=st3
  115.    st=st4
  116.    /* Umwandlung von st in kleine Buchstaben */
  117.    st=translate(st, kl, gr)
  118.        
  119.    select
  120.      when  Pos(")0", st) > 0  then Signal twt
  121.      when  Pos(")1", st) > 0  then Signal twt
  122.      when  Pos(")2", st) > 0  then Signal twt
  123.      when  Pos(")3", st) > 0  then Signal twt
  124.      when  Pos(")4", st) > 0  then Signal twt
  125.      when  Pos(")5", st) > 0  then Signal twt
  126.      when  Pos(")6", st) > 0  then Signal twt
  127.      when  Pos(")7", st) > 0  then Signal twt
  128.      when  Pos(")8", st) > 0  then Signal twt
  129.      when  Pos(")9", st) > 0  then Signal twt
  130.      when  Pos("),", st) > 0  then Signal twt
  131.      when  Pos(").", st) > 0  then Signal twt
  132.      otherwise Signal twtw
  133.    end
  134. twt:
  135.      Call charout(bufND);   Call SysFileDelete bufND
  136.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  137.      Call Unsinn
  138. twtw:
  139.    stst=strip(st)
  140.    v1  =strip(v1)
  141.    v2  =strip(v2)
  142.  
  143.    /* Wichtig, damit das Ergebnis in der Variablen z verfügbar ist, und    */
  144.    /* daß zuerst die Variablen  v1, v2 oder auch v1 und v2 verfügbar sind. */
  145.    if length(v1) > 0 & length(v2) > 0 then
  146.    do
  147.    /* Hier ist zweimal ein Semikolon erforderlich, */
  148.    /* da Trennung von drei REXX-Anweisungen        */
  149.      st=v1||";"||v2||";   "||"z = "||stst
  150.      Signal NV
  151.    end
  152.  
  153.    if length(v1) > 0 & length(v2) = 0 then
  154.    do
  155.    /* Hier ist einmal ein Semikolon erforderlich,  */
  156.    /* da Trennung von zwei REXX-Anweisungen        */
  157.      st=v1||";   "||"z = "||stst
  158.      Signal NV
  159.    end
  160.  
  161.    if length(v2) > 0 & length(v1) = 0 then
  162.    do
  163.    /* Hier ist einmal ein Semikolon erforderlich,  */
  164.    /* da Trennung von zwei REXX-Anweisungen        */
  165.      st=v2||";   "||"z = "||stst
  166.      Signal NV
  167.    end
  168.  
  169.    st ="z = "||stst
  170. NV:
  171.    stA="z = "||stst
  172.  
  173.    /* Für die aktuelle Berechnung und deren Anzeige sollen die von    */
  174.    /* alle großen Buchstaben in kleine Buchstaben umgewandelt werden  */
  175.    kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  176.    st = translate(st,  kl, gr)
  177.    v1 = translate(v1,  kl, gr)
  178.    v2 = translate(v2,  kl, gr)
  179.    stA= translate(stA, kl, gr)
  180.    say
  181.     
  182.    /* Die Funktionen D2X, X2D, B2X, X2B, D2B und B2D müssen direkt */
  183.    /* von der Kommandozeile, das heißt, ohne die Funktion kzr.CMD  */
  184.    /* aufgerufen werden.                                           */
  185.    /* Diese Abfrage muß an dieser Stellegeschehen.                 */
  186.    if Pos("D2X", st)>0 | Pos("X2D", st)>0 |,
  187.       Pos("B2X", st)>0 | Pos("X2B", st)>0 |,
  188.       Pos("D2B", st)>0 | Pos("B2D", st)>0 | Pos("PRIM", st)>0 then Signal FalschRuf
  189.    
  190.    Numeric Digits ND+4  /* Intern wird mit ND+4 Dezimalstellen gerechnet. */
  191.    /* Dies ist der wichtigste Befehl ! */
  192.    /**/         interpret st         /**/
  193.    /* Dies ist der wichtigste Befehl ! */
  194.  
  195.  /* Von NDA_MIN wird der niedrigste Wert NDA für die Rechengenauigkeit    */
  196.  /* der verwendeten Funktionen ermittelt und dieser "Kernfunktion"kzr.CMD */
  197.  /* für die Ergebnisanzeige übergeben.                                    */
  198.    ND=MinNDA()
  199.    Numeric Digits ND
  200.  
  201.    /* Nur wenn das Ergebnis eine gültige REXX-Zahl ist, Ergebnis formen */
  202.    if DataType(z, 'N') = 1 then
  203.    do
  204.      Numeric Digits ND
  205.      zz=Format(z, , , , )
  206.      st10=ErgFormat(zz)
  207.    end
  208.    else st10=z
  209.  
  210.    /* Ausgabe, wenn ein Ergebnis berechnet werden konnte */
  211.    Call Color 0,White
  212.    Call Charout,"Ergebnis der vorangegangenen Berechnung:"; say; say
  213.    Call Color 1,Green
  214.    Call Charout,"   "zv; say; say; say
  215.    Call Color 0,White
  216.    Call Charout,"Aufgabe der aktuellen Berechnung:"
  217.    say; say
  218.    
  219.    Call Color 1,White
  220.    Call Charout,"  "stA; say
  221.    
  222.    if length(v1)>0 | length(v2)>0 then do
  223.      Call Color 0,White
  224.      say; call Charout,"mit"; say;say
  225.    end
  226.  
  227.    Call Color 1,White
  228.    if length(v1) > 0 then
  229.    do
  230.      parse value v1 with w1 '=' w2
  231.      v1=strip(w1)||" = "||strip(w2)  
  232.      Call Charout,"  "v1; say
  233.    end
  234.  
  235.    if length(v2) > 0 then
  236.    do
  237.    parse value v2 with w1 '=' w2
  238.      v2=strip(w1)||" = "||strip(w2)  
  239.      Call Charout,"  "v2; say        
  240.    end 
  241.    say; say
  242.    
  243.    Call Color 1,White
  244.    Call Charout,"Ergebnis  ";
  245.    Call Color 1,White
  246.    Call Charout,"z"
  247.    Call Color 0,White
  248.    Call Charout,"  der aktuellen Berechnung mit "
  249.    Call Color 1,White
  250.    Call Charout,ND
  251.    Call Color 0,White
  252.    Call Charout," Dezimalstellen:"
  253.    say; say
  254.    Call Color 1,Cyan
  255.    Call Charout,"  "st10; say
  256.  
  257.    /* Nur wenn  st10  eine gültige REXX-Zahl ist. */     
  258.    if DataType(st10, 'N')==1 then
  259.    do
  260.       /* Nur bei verschiedenen Ausgabeformaten Ausgabe von zwei Anzeigen. */
  261.       if Compare(st10,  Format(st10, , , ,0)) <> 0 then
  262.       do
  263.          Call Charout,"  "Format(st10, , , ,0)
  264.       end
  265.       Call Color 0,White
  266.       ret=LineOut(buferg, st10)
  267.    end
  268.    say
  269.  
  270. PgmEnd:
  271.    Call Color 0,White
  272.    Call charout(bufND);   Call SysFileDelete bufND
  273.    Call charout(bufNDA);  Call SysFileDelete bufNDA
  274.    Call charout(bufMsg);  Call SysFileDelete bufMsg
  275.    /* Das REXX-Programm MinNDA.CMD löscht temporäre Dateien,          */
  276.    /* die von "externen" mathematischen Funktionen hizugefügt wurden. */
  277.    Dummy=MinNDA()
  278. EXIT
  279.  
  280. /******************************* Prozeduren *********************************/
  281.  
  282. Filter2:
  283.   Procedure
  284.   parse arg str
  285.   i=1; st2.i=str
  286.   Anf2:
  287.   j=i+1
  288.   l2.i=Pos(":", st2.i)
  289.   if l2.i=0 then Signal w2e
  290.   st2.j=Overlay("/", st2.i, l2.i)
  291.   st2=st2.j
  292.   i=i+1
  293.   Signal Anf2
  294.   w2e:
  295.   Return(st2)
  296.  
  297. Filter3:
  298.   Procedure
  299.   parse arg str
  300.   i=1; st3.i=str
  301.   Anf3:
  302.   j=i+1
  303.   l3.i=Pos("DIVGANZ", st3.i); if l3.i > 0 then Signal w31
  304.   w31:
  305.   if l3.i=0 then Signal w3e
  306.   sub3.i=SubStr(st3.i, l3.i, 7)
  307.   st3.i =DelStr(st3.i, l3.i, 7)
  308.   if  sub3.i=="DIVGANZ" then neu3.i="%"
  309.   st3.j=Insert(neu3.i, st3.i, l3.i-1  ); st3=st3.j
  310.   i=i+1
  311.   signal Anf3
  312.   w3e:
  313.   Return(st3)
  314.  
  315. Filter4:
  316.   Procedure
  317.   parse arg str
  318.   i=1; st4.i=str
  319.   Anf4:
  320.   j=i+1
  321.   l4.i=Pos("DIVREST", st4.i); if l4.i > 0 then Signal w41
  322.   w41:
  323.   if l4.i=0 then Signal w4e
  324.   sub4.i=SubStr(st4.i, l4.i, 7)
  325.   st4.i =DelStr(st4.i, l4.i, 7)
  326.   if  sub4.i=="DIVREST" then  neu4.i="//"
  327.   st4.j=Insert(neu4.i, st4.i, l4.i-1  ); st4=st4.j
  328.   i=i+1
  329.   signal Anf4
  330.   w4e:
  331.   Return(st4)
  332.  
  333. /* Diese Funktion entfernt den Dezimalpunkt und die darauf folgenden      */
  334. /* Ziffern  "0"  , wenn nach diesem Dezimalpunkt nur noch Nullen folgen.  */
  335. ErgFormat:
  336.   Procedure
  337.   arg u
  338.   /* Nur wenn das Ergebnis einen Dezimalpunkt enthält */
  339.   /* und in der Exponential-Schreibweise vorliegt.    */
  340.   if Pos(".", u)>0 & Pos("E", u)=0 then
  341.   do
  342.   /* Ziffern-Reihe aus der Ziffer  "0"  nach dem Dezimalpunkt entfernen */
  343.     do forever
  344.       lu=length(u)
  345.       if Pos("0", u, lu) > 0 then u=DelStr(u, lu); else leave
  346.     end
  347.     /* Den Dezimalpunkt entfernen */
  348.     lu=length(u)
  349.     if Pos(".", u) = lu then u=DelStr(u, lu)
  350.    end
  351.    Return(u)
  352.  
  353. NoVar:
  354.   say
  355.   Call Color 1,Red
  356.   Call Charout,"Kein Ergebnis !"; say; say
  357.   Call Color 1,White
  358.   Call Charout,"Sie haben einen algebraisch unsinnigen Ausdruck eingeben"; say
  359.   Call Charout,"oder einer Variablen keinen Wert zugewiesen. (NoVar)";say
  360.   Call Color 0,White
  361.   say
  362.   Beep(444, 200); Beep(628,300)
  363.   Signal PgmEnd
  364.  
  365. kommav:
  366.   say
  367.   Call Color 1,white
  368.   Call Charout,"In dem Kommandozeilen-String muß nach dem Teilstring  "
  369.   Call Color 1,cyan
  370.   Call Charout,"kzr"; say
  371.   Call Color 1,white
  372.   Call Charout,"mindestens  "
  373.   Call Color 1,green
  374.   Call Charout,"1"
  375.   Call Color 1,white
  376.   Call Charout,"  Leerzeichen enthalten sein."; say
  377.   Call Charout,"Darauf folgend, bevor die eigentliche ""Rechenaufgabe"" eingegeben wird,"; say
  378.   Call Charout,"entweder";say
  379.   Call Charout,"         ein "
  380.   Call Color 1,cyan
  381.   Call Charout,"einzelnes Komma"
  382.   Call Color 1,white
  383.   Call Charout," mit mindestens  "
  384.   Call Color 1,green
  385.   Call Charout,"1"
  386.   Call Color 1,white
  387.   Call Charout,"  Leerzeichen dahinter,"; say
  388.   Call Charout,"oder";say
  389.   Call Charout,"         eine "
  390.   Call Color 1,cyan
  391.   Call Charout,"ganze Zahl > 1"
  392.   Call Color 1,white
  393.   Call Charout,", gefolgt von"; say
  394.   Call Charout,"         einem "
  395.   Call Color 1,cyan
  396.   Call Charout,"einzelnen Komma"
  397.   Call Color 1,white
  398.   Call Charout," mit mindestens  "
  399.   Call Color 1,green
  400.   Call Charout,"1"
  401.   Call Color 1,white
  402.   Call Charout,"  Leerzeichen dahinter."; say; say
  403.   Call Charout,"Näheres ist in der "
  404.   Call Color 1,Green
  405.   Call Charout,"kzr.INF"
  406.   Call Color 1,white
  407.   Call Charout," zu finden."
  408.   say
  409.   Beep(444, 200); Beep(628,300)
  410.   Signal PgmEnd
  411.  
  412. FalschZahl:
  413.   say
  414.   arg ND
  415.   Call Color 1,Red
  416.   Call Charout,"Kein Ergebnis !"; say; say
  417.   Call Color 1,White
  418.   Call Charout,"Anstelle einer ganzen Zahl, die größer als  1  sein muß,"; say
  419.   Call Charout,"haben Sie den String  "
  420.   Call Color 1,cyan
  421.   Call Charout,strip(ND)
  422.   Call Color 1,White
  423.   Call Charout,"  eingegeben."
  424.   Call Color 0,White
  425.   say
  426.   Beep(444, 200); Beep(628,300)
  427.   Signal PgmEnd
  428.  
  429. FalschZeichen:
  430.   say
  431.   Call Color 1,Red
  432.   Call Charout,"Kein Ergebnis !"; say; say
  433.   Call Color 1,White
  434.   Call Charout,"Sie haben nach der Festlegung der ersten Variablen"; say
  435.   Call Charout,"anstelle des erforderlichen Kommas ein Semikolon,"; say
  436.   Call Charout,"einen Punkt oder einen Doppelpunkt eingegeben."; say
  437.   Call Color 0,White
  438.   say
  439.   Beep(444, 200); Beep(628,300)
  440.   Signal PgmEnd
  441.    
  442. FalschArg:
  443.   say
  444.   Call Color 1,white
  445.   Call Charout,"In dem Kommandozeilen-String muß zwischen dem Teilstring  "
  446.   Call Color 1,cyan
  447.   Call Charout,"kzr"; say
  448.   Call Color 1,white
  449.   Call Charout,"und dem ersten  "
  450.   Call Color 1,cyan
  451.   Call Charout,"Komma"
  452.   Call Color 1,white
  453.   Call Charout,"  entweder"; say; say
  454.   Call Charout,"eine  "
  455.   Call Color 1,Green
  456.   Call Charout,"ganze Zahl > 1"
  457.   Call Color 1,white
  458.   Call Charout,"  oder"; say
  459.   Call Charout,"mindestens  "
  460.   Call Color 1,Green
  461.   Call Charout,"1"
  462.   Call Color 1,white
  463.   Call Charout,"  Leerzeichen eingegeben werden."
  464.   Call Color 0,white
  465.   say
  466.   Beep(444, 200); Beep(628,300)
  467.   Signal PgmEnd
  468.  
  469. FalschRuf:
  470.   say
  471.   Call Color 1,white
  472.   Call Charout,"Die Umwandlungsfunktionen"; say; say
  473.   Call Color 1,cyan
  474.   Call Charout,"D2X"
  475.   call Color 0,white
  476.   Call Charout,", "
  477.   Call Color 1,cyan
  478.   Call Charout,"X2D"
  479.   call Color 0,white
  480.   Call Charout,", "
  481.   Call Color 1,cyan
  482.   Call Charout,"B2X"
  483.   call Color 0,white
  484.   Call Charout,", "
  485.   Call Color 1,cyan
  486.   Call Charout,"X2B"
  487.   call Color 0,white
  488.   Call Charout,", "
  489.   Call Color 1,cyan
  490.   Call Charout,"D2B"
  491.   call Color 0,white
  492.   Call Charout," und "
  493.   Call Color 1,cyan
  494.   Call Charout,"B2D"; say; say
  495.   call Color 1,white
  496.   call Charout,"sowie die Funktion "
  497.   Call Color 1,cyan
  498.   call Charout,"Prim.CMD"
  499.   call Color 1,white
  500.   call Charout," zur Primfaktor-Zerlegung"; say
  501.   call Charout,"dürfen nur von der Kommandozeile direkt und "
  502.   Call Color 1,red
  503.   call Charout,"ohne"
  504.   call Color 1,white
  505.   call Charout," den"; say
  506.   call Charout,"vorangesetzten Teilstring "
  507.   Call Color 1,cyan
  508.   call Charout," kzr xy, "
  509.   call Color 1,white
  510.   call Charout," eingegeben werden."; say; say
  511.   call Charout,"(Näheres dazu in der kzr.INF)"
  512.   call Color 0,white
  513.   say
  514.   Beep(444, 200); Beep(628,300)
  515.   Signal PgmEnd
  516.    
  517. Fehlermeldung:
  518.   sf=ErrorText(RC)
  519.   
  520.   Call CsrLeft 10
  521.   Call Charout,"                                                                              "; say
  522.   Call Charout,"                                                                              "; say
  523.   Call Charout,"                                                                              "; say
  524.   Call Charout,"                                                                              "; say
  525.   Call Charout,"                                                                              "; say
  526.   Call Charout,"                                                                              "; say
  527.   Call Charout,"                                                                              "; say
  528.   Call Charout,"                                                                              "; say
  529.   Call Charout,"                                                                              "; say
  530.   Call Charout,"                                                                              "; say
  531.   Call Charout,"                                                                              "; say
  532.   Call Charout,"                                                                              "; say
  533.   Call Charout,"                                                                              "; say
  534.   Call CsrUp 12
  535.  
  536.   if  Pos("Invalid ex", sf) > 0 then
  537.   do
  538.     sfstr="Sie haben einen algebraisch unsinnigen Ausdruck eingeben,",
  539.           "                     ",
  540.           "einer Variablen keinen Wert zugewiesen",
  541.           "                                        ",
  542.           "oder gar keine mathematische Funktion aufgerufen."
  543.     Signal raus
  544.   end
  545.  
  546.   if  Pos("Arithmetic", sf) > 0 then
  547.   do
  548.     sfstr="Haben Sie etwa versucht, durch  0  zu dividieren ?   ·····   Pfui !"
  549.     Signal raus
  550.   end
  551.  
  552.   if  Pos('Unexpected ","', sf) > 0 then
  553.   do
  554.     sfstr="Sie haben zuviele rechte Klammern oder ein unzulässiges Komma eingegeben."
  555.     Signal raus
  556.   end
  557.  
  558.   if  Pos("Invalid ch", sf) > 0 then
  559.   do
  560.     sfstr="Sie haben ein in algebraischen Ausdrücken unzulässiges Symbol eingegeben."
  561.     Signal raus
  562.   end
  563.  
  564.   if  Pos('Unmatched "("', sf) > 0 & Pos("in expression", sf, 15) > 0 then
  565.   do
  566.     sfstr="Sie haben zu viele linke oder zu wenige rechte Klammern eingegeben."
  567.     Signal raus
  568.   end
  569.  
  570.   if  Pos("Bad arithmetic conversion", sf) > 0 then
  571.   do
  572.     sfstr="     Sie haben einen algebraisch unsinnigen Ausdruck eingeben",
  573.           "                 ",
  574.           "     oder einer Variablen keinen Wert zugewiesen.",
  575.           "                             ",
  576.           "     Möglicherweise aber wollten Sie in der aktuellen Rechenaufgabe",
  577.           "           ",
  578.           "     mit der Spezialvariablen  z  das Ergebnis der (gescheiterten)",
  579.           "            ",
  580.           "     vorangegangenen Rechenaufgabe verwenden,",
  581.           "                                 ",
  582.           "     der natürlich noch kein Wert zugewiesen war."
  583.     Signal raus
  584.   end
  585.  
  586.   if  Pos("Routine not", sf) > 0 then
  587.   do
  588.     sfstr="Die Funktion in diesem Ausdruck kann nicht aufgerufen werden."
  589.     Signal raus
  590.   end
  591.  
  592.   if  Pos("Invalid whole number", sf) > 0 then
  593.   do
  594.     sfstr="     Entweder werden für die interne Rechengenauigkeit",
  595.           "                        ",
  596.           "     zu wenig Dezimalstellen verwendet,",
  597.           "                                       ",
  598.           "     oder Sie haben als Exponenten keine ganzen Zahlen eingegeben."
  599.     Signal raus
  600.   end
  601.  
  602.   if  Pos("Unknown command", sf) > 0 then
  603.   do
  604.     sfstr="Eingabe oder Ergebnis der Berechnung ist keine gültige REXX-Zahl."
  605.     Signal raus
  606.   end
  607.  
  608.   if  Pos("Name starts with number or", sf) > 0 then
  609.   do
  610.     sfstr="Sie haben einer Variablen keinen Wert zugewiesen. (Name starts with number)"
  611.     Signal raus
  612.   end
  613.  
  614.   /* Gibt Fehlermeldungen eines Unterprogramms zurück, */
  615.   /* die in  bufMsg  gespeichert sind. Object-REXX-Version */
  616.   if  Pos("Function or message did not", sf) > 0 then
  617.   do
  618.     sfstr=LineIn(bufMsg, 1)
  619.     /* Hier besonders wichtig ! */
  620.     Call charout(bufMsg);  Call SysFileDelete bufMsg
  621.     Signal raus
  622.   end
  623.  
  624.   /* Gibt Fehlermeldungen eines Unterprogramms zurück, */
  625.   /* die in  bufMsg  gespeichert sind. Klass.-REXX-Version */
  626.   if  Pos("Function did not", sf) > 0 then
  627.   do
  628.     sfstr=LineIn(bufMsg, 1)
  629.     /* Hier besonders wichtig ! */
  630.     Call charout(bufMsg);  Call SysFileDelete bufMsg
  631.     Signal raus
  632.   end
  633.  
  634.   if  Pos("Incorrect call to method", sf) > 0 then
  635.   do
  636.     sfstr=LineIn(bufMsg, 1)
  637.     /* Hier besonders wichtig ! */
  638.     Call charout(bufMsg);  Call SysFileDelete bufMsg
  639.     Signal raus
  640.   end
  641.            
  642.   raus:
  643.   Call Color 1,Red
  644.   Call Charout,"Kein Ergebnis !"; say; say
  645.   Call Color 1,White
  646.   Call Charout,sfstr; say
  647.   Call charout(bufND);   Call SysFileDelete bufND
  648.   Call charout(bufMsg);  Call SysFileDelete bufMsg
  649.   Beep(444, 200); Beep(628,300)
  650.   Signal PgmEnd
  651.  
  652. Unsinn:
  653.   say;
  654.   Call Color 1,Red
  655.   Call charout(bufND);   Call SysFileDelete bufND
  656.   Call charout(bufMsg);  Call SysFileDelete bufMsg
  657.   Call Charout,"Kein Ergebnis !"; say; say
  658.   Call Color 1,White
  659.   Call Charout,"Sie haben einen algebraisch unsinnigen Ausdruck eingeben."
  660.   say
  661.   Beep(444, 200); Beep(628,300)
  662.   Signal PgmEnd
  663.  
  664. QuoteFilter:
  665.   say
  666.   Call Color 1,Red
  667.   Call Charout,"Kein Ergebnis !"; say; say
  668.   Call Color 1,White
  669.   Call Charout,"Die Symbole "
  670.   Call Color 1,cyan; Call Charout,""; Call Color 1,white; Call Charout,", "
  671.   Call Color 1,cyan; Call Charout,"$"; Call Color 1,white; Call Charout,", "
  672.   Call Color 1,cyan; Call Charout,"="; Call Color 1,white; Call Charout,", "
  673.   Call Color 1,cyan; Call Charout,"?"; Call Color 1,white; Call Charout,", "
  674.   Call Color 1,cyan; Call Charout,"\"; Call Color 1,white; Call Charout,", "
  675.   Call Color 1,cyan; Call Charout,"@"; Call Color 1,white; Call Charout,", "
  676.   Call Color 1,cyan; Call Charout,"#"; Call Color 1,white; Call Charout,", "
  677.   Call Color 1,cyan; Call Charout,"'"; Call Color 1,white; Call Charout," und "
  678.   Call Color 1,cyan; Call Charout,'"'; say
  679.   Call Color 1,white
  680.   Call Charout,"dürfen auf der Kommandozeile dieses Programms nicht verwendet werden."; say;say
  681.   call Charout,"Lediglich bei einer Zuweisung von Werten zu einer oder zwei der beiden"; say  
  682.   call Charout,"Variablen, zum Beispiel  x=2  und/oder  y=3  unmittelbar im Anschluß";say  
  683.   call Charout,"an die Eingabe der eigentlichen Rechenaufgabe auf der Kommandozeile,";say  
  684.   call Charout,"ist das Gleiheitszeichen erlaubt.";say; say  
  685.   Call Color 1,Red
  686.   Call Charout,"Warnung für weitere Eingaben !"; say; say
  687.   Call Color 1,white
  688.   Call Charout,"Die Symbole  "
  689.   Call Color 1,cyan; Call Charout,"%"; Call Color 1,white; Call Charout,", "
  690.   Call Color 1,cyan; Call Charout,"&"; Call Color 1,white; Call Charout,", "
  691.   Call Color 1,cyan; Call Charout,"<"; Call Color 1,white; Call Charout,", "
  692.   Call Color 1,cyan; Call Charout,">"; Call Color 1,white; Call Charout," und "
  693.   Call Color 1,cyan; Call Charout,"|"; Call Color 1,white
  694.   Call Charout,"  sowie die Strings  "
  695.   Call Color 1,cyan; Call Charout,"<<"; Call Color 1,white; Call Charout,", "
  696.   Call Color 1,cyan; Call Charout,">>"; Call Color 1,white;  Call Charout," und "
  697.   Call Color 1,cyan; Call Charout,"//"; say
  698.   Call Color 1,white
  699.   Call Charout,"dürfen auf der OS/2-Kommandozeile nur in bestimmten Fällen verwendet werden;"; say
  700.   Call Charout,"nur zeigt  "
  701.   Call Color 1,cyan; Call Charout,"kzr.CMD"; Call Color 1,white
  702.   Call Charout,"  bei Verletzung der einschlägigen Regeln"; say
  703.   Call Charout,"leider keine diesbezüglichen Meldung an."
  704.   say
  705.   Beep(444, 200); Beep(628,300)
  706.   Signal PgmEnd
  707.  
  708. /***************************** ANSI-Prozeduren ******************************/
  709.  
  710.  
  711. Color:     /* Call Color <Attr>,<ForeGround>,<BackGround>                */  
  712. Procedure  /* Attr=1 -> HIGH;  Attr=0 -> LOW; Attr only for ForeGround ! */
  713. arg A,F,B   
  714. CLRS = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  715. A=strip(A); if length(A)==0 then A=0    
  716. F=strip(F); if length(F)==0 then F=WHITE
  717. B=strip(B); if length(B)==0 then B=BLACK
  718. return CHAROUT(,D2C(27)||"["A";"WORDPOS(F,CLRS)+29";"WORDPOS(B,CLRS)+39"m")
  719.  
  720.  
  721. /* In kzr.cmd sind die Funktionen  CsrLeft  und  CsrUp  erforderlich. */
  722. CsrLeft: procedure
  723. arg l
  724. Rc = Charout(,D2C(27)"["l"D")
  725. Return ""
  726.  
  727.  
  728. CsrUp: Procedure  /* CsrUp(Rows) */
  729. Arg u
  730. Rc = Charout(,D2C(27)"["u"A")
  731. return ""
  732.  
  733.  
  734.