PROGRAM TextToMultiplanSYLK(Input,Output,Afile,OutFile);
{Written by Nick Hadwick, 9884.
 Last modified: 917}
(*$Entry+*)
(*$symtab*)
(*$Line+*)
(*$PAGESIZE: 60*)
(*$LINESIZE: 132*)

{This program is designed to take a text file as input and create
 a SYLK file. When loaded into Multiplan this spreadsheet will look
 very similar to the input file. The strategy followed is to first 
 read a line from the input file, break the line into words by scanning
 for word separators (usually spaces) and process each word, creating a 
 record in the output file for each valid word found.

 The Boolean function WordOK is useful for eliminating words from
 the output file. I would recommend it to customize
 this program for various applications.

 Comments follow that describe the constants and variables used. Many
 of the procedures have a short explanation at the beginning.}

(*$page+*)

CONST

MaxLineLength  = 133;
MaxWordLength  = 33; This is the max multiplan column width.
DefaultCellWidth = 10;
MaxLinesInSpreadSheet = 255;
Blank = ' ';
{BlankLine = '                                                                                                                 ';}
{This is 130 spaces change it if you change MaxLineLength.}

TYPE  

LStringMLL   = Lstring(MaxLineLength);
LStringMWL   = Lstring(MaxWordLength);

{Variables of these types are used to
 hold a word (a number or text) or line of the text
 file.}



VAR

BlankLine,
TheLine                  : LStringMLL;   
BlankWord,
TheWord                  : LStringMWL;
OutFile,
AFile                    : TEXT;
LineLength,
OutRecordNum,
LineNum,  
WordNumber,
WordLength,
EndOfLastWord             : INTEGER;
NewLine,
MoreWords                 : BOOLEAN;

(*$page+*)
{ The global variables

****  Theline           A line (GetALine) from the text files, 
                    it is subsequently broken into as many words 
                    (the word) as needed.
                        If A line is considered to be all text it 
                    is put into the SYLK continuous format and
                    written as a line to the output file.

****  TheWord           These are broken off a line by GetAWord
                    and consist of discrete lexical units, these
                    may be made up of numbers, single characters
                    or even words.
 
****  OutFile           This is a TEXT file that is compatible
                    with Multiplan SYLK formet. Its name is 
                    passed from the command form.
 
****  AFile             The input file. Type should be text. Format 
                   can vary. 

****  LineLength        The line length as determined by GetALine.

****  OutRecordNum      A counter that is displayed as the OutFile
                   is written.

****  LineNum           Used to determine the position (YCoord) of
                   TheWord(s) in the spreadsheet.
  
****  WordNumber        The XCoord of a cell within a line.

****  WordLength        As Returned by GetAWord or modified by EditCell.

****  EndOfLastWord     Points at TheLine, at the end of last word 
                    that was broken off. Also Pointer, BeginNextWord.

****  NewLine           Is this a new line in the text file, it will 
                    be in the spreadsheet.
                    
****  MoreWords         As TheLine is scanned, this becomes false
                    when the last word is reached.
****}

(*$page+*)
PROCEDURE DisplayStatus(Words : LStringMWL;
                        Number : INTEGER);
BEGIN
  WRITE(CHR(255)*'VF'); 
  WRITE(CHR(255)*'C'*CHR(0)*CHR(2)); {Positions the cursor}
  Writeln(Words,' ',Number:2)
END;{DisplayStatus}

PROCEDURE ShowLine(Line : LStringMLL;
                   Words : LStringMWL;
                   Number : INTEGER);
BEGIN
  WRITE(CHR(255)*'VF'); 
  WRITE(CHR(255)*'C'*CHR(0)*CHR(0)); {Positions the cursor}
  WRITELN(Words, Number:2);
{ WRITE(CHR(255)*'VF'); 
  WRITE(CHR(255)*'C'*CHR(0)*CHR(1)); 
  Writeln('Current line: ');
  WRITELN(Line)}
END;{ShowLine}

PROCEDURE ClearScreen;
 
BEGIN
  WRITE(CHR(255)*'C'*CHR(0)*CHR(0));{clears the screen}
  WRITE(CHR(255)*'EF');
END; {ClearScreen}

PROCEDURE RemoveTrailingBlanks(ALine : LStringMLL;
                               VAR Counter : INTEGER);
{Changes the line length (counter) to reflect
 the actual number of characters in the line.}
BEGIN

  WHILE (ALine[Counter] = Blank) AND (Counter > 0)
     DO Counter := Counter  1;

END;{RemoveTrailingBlanks} 
(*$page+*)

PROCEDURE   FindBeginningOfNextWord(ALine : LStringMLL; 
                                    LineLength : INTEGER;
                                    VAR BeginNextWord : INTEGER;
                                    VAR MoreWords : BOOLEAN);
{Advances pointer from end of last word to
 Beginning of next word. }
VAR

WordFound : BOOLEAN;
TheChar   : CHAR;

BEGIN
  
  MoreWords := True;

  REPEAT

    IF BeginNextWord < LineLength
       THEN BEGIN           
 
              TheChar := ALine[BeginNextWord + 1];

              IF TheChar <> Blank                
                 THEN WordFound := TRUE;

              BeginNextWord := BeginNextWord + 1

            END

       ELSE MoreWords := False;

  UNTIL (WordFound OR (NOT MoreWords));
  
  IF BeginNextWord > LineLength THEN BeginNextWord := LineLength

END; {FindNextWordBeginning}
(*$PAGE+*)

PROCEDURE GetAWord(ALine : LStringMLL; VAR AWord : LStringMWL;
                   BlankLine : LStringMWL; VAR Pointer, Counter : INTEGER;
                   LineLength : INTEGER;
                   VAR MoreWords : BOOLEAN); 
{Breaks words off the line.
 Words are separated by spaces or other characters,
 in the set that is tested.
 
 Global effects: TheWord, EndOfLastWord(pointer), WordLength(counter)
                 MoreWords.}

VAR
TheChar         : CHAR;
LastCharinLine, 
WordFound       : BOOLEAN;

PROCEDURE IncrementIndices(VAR NextInLine, NextInWord : INTEGER;
                               LineLength : INTEGER);
BEGIN
  IF NextInLine < LineLength
     THEN NextInLine := NextInLine + 1;
  IF NextInWord < MaxWordLength
     THEN NextInWord := NextInWord + 1
END; {IncrementIndices}               


BEGIN
 
  Counter := 1;
  AWord := BlankWord;
  WordFound := False;

  FindBeginningOfNextWord(ALine, LineLength, Pointer, MoreWords);
  
  REPEAT

    LastCharinLine := (Pointer = LineLength);
    TheChar := ALine[Pointer];
 
    IF LastCharinLine

       THEN BEGIN
              IF TheChar IN [Blank]
                 THEN BEGIN
                        Counter := Counter  1;
                      END
                 ELSE AWord[Counter] := TheChar;
              WordFound := True;
              MoreWords := False
       END {Then}

       ELSE BEGIN
            IF TheChar IN [Blank]
               THEN BEGIN
                      WordFound := TRUE;
                      Counter := Counter  1;
                      Pointer := Pointer  1
               END {Then}
               ELSE BEGIN
                      WordFound := FALSE;
                      AWord[Counter] := TheChar
               END {Else}     
       END; {Else}             


    IncrementIndices(Pointer, Counter, LineLength);                   

  UNTIL WordFound;
  Counter := Counter  1;
END; {GetAWord}  
    
(*$page+*)
PROCEDURE GetALine(VAR ALine : LStringMLL; BlankLine : LStringMLL;
                   VAR Counter : INTEGER;
                   LineNum : INTEGER);

{1.Initializes line to all blanks.
 2. Reads in a line from the file.
 3. Replaces all nonprinting characters with a space.
 4. Checks for truncation of line.
 5. Removes trailing spaces from the line.

 Returns a line of text and a count of characters in 
 that line to the main program.

 Global effects: ALine and LineLength}
VAR
  TheChar  : CHAR;
  I : INTEGER;

PROCEDURE FilterBadChars(VAR TheChar : CHAR);
CONST
LittleZ  = 'z';
BEGIN
  IF (ORD(TheChar) < ORD(Blank)) OR
     (ORD(TheChar) > ORD(LittleZ))
      THEN TheChar := Blank;
END; {FilterBadChars}


BEGIN

  ALine := BlankLine;

  Counter := 1;

  WHILE NOT  (EOLN(AFile) OR 
              EOF(AFile) OR 
              (Counter > MaxLineLength))
     DO BEGIN
          READ(AFile,TheChar);
          FilterBadChars(TheChar);
          ALine[Counter] := TheChar;
          Counter := Counter + 1
        END; {While}
  Counter := Counter  1;


  IF NOT EOF(AFile)
     THEN BEGIN
            IF NOT EOLN(AFile) THEN
               Writeln('Warning: Line ', LineNum:2,' is too long..truncated ');
            READLN(AFile);            
          END;

  IF Counter > 0
     THEN RemoveTrailingBlanks(ALine, Counter)

END;{GetaLine}

(*$page+*) 

PROCEDURE CreateFirstRecords(VAR CellNum : INTEGER);
{Writes some preliminary records to the out file.
 These records define the default format and boundaries
 of the spreadsheet}
CONST
MaxRows = 50;
MaxColumns = 8;

BEGIN
  DisplayStatus('Processing Cell ',CellNum);
  WRITELN(OutFile,'ID;PMP');      
  {an identification record}                 
  WRITELN(OutFile,'F;DG4G');
  {default formatting information}
  WRITELN(OutFile,'B;Y',MaxRows:1,';X',MaxColumns:1);
  {Defines the outer boundaries of the spreadsheet}
  CellNum := CellNum + 3;
  DisplayStatus('Processing Cell ',CellNum);
END; {CreateFirstRecords}

(*$page+*)     
FUNCTION WordOK(TheWord : LstringMWL; WordLength : INTEGER) : BOOLEAN;

{This function is generally true, but it may be used to
 eliminate any word or words that are not wanted in the 
 final spreadsheet. The way to do this is:
   IF TheWord <operator> Conditions
      THEN WordOK := FALSE;

 Only words that are ok will be put into the output file.}
 
BEGIN

  WordOK := TRUE;
  IF WordLength = 0
     THEN WordOK := FALSE;
  IF (WordLength = 1) AND (TheWord[1] = CHR(00))
     THEN WordOK := FALSE {to get around a little bug}
END;{wordok}

(*$page+*)     

PROCEDURE CreateCellRecords(YCoord, XCoord, WordLength : INTEGER;
                            VAR CellNum : INTEGER;
                            TheWord : LStringMWL; 
                            VAR NewRow : BOOLEAN; NotLastWord : BOOLEAN);

 {Creates the body of the SYLK file. This determines if the
 cell contents are numeric. YCoord is the line number,
 XCoord is the word number on a given row.}

VAR
DecimalPosition,
I                : Integer;              
Number           : BOOLEAN;

FUNCTION Numeric(TheWord: LStringMWL; WordLength : Integer;
                 VAR Number : BOOLEAN; 
                 VAR DecimalPosition : INTEGER): BOOLEAN;

{this will be true if a word contains only digits,
 Parentheses, decimal points and minus signs.}
VAR
Counter    : INTEGER;                
BEGIN
  Numeric := TRUE;
  Counter := 1;

  REPEAT
    IF NOT (TheWord[Counter] IN ['0' .. '9','e','E','+','.','','(',')'])
       THEN BEGIN
              Numeric := FALSE;
              Number := FALSE
            END
       ELSE BEGIN
              IF ((TheWord[Counter] = '') AND (TheWord[Counter + 1] = ''))
                 THEN BEGIN{The case of }
                       Numeric := FALSE;
                       Number := FALSE
                      END;
              IF TheWord[Counter] = '.'
                 THEN DecimalPosition := (WordLength  Counter);
            END; {ELSE} 

    Counter := Counter + 1;
  UNTIL (Counter > WordLength) OR NOT(Number)

END; {Numeric}

(*$page+*)

PROCEDURE EditCell(VAR TheWord: LStringMWL; VAR WordLength : INTEGER;
                    Numeric : BOOLEAN);
VAR
I : INTEGER;

BEGIN

  IF NOT Numeric 

       THEN BEGIN {Puts quotes around literals.}

              IF WordLength > (MaxWordLength  2) {We'll be adding
                                                  two characters.}
                 THEN WordLength := WordLength  2; {goodbye 2 characters}

              FOR I := (Wordlength + 1) DOWNTO 1 
                  DO TheWord[I + 1] := TheWord[I];
              TheWord[1] := '';
              TheWord[WordLength + 2] := '';
              WordLength  :=  WordLength + 2;

            END {THEN}
  END; {EditCell}
(*$page+*)
BEGIN {CreateCellRecords}

  DecimalPosition := 0;
  Number := TRUE;
  Number := Numeric(TheWord, WordLength, Number, DecimalPosition);   
  EditCell(TheWord, WordLength,Number);

  CellNum := CellNum + 1;                      
  DisplayStatus('Processing Cell ',CellNum);

  WRITE(OutFile,'C;');
  IF NewRow
     THEN WRITE(OutFile,'Y',YCoord:1,';');
  WRITE(OutFile,'X',XCoord:1,';K');
  IF WordLength > 0 THEN
      FOR I := 1 TO WordLength
          DO WRITE(OutFile, TheWord[I]);
  WRITELN(OutFile);       
  NewRow := False;

  CellNum := CellNum + 1;                      
  DisplayStatus('Processing Cell ',CellNum);

  IF Number 
     THEN BEGIN
            WRITELN(OutFile,'F;FG',DecimalPosition:1,'D')
          END 
     ELSE WRITELN(OutFile,'F;FD0C')
END; {CreateCellRecord}

(*$page+*)
  
PROCEDURE Initialize(VAR LineNum, OutRecordNum : INTEGER;
                     VAR BlankLine : LStringMLL;
                     VAR BlankWord : LStringMWL);
VAR
I : INTEGER;
BEGIN

  REWRITE(OutFile);
  RESET(AFile);
  LineNum:= 0;
  OutRecordNum := 0;
  FOR I := 1 TO MaxLineLength
    DO BlankLine[I] := ' ';
  FOR I := 1 TO MaxWordLength
    DO BlankWord[I] := Blank;

END;

PROCEDURE InitializeLineVariables(VAR EndOfLastWord, WordNumber : INTEGER;
                                  VAR NewLine, MoreWords : BOOLEAN);

BEGIN
   EndOfLastWord := 0;
   NewLine := TRUE;
   MoreWords := TRUE;
   WordNumber := 0;
END; {InitializeLineVariables}

PROCEDURE Increment(VAR Number : INTEGER);
BEGIN
  Number := Number + 1;
END; {Increment}

PROCEDURE CreateLastRecords(VAR CellNum : INTEGER);
BEGIN

  CellNum := CellNum + 2;                      
  DisplayStatus('Processing Cell ',CellNum);
  
  WRITELN(OutFile,'W;N1;B;A1 1');
  {this is used to define the window}
  WRITELN(OutFile,'E');
  WRITELN('Program terminating')
END; {CreateLastRecords}

PROCEDURE CleanUp(LineNum, OutRecordnum : INTEGER);
BEGIN
  Close(AFile);
  Close(OutFile);
  ClearScreen;
  WRITELN('End of File, Lines processed ',LineNum:2);
  DisplayStatus('Total cells:',OutRecordNum);
END; {CleanUp}
(*$page+*)
 
BEGIN  {MAIN}

  ClearScreen;
  Initialize(LineNum, OutRecordNum, BlankLine, BlankWord);
  CreateFirstRecords(OutRecordNum);

  REPEAT
    Increment(LineNum);
    IF Not EOF(AFile)
      THEN BEGIN

              GetALine(TheLine, BlankLine, LineLength, LineNum);   
              ShowLine(TheLine, 'Reading line ', LineNum);
              InitializeLineVariables(EndOfLastWord, WordNumber,
                                      NewLine, MoreWords);

              WHILE MoreWords DO
                BEGIN
                  GetAWord(TheLine, TheWord, BlankWord, 
                           EndOfLastWord, WordLength,
                           LineLength, MoreWords);
                 
                  IF WordOK(TheWord, WordLength)
                     THEN BEGIN

                            Increment(WordNumber);
                            CreateCellRecords(LineNum, WordNumber, WordLength,
                                              OutRecordNum, TheWord, NewLine,
                                              MoreWords)
                            END {if wordok}
                END {while}

            END; {then}

  UNTIL EOF(AFile) OR (LineNum = MaxLinesInSpreadSheet); 

CreateLastRecords(OutRecordNum);
Cleanup(LineNum, OutRecordnum);

END.

