home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / b2d.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-31  |  8KB  |  302 lines
  1. /* REXX-Programm B2D.CMD                                   */
  2. /* B2D.CMD wandelt binäre Zahlen in dezimale Zahlen. */
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    Signal on syntax name B2DMsg  
  6.  
  7.    /* Die Dateien "kzr.INF" und "krz.CMD   */
  8.    /* befinden sich im selben Verzeichnis. */
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.  
  13.    parse UPPER arg strstr
  14.    stE=strstr
  15.    /* Zwischenräume aus dem String  strstr  entfernen */
  16.    do forever
  17.      lzw=Pos(" ", strstr)
  18.      if lzw = 0 then leave
  19.      strstr=DelStr(strstr,lzw,1)
  20.    end
  21.  
  22.    if (length(strstr)= 0) then Call KeinEing
  23.  
  24.    ll=length(strstr)
  25.    ND=2*ll+200
  26.    Numeric Digits ND
  27.  
  28.    if Pos(".", strstr)>0 & Pos(",", strstr)==0 then Call kommav
  29.  
  30.    /* Im Eingabestring strstr gibt es weder Komma noch Punkt. */
  31.    if Pos(",", strstr)==0 & Pos(".", strstr)==0 then
  32.    do
  33.    /* Der Eingabestring strstr wird gleich str. */
  34.      stA=strstr 
  35.      stV=strstr
  36.      stN=""
  37.      if DataType(stV, 'B')<>1 then Call EingStr stV
  38.      Signal WW
  39.    end
  40.  
  41.    /* Im Eingabestring gibt es ein Komma, aber keinen Punkt */
  42.    if Pos(",", strstr)>0 & Pos(".", strstr)=0 then
  43.    do
  44.      parse UPPER value strstr with NM ',' str
  45.      stA=str
  46.      stV=str
  47.      stN=""
  48.      if DataType(NM , 'W')<>1 then Call FalschNum NM
  49.      if DataType(NM , 'W')=1 & NM<2 then Call FalschNum NM
  50.      if DataType(stV, 'B')<>1 then Call EingStr stV
  51.      Signal WW
  52.    end
  53.  
  54.    /* Im Eingabestring gibt es sowohl ein Komma als auch einen Punkt */
  55.    if Pos(",", strstr)>0 & Pos(".", strstr)>0 then
  56.    do
  57.      parse UPPER value strstr with NM ',' stV '.' stN
  58.      stA=stV||'.'||stN
  59.      if DataType(NM , 'W')<>1 then Call FalschNum NM
  60.      if DataType(NM , 'W')=1 & NM<2 then Call FalschNum NM
  61.      if length(strip(stV))=0 & length(strip(stN)) =0 then Call Nichts  
  62.      if length(strip(stV))>0 & DataType(stV, 'B')<>1 then Call EingStr stV
  63.      if length(strip(stN))>0 & DataType(stN, 'B')<>1 then Call EingStr stN
  64.    end
  65.  
  66. WW:
  67.    /* Die für die Berechnung einer Mantisse gewünschte Anzahl     */
  68.    /* der Dezimalstellen wird mit der Variablen  NM  eingestellt. */
  69.    NM=strip(NM)
  70.    if NM=="" then NM=20    
  71.  
  72.    stV=strip(stV) 
  73.    if length(stV)>0 then 
  74.    do
  75.      stV=B2DInt(stV)
  76.    end
  77.  
  78.    stN=strip(stN) 
  79.    if length(stN)>0 then
  80.    do
  81.      stN=B2DMant(stN, NM)
  82.      stN=SubStr(stN, 2)
  83.    end
  84.   
  85.    stG=stV||stN
  86.  
  87.    /* Anfang der Ausgabe-Anweisungen */
  88.    say
  89.    Call Color 1,White
  90.    Call Charout,"  Eingabe:"; say
  91.    Call Color 1,Red
  92.    Call Charout,"    Binär: "
  93.    Call Color 1,White
  94.    Call Charout,stA; say; say
  95.  
  96.  
  97.    if length(stN)>0 then
  98.    do
  99.      Call Color 0,White
  100.      Call Charout,"  Kann die Mantisse der gewünschten Dezimalzahl,"; say
  101.      Call Charout,"  wie es in den meisten Fällen der Fall ist,"; say
  102.      Call Charout,"  nur als "
  103.      Call Color 1,White
  104.      Call Charout,"Näherungs-Ergebnis"
  105.      Call Color 0,White
  106.      Call Charout," berechnet werden,"; say
  107.      Call Charout,"  so wird die Mantisse mit bis zu "
  108.      Call Color 1,White
  109.      Call Charout,NM
  110.      Call Color 0,White
  111.      Call Charout," Stellen ausgegeben."; say
  112.    end
  113.  
  114.    say
  115.    Call Color 1,White
  116.    Call Charout,"  Ausgabe:"; say
  117.    Call Color 1,GREEN
  118.    Call Charout,"  Dezimal: "
  119.    Call Color 1,White
  120.    Call Charout,strip(stG); say
  121.    /* Ende der Ausgabe-Anweisungen */
  122.  
  123. PgmEnd:
  124.    say
  125.    Call Color 0,White
  126. EXIT
  127.  
  128.  
  129. B2DInt:
  130.    Procedure
  131.    parse upper arg str
  132.    /* Der Eingangsstring muß zunächst umgedreht werden. */
  133.    str=Reverse(str)
  134.    /* Die Zahl der Stellen wird ermittelt. */
  135.    i=0
  136.    do forever
  137.      z.i=SubStr(str, 1+i, 1)
  138.      if z.i='' then leave
  139.      i=i+1
  140.    end
  141.    u=0; DEZ=0
  142.    do while u<=i
  143.      if z.u==1 then
  144.      do
  145.        DEZ=DEZ+2**u
  146.      end
  147.      u=u+1
  148.    end
  149.    Return(DEZ)
  150.  
  151.  
  152. B2DMant:
  153.    Procedure
  154.    parse upper arg str
  155.    /* Die Zahl der Stellen wird ermittelt. */
  156.    i=0
  157.    do forever
  158.      z.i=SubStr(str, 1+i, 1)
  159.      if z.i=" " then leave
  160.      i=i+1
  161.    end
  162.    n=i-1
  163.    m=0; DEZ=0
  164.    do forever
  165.      if z.m==" " | m>=200 then leave
  166.      DEZ=DEZ+(z.m)*(2**(-m-1))
  167.      m=m+1
  168.    end
  169.    /* Angehängte Ziffern '0' werden entfernt. */
  170.    /* String wird umgedreht.                  */
  171.    DEZ=Reverse(DEZ)
  172.    /* Führende Ziffern '0' werden entfernt.   */
  173.    do forever
  174.      if SubStr(DEZ, 1, 1) >"0" then leave
  175.      if SubStr(DEZ, 1, 1)=="0" then
  176.      do
  177.        DEZ=SubStr(DEZ, 2)
  178.      end
  179.    end
  180.    /* String wird wieder umgedreht.           */
  181.    DEZ=Reverse(DEZ)
  182.    Return(DEZ)
  183.  
  184.  
  185. EingStr:
  186.   say
  187.   parse upper arg stst 
  188.   Call Color 1,White
  189.   Call Charout,"Sie haben in den String "
  190.   Call Color 1,Cyan
  191.   /* Für die Anzeige der aktuellen Berechnung sollen die von  b2d.CMD  */
  192.   /* in große Buchstaben umgewandelte kleinen Buchstaben wieder        */
  193.   /* in kleine Buchstaben umgewandelt werden.                          */
  194.   kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  195.   stst=translate(stst, kl, gr)
  196.   Call Charout,stst; say
  197.   Call Color 1,White
  198.   Call Charout,"der Eingabe-Kette ein oder mehrere"; say
  199.   Call Charout,"für binäre Darstellung nicht erlaubte Zeichen eingegeben."; say
  200.   Beep(444, 200); Beep(628,300)
  201.   Signal PgmEnd
  202.  
  203. Nichts:
  204.   say
  205.   Call Color 1,White
  206.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  207.   Call Charout,"weder für den ganzzahligen Anteil noch für die Mantisse"; say
  208.   Call Charout,"eine Binärzahl eingegeben."; say
  209.   Beep(444, 200); Beep(628,300)
  210.   Signal PgmEnd
  211.  
  212. KeinEing:
  213.   say
  214.   Call Color 1,White
  215.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  216.   Call Charout,"keine umzuwandelnde Zahl eingegeben."; say
  217.   Beep(444, 200); Beep(628,300)
  218.   Signal PgmEnd
  219.  
  220. FalschNum:
  221.   say
  222.   Call Color 1,White
  223.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  224.   Call Charout,"für die Anzahl der intern zu verwendenden Stellen"; say
  225.   Call Charout,"keine positive ganze Zahl "
  226.   Call Color 1,Cyan
  227.   Call Charout,"> 1"
  228.   Call Color 1,White
  229.   Call Charout," eingegeben."; say
  230.   Beep(444, 200); Beep(628,300)
  231.   Signal PgmEnd
  232.  
  233. kommav:
  234.   say
  235.   Call Color 1,white
  236.   Call Charout,"Soll eine nicht ganzzahlige "
  237.   Call Color 1,Red
  238.   Call Charout,"Binärzahl"
  239.   Call Color 1,white
  240.   Call Charout," in eine "
  241.   Call Color 1,Green
  242.   Call Charout,"Dezimalzahl"; say
  243.   Call Color 1,white
  244.   Call Charout,"umgewandelt werden, so muß in der Eingabe-Kette nach dem"; say
  245.   Call Charout,"String  "
  246.   Call Color 1,cyan
  247.   Call Charout,"b2d"
  248.   Call Color 1,white
  249.   Call Charout,"  mindestens  "
  250.   Call Color 1,green
  251.   Call Charout,"1"
  252.   Call Color 1,white
  253.   Call Charout,"  Leerzeichen enthalten sein."; say; say
  254.   Call Charout,"Darauf muß, bevor die in eine "
  255.   Call Color 1,Green
  256.   Call Charout,"Dezimalzahl"
  257.   Call Color 1,white
  258.   Call Charout," umzuwandelnde "; say
  259.   Call Charout,"nicht ganzzahlige "
  260.   Call Color 1,Red
  261.   Call Charout,"Binärzahl"
  262.   Call Color 1,white
  263.   Call Charout," eingegeben werden kann,"; say
  264.   Call Charout,"eine "
  265.   Call Color 1,cyan
  266.   Call Charout,"ganze Zahl > 1"
  267.   Call Color 1,white
  268.   Call Charout,", gefolgt von einem "
  269.   Call Color 1,cyan
  270.   Call Charout,"einzelnen Komma"
  271.   Call Color 1,white;  say
  272.   Call Charout,"eingegeben werden."; say; say
  273.   Call Charout,"Näheres ist in der "
  274.   Call Color 1,Green
  275.   Call Charout,"kzr.INF"
  276.   Call Color 1,white
  277.   Call Charout," zu finden."
  278.   say
  279.   Beep(444, 200); Beep(628,300)
  280.   Signal PgmEnd
  281.  
  282. B2DMsg:
  283.    say
  284.    Call Color 1,White
  285.    Call Charout,"Sie haben bei der Eingabe der Umwandlungs-Aufgabe"; say
  286.    Call Charout,"eines oder mehrere für binäre Darstellung nicht erlaubte "
  287.    Call Charout,"Zeichen eingegeben."; say
  288.    Beep(444, 200); Beep(628,300)
  289.    Signal PgmEnd
  290.  
  291. /***************************** ANSI-Prozeduren ******************************/
  292.  
  293. Color:     /* Call Color <Attr>,<ForeGround>,<BackGround>                */  
  294. Procedure  /* Attr=1 -> HIGH;  Attr=0 -> LOW; Attr only for ForeGround ! */
  295. arg A,F,B   
  296. CLRS = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  297. A=strip(A); if length(A)==0 then A=0    
  298. F=strip(F); if length(F)==0 then F=WHITE
  299. B=strip(B); if length(B)==0 then B=BLACK
  300. return CHAROUT(,D2C(27)||"["A";"WORDPOS(F,CLRS)+29";"WORDPOS(B,CLRS)+39"m")
  301.  
  302.