home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kmpl9803.zip / kmpl.cmd < prev    next >
OS/2 REXX Batch file  |  1998-03-14  |  45KB  |  1,296 lines
  1. /* REXX-PROGRAMM kmpl.CMD      */
  2.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  3.    Call SysLoadFuncs
  4.    Call SysCls
  5.  
  6.    /* Wird bei der Ausführung einer REXX-Anweisung ein Syntaxfehler */
  7.    /* festgestellt, so wird zur Prozedur "kmplMsg" verzweigt.       */
  8.   /* signal on syntax name kmplMsg          */
  9.  
  10.  /* Mit den folgenden Zeilen wird, wenn das Verzeichnis, in dem sich diese */
  11.  /* Datei  kmpl.CMD  befindet, im Pfad steht, sichergestellt, daß auch die */
  12.  /* Datei  kmpl.INF  bei Fehlern von kmpl.CMD angezeigt werden kann,       */
  13.  /* wenn   kmpl.CMD  nicht aus diesem Verzeichnis aufgerufen wird.         */
  14.    Pfd=SysSearchPath("PATH", "kmpl.cmd")
  15.    lp=LastPos("\", Pfd)
  16.    Pfd=DelStr(Pfd, 1+lp)
  17.    
  18. Anf:  
  19.    call Locate 02,14
  20.    call Charout,"Elementare Rechenoperationen mit zwei komplexen Zahlen"; say
  21.    call Locate 03,15
  22.    call Charout,"mit deren Komponenten "
  23.    call CsrAttrib "High";  call Color "white"; call Charout,"Re1"
  24.    call CsrAttrib "Normal";                    call Charout," und "
  25.    call CsrAttrib "High";  call Color "white"; call Charout,"Im1"
  26.    call CsrAttrib "Normal";                    call Charout," sowie "
  27.    call CsrAttrib "High";  call Color "white"; call Charout,"Re2"
  28.    call CsrAttrib "Normal";                    call Charout," und "
  29.    call CsrAttrib "High";  call Color "white"; call Charout,"Re2"
  30.    call CsrAttrib "Normal";                    call Charout,","
  31.    call Locate 04,03
  32.    call Charout,"sowie Berechnung von Funktionswerten der Ergebnisse"
  33.    call Charout," dieser Rechenoperationen."
  34.    sch=0                          
  35.    
  36. lRe1:  
  37.    call Locate 06,09
  38.    call Charout,"                                                                 "
  39.    call Locate 06,09
  40.    call Charout,"(1) "
  41.    call CsrAttrib "High";                        call Charout,"Re1"
  42.    call CsrAttrib "Normal";                      call Charout," = " 
  43.    Re1=strip(EditStr(54))
  44.    if DataType(Re1, 'N')<>1 then
  45.    do    
  46.      Call Quatsch
  47.      Call Loesch
  48.      Call SysCurState ON
  49.      signal lRe1
  50.    end    
  51.    call Locate 06,19;                                            
  52.    call CsrAttrib "High";                        call Charout,Re1
  53.    call CsrAttrib "Normal"
  54.    if sch==1 then signal sel
  55.    sch=0
  56.    
  57. lIm1:
  58.    call Locate 07,09
  59.    call Charout,"                                                                 "
  60.    call Locate 07,09
  61.    call Charout,"(2) "
  62.    call CsrAttrib "High";                        call Charout,"Im1"
  63.    call CsrAttrib "Normal";                      call Charout," = "
  64.    Im1=strip(EditStr(54))
  65.    if DataType(Im1, 'N')<>1 then
  66.    do    
  67.      Call Quatsch
  68.      Call Loesch
  69.      Call SysCurState ON
  70.      signal lIm1
  71.    end    
  72.    call Locate 07,19;                                            
  73.    call CsrAttrib "High";                        call Charout,Im1
  74.    call CsrAttrib "Normal"
  75.    if sch==1 then Signal sel 
  76.    sch=0 
  77.  
  78. lRe2:   
  79.    call Locate 09,09
  80.    call Charout,"                                                                 "
  81.    call Locate 09,09
  82.    call Charout,"(3) "             
  83.    call CsrAttrib "High";                        call Charout,"Re2"
  84.    call CsrAttrib "Normal";                      call Charout," = "
  85.    Re2=strip(EditStr(54))
  86.    if DataType(Re2, 'N')<>1 then
  87.    do    
  88.      Call Quatsch
  89.      Call Loesch
  90.      Call SysCurState ON
  91.      signal lRe2
  92.    end 
  93.    call Locate 09,19; 
  94.    call CsrAttrib "High";                        call Charout,Re2
  95.    call CsrAttrib "Normal"
  96.    if sch==1 then signal sel
  97.    sch=0
  98.    
  99. lIm2:   
  100.    call Locate 10,09
  101.    call Charout,"                                                                 "
  102.    call Locate 10,09
  103.    call Charout,"(4) "
  104.    call CsrAttrib "High";                        call Charout,"Im2"
  105.    call CsrAttrib "Normal";                      call Charout," = "
  106.    Im2=strip(EditStr(54))
  107.    if DataType(Im2, 'N')<>1 then
  108.    do    
  109.      Call Quatsch
  110.      Call Loesch
  111.      Call SysCurState ON
  112.      signal lIm2
  113.    end    
  114.    call Locate 10,19; 
  115.    call CsrAttrib "High";                        call Charout,Im2
  116.    call CsrAttrib "Normal"
  117.    if sch==1 then Signal sel 
  118.    sch=0 
  119.         
  120. lop:    
  121.    call Locate 12,09
  122.    call Charout,"                                               "
  123.    call Locate 12,09
  124.    call Charout,"(5) Operator (+,-,*,/ oder # für ^) : "
  125.    op=EditStr(1)
  126.    op=ZRweg(op)
  127.    
  128.    if op<>"+" & op<>"-" & op<>"*" & op<>"/" & op<>"#" then
  129.    do
  130.      Beep(250, 200)
  131.      Signal lop
  132.    end
  133.    call Locate 12,47
  134.    if op=="#" then op="^"
  135. /*   call Charout,"               " */
  136.    call Locate 12,47
  137.    call CsrAttrib "High";   call Color "Cyan";   call Charout,op
  138.    call CsrAttrib "Normal"
  139.    if sch==1 then Signal sel
  140.  
  141. lnd:
  142.    call Locate 13,09
  143.    call Charout,"                                           "
  144.    call Locate 13,09
  145.    call Charout,"(6) Wieviel Dezimalstellen (ND<=54) : "
  146.    ND=EditStr(2)
  147.    if ND<4 | ND>54 then
  148.    do    
  149.      Beep(250, 200)
  150.      Signal lnd
  151.    end
  152.    call Locate 13,47
  153.    call CsrAttrib "High";   call Color "Cyan";   call Charout,ND
  154.    call CsrAttrib "Normal"
  155.    if sch==1 then Signal sel
  156.  
  157.    
  158.    Numeric Digits ND+15
  159.    /* Mathematische Konstanten */
  160.    pi=3.1415926535897932384626433832795028841971693993751058209749445923078
  161.    /* ln10 = ln(10) */
  162.    ln10=2.3025850929940456840179914546843642076011014886287729760333279009675
  163.    /*  m10 = 1/ln(10) */
  164.    m10=0.434294481903251827651128918916605082294397005803666566114453783165
  165.    
  166. sel:   
  167.    call Locate 15,04 
  168.    call Charout,"Bei Änderungswunsch (1,2,3,4,5,6), sonst nur Eingabetaste " 
  169.    call Locate 15,62 
  170.    call Charout,"  "
  171.    call Locate 15,62 
  172.    ent=EditStr(1)
  173.  
  174.    select 
  175.       when ent=='1' then do; sch=1; Signal lRe1; end
  176.       when ent=='2' then do; sch=1; Signal lIm1; end
  177.       when ent=='3' then do; sch=1; Signal lRe2; end
  178.       when ent=='4' then do; sch=1; Signal lIm2; end
  179.       when ent=='5' then do; sch=1; Signal lop;  end
  180.       when ent=='6' then do; sch=1; Signal lnd;  end
  181.       when ent==''  then do; sch=1; Signal we1;  end
  182.       otherwise 
  183.       do
  184.         Call SysCurState OFF
  185.         Beep(444, 200); Beep(628,300)  
  186.         Call SysCurState ON
  187.         Signal sel
  188.       end
  189.    end
  190. we1:   
  191.                   
  192.    if op=='+' then
  193.    do
  194.      Re=Re1+Re2; Im=Im1+Im2
  195.      signal Ausdr
  196.    end
  197.  
  198.    if op=='-' then
  199.    do
  200.      Re=Re1-Re2; Im=Im1-Im2
  201.      signal Ausdr
  202.    end
  203.  
  204.    if op=='*' then
  205.    do
  206.      Re=Re1*Re2-Im1*Im2; Im=Re1*Im2+Re2*Im1
  207.      signal Ausdr
  208.    end
  209.                                
  210.    if op=='/' then
  211.    do
  212.      nen=Re2**2+Im2**2  
  213.      if nen==0 then
  214.      do   
  215.        call Quatsch000
  216.        call Loesch
  217.        Call SysCurState ON
  218.        call SysCls
  219.        signal Anf
  220.      end
  221.      Re=(Re1*Re2+Im1*Im2)/nen
  222.      Im=(Im1*Re2-Re1*Im2)/nen
  223.      signal Ausdr
  224.    end
  225.    
  226.    if op=='^' then
  227.    do
  228.      /* Berechnung des Betrages btr1  */
  229.      btr1=0_sqrt(Re1**2+Im1**2, ND)
  230.      /* Berechnung des Winkels phi1   */
  231.      if Re1>0 & Im1==0 then 
  232.      do   
  233.        phi1=0
  234.        signal ww1
  235.      end
  236.    
  237.      if Re1<0 & Im1==0 then 
  238.      do   
  239.        phi1=pi
  240.        signal ww1
  241.      end
  242.    
  243.      if Re1==0 & Im1>0 then 
  244.      do   
  245.        phi1=Pi/2
  246.        signal ww1
  247.      end
  248.    
  249.      if Re1==0 & Im1<0 then 
  250.      do   
  251.        phi1=-Pi/2
  252.        signal ww1
  253.      end
  254.    
  255.      d=0_arctan(Im1/Re1, ND)
  256.      /* Zuordnung des ArcusTangens-Wertes in den Quadranten */ 
  257.      if Re1>0 & Im1>0 then do; phi1=d;    Signal ww1; end 
  258.      if Re1<0 & Im1>0 then do; phi1=d+pi; Signal ww1; end 
  259.      if Re1<0 & Im1<0 then do; phi1=d-pi; Signal ww1; end 
  260.      if Re1>0 & Im1<0 then do; phi1=d;    Signal ww1; end 
  261.      ww1: 
  262.  
  263.      ln_btr1=0_ln(btr1,ND)
  264.      exp_Re=Re2*ln_btr1-Im2*phi1
  265.      exp_Im=Im2*ln_btr1+Re2*phi1
  266.      u=0_exp(exp_Re,ND)
  267.      Re=u*0_cos(exp_Im,ND)
  268.      Im=u*0_sin(exp_Im,ND)
  269.      signal Ausdr
  270.    end                         
  271.                                                     
  272. Ausdr:
  273.    call Locate 17,04
  274.    call CsrAttrib "High";   call Color "white";  call Charout,"("
  275.    call Color "yellow";                          call Charout,"Re"
  276.    call Color "white";                           call Charout," + i*"
  277.    call Color "yellow";                          call Charout,"Im"
  278.    call Color "white";                           call Charout,")"
  279.    call CsrAttrib "Normal";                      call Charout," = "
  280.    call CsrAttrib "High";   call Color "White";  call Charout,"(Re1 + i*Im1)"
  281.    call Color "Cyan";                            call Charout,op 
  282.    call Color "White";                           call Charout,"(Re2 + i*Im2)" 
  283.    call Locate 19,04
  284.    call Color "yellow";                          call Charout,"Re = "
  285.    call Color "Green";                           call Charout,Format(Re,,ND,,0)
  286.    call Locate 20,04
  287.    call Color "yellow";                          call Charout,"Im = "
  288.    call Color "Green";                           call Charout,Format(Im,,ND,,0)
  289.    call CsrAttrib "Normal"
  290. ltne:   
  291.    call Locate 22,69
  292.    call Charout,"           "
  293.    call Locate 22,02
  294.    call Charout,"Sollen mit "
  295.    call CsrAttrib "High";   call Color "white";  call Charout,"("
  296.    call Color "yellow";                          call Charout,"Re"
  297.    call Color "white";                           call Charout," + i*"
  298.    call Color "Yellow";                          call Charout,"Im"
  299.    call Color "white";                           call Charout,")"
  300.    call CsrAttrib "Normal"
  301.    call Charout," als komplexes Argument die (F)unktionswerte von einigen"
  302.    call Locate 23,02
  303.    call Charout,"in diesem Programm implementierten Funktionen berechnet,"
  304.    call Charout," oder (a)ndere Werte"
  305.    call Locate 24,02
  306.    call Charout,"Re1, Im1, Re2, Im2 eingegeben, oder das Programm verlassen werden ? (F,a,v) "
  307.    call Locate 24,78
  308.    call Charout," "
  309.    call Locate 24,78
  310.    tne=EditStr(1)
  311.    
  312.    select 
  313.       when tne==''  | tne=='f' | tne=='F' then do; Signal mehr; end
  314.       when tne=='v' | tne=='V' then 
  315.                                do
  316.                                  call Locate 24,00
  317.                                  Signal PgmEnd
  318.                                end
  319.       when tne=='a' | tne=='A' then do; Call SysCls; Signal Anf; end
  320.       otherwise
  321.       do
  322.         Call SysCurState OFF
  323.         Beep(444, 200); Beep(628,300) 
  324.         Call SysCurState ON
  325.         Signal ltne
  326.       end
  327.    end
  328.                   
  329. mehr:            
  330.  
  331.    
  332.    Numeric Digits ND+15
  333.             
  334. andere:
  335. /* A N F A N G   der Berechnung von Betrag  btr  und  Winkel  phi         */
  336. /* derjenigen komplexen Zahl  Re + i*Im, die das Ergebnis der Berechnung  */
  337. /* des ersten Teils dieses Programms ist.                                 */
  338. /* Die Größen  btr  und  phi  werden im zweiten Teil dieses Programms bei */
  339. /* der Berechnung von Funktionswerten einiger Funktionen verwendet.       */  
  340.  
  341.   /* Berechnung des Betrages btr, allgemein */
  342.    btr=0_sqrt(Re**2+Im**2, ND)
  343.  
  344.   /* Berechnung des Winkels phi,  allgemein */
  345.    if Re>0 & Im==0 then 
  346.    do   
  347.      phi=0
  348.      signal ww
  349.    end
  350.  
  351.    if Re<0 & Im==0 then 
  352.    do   
  353.      phi=pi
  354.      signal ww
  355.    end
  356.  
  357.    if Re==0 & Im>0 then 
  358.    do   
  359.      phi=Pi/2
  360.      signal ww
  361.    end
  362.  
  363.    if Re==0 & Im<0 then 
  364.    do   
  365.      phi=-Pi/2
  366.      signal ww
  367.    end
  368.  
  369.      argu=Im/Re
  370.      d=0_arctan(argu, ND)
  371.      /* Zuordnung des ArcusTangens-Wertes in den Quadranten */ 
  372.      if Re>0 & Im>0 then do; phi=d;    Signal ww; end 
  373.      if Re<0 & Im>0 then do; phi=d+pi; Signal ww; end 
  374.      if Re<0 & Im<0 then do; phi=d-pi; Signal ww; end 
  375.      if Re>0 & Im<0 then do; phi=d;    Signal ww; end 
  376. ww: 
  377. /* E N D E   der Berechnung von Betrag  btr  und  Winkel  phi             */
  378. /* derjenigen komplexen Zahl  Re + i*Im, die das Ergebnis der Berechnung  */
  379. /* des ersten Teils dieses Programms ist.                                 */
  380. /* Die Größen  btr  und  phi  werden im zweiten Teil dieses Programms bei */
  381. /* der Berechnung von Funktionswerten einiger Funktionen verwendet.       */  
  382.  
  383.    call SysCls
  384.    call Locate 02,04
  385.    call CsrAttrib "High";   call Color "Yellow"; call Charout,"Re = "
  386.    call Color "Green";                           call Charout,Format(Re,,ND,,0)
  387.    call Locate 03,04
  388.    call Color "Yellow";                          call Charout,"Im = "
  389.    call Color "Green";                           call Charout,Format(Im,,ND,,0)
  390.    call CsrAttrib "Normal"
  391.    
  392.    call Locate 05,03; call Charout,"(1)  z = Betrag von (Re + i*Im)"
  393.    call Locate 06,03; call Charout,"(2)  z = Winkel von (Re + i*Im)"
  394.    call Locate 07,03; call Charout,"(3)  z = (Re + i*Im)^y"
  395.    call Locate 08,03; call Charout,"(4)  z = exp(Re + i*Im)"
  396.    call Locate 09,03; call Charout,"(5)  z =  b^(Re + i*Im)"
  397.    call Locate 10,03; call Charout,"(6)  z =  ln(Re + i*Im)"
  398.    call Locate 11,03; call Charout,"(7)  z = log(Re + i*Im)"
  399.    call Locate 12,03; call Charout,"(8)  z =               "
  400.    call Locate 13,03; call Charout,"(9)  z =               "
  401.    call Locate 14,02; call Charout,"(10)  z =               "
  402.                      
  403.    call Locate 05,42; call Charout,"(11)  z =  sin(Re + i*Im)"
  404.    call Locate 06,42; call Charout,"(12)  z =  cos(Re + i*Im)"
  405.    call Locate 07,42; call Charout,"(13)  z =  tan(Re + i*Im)"
  406.    call Locate 08,42; call Charout,"(14)  z =  cot(Re + i*Im)"
  407.    call Locate 09,42; call Charout,"(15)  z = sinh(Re + i*Im)"
  408.    call Locate 10,42; call Charout,"(16)  z = cosh(Re + i*Im)"
  409.    call Locate 11,42; call Charout,"(17)  z = tanh(Re + i*Im)"
  410.    call Locate 12,42; call Charout,"(18)  z = coth(Re + i*Im)"
  411.    call Locate 13,42; call Charout,"(19)  z =                "
  412.    call Locate 14,42; call Charout,"(20)  Programm verlassen "
  413.                                               
  414. lfu:                                              
  415.    call Locate 16,72
  416.    call Charout,"  "
  417.    call Locate 16,04
  418.    call Charout,"Welche Funktion soll berechnet werden ? Ziffer (1 bis 20)",
  419.                 "eingeben:"
  420.    call Locate 16,72
  421.    fu=EditStr(2)
  422.  
  423.    select
  424.       when fu='1'  then do; Signal Betrl;  end
  425.       when fu='2'  then do; Signal Winl;   end
  426.       when fu='3'  then do; Signal hochl;  end
  427.       when fu='4'  then do; Signal expl;   end
  428.       when fu='5'  then do; Signal hbhl;   end
  429.       when fu='6'  then do; Signal lnlnl;  end
  430.       when fu='7'  then do; Signal logl;   end
  431.       when fu='8'  then do; Signal lab8;   end
  432.       when fu='9'  then do; Signal lab9;   end
  433.       when fu='10' then do; Signal lab10;  end
  434.       when fu='11' then do; Signal sinl;   end
  435.       when fu='12' then do; Signal cosl;   end
  436.       when fu='13' then do; Signal tanl;   end
  437.       when fu='14' then do; Signal cotl;   end
  438.       when fu='15' then do; Signal sinhl;  end
  439.       when fu='16' then do; Signal coshl;  end
  440.       when fu='17' then do; Signal tanhl;  end
  441.       when fu='18' then do; Signal cothl;  end
  442.       when fu='19' then do; Signal lab19;  end
  443.       when fu='20' then do; Signal PgmEnd; end
  444.       otherwise                               
  445.       do                                      
  446.         Call SysCurState OFF
  447.         Beep(444, 200); Beep(628,300)  
  448.         Call SysCurState ON
  449.         Signal lfu
  450.       end                                     
  451.    end     
  452.  
  453. Betrl:   
  454.    call SysCls
  455.    call Locate 02,04
  456.    call Charout,"Berechnung des Betrages der komplexen Zahl "
  457.    call Farb "(Re + i*Im)"
  458.    call Locate 04,04
  459.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  460.    call CsrAttrib "Normal";                      call Charout," = "
  461.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  462.    call Locate 05,04
  463.    call Color "yellow";                          call Charout,"Im"
  464.    call CsrAttrib "Normal";                      call Charout," = "
  465.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  466.    call CsrAttrib "Normal"
  467.    call Locate 08,04
  468.    call CsrAttrib "Normal"
  469.    call Charout,"Der Betrag der komplexen Zahl "
  470.    call Locate 10,04
  471.    call Farb "(Re + i*Im)"
  472.    call Locate 12,04
  473.    call Charout,"ist = " 
  474.    call CsrAttrib "High";  call Color "cyan";    call Charout,Format(btr,,ND,,0)
  475.    call Locate 17,04
  476.    call CsrAttrib "Normal"
  477.    call Charout,"========================================================="
  478.    call Locate 19,04
  479.    call Charout,"Soll von der komplexen Zahl " 
  480.    call CsrAttrib "High";                        call Charout,"("
  481.    call Color "yellow";                          call Charout,"Re"
  482.    call Color "white";                           call Charout," + i*"
  483.    call Color "yellow";                          call Charout,"Im" 
  484.    call Color "white";                           call Charout,")"
  485.    call CsrAttrib "Normal";                      call Charout," mit den Komponenten" 
  486.    call Locate 21,04
  487.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  488.    call CsrAttrib "Normal";                      call Charout," = "
  489.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  490.    call Locate 22,04
  491.    call Color "yellow";                          call Charout,"Im"
  492.    call CsrAttrib "Normal";                      call Charout," = "
  493.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  494.    call CsrAttrib "Normal"
  495.    call Auswahl
  496.    signal PgmEnd
  497.   
  498. Winl:   
  499.    call SysCls
  500.    call Locate 02,04
  501.    call Charout,"Berechnung des Winkels der komplexen Zahl "
  502.    call Farb "(Re + i*Im)"
  503.    call Locate 04,04
  504.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  505.    call CsrAttrib "Normal";                      call Charout," = "
  506.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  507.    call Locate 05,04
  508.    call Color "yellow";                          call Charout,"Im"
  509.    call CsrAttrib "Normal";                      call Charout," = "
  510.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  511.    call CsrAttrib "Normal"
  512.    call Locate 08,04
  513.    call Charout,"Der Winkel "
  514.    call CsrAttrib "High";  call Color "cyan";    call Charout,"Φ"
  515.    call CsrAttrib "Normal"  
  516.    call Charout," der komplexen Zahl ";          call Farb "(Re + i*Im)"
  517.    call Charout,","
  518.    call Locate 10,04
  519.    call Charout,"gemessen im Bogenmaß, ist"
  520.    call Locate 12,04
  521.    call CsrAttrib "High";  call Color "cyan";    call Charout,"Φ"
  522.    call CsrAttrib "Normal"  
  523.    call Charout," = "
  524.    call CsrAttrib "High";  call Color "cyan";    call Charout,Format(phi,,ND,,0)
  525.    call Locate 17,04
  526.    call CsrAttrib "Normal"
  527.    call Charout,"========================================================="
  528.    call Locate 19,04
  529.    call Charout,"Soll von der komplexen Zahl " 
  530.    call CsrAttrib "High";                        call Charout,"("
  531.    call Color "yellow";                          call Charout,"Re"
  532.    call Color "white";                           call Charout," + i*"
  533.    call Color "yellow";                          call Charout,"Im" 
  534.    call Color "white";                           call Charout,")"
  535.    call CsrAttrib "Normal";                      call Charout," mit den Komponenten" 
  536.    call Locate 21,04
  537.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  538.    call CsrAttrib "Normal";                      call Charout," = "
  539.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  540.    call Locate 22,04
  541.    call Color "yellow";                          call Charout,"Im"
  542.    call CsrAttrib "Normal";                      call Charout," = "
  543.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  544.    call CsrAttrib "Normal"
  545.    
  546.    call Auswahl
  547.    signal PgmEnd
  548.  
  549. hochl:
  550.    call SysCls
  551.    call Locate 02,04
  552.    call Charout,"Berechnung der Funktion "
  553.    call Farb "(Re + i'Im)^(y)"
  554.    call Locate 04,04
  555.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  556.    call CsrAttrib "Normal";                      call Charout," = "
  557.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  558.    call Locate 05,04
  559.    call Color "yellow";                          call Charout,"Im"
  560.    call CsrAttrib "Normal";                      call Charout," = "
  561.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  562.    call CsrAttrib "Normal"
  563. neuExp:   
  564.    Call SysCurState ON
  565.    call Locate 06,04
  566.    call Charout,"                                                        "
  567.    call Locate 06,04
  568.    call Charout,"Exponent  y  : "; yy=EditStr(60)
  569.    signal on syntax name NVMsg1
  570.    st="y="yy
  571.    interpret st
  572.    if DataType(y, 'N')<>1 then
  573.    do
  574.      call nono
  575.      call Loesch 
  576.      signal neuexp
  577.    end
  578.   
  579.   /* Berechnung des Betrages */
  580.    u=0_exp(y*0_ln(btr,ND),ND) 
  581.   /* Berechnung der Winkelfunktionen */
  582.    Recos=0_cos(y*phi,ND)
  583.    IMsin=0_sin(y*phi,ND)
  584.   /* Berechnung der Komponenten */
  585.    Re3Erg=u*Recos   
  586.    Im3Erg=u*Imsin   
  587.  
  588.    call Ergebnis "(Re + i*Im)^("yy")", Re3Erg, Im3Erg, ND 
  589.    call Auswahl
  590.    signal PgmEnd
  591.                                 
  592. expl:
  593.   /* Berechnung des Betrages */
  594.    u=0_exp(Re,ND)
  595.   /* Berechnung der Winkelfunktionen */
  596.    Recos=0_cos(Im,ND)
  597.    IMsin=0_sin(Im,ND)
  598.   /* Berechnung von Real- und Imaginärteil */
  599.    Re4Erg=u*Recos   
  600.    Im4Erg=u*Imsin   
  601.   
  602.    call VorAnz   "exp(Re + i*Im)", Re,     Im,     ND  
  603.    call Ergebnis "exp(Re + i*Im)", Re4Erg, Im4Erg, ND 
  604.    call Auswahl
  605.    signal PgmEnd
  606.   
  607. hbhl:
  608.    call SysCls
  609.    call Locate 02,04;                            
  610.    call Charout,"Berechnung der Funktion "
  611.    call Farb "b^(Re + i*Im)"
  612.    call Locate 04,04
  613.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  614.    call CsrAttrib "Normal";                      call Charout," = "
  615.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  616.    call Locate 05,04
  617.    call Color "yellow";                          call Charout,"Im"
  618.    call CsrAttrib "Normal";                      call Charout," = "
  619.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  620.    call CsrAttrib "Normal"
  621. neuhbhl:   
  622.    Call SysCurState ON
  623.    call Locate 06,04
  624.    call Charout,"                                                        "
  625.    call Locate 06,04
  626.    call Charout,"Basis  b  : "; bb=EditStr(60)
  627.    signal on syntax name NVMsg2
  628.    st="b="bb
  629.    interpret st
  630.    if DataType(b, 'N')<>1 then
  631.    do
  632.      call nono
  633.      call Loesch
  634.      signal neuhbhl
  635.    end 
  636.   
  637.    if b>0 then
  638.    do
  639.      ReRe=Re*0_ln(b,ND)
  640.      ImIm=Im*0_ln(b,ND)
  641.      signal w51
  642.    end
  643.    
  644.    if b<0 then
  645.    do
  646.      b=abs(b)
  647.      ReRe=Re*0_ln(b,ND)-Im*pi
  648.      ImIm=Re*pi +Im*0_ln(b,ND)
  649.      signal w51
  650.    end
  651.    
  652.    if b=0 then
  653.    do
  654.      Re5Erg=0
  655.      Im5Erg=0
  656.      signal w52
  657.    end
  658.               
  659. w51:                   
  660.   /* Berechnung des Betrages */
  661.    u=0_exp(ReRe,ND)
  662.   /* Berechnung der Winkelfunktionen */
  663.    Recos=0_cos(ImIm,ND)
  664.    IMsin=0_sin(ImIm,ND)
  665.   /* Berechnung von Real- und Imaginärteil */
  666.    Re5Erg=u*Recos   
  667.    Im5Erg=u*Imsin   
  668. w52:      
  669.    call Ergebnis "("bb")^(Re + i*Im)", Re5Erg, Im5Erg, ND 
  670.    call Auswahl
  671.    signal PgmEnd
  672.    
  673. lnlnl:
  674.   /* Berechnung des Betrages */
  675.    u=0_ln(btr, ND)
  676.   /* Berechnung der Komponenten */
  677.    Re6Erg=u   
  678.    Im6Erg=phi   
  679.   
  680.    call VorAnz   "ln(Re + i*Im)", Re,     Im,     ND  
  681.    call Ergebnis "ln(Re + i*Im)", Re6Erg, Im6Erg, ND 
  682.    call Auswahl
  683.    signal PgmEnd
  684.    
  685. logl:
  686.   /* Berechnung des Betrages */
  687.    u=0_ln(btr, ND)
  688.   /* Berechnung der Komponenten */
  689.    Re7Erg=u*m10   
  690.    Im7Erg=phi*m10   
  691.   
  692.    call VorAnz   "log(Re + i*Im)", Re,     Im,     ND  
  693.    call Ergebnis "log(Re + i*Im)", Re7Erg, Im7Erg, ND 
  694.    call Auswahl
  695.    signal PgmEnd
  696.    
  697. lab8:   
  698.    call NochNicht
  699.    call Loesch
  700.    signal lfu
  701.    
  702. lab9:     
  703.    call NochNicht
  704.    call Loesch
  705.    signal lfu
  706.      
  707. lab10:     
  708.    call NochNicht
  709.    call Loesch
  710.    signal lfu
  711.      
  712. sinl:                                              
  713.   /* Berechnung der Komponenten */
  714.    Re11Erg=0_sin(Re,ND)*0_cosh(Im,ND)   
  715.    Im11Erg=0_cos(Re,ND)*0_sinh(Im,ND)   
  716.   
  717.    call VorAnz   "sin(Re + i*Im)", Re,      Im,      ND  
  718.    call Ergebnis "sin(Re + i*Im)", Re11Erg, Im11Erg, ND 
  719.    call Auswahl
  720.    signal PgmEnd
  721.    
  722. cosl:   
  723.   /* Berechnung der Komponenten */
  724.    Re12Erg=0_cos(Re,ND)*0_cosh(Im,ND)   
  725.    Im12Erg=-0_sin(Re,ND)*0_sinh(Im,ND)   
  726.   
  727.    call VorAnz   "cos(Re + i*Im)", Re,      Im,      ND  
  728.    call Ergebnis "cos(Re + i*Im)", Re12Erg, Im12Erg, ND 
  729.    call Auswahl
  730.    signal PgmEnd
  731.        
  732. tanl:                
  733.   /* Berechnung der Komponenten */
  734.    Nen13=0_cos(2*Re,ND)+0_cosh(2*Im,ND)
  735.    if Nen13==0 then
  736.    do   
  737.      call Quatsch000
  738.      call Loesch
  739.      Call SysCurState ON
  740.      call SysCls
  741.      signal Anf
  742.    end
  743.    Re13Erg=0_sin(2*Re,ND)/Nen13   
  744.    Im13Erg=0_sinh(2*Im,ND)/Nen13   
  745.   
  746.    call VorAnz   "tan(Re + i*Im)", Re,      Im,      ND  
  747.    call Ergebnis "tan(Re + i*Im)", Re13Erg, Im13Erg, ND 
  748.    call Auswahl
  749.    signal PgmEnd
  750.  
  751. cotl:
  752.   /* Berechnung der Komponenten */
  753.    Nen14=0_cosh(2*Im,ND)-0_cos(2*Re,ND)
  754.    if Nen14==0 then
  755.    do   
  756.      call Quatsch000
  757.      call Loesch
  758.      Call SysCurState ON
  759.      call SysCls
  760.      signal Anf
  761.    end
  762.    Re14Erg=0_sin(2*Re,ND)/Nen14   
  763.    Im14Erg=-0_sinh(2*Im,ND)/Nen14   
  764.   
  765.    call VorAnz   "cot(Re + i*Im)", Re,      Im,      ND  
  766.    call Ergebnis "cot(Re + i*Im)", Re14Erg, Im14Erg, ND 
  767.    call Auswahl
  768.    signal PgmEnd
  769.    
  770. sinhl:
  771.   /* Berechnung der Komponenten */
  772.    Re15Erg=0_sinh(Re,ND)*0_cos(Im,ND) 
  773.    Im15Erg=0_cosh(Re,ND)*0_sin(Im,ND)   
  774.   
  775.    call VorAnz   "sinh(Re + i*Im)", Re,      Im,      ND  
  776.    call Ergebnis "sinh(Re + i*Im)", Re15Erg, Im15Erg, ND 
  777.    call Auswahl
  778.    signal PgmEnd
  779.                                         
  780. coshl:                
  781.   /* Berechnung der Komponenten */
  782.    Re16Erg=0_cosh(Re,ND)*0_cos(Im,ND)   
  783.    Im16Erg=0_sinh(Re,ND)*0_sin(Im,ND)   
  784.   
  785.    call VorAnz   "cosh(Re + i*Im)", Re,      Im,      ND  
  786.    call Ergebnis "cosh(Re + i*Im)", Re16Erg, Im16Erg, ND 
  787.    call Auswahl
  788.    signal PgmEnd
  789.    
  790. tanhl:                
  791.   /* Berechnung der Komponenten */
  792.    Nen17=0_cosh(2*Re,ND)+0_cos(2*Im,ND)
  793.    if Nen17==0 then
  794.    do   
  795.      call Quatsch000
  796.      call Loesch
  797.      Call SysCurState ON
  798.      call SysCls
  799.      signal Anf
  800.    end
  801.    Re17Erg=0_sinh(2*Re,ND)/Nen17   
  802.    Im17Erg=0_sin(2*Im,ND)/Nen17   
  803.   
  804.    call VorAnz   "tanh(Re + i*Im)", Re,      Im,      ND  
  805.    call Ergebnis "tanh(Re + i*Im)", Re17Erg, Im17Erg, ND 
  806.    call Auswahl
  807.    signal PgmEnd
  808.    
  809. cothl:      
  810.   /* Berechnung der Komponenten */
  811.    Nen18=0_cosh(2*Re,ND)-0_cos(2*Im,ND)
  812.    if Nen18==0 then
  813.    do   
  814.      call Quatsch000
  815.      call Loesch
  816.      Call SysCurState ON
  817.      call SysCls
  818.      signal Anf
  819.    end
  820.    Re18Erg=0_sinh(2*Re,ND)/Nen18   
  821.    Im18Erg=-0_sin(2*Im,ND)/Nen18   
  822.   
  823.    call VorAnz   "coth(Re + i*Im)", Re,      Im,      ND  
  824.    call Ergebnis "coth(Re + i*Im)", Re18Erg, Im18Erg, ND 
  825.    call Auswahl
  826.    signal PgmEnd
  827.       
  828. lab19:      
  829.    call NochNicht
  830.    call Loesch                                      
  831.    signal lfu
  832.       
  833. PgmEnd:
  834.    Call CsrAttrib "Normal"
  835.    call SysCls
  836. EXIT
  837.  
  838. /******************* Eigene Prozeduren und Funktionen **********************/
  839.    
  840.           
  841. EditStr:   
  842.   /* ImGegensatz zur ANSI-Prozedur "call Locate y,x", deren Variable */
  843.   /* y für Zeile und x für Spalte mit 1 beginnen, beginnen die       */
  844.   /* Variablen für Zeile und Spalte der Funktion                     */
  845.   /* "parse value SysCurPos with Zeile Spalte" mit dem Wert 0  !!!!  */
  846.   "@ echo off"                                            
  847.   /* Ausgangs-Koordinaten PosY und PosX ermitteln */
  848.       parse value SysCurPos() with PosY PosX
  849.   /*    call SysCurPos PosY, PosX  */
  850.       
  851.   parse arg l
  852.   done=0; k=1; m=1                                            
  853.   enter="0D"; BckSpc="08"; si="" 
  854.    
  855.   do while done<>1
  856.     /* Einlese-Befehl */
  857.     ch=SysGetKey("noecho")
  858.                                       
  859.     /* Wenn die Eingabetaste gedrückt wird, ist die Eingabe abgeschlossen */                                
  860.     if c2x(ch)==enter then done=1
  861.  
  862.     /* Zeichen, deren Tastencode zwei Symbole zurückliefert  */                                
  863.     /* werden ignoriert.                                     */                                
  864.     if c2x(ch)=="00" | c2x(ch)=="E0" then
  865.     do
  866.       ch=""
  867.       hc=SysGetKey("noecho") /* andere Variable hc unbedingt erforderlich ! */
  868.       k=k-1 /* Zähler k wird um 1 vermindert. */ 
  869.     end    
  870.     
  871.     /* Anfang Backspace-Taste für <EditStr> einrichten. */
  872.     if c2x(ch)==BckSpc & k>1 then 
  873.     do   
  874.       k=k-1                           
  875.       call SysCurPos PosY, PosX+k-1   
  876.       call Charout," "
  877.       call SysCurPos PosY, PosX+k-1   
  878.       b=Length(si)
  879.       if b>0 then si=Left(si,b-1)
  880.       call SysCurPos PosY, PosX+k-1    
  881.     end /*  end  von "if k>1" u.s.w. */   
  882.                                  
  883.     /* Es werden nur erlaubte Zeichen eingelesen. */
  884.     if k<=l & c2x(ch)<>BckSpc then
  885.     do
  886.       call Charout,ch  
  887.       si=si||ch
  888.       if c2x(ch)==enter then leave
  889.       k=k+1
  890.       b=length(si)
  891.     end  /* end k */ 
  892.               
  893.   end /* end von <do while> */  
  894.   
  895.   /* Ausgabe-Vorbereitung */
  896.                
  897.   call SysCurPos PosY, PosX  
  898.   call Charout,copies(" ",80-PosX)
  899.   call SysCurPos PosY, PosX   
  900.   call CsrAttrib "High";   call Color "white"
  901.   call Charout,si
  902.   call CsrAttrib "Normal"
  903.                                                
  904.   /* Die folgenden zwei Zeilen sind unbedingt erforderlich, weil in        */
  905.   /* dieser Funktion "EditStr" beim Abschluß der Eingabe mit "Enter" das   */
  906.   /* hexadezimale Zeichen 0D (dezimal: 13) angehängt wird.                 */
  907.   /* (Eine Ausnahme liegt dann vor, wenn genau soviele Zeichen eingegeben  */
  908.   /* werden, wie es die zulässige Länge des Eingabestrings erlaubt.)       */
  909.   /* Da dieses Zeichen zu den ASCII-Steuerzeichen gehört und somit von     */
  910.   /* einem Editor nicht in einen Quelltext eingefügt werden kann, muß für  */
  911.   /* REXX-Funktion "Pos" das Zeichen 0D mit Hilfe der REXX-Funktion x2c()  */
  912.   /* dargestellt werden, also mit  x2c(0D).                                */
  913.   q13=Pos(x2c(0D), si) 
  914.   if q13>0 then si=DelStr(si,q13) 
  915.   return(si)        
  916.           
  917. ZRweg: /* entfernt Zwischenräume in Strings */                    
  918.   arg st
  919.   do forever
  920.     lzw=Pos(" ", st)
  921.     if lzw = 0 then leave
  922.     st=DelStr(st,lzw,1)
  923.   end  
  924.   return(st)
  925.  
  926. Farb:
  927.    arg str
  928.    /* parse value str with übernimmt immer große Buchstaben */
  929.    parse value str with s1'RE's2'IM's3
  930.    kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  931.    s1=translate(s1, kl, gr)
  932.    s2=translate(s2, kl, gr)  
  933.    s3=translate(s3, kl, gr) 
  934.    
  935.    call CsrAttrib "High";  call Color "white";      call Charout,s1
  936.    call Color "yellow";                             call Charout,"Re"
  937.    call Color "white";                              call Charout,s2
  938.    call Color "yellow";                             call Charout,"Im"
  939.    call Color "white";                              call Charout,s3
  940.    call CsrAttrib "Normal" 
  941.    return
  942.  
  943. VorAnz:
  944.    call SysCls
  945.    parse arg st1,intRe,IntIm,ND
  946.    call Locate 02,04
  947.    call Charout,"Berechnung der Funktion "
  948.    call Farb st1
  949.    call Locate 04,04
  950.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  951.    call CsrAttrib "Normal";                      call Charout," = "
  952.    call CsrAttrib "High";   call Color "green";  call Charout,Format(intRe,,ND,,0)
  953.    call Locate 05,04
  954.    call Color "yellow";                          call Charout,"Im"
  955.    call CsrAttrib "Normal";                      call Charout," = "
  956.    call CsrAttrib "High";   call Color "green";  call Charout,Format(intIm,,ND,,0)
  957.    call CsrAttrib "Normal"
  958.    return
  959.  
  960. Quatsch:  
  961.    Call SysCurState OFF
  962. nono:   
  963.    call CsrAttrib "High";   call Color "cyan","cyan"
  964.    call Locate 20,03
  965.    say"╔═════════════════════════════════════════════════════════════════════════╗"
  966.    call Locate 21,03
  967.    say"║                                                                         ║"
  968.    call Locate 22,03
  969.    say"║                                                                         ║"
  970.    call Locate 23,03
  971.    say"║                                                                         ║"
  972.    call Locate 24,03
  973.    say"╚═════════════════════════════════════════════════════════════════════════╝"
  974.    call Locate 22,12
  975.    call Charout,"!! Der eingegebene String ist keine gültige REXX-Zahl !!"                              
  976.    call Locate 24,24
  977.    call Color "Green","green"
  978.    call Charout," Zurück mit der Eingabetaste "
  979.    call CsrAttrib "Normal"
  980.    Beep(444, 200); Beep(628,300)
  981.    q=EditStr(0)
  982.    call Charout,"         " 
  983.    Call SysCurState ON
  984.    return                              
  985.   
  986. NochNicht:  
  987.    Call SysCurState OFF
  988.    call CsrAttrib "High";   call Color "cyan","cyan"
  989.    call Locate 20,03
  990.    say"╔═════════════════════════════════════════════════════════════════════════╗"
  991.    call Locate 21,03
  992.    say"║                                                                         ║"
  993.    call Locate 22,03
  994.    say"║                                                                         ║"
  995.    call Locate 23,03
  996.    say"║                                                                         ║"
  997.    call Locate 24,03
  998.    say"╚═════════════════════════════════════════════════════════════════════════╝"
  999.    call Locate 22,16
  1000.    call Charout,"!! Hier ist noch keine Funktion implementiert !!"
  1001.    call Locate 24,24
  1002.    call Color "Green","Green"
  1003.    call Charout," Zurück mit der Eingabetaste "
  1004.    call CsrAttrib "Normal"
  1005.    Beep(444, 200); Beep(628,300) 
  1006.    q=EditStr(0)
  1007.    Call SysCurState ON
  1008.    return
  1009.                      
  1010. Loesch:  
  1011.    call Locate 19,03
  1012.    call Locate 20,03
  1013.    say"                                                                           "
  1014.    call Locate 21,03
  1015.    say"                                                                           "
  1016.    call Locate 22,03
  1017.    say"                                                                           "
  1018.    call Locate 23,03
  1019.    say"                                                                           "
  1020.    call Locate 24,03
  1021.    say"                                                                           "
  1022.    call Locate 22,12
  1023.    return                              
  1024.    
  1025. Quatsch0:  
  1026.    Call SysCurState OFF
  1027.    call CsrAttrib "High";   call Color "cyan","cyan"
  1028.    call Locate 20,03
  1029.    say"╔═════════════════════════════════════════════════════════════════════════╗"
  1030.    call Locate 21,03
  1031.    say"║                                                                         ║"
  1032.    call Locate 22,03
  1033.    say"║                                                                         ║"
  1034.    call Locate 23,03
  1035.    say"║                                                                         ║"
  1036.    call Locate 24,03
  1037.    say"╚═════════════════════════════════════════════════════════════════════════╝"
  1038.    call Locate 22,16
  1039.    call Charout,"!! Man darf doch nicht durch Null dividieren !!"                              
  1040.    call Locate 24,24
  1041.    call Color "Green","Green"
  1042.    call Charout," Zurück mit der Eingabetaste "
  1043.    call CsrAttrib "Normal"
  1044.    Beep(444, 200); Beep(628,300) 
  1045.    q=EditStr(0)
  1046.    Call SysCurState ON
  1047.    return                              
  1048.    
  1049. Quatsch000:  
  1050.    Call SysCurState OFF
  1051.    call CsrAttrib "High";   call Color "cyan","cyan"
  1052.    call Locate 19,03
  1053.    say"╔═════════════════════════════════════════════════════════════════════════╗"
  1054.    call Locate 20,03
  1055.    say"║                                                                         ║"
  1056.    call Locate 21,03
  1057.    say"║                                                                         ║"
  1058.    call Locate 22,03
  1059.    say"║                                                                         ║"
  1060.    call Locate 23,03
  1061.    say"║                                                                         ║"
  1062.    call Locate 24,03
  1063.    say"╚═════════════════════════════════════════════════════════════════════════╝"
  1064.    call Locate 21,15
  1065.    call Charout,"!! Im Verlauf der Berechnung des Funktionswertes !!"
  1066.    call Locate 22,20
  1067.    call Charout,"!! ist ein Nenner gleich Null gewesen !!"
  1068.    call Locate 24,24
  1069.    call Color "Green","Green"
  1070.    call Charout," Zurück mit der Eingabetaste "
  1071.    call CsrAttrib "Normal"
  1072.    Beep(444, 200); Beep(628,300) 
  1073.    q=EditStr(0)
  1074.    return                              
  1075.    
  1076. Ergebnis: /* Diese Prozedur kann fast alle Ergebnisse ausgeben. */
  1077.           /* Ausnahmen sind die Funktionen 1 und 2.             */
  1078.    parse arg st1,ReErg,ImErg,ND
  1079.    call Locate 08,04
  1080.    call Charout,"Die Komponenten "
  1081.    call CsrAttrib "High";                       call Charout,"ErgRe"
  1082.    call CsrAttrib "Normal";                     call Charout," und "
  1083.    call CsrAttrib "High";                       call Charout,"ErgIm"
  1084.    call CsrAttrib "Normal";
  1085.    call Charout," der berechneten komplexen Zahl"
  1086.    call Locate 10,04
  1087.    call Farb st1
  1088.    call Locate 12,04
  1089.    call Charout,"sind:"
  1090.    call Locate 14,04
  1091.    call CsrAttrib "High";                        call Charout,"ErgRe"
  1092.    call CsrAttrib "Normal";                      call Charout," = "
  1093.    call CsrAttrib "High";  call Color "cyan";    call Charout,Format(ReErg,,ND,,0)
  1094.    call Locate 15,04       
  1095.    call Color "white";                           call Charout,"ErgIm"
  1096.    call CsrAttrib "Normal";                      call Charout," = "
  1097.    call CsrAttrib "High";  call Color "cyan";    call Charout,Format(ImErg,,ND,,0)
  1098.    call Locate 17,04
  1099.    call CsrAttrib "Normal"
  1100.    call Charout,"========================================================="
  1101.    call Locate 19,04
  1102.    call Charout,"Soll von der komplexen Zahl " 
  1103.    call CsrAttrib "High";                        call Charout,"("
  1104.    call Color "yellow";                          call Charout,"Re"
  1105.    call Color "white";                           call Charout," + i*"
  1106.    call Color "yellow";                          call Charout,"Im" 
  1107.    call Color "white";                           call Charout,")"
  1108.    call CsrAttrib "Normal"
  1109.    call Charout," mit den Komponenten" 
  1110.    call Locate 21,04
  1111.    call CsrAttrib "High";   call Color "yellow"; call Charout,"Re"
  1112.    call CsrAttrib "Normal";                      call Charout," = "
  1113.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Re,,ND,,0)
  1114.    call Locate 22,04
  1115.    call Color "yellow";                          call Charout,"Im"
  1116.    call CsrAttrib "Normal";                      call Charout," = "
  1117.    call CsrAttrib "High";   call Color "green";  call Charout,Format(Im,,ND,,0)
  1118.    call CsrAttrib "Normal"
  1119.    return
  1120.  
  1121. Auswahl:
  1122. q3q:   
  1123.    call Locate 24,50
  1124.    call Charout,"                           "   
  1125.    call Locate 24,04
  1126.    call Charout,"eine andere Funktion berechnet werden ? (J,n) "   
  1127.    call Locate 24,50; qqq=EditStr(1) 
  1128.                  
  1129.    select
  1130.       when qqq==''  | qqq=='j' | qqq=='J' then do; Signal andere; end
  1131.       when qqq=='n' | qqq=='N' then do; Signal PgmEnd; end
  1132.       otherwise
  1133.       do
  1134.         Call SysCurState OFF
  1135.         Beep(444, 200); Beep(628,300)  
  1136.         Call SysCurState ON
  1137.         signal q3q
  1138.       end
  1139.    end
  1140.    return                             
  1141.                            
  1142. kmplMsg:                           
  1143.    Call SysCurState OFF
  1144.    call CsrAttrib "High";   call Color "cyan","cyan"
  1145.    call Locate 11,03
  1146.    say"╔═════════════════════════════════════════════════════════════════════════╗"
  1147.    call Locate 12,03
  1148.    say"║                                                                         ║"
  1149.    call Locate 13,03
  1150.    say"║                                                                         ║"
  1151.    call Locate 14,03
  1152.    say"║                                                                         ║"
  1153.    call Locate 15,03
  1154.    say"║                                                                         ║"
  1155.    call Locate 16,03
  1156.    say"║                                                                         ║"
  1157.    call Locate 17,03
  1158.    say"║                                                                         ║"
  1159.    call Locate 18,03
  1160.    say"║                                                                         ║"
  1161.    call Locate 19,03
  1162.    say"║                                                                         ║"
  1163.    call Locate 20,03
  1164.    say"║                                                                         ║"
  1165.    call Locate 21,03
  1166.    say"║                                                                         ║"
  1167.    call Locate 22,03
  1168.    say"║                                                                         ║"
  1169.    call Locate 23,03
  1170.    say"║                                                                         ║"
  1171.    call Locate 24,03
  1172.    say"╚═════════════════════════════════════════════════════════════════════════╝"
  1173.    call Locate 13,10
  1174.    call Charout,"Im Verlauf der Berechnung des Funktionswertes"
  1175.    call Locate 14,10
  1176.    call Charout,"entweder"
  1177.    call Locate 16,10
  1178.    call Charout,"ein Nenner gleich Null gewesen oder"
  1179.    call Locate 17,10
  1180.    call Charout,"ein Funktionsargument außerhalb des zulässigen Bereichs gewesen."
  1181.    call Locate 19,10
  1182.    call Charout,"Angaben über die zulässigen Bereichsgrenzen von Variablen"
  1183.    call Locate 20,10
  1184.    call Charout,"als Funktionsargumente finden Sie in der Datei kmpl.INF !"
  1185.    call Locate 24,24
  1186.    call Color "Green","Green"
  1187.    call Charout," Weiter mit der Eingabetaste "
  1188.    call CsrAttrib "Normal"
  1189.    Beep(444, 200); Beep(628,300) 
  1190.    q=EditStr(0)
  1191.    Call SysCurState ON
  1192.    call SysCls
  1193.    "start /PM /Max C:\OS2\VIEW.EXE "pfd"KMPL.INF"
  1194.    signal Anf
  1195.    return     
  1196.  
  1197. nvMsg1: 
  1198.    Call SysCurState OFF
  1199.    Beep(444, 200); Beep(628,300) 
  1200.    signal neuexp
  1201.  
  1202. nvMsg2: 
  1203.    Call SysCurState OFF
  1204.    Beep(444, 200); Beep(628,300) 
  1205.    signal neuhbhl
  1206.  
  1207.  
  1208.    
  1209.                             
  1210. /*---------------------------- ANSI-Prozeduren ----------------------------*/
  1211. /* Ansi Procedures for moving the cursor */
  1212. Locate: Procedure   /*  Call Locate Row,Col */
  1213. Row = arg(1)
  1214. Col = Arg(2)
  1215. Rc = Charout(,D2C(27)"["Row";"col"H")
  1216. return ""
  1217.  
  1218. CsrUp: Procedure  /* CsrUp(Rows) */
  1219. Arg u
  1220. Rc = Charout(,D2C(27)"["u"A")
  1221. return ""
  1222.  
  1223. CsrDown: Procedure /* CsrDn(Rows) */
  1224. Arg d
  1225. Rc = Charout(,D2C(27)"["d"B")
  1226. return ""
  1227.  
  1228. CsrRight: Procedure  /* CsrRight(Cols) */
  1229. arg r
  1230. Rc = Charout(,D2C(27)"["r"C")
  1231. Return ""
  1232.  
  1233. CsrLeft: procedure  /* CsrLeft(Cols) */
  1234. arg l
  1235. Rc = Charout(,D2C(27)"["l"D")
  1236. Return ""
  1237.  
  1238.  
  1239. /*
  1240. A------------------------------------------------------------:*
  1241. SaveCsr and PutCsr are meant to be used together for saving  :*
  1242. and restoring the cursor location. Do not confuse            :*
  1243. with Locate, CsrRow, CsrCol, these are different routines.   :*
  1244. SaveCsr Returns a string that PutCsr can use.                :*
  1245. A:*/
  1246. SaveCsr: procedure  /* cursor_location = SaveCsr() (for PutCsr(x))*/
  1247. Rc = Charout(,D2C(27)"[6n")
  1248. Pull Q
  1249. Call CsrUp
  1250. return Q
  1251.  
  1252. PutCsr: procedure  /* Call PutCsr <Previous_Location>  (From SaveCsr() ) */
  1253. Where = arg(1)
  1254. Rc = Charout(,substr(Where,1,7)"H")
  1255. return ""
  1256. /*
  1257. A:*/
  1258. /* clear screen :*/
  1259. Cls: Procedure      /* cls() Call Cls */
  1260. Rc = CharOut(,D2C(27)"[2J")
  1261. return ""
  1262.  
  1263.     /* get cursors Line */
  1264. CsrRow: Procedure      /* Row = CsrRow()*/
  1265. Rc = Charout(,D2C(27)"[6n")
  1266. Pull Q
  1267. Return substr(Q,3,2)
  1268.  
  1269.    /* get cursors column */
  1270. CsrCol: Procedure          /*  Col = CsrCol()  */
  1271. Rc = Charout(,D2C(27)"[6n")
  1272. Pull Q
  1273. return Substr(Q,6,2)
  1274.  
  1275. /* procedure to color screen
  1276. A:--------------------------------------------------------------*
  1277. accepts colors: BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE  *
  1278. */
  1279. Color: Procedure /* Call Color <ForeGround>,<BackGround> */
  1280. arg F,B
  1281. Colors = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  1282. return CHAROUT(,D2C(27)"["WORDPOS(F,COLORS)+29";"WORDPOS(B,COLORS)+39";m")
  1283.  
  1284. /*  change screen attributes
  1285. A:---------------------------------------------------------------*
  1286. attributes: NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE *
  1287. */
  1288. CsrAttrib: Procedure  /* call CsrAttrib <Attrib> */
  1289. Arg A
  1290. attr = "NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE"
  1291. return CHAROUT(,D2C(27)"["WORDPOS(A,ATTR) - 1";m")
  1292.  
  1293. EndAll:
  1294. Call Color "White","Black"
  1295. CALL CsrAttrib "Normal"
  1296.