Topspeed_JPI/TS/MODBASE/DATADEF.MOD

MODULE DataDef;
(*
 *  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 Gen IMPORT GenFile;
FROM MakeDBF IMPORT MakeDataBaseFile;
FROM DataTypes IMPORT DataElmtRec,IndexElmtRec,TableName,FldList,IdxList,
     DBFName,FullTableName;
FROM GenEdt IMPORT GenEdtFile;
FROM EnvironUtils IMPORT ReadEnvironment;
FROM NumTypes IMPORT Real8;
FROM Str IMPORT Copy;
FROM SmartScreen IMPORT ClearScreen;
FROM Hash IMPORT Define,Insert,KeyFind,HashTable,GetData;
FROM StrConv IMPORT RealToStr,CardinalToStr;
FROM ScrnUtl1 IMPORT GetFieldImageRec;
FROM Tables IMPORT Table,CellValue,GetCell,PutCell,BuildTable,
     DefineTextCol,DefineIntegerCol,DefineGroupCol,DefineTable,ControlTable,
     DeleteTable,ShowTable,NumberOfRows;
FROM GenLists IMPORT GenList,ListLength,GetElmtAdr,BlockToList,
     GetElmt, ListInsertAdr,NewList,DisposeList,ListInsert,ShellSortList;
FROM HandleIO IMPORT BlockRead,BlockWrite,FileExists,
     OpenFile,CloseHandle,CreateFile;
FROM StringIO IMPORT ErrorMessage,NoError,WriteEol,outp;
FROM PosUtils IMPORT Equal,Present,Pos;
FROM Prompts IMPORT PromptStr,PromptYN;
FROM M2Strings IMPORT Length,CompareStr;
FROM StrEdit IMPORT CAPstr,CrunchBlanks,Append,SetLength,AssignStr,LowerStr,
     DeleteRightJustified,CAPstr;
FROM ControlUtils IMPORT AddMenuItem,ChangeField,ReadInput,Control;
FROM DirManager IMPORT DirToFrame;
FROM Drectory IMPORT GetDrivePathAndName,GetCurrentDir,GetDefaultDrive,
     SetDefaultDrive,ChDir;
FROM FramePainter IMPORT ShowDisplayFrame;
FROM InputManager IMPORT ControlFrame;
FROM ScrnTypes IMPORT InitDisplayFrame,DisplayFrame,AFrameName,ImageElement;
FROM ScrnUtl2 IMPORT CloseDisplayFrame;
FROM LowLevel IMPORT Fill;
FROM ModBase3 IMPORT DBFile, DBFieldDescriptor,AppendBlank,GetField,
     CloseDBF,WriteDBRec,BuildDBF;
FROM DBIndxes IMPORT DBIndex,InitIndex,CloseIndex,BuildIndex,AddRecord,
     InitCompIndex,BuildCompIndex;
FROM SYSTEM IMPORT TSIZE,ADR,ADDRESS;
IMPORT VWindows;
FROM VStorage IMPORT DosAlloc,DosDealloc;
FROM DBUtils IMPORT GetSelected,SelectFromScreen;
IMPORT InitCompilerMods;




VAR
   DF : DisplayFrame;
   Tab : Table;
   SerList : GenList;
   FileName : ARRAY[0..20] OF CHAR;
   Card : CARDINAL; 
   EM : ErrorMessage;
   Code,J : CARDINAL;
   Bool : BOOLEAN;
   Environ : ARRAY[0..60] OF CHAR;

(*   Table should look like this
1234567890123456789012345678901234567890123456789012345678901234567890123456
         1         2         3         4         5         6         7
  Index  Name      Type   Length  Dec  Description       *)	 


PROCEDURE SetupTable();
BEGIN

   DefineTable(Tab,'Data Definitions');
   DefineTextCol(Tab,3,1,'Index',FALSE);  
   DefineTextCol(Tab,10,10,'Name',FALSE);
   DefineTextCol(Tab,22,1,'Type',FALSE);
   DefineIntegerCol(Tab,27,5,'Length',0,9999);
   DefineIntegerCol(Tab,35,2,'Dec',0,99);
   DefineTextCol(Tab,40,35,'Desc',FALSE);   
END SetupTable;






    			
PROCEDURE GetDataElmts(FileName : ARRAY OF CHAR);

(* return a list of all products *)
VAR
  H : CARDINAL;
  FldDesc: DataElmtRec;  
  EM : ErrorMessage;
  Size : CARDINAL;
  J : CARDINAL;
BEGIN
  IF FileExists(FileName)
    THEN
      EM := OpenFile(H,FileName);
      EM := BlockRead(H,ADR(FldDesc),SIZE(FldDesc));     (* get the first*)
      WHILE (EM = 0)  DO
        ListInsert(FldDesc,1,FldList,1000);                (* put at the end*)
        EM := BlockRead(H,ADR(FldDesc),SIZE(FldDesc));
      END;    (* end while *)	
      EM := CloseHandle(H);
   END;
END GetDataElmts;


PROCEDURE UpdateDataElmtsFile(FileName : ARRAY OF CHAR);
VAR
  Row : CARDINAL;
  FldDesc : DataElmtRec;
  Cell : CellValue;
  Code,Size : CARDINAL;
  H : CARDINAL;
  EM : ErrorMessage;
BEGIN
  DisposeList(FldList);     (* start the list over *)
  NewList(FldList);
  EM := CreateFile(H,FileName);
  FOR Row := 1 TO NumberOfRows(Tab)  DO  (* read the screen & get elemts*)
    GetCell(Tab,1,Row,Cell);
    FldDesc.Idx := Cell.Str[0];    (* indexed field*)
    CAPstr(FldDesc.Idx);

    GetCell(Tab,2,Row,Cell);       (* fld name *)
    CAPstr(Cell.Str);
    Copy(FldDesc.Name , Cell.Str);

    GetCell(Tab, 3,Row,Cell);       (* Fld Type *)
    CAPstr(Cell.Str);    
    FldDesc.Type := Cell.Str[0];
    
    GetCell(Tab,4,Row,Cell);        (* fld lenght *)
    FldDesc.Len := Cell.I;
    
    GetCell(Tab,5,Row,Cell);        (* dec positions *)
    FldDesc.Dec := Cell.I;
    
    GetCell(Tab,6,Row,Cell);      
    Copy(FldDesc.Desc , Cell.Str);       (* description *)
    
    IF (FldDesc.Name[0] # ' ') AND(FldDesc.Idx # 'D')
      THEN
         ListInsert(FldDesc,1,FldList,1000);                (* put at the end*)      
         EM := BlockWrite(H,ADR(FldDesc),SIZE(FldDesc));
      END;	 
  END; (* end for row *)
  EM := CloseHandle(H);
      
END UpdateDataElmtsFile;



PROCEDURE DefineDataElmts(TableName : ARRAY OF CHAR);
VAR
  J : CARDINAL;
  Cell : CellValue;
  Row  : CARDINAL;
  DataElmt  : POINTER TO DataElmtRec;
  Nbr : ARRAY[0..4] OF CHAR;
  Size,Code : CARDINAL;
BEGIN
  BuildTable(Tab,ListLength(FldList)+20);  (* increase table size by 20*)
  FOR Row := 1 TO ListLength(FldList) DO  
    GetElmtAdr(FldList,Row,DataElmt,Size,Code);  (* get address of data elmt *)
    Cell.Str[0] := DataElmt^.Idx;
    Cell.Str[1] := 0C;
    PutCell(Tab,1,Row,Cell);     (* indexed *)
    
    Copy(Cell.Str , DataElmt^.Name);	(* field names *)
    PutCell(Tab,2,Row,Cell);
    
    Cell.Str[0] := DataElmt^.Type;  (* field type *)
    Cell.Str[1] := 0C;
    PutCell(Tab,3,Row,Cell);
    
    Cell.I := DataElmt^.Len;	(* field length *)
    PutCell(Tab,4,Row,Cell);
    
    Cell.I := DataElmt^.Dec;	(* decimal positions *)
    PutCell(Tab,5,Row,Cell);
    
    Copy(Cell.Str , DataElmt^.Desc);	(* Description *)
    PutCell(Tab,6,Row,Cell);    
    
  END;  
  ControlTable(Tab,2,5,78,20);


END DefineDataElmts;




PROCEDURE SelectTable(VAR TableName : ARRAY OF CHAR);
VAR
   DF : DisplayFrame;
   NxtFrame : AFrameName;
   ReturnVal: ARRAY[0..40] OF CHAR;
   Row : CARDINAL;
   Drive : CHAR;
   Card : CARDINAL;
   PathName : ARRAY[0..63] OF CHAR;
   Str : ARRAY[0..12] OF CHAR;
   FileName : AFrameName;

   ImageRec: ImageElement;
   
BEGIN
  InitDisplayFrame(DF,VWindows.CurrentWindow);
  DF^.action := 'I';
  AddMenuItem(DF,2,2,'NEW',30,1,'NEW');
  DF^.headline := 3;
  EM := DirToFrame('*.ddf',DF,1);   (* find data definition file *)

  ControlFrame(DF,1,'',TRUE,FileName);
  GetFieldImageRec( DF, DF^.CurrentField, ImageRec );
  Copy(FileName , ImageRec.text);
  Copy(TableName , FileName);
  CrunchBlanks(TableName);
  IF Equal(TableName,'NEW')
    THEN
      PromptStr('Enter Table Name ',TableName);
      CrunchBlanks(TableName);
      IF Present('.',TableName)
        THEN
	  SetLength(TableName,Pos('.',TableName)); (* make sure .ddf type*)
	END;  
       Append(TableName,'.DDF')	
    END;  
    Drive := GetDefaultDrive();
    Card := GetCurrentDir(Drive,PathName);
    FullTableName[0] := Drive;
    FullTableName[1] := 0C;
    Append(FullTableName,':');
    Append(FullTableName,PathName);
    IF FullTableName[Length(FullTableName)-1] <> '\'
      THEN Append(FullTableName,'\');
      END;
    Append(FullTableName,TableName);
END SelectTable;

PROCEDURE FixLists();

(* go through the list of fields and create a list of indexes  *)
(* Give each index a accelerator key (highlighted key on menu) *)
(* by checking each letter in the field for an unused letter   *)
(* the index will be given an name = Fieldname+'IDX'           *)
(* the data base will be given the name of the table + 'DBF'   *)

PROCEDURE MakeRep(VAR Item : DataElmtRec);
 VAR Str : ARRAY [0..10] OF CHAR;
BEGIN
  CASE Item.Type OF
    'C'  :  IF Item.Len = 1
    	     THEN Item.RecType := 'CHAR'
    	     ELSE Item.RecType := 'ARRAY[0..';
		  CardinalToStr(Item.Len,3,Str);
		  Append(Item.RecType,Str);
		  Append(Item.RecType,'] OF CHAR;');
	     END;
    |'N'  : IF (Item.Dec = 0 ) AND (Item.Len < 6)
    		THEN Item.RecType := 'CARDINAL';
    	     ELSIF (Item.Dec = 0)
    	        THEN Item.RecType := 'LONGINT';
    	     ELSE Item.RecType := 'Real8';
    	     END;   		       
    |'M'   : Item.RecType := 'Memo';
    |'D'   : Item.RecType := 'Date';
    
    |'L'   : Item.RecType := 'BOOLEAN';
    END;
END MakeRep;    

VAR
 J : CARDINAL;
 Item : POINTER TO DataElmtRec;
 IdxItem : IndexElmtRec;
 Size,Code : CARDINAL;
 CharSet : SET OF CHAR;
 C : CHAR;
 K : CARDINAL;
BEGIN
  SetLength(TableName,Pos('.',TableName));   (* get rid of file type in name*)
  LowerStr(TableName);
  CAPstr(TableName[0]);
  Copy(DBFName , TableName);
  Append(DBFName,'DBF');
			(* the index fields will become menu items in
			   the generated EDT file.  Each menu item will
			   have a selection character  highlighted -
			   Find an unused character in the index name to 
			   highlight *)
  
  CharSet := CharSet/CharSet;  (* Charset = the set of used characters *)
       
  INCL(CharSet,'F');	       (* First record*)
  INCL(CharSet,'L');	       (* Last record *)
  INCL(CharSet,'N');           (* Next record *)
  INCL(CharSet,'P');	       (* Prev record *)
  INCL(CharSet,'A');	       (* Add Record *)
  INCL(CharSet,'Q');	       (* The oddballs*)
  NewList(IdxList);
  FOR J := 1 TO ListLength(FldList) DO 
    GetElmtAdr(FldList,J,Item,Size,Code);
    MakeRep(Item^);    				
    CrunchBlanks(Item^.Desc);
    IF Item^.Idx = 'I'
      THEN
        CrunchBlanks(Item^.Name);
        Copy(IdxItem.FldName , Item^.Name);
	LowerStr(IdxItem.FldName);
	CAPstr(IdxItem.FldName[0]);
	Copy(IdxItem.EdtName , IdxItem.FldName);
	Copy(IdxItem.IdxName , IdxItem.FldName);
	IF Equal(Item^.RecType ,'Real8')
 	    THEN IdxItem.IndexType := 'R'   (* real type *)
	  ELSIF Equal(Item^.RecType, 'CARDINAL')
	    THEN IdxItem.IndexType := 'N'   (* cardinal type *)
	  ELSE IdxItem.IndexType := 'C';    (* everything else is char*)
	END;    
	  
	IF Length(IdxItem.IdxName) > 8
	  THEN
	    IdxItem.IdxName[8] := 0C;  (* set to max of 8 *)
	  END;  
	CrunchBlanks(IdxItem.EdtName);
	
	K := 0;
	LOOP
	  IF K > Length(IdxItem.FldName)
	    THEN
	      CAPstr(IdxItem.FldName[0]);  (* this will cause a compiler error*)
	      IdxItem.HighLight := 'Q';	      
	      EXIT;			  (* in the generated program CASE stm*)
	    END;  
	  C := IdxItem.FldName[K];
	  CAPstr(C);  
	  IF NOT (C IN CharSet)
	    THEN
	      CAPstr(IdxItem.EdtName[K]); (* make highlighted char *)
              INCL(CharSet,IdxItem.EdtName[K]); (* add to set of used char*)
	      IdxItem.HighLight := IdxItem.EdtName[K];
	      EXIT;
	    END;
	  INC(K);  
	 END;     
	ListInsert(IdxItem,1,IdxList,100);
      END;	
   END; (* end for j *)   

END FixLists;


BEGIN


  NewList(FldList);
  SelectTable(TableName);         (* Get name of table  *)

  GetDataElmts(FullTableName);	  (* get the elements from the file *)
  ClearScreen();
  IF PromptYN('Update Table ?',DF)
    THEN
      ClearScreen();
      WriteEol(outp,
        '  ....This may take a few minutes to create the data structures ..');
      SetupTable();  
      DefineDataElmts(TableName);
      UpdateDataElmtsFile(FullTableName);
     END; 
  FixLists();   
  IF PromptYN('Create New database file ?',DF)
    THEN
     ClearScreen();
     MakeDataBaseFile(FldList);
     END;
 (* GenCode(TableName,FldList); *)
 IF PromptYN('Create the EDT file?',DF)
   THEN
     GenEdtFile(TableName,FldList,IdxList);
   END;
  IF PromptYN('Generate Gode ?',DF)
    THEN
      ClearScreen();
      InitDisplayFrame(DF,VWindows.CurrentWindow);
      DF^.action := 'I';
      DF^.headline := 2;
      EM := DirToFrame('*.TPL',DF,1);   (* find data definition file *)
      SelectFromScreen(DF);
      GetSelected(SerList,DF);
      FOR J := 1 TO ListLength(SerList) DO
        GetElmt(SerList,J,FileName,Code);
        GenFile(FileName);
      END;  
    END;  
  ClearScreen();  
END DataDef.