home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TXTDIF.ZIP / TEXT2DIF.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-12-03  |  8.3 KB  |  241 lines
  1. PROGRAM  SpreadSheetFileConversion;
  2.  
  3.    VAR  FilVar: TEXT; Choice: CHAR;
  4.         Line, StringRem, AllBlanks  : STRING[255];
  5.         Row, Col, Delimit, NrCells, CellWidth, I  : INTEGER;
  6.  
  7.    TYPE  FileName = STRING[12];
  8.          DataStrings = ARRAY[1..128] of STRING[255];
  9.          String128 = STRING[128];
  10.          FileTypes = SET OF CHAR;
  11.  
  12.    VAR   InputFile, OutputFile: FileName;
  13.          Strings : DataStrings;
  14.          ValidFileTypes : FileTypes ;
  15.  
  16.  PROCEDURE GenerateBlankField;  VAR I : INTEGER;
  17.     BEGIN
  18.        AllBlanks := '';
  19.        FOR I:= 1 to CellWidth DO BEGIN  AllBlanks := AllBlanks + ' '; END;
  20.     END;  (* PROCEDURE GenerateBlankField  *)
  21.  
  22.  PROCEDURE StripBlanks (VAR Incoming, Stripped :String128);
  23.      VAR  BlankTrue : BOOLEAN ;
  24.  
  25.      BEGIN
  26.        Stripped := Incoming;
  27.        BlankTrue := TRUE ;
  28.  
  29.     (*  Leading Blanks   *)
  30.        WHILE  BlankTrue AND (Stripped <> '')  DO
  31.             BEGIN
  32.                  BlankTrue := ( COPY(Stripped,1,1) = ' ') ;
  33.                  IF BlankTrue  THEN  DELETE (Stripped,1,1) ;
  34.             END ;
  35.  
  36.     (*  Trailing Blanks   *)
  37.        BlankTrue :=  TRUE ;
  38.        WHILE BlankTrue AND (Stripped <> '' ) DO
  39.             BEGIN
  40.               BlankTrue := (' '= COPY(Stripped, LENGTH (Stripped), 1) ) ;
  41.               IF BlankTrue THEN DELETE (Stripped, LENGTH (Stripped), 1) ;
  42.             END;
  43.  
  44.      END;  (* PROCEDURE  StripBlanks  *)
  45.  
  46.    PROCEDURE  PlaceDelimiters;
  47.       VAR  PrevBlank, ThisBlank: BOOLEAN ; J, Limit : INTEGER ;
  48.  
  49.       BEGIN
  50.          FOR  J := 1 to  Row   DO
  51.            BEGIN
  52.               Line :=  Strings[J] ;
  53.               PrevBlank := COPY (Line,1,1) = ' ' ;
  54.               Limit := LENGTH (Line);
  55.                 FOR  I := 2 to (Limit -1)  DO
  56.                     BEGIN  ThisBlank := COPY (Line, I, 1) = ' ' ;
  57.                            IF ( (NOT PrevBlank)  AND  ThisBlank)
  58.                              THEN BEGIN
  59.                                     DELETE  (Strings [J],I,1);
  60.                                     INSERT (CHR(124), Strings[J],I) ;
  61.                                   END ;
  62.                            PrevBlank := ThisBlank ;
  63.                     END ;  (* FOR I DO  *)
  64.  
  65.            END;  (*  FOR  J  DO   *)
  66.  
  67.       END;  (*  PROCEDURE  Placedelimiters  *)
  68.  
  69.  
  70.    PROCEDURE ReadFiletoArray (InputFile: FileName);
  71.        BEGIN     ASSIGN (FilVar, InputFile);
  72.                  RESET (FilVar);
  73.                  I := 1;
  74.  
  75.                  WHILE  NOT  EOF(FilVar)  DO
  76.                    BEGIN   ReadLn (FilVar, Line);
  77.                            Strings[I] := Line;
  78.                            I := I + 1;
  79.                    END;  (* WHILE NOT EOF *)
  80.  
  81.                  Row := I - 1;
  82.        END ;   (*  PROCEDURE ReadFileToArray  *)
  83.  
  84.  
  85.   PROCEDURE  ColumnCount (VAR  Count: INTEGER); VAR Point: INTEGER;
  86.      BEGIN
  87.         Point := 1; Count := 0; StringRem := Strings[Row];
  88.  
  89.         WHILE  Point > 0  DO
  90.             BEGIN
  91.                  Point := POS (CHR(Delimit), StringRem);
  92.                  Count := Count + 1;
  93.                  StringRem := COPY (StringRem, Point +1, 255) ;
  94.             END;
  95.      END ;  (*  PROCEDURE ColumnCount  *)
  96.  
  97.  
  98.  PROCEDURE  WriteDIF (OutputFile: FileName) ;
  99.     VAR   FileNameDIF, RowString, ColString : STRING[12];
  100.           Piece, NewPiece : String128;
  101.           PieceValu : REAL;  Code, I, J, Point, PW : INTEGER;
  102.  
  103.     FUNCTION NewPointer: INTEGER ;
  104.       BEGIN
  105.         IF  Choice IN ['D', 'T']
  106.            THEN NewPointer := POS (CHR (Delimit), STRINGS[J])
  107.            ELSE  BEGIN
  108.                       IF LENGTH (Strings[J]) <= CellWidth
  109.                            THEN  NewPointer := 0
  110.                            ELSE  NewPointer := CellWidth ;
  111.                  END;
  112.       END;  (* FUNCTION *)
  113.  
  114.     FUNCTION  PieceWidth :  INTEGER ;
  115.       BEGIN
  116.         IF  Choice IN ['D', 'T']
  117.               THEN  PieceWidth := Point
  118.               ELSE  PieceWidth := CellWidth ;
  119.       END;  (*  FUNCTION  *)
  120.  
  121.   BEGIN   (* PROCEDURE  WriteDIF  *)
  122.       FileNameDIF := OutPutFile + '.DIF';
  123.       ASSIGN (FilVar, FileNameDIF) ; REWRITE (FilVar);
  124.  
  125.    (* --- Write DIF HEADER --- *)
  126.       BEGIN
  127.           WriteLn (FilVar, 'TABLE'); WriteLn (FilVar, '0,1');
  128.           WriteLn (FilVar, '""');  WriteLn (FilVar, 'VECTORS');
  129.           Write (FilVar, '0,');
  130.           STR (Row, Rowstring);
  131.           WriteLn (FilVar, RowString); WriteLn (FilVar, '""' );
  132.           WriteLn (FilVar, 'TUPLES') ; Write (FilVar, '0,') ;
  133.           STR (Col, ColString);
  134.           WriteLn ( FilVar, ColString); WriteLn (FilVar, '""' ) ;
  135.           WriteLn (FilVar, 'DATA');  WriteLn (FilVar, '0,0' ) ;
  136.           WriteLn (FilVar, '""');
  137.       END; (* Writing Header *)
  138.  
  139.     (* ---  WRITE  TUPLES   ---------  *)
  140.       FOR  I := 1 to Col  DO
  141.         BEGIN
  142.              WriteLn (FilVar,'-1,0') ;   WriteLn (FilVar, 'BOT' ) ;
  143.  
  144.              FOR  J := 1  to  Row  DO
  145.                BEGIN
  146.                     Point := 1 ;
  147.                     IF   Point >0  THEN
  148.                       BEGIN
  149.                          Point := NewPointer;
  150.  
  151.                          IF  Point = 0
  152.                                  THEN Piece := Strings[J]
  153.                                  ELSE Piece := COPY (Strings[J],1,PieceWidth);
  154.                          PW := LENGTH (Piece) ;
  155.                          DELETE (Strings[J], 1, PW );
  156.  
  157.                          IF Choice IN ['D', 'T'] THEN
  158.                             IF (PW >0) AND (COPY (Piece, PW, 1) = CHR(Delimit))
  159.                                THEN  DELETE (Piece, PW, 1);
  160.  
  161.                       END;  (*  IF POINT > 0  *)
  162.  
  163.         IF Choice = 'F' THEN BEGIN   IF ((Piece <> AllBlanks) AND (Piece<>''))
  164.                                        THEN StripBlanks (Piece, NewPiece)
  165.                                        ELSE NewPiece := Piece;
  166.                              END
  167.                         ELSE  StripBlanks (Piece, NewPiece) ;
  168.  
  169.              (* Determine if Number or String  *)
  170.                 VAL (NewPiece, PieceValu, Code) ;
  171.                 IF Code = 0 THEN
  172.                                BEGIN    (* Numerical  *)
  173.                                  Write (FilVar, '0,');
  174.                                  WriteLn (FilVar, NewPiece) ;
  175.                                  WriteLn (FilVar, 'V' ) ;
  176.                                END
  177.  
  178.                             ELSE  (* STRING *)
  179.                                BEGIN
  180.                                  WriteLn (FilVar, '1,0' );
  181.                                  WriteLn (FilVar, '"', NewPiece, '"') ;
  182.                                END;  (* String  *)
  183.  
  184.                END ;  (*  For J = 1  to  Row   *)
  185.  
  186.         END ;  (*  For I = 1 to  Col   *)
  187.       (* -------------  End  TUPLES   ------------  *)
  188.  
  189.      (*  Write  End  Designator   *)
  190.      WriteLn(FilVar, '-1,0' ) ;  WriteLn (FilVar, 'EOD' ) ;
  191.  
  192.    CLOSE (FilVar);
  193.   END ;  (*  WriteDIF  *)
  194.  
  195.  
  196. BEGIN   (* - - -   MAIN  PROGRAM   - - -   *)
  197.     Write ('Input File Name ?');  ReadLn (InputFile) ;
  198.     Write ('Output File Name  ? '); ReadLn (OutputFile) ;
  199.     ValidFileTypes := ['D', 'F', 'T'] ;
  200.     CLRSCR ; Choice := 'X';
  201.  
  202.     WHILE  NOT (Choice IN ValidFiletypes)  DO
  203.                 BEGIN
  204.                   WriteLn ('Table (delimited by blanks) - Type a "T"...');
  205.                   WriteLn ('or a Delimited File - Type a "D"...');
  206.                   WriteLn ('or a Fixed Format file - Type an "F"...');
  207.                   ReadLn (Choice);
  208.                   Choice := UPCASE (Choice);
  209.                 END ;
  210.  
  211.     CASE  Choice  OF
  212.  
  213.           'D':  BEGIN
  214.                   WriteLn ('Delimiter ASCII Value ?');
  215.                   ReadLn (Delimit);
  216.                 END;
  217.  
  218.           'T':  Delimit := 124 ;
  219.  
  220.           'F':  BEGIN
  221.                   WriteLn ('Number of fields (cells) per Record (Row) ?');
  222.                   ReadLn (NrCells) ;
  223.                   WriteLn ('Characters per field (Width of cell) ?');
  224.                   ReadLn (CellWidth);
  225.                   GenerateBlankField;
  226.                 END;
  227.      END;  (*  CASE Choice OF  *)
  228.  
  229.  
  230.     ReadFileToArray (InputFile);
  231.  
  232.     CASE  Choice  OF
  233.               'T':  BEGIN  PlaceDelimiters; ColumnCount (Col); END;
  234.               'D':  ColumnCount (Col) ;
  235.               'F':  Col := NrCells ;
  236.     END ;   (*  CASE  Choice OF  *)
  237.  
  238.     WriteDIF (OutputFile);
  239.  
  240. END.
  241.