home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / DIF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-10  |  2.9 KB  |  132 lines
  1. {ARRAYDIF.PAS
  2. created: 05/09/85
  3. revised: 00/00/85
  4. Purpose: This program saves an array of data to a file, in DIF format
  5. Source: adapted from XtrtDif.Pas
  6. }
  7.  
  8. program Array_To_Dif;
  9.  
  10. type
  11.      string14 = string[14];
  12.      Anystring = string[255];
  13.  
  14. const
  15.     NRows = 6;
  16.     NColumns = 3;
  17.  
  18.  
  19. var
  20. InFile,DiFFile : string14;
  21. Dot_Pos : integer;
  22. Extension : string[3];
  23. Prefix : string[11];
  24. Data : array[1..NColumns,1..NRows] of real;
  25.  
  26.  
  27. {*** Read Data file & load into Array}
  28. Procedure ReadData(FileName:String14);
  29. var
  30.  irow,icol : integer;
  31.  F1 : text;
  32.  
  33. begin
  34.     writeln('* OPENING Data File for Read: ',FileName);
  35.     Assign(F1,FileName);
  36.     Reset(F1);
  37.     for irow := 1 to NRows do begin
  38.        for icol := 1 to NColumns do begin
  39.          Read(F1,Data[icol,irow]);
  40.          writeln(irow:8,icol:8,Data[icol,irow]:12:8);
  41.  
  42.        end; {icol}
  43.     end; {irow}
  44.     Close(F1);
  45.  
  46. end; {ReadData}
  47.  
  48.  
  49.  
  50. {*** SAVEDIF converts to DIF format
  51. Source: XtrtDif.Pas program     }
  52.  
  53. procedure SaveDif(FileName:string14);
  54. var
  55.    F2: text;
  56.    irow,icol: integer;
  57.    st : anystring;
  58.    NVector,NTuple : integer;
  59.    SNVector, SNTuple : anystring;
  60.    value : real;
  61.  
  62. const
  63.    DblQuote = #34#34;
  64.  
  65. begin
  66.     NVector := NColumns;                    {vector = column}
  67.     NTuple  := NRows;           {tuple = row}
  68.  
  69.     Str(NVector,SNVector);           {convert to string}
  70.     Str(NTuple,SNTuple);
  71.  
  72.     write('* OPENING DIF FILE for Write: ',FileName);
  73.     Assign(F2,FileName);
  74.     Rewrite(F2);
  75.  
  76.     writeln; writeln('* SAVING DIF File: ');
  77.  
  78.     writeln(F2,'TABLE');
  79.     writeln(F2,'0,1');
  80.     writeln(F2,DblQuote);
  81.     writeln(F2,'VECTORS');
  82.     writeln(F2,'0,'+SNVector);
  83.     writeln(F2,DblQuote);
  84.     writeln(F2,'TUPLES');
  85.     writeln(F2,'0,'+SNTuple);
  86.     writeln(F2,DblQuote);
  87.     writeln(F2,'DATA');
  88.     writeln(F2,'0,0');
  89.     writeln(F2,DblQuote);
  90.  
  91.     for icol := 1 to NColumns do begin
  92.        writeln(F2,'-1,0');
  93.        writeln(F2,'BOT');
  94.        for irow := 1 to NRows do begin
  95.          Value := Data[icol,irow];
  96.           writeln('VALUE= ',value);
  97. (*          if value = 0 then begin
  98.              writeln(F2,'1,0');
  99.              writeln(F2,DblQuote);
  100.           end {if Data=0 }
  101.           else begin  *)
  102.              Str(value,St);
  103.              writeln(F2,'0,'+ St);
  104.              writeln(F2,'V');
  105. (*          end; {if Data[] }*)
  106.        end; {for irow}
  107.     end; {for icol}
  108.     writeln(F2,'-1,0');
  109.     writeln(F2,'EOD');
  110. {    writeln(F2,-1);}
  111.  
  112.   Close(F2);
  113.    writeln('* DONE *');
  114.  
  115. end; {SaveDIF}
  116.  
  117.  
  118.  
  119. begin {*** MAIN PROGRAM ***}
  120.  
  121. Write('Enter file with array elements listing: ');
  122. Readln(InFile);
  123. Dot_Pos := POS('.',InFile);
  124. Extension := COPY(InFile,1+Dot_Pos,LENGTH(InFile));
  125. Prefix := COPY(InFile,1,Dot_Pos-1);
  126. DIFFile := Prefix + '.DIF';
  127. Writeln('DIF File Name will be: ',DIFFile);
  128.  
  129. ReadData(InFile);
  130. SaveDIF(DIFFile);
  131. end.
  132.