Topspeed_JPI/TS/MODBASE/TABLES.MOD

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


FROM ScrnTypes IMPORT DisplayFrame,InputFieldRecord,InitField,
    IntCode,StringCode,RealCode,DispCode,GroupMember,InitDisplayFrame,
    ImageElement,InputFieldPtr;
FROM ScrnUtl1 IMPORT PutFieldRec,PutFrameLists,GetImageRec,PutFieldRec,
     GetImageRec,PutFieldImageRec,GetFieldPtr;
FROM ScrnUtl2 IMPORT CreateImageElement,AddImageElement,CloseDisplayFrame;
FROM StrEdit IMPORT SetLength,OverWrite;
FROM GenLists IMPORT NewList,DisposeList,GetElmt,GetElmtAdr,ListInsert,
     ListInsertAdr,ListLength,GenList,SortList,ShellSortList;
FROM SYSTEM IMPORT SIZE,TSIZE, ADR,ADDRESS;
FROM FramePainter IMPORT ShowDisplayFrame;
FROM M2Strings IMPORT Length,Assign;
FROM NumTypes IMPORT REALToReal8;
FROM StrConv IMPORT IntegerToStr,RealToStr,StrToInteger,StrToReal;
FROM VStorage IMPORT DosAlloc,DosDealloc;
FROM LowLevel IMPORT Fill;
FROM ControlUtils IMPORT Control;
IMPORT VWindows;
IMPORT MsColors;
TYPE
  Table = POINTER TO TableRec;
  TableRec = RECORD
    DF  : DisplayFrame;
    Choice     : ARRAY[0..15] OF CHAR; (* choice fields *)
    RowDef     : GenList;
    NumberOfRows,
    NumberOfCols : CARDINAL;
  END;

   ColumDef = RECORD
     InField : InputFieldRecord;
     X       : CARDINAL;
     Width   : CARDINAL;
     Choice  : ARRAY[0..15] OF CHAR;
     Title : ARRAY[0..40] OF CHAR;   (* caption for top of field *)
   END;


(* these procedures are used to define the table *)
PROCEDURE DefineTextCol(VAR T:Table; X, Width : CARDINAL;
          Title : ARRAY OF CHAR; DisplayOnly : BOOLEAN);
VAR
  Col : ColumDef;
BEGIN
  InitField(Col.InField);
  IF DisplayOnly
    THEN Col.InField.typ := DispCode
    ELSE Col.InField.typ := StringCode;
  END;
  Col.X := X;
  Col.Width := Width;
  Assign( Title,Col.Title);
  ListInsert(Col,1,T^.RowDef,80);

 END DefineTextCol;

PROCEDURE DefineGroupCol(VAR T:Table; X,Width : CARDINAL; Title : ARRAY OF CHAR;
          Choice : ARRAY OF CHAR; MenuKey : CARDINAL; NbrOfChoice, ThisChoice : CARDINAL;
	  SelectDefault: BOOLEAN );
VAR
  Col : ColumDef;
BEGIN
  InitField(Col.InField);
  Col.InField.typ := GroupMember;
  Col.InField.MenuKey := MenuKey;
  Col.InField.GroupSize := NbrOfChoice;
  Col.InField.GroupID := ThisChoice;
  Col.InField.selected := SelectDefault;
  Assign(Choice,Col.InField.fnam );
  Col.X := X;
  Col.Width := Width;
  Assign( Choice,Col.Choice);       (* default text *)
  Assign( Title,Col.Title );
  ListInsert(Col,1,T^.RowDef,80);
END DefineGroupCol;	
	
PROCEDURE DefineIntegerCol(VAR T:Table; X,Width : CARDINAL; Title : ARRAY OF CHAR;
          Min, Max : LONGINT);	
VAR
  Col : ColumDef;
BEGIN
  InitField(Col.InField);
  Col.InField.typ := IntCode;
  Col.InField.iMax := Max;
  Col.InField.iMin := Min;
  Col.X := X;
  Col.Width := Width;
  Assign( Title,Col.Title );
  ListInsert(Col,1,T^.RowDef,80);
END DefineIntegerCol;


PROCEDURE DefineRealCol(VAR T:Table; X,Width : CARDINAL; Title : ARRAY OF CHAR;
          Min, Max : REAL);
VAR
  Col : ColumDef;
BEGIN
  InitField(Col.InField);
  Col.InField.typ := RealCode;
  Col.InField.rMax := REALToReal8(Max);
  Col.InField.rMin := REALToReal8(Min);
  Col.InField.decimalPlace := 2;

  Col.X := X;
  Col.Width := Width;
  Assign( Title,Col.Title );
  ListInsert(Col,1,T^.RowDef,80);

END DefineRealCol;


PROCEDURE DefineTable(VAR T:Table; Caption : ARRAY OF CHAR);
BEGIN
  DosAlloc(T,TSIZE(TableRec));    (* allocate the table *)
  InitDisplayFrame(T^.DF,VWindows.CurrentWindow);  (* inint the display Frame*)
  T^.DF^.action := 'I';
  T^.DF^.headline := 3;    (* the title shouldn't scroll *)
  T^.DF^.selfor := MsColors.brightwhite;
  Assign( Caption,T^.DF^.Caption);
  T^.DF^.ClearAfter := TRUE;
  NewList( T^.DF^.FieldList );
  PutFrameLists( T^.DF );
          (*Make sure the new FieldList gets inserted into
            TheFrame's .self list. Stole this from Cole???? *)
  NewList(T^.RowDef);
END DefineTable;



PROCEDURE PutInOrder( Adr1 : ADDRESS; S1 : CARDINAL;
                      Adr2 : ADDRESS; S2:CARDINAL) : INTEGER;
(* before building the table make sure the thing is in correct order *)
VAR
  C1, C2 : POINTER TO ColumDef;
BEGIN
 C1 := Adr1;
 C2 := Adr2;
 IF C1^.X > C2^.X
   THEN  RETURN 1
   ELSE RETURN -1
END;
END PutInOrder;

          		
PROCEDURE BuildTable(VAR T:Table; NbrRows : CARDINAL);
(* this routine will go through the row list of the table and build the*)
(* The table  *)
VAR J : CARDINAL;
  Row : CARDINAL;
  Col : POINTER TO ColumDef;
  TmpCol : ColumDef;
  Size,Code : CARDINAL;
  ImgNbr : CARDINAL;
  Str : ARRAY[0..80] OF CHAR;
  TmpRec : ImageElement;
BEGIN

 WITH T^ DO
   ShellSortList(RowDef,PutInOrder);  (* should have been defined in order *)
                                      (* but make sure -                   *)

   NumberOfRows := NbrRows;
   NumberOfCols := ListLength(RowDef);

   (* at the top of the table put the title rows *)
   FOR J := 1 TO ListLength(RowDef) DO   (* add title row *)
      GetElmt(RowDef,J,TmpCol,Code);   (* get a copy of the record *)
      TmpCol.InField.typ := 'D';     (* make it a display only *)
      CreateImageElement(TmpRec,TmpCol.X,2,DF^.normfor,DF^.normbak,
	       DF^.normatrb,ListLength(DF^.FieldList)+1,TmpCol.Title);

      AddImageElement(DF,TmpRec,ImgNbr);
      TmpCol.InField.ImageNum := ImgNbr;
      PutFieldRec(TmpCol.InField,DF,65535);  (* stick at end*)
    END;
                    (* add the elemets to the table *)

   FOR Row := 1 TO NbrRows DO     (* for each row in the table *)
      FOR J := 1 TO ListLength(RowDef) DO   (* for each colum in row *)
         GetElmtAdr(RowDef,J,Col,Size,Code);
         Fill(ADR(Str),SIZE(Str),' ');   (* blank fill the input string *)	
	 SetLength(Str,Col^.Width);
	 IF Col^.InField.typ = GroupMember
	   THEN
	     Assign(Col^.Choice,Str );
	   END;
         CreateImageElement(TmpRec,Col^.X,Row+3,DF^.normfor,DF^.normbak,
	       DF^.normatrb,ListLength(DF^.FieldList)+1,Str);

	 AddImageElement(DF,TmpRec,ImgNbr);
	 Col^.InField.ImageNum := ImgNbr;
	 PutFieldRec(Col^.InField,DF,65535);  (* stick at end*)
	END;   (* end of for each col *)
     END;   (* end for each row *)	
  END; (* end with table *)	


END BuildTable;

PROCEDURE ShowTable(T : Table;X1,Y1,X2,Y2: CARDINAL);
BEGIN
  ShowDisplayFrame(T^.DF,X1,Y1,X2,Y2);
END ShowTable;

PROCEDURE ControlTable(VAR T:Table;X1,Y1,X2,Y2: CARDINAL);
BEGIN
  ShowDisplayFrame(T^.DF,X1,Y1,X2,Y2);
  Control(T^.DF);
END ControlTable;

PROCEDURE DeleteTable(VAR T:Table);
BEGIN
  CloseDisplayFrame(T^.DF);
  DisposeList(T^.RowDef);
  DosDealloc(T,TSIZE(TableRec));

END DeleteTable;

PROCEDURE PutCell(VAR T:Table; X,Y : CARDINAL; Cell : CellValue);
(* fill a value in table - the X and Y here refer to the cell numbers  *)
(* not to the placement on the screen *)
VAR
  FieldNbr : CARDINAL;
  Image : ImageElement;
  FldPtr : InputFieldPtr;
  B : BOOLEAN;
  LL : CARDINAL;
  Str : ARRAY[0..80] OF CHAR;     (* must maintain the original length*)
BEGIN
  LL := ListLength(T^.RowDef);
  FieldNbr := ((Y) * LL) + X ;  (* compute field nbr*)
  GetImageRec(T^.DF,FieldNbr,Image);
  GetFieldPtr(T^.DF,FieldNbr,FldPtr);
  CASE  FldPtr^.typ OF
   StringCode,DispCode :
               Fill(ADR(Str),SIZE(Str),' ');
	       OverWrite(Cell.Str,Str,0);   (* keep the length of the orignal*)
	       SetLength(Str,Length(Image.text)+1);
               Assign( Str,Image.text);
  |IntCode    : IntegerToStr(Cell.I,Length(Image.text),Image.text);
  |RealCode   : RealToStr(Cell.R,2,Length(Image.text),Image.text);
  |GroupMember: FldPtr^.selected := Cell.B;
 END;
  PutFieldImageRec(Image,T^.DF,FieldNbr);
END PutCell;

PROCEDURE GetCell(VAR T:Table; X,Y : CARDINAL; VAR Cell : CellValue); (* get contents of cell*)
VAR
  FieldNbr : CARDINAL;
  Image : ImageElement;
  FldPtr : InputFieldPtr;
  B : BOOLEAN;
  LL : CARDINAL;
BEGIN
  LL := ListLength(T^.RowDef);
  FieldNbr := ((Y) * LL) + X;  (* compute field nbr*)
  GetImageRec(T^.DF,FieldNbr,Image);
  GetFieldPtr(T^.DF,FieldNbr,FldPtr);
  CASE  FldPtr^.typ  OF
   StringCode,DispCode : Assign( Image.text,Cell.Str);
  |IntCode    : B := StrToInteger(Image.text,0,Cell.I);
  |RealCode   : B := StrToReal(Image.text,0,Cell.R);
  |GroupMember: Cell.B := FldPtr^.selected;
 END;

END GetCell;

PROCEDURE NumberOfRows(T : Table) : CARDINAL;
BEGIN
 RETURN T^.NumberOfRows;
END NumberOfRows;

PROCEDURE NumberOfCols( T : Table) : CARDINAL;
BEGIN
  RETURN T^.NumberOfCols;
END NumberOfCols;

END Tables.