home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: InfoMgt / InfoMgt.zip / pmmeal10.zip / convert.cmd < prev    next >
OS/2 REXX Batch file  |  1994-07-28  |  5KB  |  175 lines
  1. /*  */
  2.  
  3.       von_dir=".\"
  4.       nach_dir=".\"
  5.       if arg(1,"E") then von_dir=arg(1)
  6.       if arg(2,"E") then nach_dir=arg(2)
  7.       if right(von_dir,1)<>"\" & right(von_dir,1)<>":" then von_dir=von_dir"\"
  8.       if right(nach_dir,1)<>"\" & right(nach_dir,1)<>":" then nach_dir=nach_dir"\"
  9.       numeric digits 15
  10.       such.titel.0=0
  11.       such.titel="ff"x
  12.       such.category.0=0
  13.       ok=stream(von_dir"Ingred.mme","C","Open Read")
  14.       ok=stream(von_dir"index.mme","C","Open Read")
  15.       ok=stream(von_dir"direct.mme","C","Open Read")
  16.       indexlg=stream(von_dir"index.mme","C","Query Size")/634-1
  17.       indexnr=0;  directnr=0;
  18.       say "Konvertiere Daten   MEALMASTER --> PMMEAL"
  19.       do n=1 to indexlg
  20.         call charout "con",n"/"indexlg"0d"x
  21.         call readindex n,1,1
  22.         say meal.titel
  23.         such.titel=such.titel||meal.titel||"ff"x||n||"ff"x
  24.         x=left(meal.titel,60)
  25.         do m=1 to 5
  26.           x=x||left(meal.category.m,11)
  27.           if meal.category.m<>"" then do
  28.             cat=translate(meal.category.m)
  29.             if such.cat<>"SUCH."CAT then do
  30.               k=such.cat
  31.             end; else do
  32.               k=such.category.0+1
  33.               such.cat=k
  34.               such.category.k=meal.category.m
  35.               such.category.k.0=0
  36.               such.category.0=k
  37.             end
  38.             i=such.category.k.0+1
  39.             such.category.k.i=n
  40.             such.category.k.0=i
  41.           end
  42.         end
  43.         x=x||left(meal.anzyield,4)||left(meal.yield,10)
  44.         x=x||meal.suchstring
  45.         do m=1 to meal.ingred.0
  46.           indexnr=indexnr+1
  47.           meal.anz.m=makemenge(meal.anz.m)
  48.           if meal.anz.m=3000000 then meal.anz.m="-------"
  49.           call lineout nach_dir"PMMZUTAT.DAT",left(meal.anz.m,7)left(meal.einheit.m,2)left(meal.ingred.m,28)
  50.           x=x||d2c(indexnr,3)
  51.         end
  52.         x=x||left("",(100-(meal.ingred.0+meal.direct.0))*3,"0"x)
  53.         do m=meal.direct.0 to 1 by -1
  54.           directnr=directnr+1
  55.           call lineout nach_dir"PMMTEXTE.DAT",left(meal.direct.m,75)
  56.           x=x||d2c(directnr,3)
  57.         end
  58.         x=x||" 0     0    "
  59.         call charout nach_dir"PMMINDEX.DAT",x
  60.       end
  61.       call lineout nach_dir"PMMTITEL.IDX",indexlg
  62.       call lineout nach_dir"PMMTITEL.IDX",such.titel
  63.       call lineout nach_dir"PMMCATEG.IDX",indexlg
  64.       do n=1 to such.category.0
  65.         x=such.category.n
  66.         do m=1 to such.category.n.0
  67.           x=x";"such.category.n.m
  68.         end
  69.         call lineout nach_dir"PMMCATEG.IDX",x
  70.       end
  71.  
  72.       ok=stream(von_dir"Ingred.mme","C","close")
  73.       ok=stream(von_dir"index.mme","C","close")
  74.       ok=stream(von_dir"direct.mme","C","close")
  75.       ok=stream(nach_dir"PMMtitel.idx","C","close")
  76.       ok=stream(nach_dir"PMMcateg.idx","C","close")
  77.       ok=stream(nach_dir"PMMzutat.dat","C","close")
  78.       ok=stream(nach_dir"PMMtexte.dat","C","close")
  79.       ok=stream(nach_dir"PMMindex.dat","C","close")
  80.       signal ende
  81.  
  82. readindex: procedure expose meal. von_dir
  83.     p=arg(1)
  84.     suchingred=arg(2,"E")
  85.     suchdirect=arg(3,"E")
  86.     index=charin(von_dir"index.mme",1+634*p,634)
  87.     lg=c2d(substr(index,1,1))
  88.     meal.nr=p
  89.     meal.titel=substr(index,2,lg)
  90.     do n=1 to 5
  91.       m=62+(n-1)*12
  92.       lg=c2d(substr(index,m,1))
  93.       meal.category.n=substr(index,m+1,lg)
  94.     end
  95.     meal.anzyield=c2d(reverse(substr(index,122,2)))
  96.     lg=c2d(substr(index,124,1))
  97.     meal.Yield=substr(index,125,lg)
  98.     if suchingred then do 
  99.       i=0;  d=0;
  100.       meal.direct.0=0;
  101.       meal.suchstring=substr(index,135,100)
  102.       do n=135 to 234
  103.         x=substr(index,n,1)
  104.         select
  105.           when x="I" then do
  106.             i=i+1
  107.             ix=c2d(reverse(substr(index,235+(n-135)*4,4)))
  108.             x=charin(von_dir"Ingred.mme",1+ix*38,38)
  109.             if suchdirect then do 
  110.               lg=c2d(substr(x,7,1))
  111.               meal.einheit.i=substr(x,8,lg)
  112.               meal.anz.i=makereal(substr(x,1,6))
  113.             end
  114.             lg=c2d(substr(x,10,1))
  115.             meal.ingred.i=substr(x,11,lg)
  116.           end
  117.           when x="X" & \suchdirect then n=999
  118.           when x="D" & suchdirect then do
  119.             if d=0 then meal.direct.0=235-n
  120.             d=235-n
  121.             ix=c2d(reverse(substr(index,235+(n-135)*4,4)))
  122.             x=charin(von_dir"direct.mme",1+ix*76,76)
  123.             lg=c2d(substr(x,1,1))
  124.             meal.direct.d=substr(x,2,lg)
  125.           end
  126.           otherwise nop
  127.         end
  128.       end
  129.       meal.ingred.0=i
  130.     end
  131. return
  132.  
  133. makereal: procedure
  134.     real=arg(1)
  135.     teiler=1099511627775
  136.     breal=x2b(c2x(reverse(real)))
  137.     minus=left(breal,1)
  138.     expo=x2d(b2x(right(breal,7)))
  139.     mant=x2d(b2x(substr(breal,2,39)))
  140.     test=substr(breal,41,1)
  141.     e=1
  142.     if expo=0 & \test then e=0
  143.     if \test & expo>0 then 
  144.       do m=1 to 128-expo
  145.         e=e/2
  146.       end
  147.     else
  148.       do m=1 to expo
  149.         e=e*2
  150.       end
  151.     wert=format(e*(0.5+mant/teiler),,4)
  152. return wert
  153.  
  154. makemenge: procedure
  155.     wert=arg(1)
  156.     wert1=trunc(wert)
  157.     wert2=wert-wert1
  158.     if format(wert2,,5)=0 then
  159.       wert2="";
  160.     else do
  161.       div=1
  162.       divi=div/wert2
  163.       do while right(format(divi,,3),3)<>"000"
  164.         div=div+1
  165.         divi=div/wert2
  166.       end
  167.       wert2=" "div"/"format(divi,,0)
  168.     end
  169.     if wert1=0 then wert1=""
  170.     wert=right(wert1||wert2,7)
  171. return  wert
  172.  
  173. ende:
  174.  
  175.