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