Topspeed_JPI/TS-V3/MODBASE/GEN.MOD

IMPLEMENTATION MODULE Gen;
(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 PMI
    Copyright 1988 - 1991 John McMonagle
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *  by Ed Ross
 *)

FROM GenLists IMPORT GenList,CopyList,DisposeList,ElmtNow,GetElmt,
     GetElmtAdr,ListDelete,ListInsert,ListLength,NewList,StrCode,
     ListReplace;
FROM ListUtils IMPORT TextFileToList;
FROM StrEdit IMPORT Append,SetLength,DeleteChar,DeleteRightJustified;
FROM StrConv IMPORT CardinalToStr;
FROM M2Strings IMPORT Length,Delete,Delete;
FROM Str IMPORT Copy,Slice;
FROM PosUtils IMPORT Pos;
FROM StringIO IMPORT ErrorMessage,WriteStr,WriteEol;
FROM HandleIO IMPORT CreateFile;
FROM Prompts IMPORT Prompt;
FROM PosUtils IMPORT Present,Equal;
FROM StrEdit IMPORT CAPstr,CrunchBlanks,ReplaceStr;
FROM DataTypes IMPORT IndexElmtRec,IdxList,FldList,TableName,
     DBFName,DataElmtRec,TableName;

CONST
  TableNm ='@TABLENAME@';   (* name of table without appendages *)

  IdxFldNm='@IDX@';      (* indexed fld name *)
  IdxName ='@IDXNAME@';     (* name of index (fld name with trunc to 8)*)
  FldName ='@FLDNAME@';     (* field name (indexed and non indexed *)
  IdxNbr  ='@IDXNBR@';      (* index number *)
  IdxChar = '@IDXCHAR@';    (* accel key /Highlight key for menu *)


  ForEachFld = '>>FOR EACH FLD<<'; (* for each field start loop *)
  EndEachFld = '>>END FLD<<';

  ForEachIdx = '>>FOR EACH IDX<<'; (* for every index in table*)
  EndEachIdx = '>>END IDX<<';
  MakeRec    = '>>MAKE RECORD<<';  (* create a record from data *)
  MakeDBF    = '>>MAKE DATABASE<<';
  MoveTo     = '>>MOVE TO DB<<';   (* move data from record to db rec *)
  MoveFrom   = '>>MOVE FROM DB<<';
  OutFileName= '>>FILE NAME =';
  IfIdx      = '>>IF INDEX =';     (* either Real, Character, or  *)
                                   (* or Numeric (cardinal )      *)
  EndIfIdx   = '>>END IF<<';       (* end of conditional*)				
  Include    = '>>INCLUDE FILE ='; (* include a file by name of *)
VAR

  FileList : GenList;
  Handle   : CARDINAL;
  SubList  : GenList;
  Condition : BOOLEAN;   (* if processing in a conditional statement *)
  ChangingState : BOOLEAN;
  ProcessIdxType : CHAR;

PROCEDURE WriteCard(H: CARDINAL; Card : CARDINAL);
VAR
 Str : ARRAY[0..10] OF CHAR;
BEGIN
  CardinalToStr(Card,3,Str);
  WriteStr(H,Str);

END WriteCard;


PROCEDURE MakeModRec(ItemList : GenList);
VAR Str : ARRAY[0..80] OF CHAR;
    J : CARDINAL;
    Code,Size: CARDINAL;
    Item : POINTER TO DataElmtRec;
BEGIN
  WriteStr(Handle,TableName);
  WriteEol(Handle,'Rec = RECORD');
  FOR J := 1 TO ListLength(ItemList) DO
    GetElmtAdr(ItemList,J,Item,Code,Size);
    WriteStr(Handle,'    ');
    WriteStr(Handle,Item^.Name);
    WriteStr(Handle,' : ');
    WriteStr(Handle,Item^.RecType);
    WriteStr(Handle,';');           (* write the comments *)
    WriteStr(Handle,'   (* ');
    WriteStr(Handle,Item^.Desc);
    WriteEol(Handle,' *)');
  END;
  WriteEol(Handle,'END;');

END MakeModRec;

PROCEDURE MakeMoveTo(ItemList : GenList); (* create move to record *)
(* generate the code to move data from a record to the database *)
VAR J : CARDINAL;
    Item : POINTER TO DataElmtRec;
    Size,Code : CARDINAL;

BEGIN
  WriteStr(Handle,'PROCEDURE Move');
  WriteStr(Handle,TableName);
  WriteStr(Handle,'ToDBF(Rec : ');
  WriteStr(Handle,TableName);
  WriteEol(Handle,'Rec ); ');
  WriteEol(Handle,'(* This code will move the data from the record to *)');
  WriteEol(Handle,'(* the data base                                   *)');
  WriteEol(Handle,'BEGIN');
  WriteEol(Handle,'  WITH Rec DO');
  FOR J := 1 TO ListLength(ItemList) DO
    GetElmtAdr(ItemList,J,Item,Code,Size);
    CASE Item^.Type OF
    	'C'  : WriteStr(Handle,'    Replace( ');
        	  WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
	          WriteStr(Handle,',');
	          WriteStr(Handle,Item^.Name);
	          WriteStr(Handle,');');
	
	   |'N' : WriteStr(Handle,'    ReplaceN( ');
	          WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
	          WriteStr(Handle,',');
	          IF Item^.Dec > 0
	            THEN WriteStr(Handle,Item^.Name);
	            ELSE WriteStr(Handle,'FLOAT(');
	                 WriteStr(Handle,Item^.Name);
	       	         WriteStr(Handle,')');
        	    END;     
	          WriteStr(Handle,');');
	   |'D' : WriteStr(Handle,'    ReplaceD( ');
        	  WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
	          WriteStr(Handle,',');
	          WriteStr(Handle,Item^.Name);
	          WriteStr(Handle,');');
          
	  |'L'   : WriteStr(Handle,'    ReplaceL( ');
        	  WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
        	  WriteStr(Handle,',');
	          WriteStr(Handle,Item^.Name);
        	  WriteStr(Handle,');');
	END;    (* end of case of *)
       WriteStr(Handle,'    (* ');
       WriteStr(Handle,Item^.Desc);
       WriteEol(Handle,' *)');	
  END;  (* end of for each field *)
  WriteEol(Handle,'END;  (* end of with REC *)');
  WriteStr(Handle,'END Move');
  WriteStr(Handle,TableName);
  WriteEol(Handle,'ToDBF;');
  WriteEol(Handle,'');
  WriteEol(Handle,'');
END MakeMoveTo;





PROCEDURE MakeMoveFrom(ItemList : GenList); (* create move to record *)
(* generate the code to move data from a record to the database *)
VAR J : CARDINAL;
  Item : POINTER TO DataElmtRec;
    Size,Code : CARDINAL;

BEGIN
  WriteStr(Handle,'PROCEDURE Move');
  WriteStr(Handle,TableName);
  WriteStr(Handle,'FromDBF(VAR Rec : ');
  WriteStr(Handle,TableName);
  WriteEol(Handle,'Rec ); ');
  WriteEol(Handle,'(* This code will move the data from the Database to *)');
  WriteEol(Handle,'(* the record                                        *)');
  WriteEol(Handle,'VAR B : BOOLEAN;');
  WriteEol(Handle,'    R : Real8;');
  WriteEol(Handle,'BEGIN');
  WriteEol(Handle,'  WITH Rec DO');
  FOR J := 1 TO ListLength(ItemList) DO
    GetElmtAdr(ItemList,J,Item,Code,Size);  
    CASE Item^.Type OF
    	'C'  : WriteStr(Handle,'    GetField( ');
        	  WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
	          WriteStr(Handle,',');
	          WriteStr(Handle,Item^.Name);
	          WriteStr(Handle,');');
	
	   |'N' : WriteStr(Handle,'    GetNumField( ');
	          WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
	          WriteStr(Handle,',');
	          IF Item^.Dec > 0
	            THEN WriteStr(Handle,Item^.Name);
	            ELSE WriteEol(Handle,'R);');
		         WriteStr(Handle,'    ');
	                 WriteStr(Handle,Item^.Name);
	       	         WriteStr(Handle,':= TRUNC(R');
        	    END;     
	          WriteStr(Handle,');');
	   |'D' : WriteStr(Handle,'    GetDateField( ');
        	  WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
	          WriteStr(Handle,',');
	          WriteStr(Handle,Item^.Name);
	          WriteStr(Handle,');');
          
	  |'L'  : WriteStr(Handle,'    GetLogicalField( ');
        	  WriteStr(Handle,DBFName);
	          WriteStr(Handle,',');
	          WriteCard(Handle,J);
        	  WriteStr(Handle,',');
	          WriteStr(Handle,Item^.Name);
        	  WriteStr(Handle,');');
	END;    (* end of case of *)
        WriteStr(Handle,'   (* ');
        WriteStr(Handle,Item^.Desc);
        WriteEol(Handle,' *)');	
  END;  (* end of for each field *)
  WriteEol(Handle,'END;  (* end of with REC^ *)');
  WriteStr(Handle,'END Move');
  WriteStr(Handle,TableName);
  WriteEol(Handle,'FromDBF;');
  WriteEol(Handle,'');
  WriteEol(Handle,'');

END MakeMoveFrom;

PROCEDURE MakeDatabase( ItemList : GenList);
(* produce the code to build the data base *)
VAR
  Str : ARRAY[0..80] OF CHAR;
  TmpStr : ARRAY[0..15] OF CHAR;
  Code, Size : CARDINAL;
  Item : POINTER TO DataElmtRec;
  J : CARDINAL;
BEGIN
  WriteEol(Handle,'PROCEDURE MakeDatabase();');
  WriteEol(Handle,'VAR ');
  WriteEol(Handle,' Error : CARDINAL;');
  WriteEol(Handle,' Desc : POINTER TO ARRAY [1..200] OF DBFieldDescriptor;');
  WriteEol(Handle,'BEGIN');
  CardinalToStr(ListLength(ItemList),3,Str);
  WriteStr(Handle,'  ALLOCATE(Desc,');
  WriteStr(Handle,Str);
  WriteEol(Handle,' * SIZE(DBFieldDescriptor));');
  WriteStr(Handle,'  Fill(Desc, ');
  WriteStr(Handle,  Str);
  WriteEol(Handle,' * SIZE(DBFieldDescriptor),0);');
  FOR J := 1 TO ListLength(ItemList) DO 
    GetElmtAdr(ItemList,J,Item,Code,Size);  
    WriteStr(Handle,'   MakeDescriptor(');
    CardinalToStr(J,3,Str);

    TmpStr := '  Desc^[';
    Append(TmpStr,Str);
    Append(TmpStr,"], '");
    WriteStr(Handle,TmpStr);
    WriteStr(Handle,Item^.Name);
    WriteStr(Handle,"'," );

    WriteCard(Handle,Item^.Len);
    WriteStr(Handle,"," );
    
    WriteCard(Handle,Item^.Dec);
    WriteStr(Handle,", '" );
    
    WriteStr(Handle,Item^.Type);
    WriteEol(Handle,"');");
  END;       
  WriteStr(Handle,"   InitDBF('");
  WriteStr(Handle,TableName);
  WriteStr(Handle,".DBF',");
  WriteStr(Handle,TableName);
  WriteEol(Handle,"DBF,0,FALSE,TRUE,FALSE,DefaultFixUp);");
  WriteEol(Handle,"   (* It would be a good to test error.*)");
  WriteStr(Handle,"   Error:=BuildDBF(");
  WriteStr(Handle,"Desc^,");
  WriteStr(Handle,Str);
  WriteStr(Handle,',');
  WriteStr(Handle,TableName);
  WriteEol(Handle,'DBF);');
  WriteStr(Handle,'   CloseDBF(');
  WriteStr(Handle,TableName);
  WriteEol(Handle,'DBF);');
  WriteStr(Handle,' DEALLOCATE(Desc,');
  WriteStr(Handle,Str);
  WriteEol(Handle,' * SIZE(DBFieldDescriptor));');
  WriteEol(Handle,'END MakeDatabase;');  
END MakeDatabase;


PROCEDURE ReplaceName(SrchStr, ReplStr : ARRAY OF CHAR; VAR TheList : GenList);
(* loop through the file and replace the strings *)
VAR
 J : CARDINAL;
 Str : ARRAY[0..300] OF CHAR;
 Size,Code : CARDINAL;
BEGIN
  FOR J := 1 TO ListLength(TheList) DO
    GetElmt(TheList,J,Str,Code);
    ReplaceStr(SrchStr,ReplStr,Str);
    ListReplace(Str,StrCode,TheList,J);          
  END;
END ReplaceName;  

PROCEDURE OKCondition(VAR Str:ARRAY OF CHAR ) : BOOLEAN;

  (* this routine will return true if the line should be included 
     otherwise it will return false - don't include the line
     no -duh *)
 VAR 
    IndexType : CHAR;     
BEGIN
  
  IF NOT (Present(IfIdx,Str) OR Present(EndIfIdx,Str))
                                (* check if this is a conditional stm*)
    THEN RETURN Condition       (* Nope - return current state *)
   ELSIF Present(EndIfIdx,Str)  (* check for end of condition *)
     THEN
       Copy(Str , '');
       Condition := TRUE;
       RETURN TRUE;
   END;                             (* if we fell through this must be the
                                       begining of a conditional statement*)
				   (* the value must be R - Real            *)
				   (*                   N - Numeric Cardinal*)
 	                           (*                   C - Character       *)
				
   DeleteRightJustified ( Str, 0, Pos('=',Str)+1);  (* get rid of the prefix *)
   DeleteChar(' ',Str);                       (* whats left should be index type*)
   IF Str[0] = ProcessIdxType
     THEN Condition := TRUE
     ELSE Condition := FALSE;
   END;
  Copy(Str , '');
  RETURN Condition;

END OKCondition;



PROCEDURE ProcessRepeat(VAR TheList : GenList; VAR Spot : CARDINAL;
           StartMark,EndMark: ARRAY OF CHAR); FORWARD;

PROCEDURE WriteList(VAR TheList : GenList);
(* Write the list to the file *)
(* Write until a ">>for each idx<<or >>for each fld<<" is encountered*)
(* Extract the items that are for idx or flds; create a sublist and *)
(* call writelist (recursivly) *)

VAR
  J : CARDINAL;
  S : ARRAY[0..200] OF CHAR;
  Code,Size : CARDINAL;
BEGIN
  J := 1;
  LOOP
    IF J > ListLength(TheList) THEN
      EXIT;    (* I alter the J variable in a subroutine *)
      END;     (* so use a loop construct rather than for *)
    GetElmt(TheList,J,S,Code);
    IF OKCondition(S)     (* not in a conditional gen area*)
      THEN
	IF Present(ForEachIdx,S)
	    THEN  ProcessRepeat(TheList,J,ForEachIdx,EndEachIdx)
	  ELSIF Present(ForEachFld,S)
	    THEN  ProcessRepeat(TheList,J,ForEachIdx,EndEachIdx);
	  ELSIF Present(MakeRec,S)
	    THEN  MakeModRec(FldList);
		  INC(J);
	  ELSIF Present(MoveTo,S)
	    THEN  MakeMoveTo(FldList);
		  INC(J);
	  ELSIF Present(MoveFrom,S)
	    THEN MakeMoveFrom(FldList);
		 INC(J);
	  ELSIF Present(MakeDBF,S)
            THEN MakeDatabase(FldList);
	     INC(J);
		 			
	  ELSE  
	    WriteEol(Handle,S);
	    INC(J);
	END;
       ELSE INC(J);    (* else if in condition *)	
      END;    (* end of if in condition *)	
  END; (* end of LOOP *)
END WriteList;

PROCEDURE ProcessRepeat(VAR TheList : GenList; VAR Spot : CARDINAL;
           StartMark,EndMark: ARRAY OF CHAR);
(* write out the line containing the for each field *)
(* Make a sublist for the for each fld *)
(* make a copy of the sublist          *)
(* for each fld replace the idx stuff  *)
(* writelist(the sublist) *)

VAR
  S: ARRAY [0..200] OF CHAR;
  Size,Code : CARDINAL;
  TmpStr : ARRAY[0..200] OF CHAR;
  SubList, TmpList : GenList;
  J : CARDINAL;
  IdxRec :  POINTER TO IndexElmtRec;
  
BEGIN
    GetElmt(TheList,Spot,S,Code);
    Copy(TmpStr , S);     (* for the first line *)
    J := Pos(StartMark,TmpStr)+Length(StartMark);
    SetLength(TmpStr,Pos(StartMark,TmpStr));
    WriteStr(Handle,TmpStr);    (* write out the remainder of the currentline*)
    Delete(S,0,J);    (* dump the front of str + the start mark *)
    NewList(SubList);
    LOOP               (* create a sublist for the repeat field *)
      INC(Spot);  
      IF Present(EndMark,S)
        THEN EXIT;     (* last line processing *)
        END;
      ListInsert(S,StrCode,SubList,1000);  (* insert a replace line *)	

      IF Spot > ListLength(TheList)
        THEN EXIT;
        END;
      GetElmt(TheList,Spot,S,Code);
    END;
    Copy(TmpStr , S);	
    			(********************************************)
    			(* last line processing                     *)
    			(* if I need to have embedded loops put the *)
    			(* search for start of loop here and call   *)
    			(* process repeating recursive call         *)
    			(********************************************)
    			
    IF Present(EndMark,TmpStr)
      THEN
        SetLength(TmpStr,Pos(EndMark,TmpStr));
        J := Pos(EndMark,S)+Length(EndMark);
        Delete(S,0,J);    (* dump the front of str + the start mark *)
      END;
(*    DEC(Spot);  
    ListReplace(S,StrCode,TheList,Spot);       Replace with write at end*)
    IF Length(TmpStr) > 0
      THEN
        ListInsert(TmpStr,StrCode,SubList,1000);
      END;	
    
    
(* now for each index or fld copy the list, replace the idx or fld
   and write list - NOTICE THIS IS A RECURSIVE CALL to witelist *)

   FOR J := 1 TO ListLength(IdxList) DO
     GetElmtAdr(IdxList,J,IdxRec,Size,Code);
     ProcessIdxType := IdxRec^.IndexType;    (* set for conditional gen*)
     NewList(TmpList);
     CopyList(SubList,TmpList);
     ReplaceName(IdxFldNm,IdxRec^.FldName,TmpList);
     ReplaceName(FldName,IdxRec^.FldName,TmpList);
     ReplaceName(IdxName,IdxRec^.IdxName,TmpList);
     ReplaceName(IdxChar,IdxRec^.HighLight,TmpList);
     WriteList(TmpList);
     DisposeList(TmpList);
     WriteStr(Handle,S);    (* fininsh the last line *)
   END;
   DisposeList(SubList);
END ProcessRepeat;












PROCEDURE GenFile(TemplateName : ARRAY OF CHAR);
VAR  
  FileName : ARRAY[0..80] OF CHAR;
  TmpStr : ARRAY [0..80] OF CHAR;
  ExtPart : ARRAY[0..3] OF CHAR;
  EM : ErrorMessage;
  FileList : GenList;
  Code : CARDINAL;
BEGIN  
  NewList(FileList);
  Condition := TRUE;        (* ititialize the conditional generation stuff*)
  ChangingState := FALSE;
  EM := TextFileToList(TemplateName,FileList);
  ReplaceName(TableNm,TableName,FileList);

(*   If the file name is in the template, create a new file *)
  GetElmt(FileList,1,FileName,Code);
  IF Present(OutFileName,FileName)
    THEN
      TmpStr := OutFileName;
      Code := Length(TmpStr);
      Delete(FileName,Pos(OutFileName,FileName),Code); (* dump the front of line*)
      DeleteChar(' ',FileName);    (* get rid of any excess blanks *)
      IF Pos('.',FileName)> 8      (* if name to long 8 + period *)
       THEN

         Slice(ExtPart,FileName,Pos('.',FileName)+1,3);
	 SetLength(FileName,8);     (* set to max length *)
	 Append(FileName,'.');
  	 Append(FileName,ExtPart);
       END;	
      EM := CreateFile(Handle,FileName);
      ListDelete(FileList,1,1);   (* delete file name *)
    END; (* if file is named *)
  WriteList(FileList);

END GenFile;

END Gen.