Topspeed_JPI/TS-V3/MODBASE/DBSCREEN.MOD

IMPLEMENTATION MODULE DBScreen;
(*
 *  ModBase
 *  Release 3.0
 *  By Don Fletcher & John McMonagle
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *
 *)

IMPORT SYSTEM;

(*Repertoire modules*)
IMPORT BigSets;
IMPORT LowLevel;
IMPORT KbdInput;
IMPORT SmartScreen;
IMPORT StrEdit;
IMPORT StrInput;
IMPORT StrConv;
IMPORT M2Strings;
IMPORT VWindows;
IMPORT WindowPrims;
IMPORT ModBase3;
IMPORT ErrorManager;
FROM MiscFunctions IMPORT FieldName, FieldNameChar,
     Alph, Trim, Upper;
CONST Blank  = ' ';
      MaxGets = 80;
      MaxField = 128;
      MaxLength = 256;
      MaxNLength = 18;

    CRnum = 13;
    TABnum = 9;
    BSPnum = 8;
    ESCnum = 27;
    BTBnum = 15 + KbdInput.Extended;
    (*back tab numeric code for extended scan code*)
    LARWnum = 75 + KbdInput.Extended;
    (*left arrow numeric code*)
    RARWnum = 77 + KbdInput.Extended;
    (*right arrow*)
    UARWnum = 72 + KbdInput.Extended;
    (*up arrow*)
    DARWnum = 80 + KbdInput.Extended;

TYPE
  String = ARRAY [0..MaxField] OF CHAR;

  StrPtr = POINTER TO String;

  GetType = RECORD
    row: CARDINAL;
    col: CARDINAL;
    len: CARDINAL;
    val: StrPtr;
  END;

  InputArray = ARRAY [1..MaxGets] OF GetType;

VAR input: InputArray;
    lastget: CARDINAL;

PROCEDURE ValidType(ch: CHAR): BOOLEAN;
BEGIN
  RETURN (CAP(ch)='C') OR (CAP(ch)='N') OR (CAP(ch)='L') OR
      (CAP(ch)='D') OR (CAP(ch)='M');
END ValidType;

PROCEDURE ValidSize(size: CARDINAL; fieldtype: CHAR): BOOLEAN;
(* Checks to see whether size is valid for the given fieldtype*)
BEGIN
  CASE CAP(fieldtype) OF
      'C': RETURN (size >= 1) AND (size <= MaxLength);
    | 'N': RETURN (size >= 1) AND (size <= MaxNLength);
    | 'L': RETURN (size = 1);
    | 'D': RETURN (size = 8);
    | 'M': RETURN (size = 10);
  END;
  RETURN FALSE;
END ValidSize;

PROCEDURE ValidDec(size, decimalplaces: CARDINAL): BOOLEAN;
BEGIN
  RETURN (decimalplaces <= size);
END ValidDec;

PROCEDURE GetDescriptors(VAR fields: ARRAY OF ModBase3.DBFieldDescriptor);

VAR
  i, j, crow, ccol, lastfield, pagebottom, pagetop: CARDINAL;
  sizestring: ARRAY [0..2] OF CHAR;
  decstr: ARRAY [0..1] OF CHAR;
  confirmed: CHAR;
  ok: BOOLEAN;

  PROCEDURE UniqueName(testname: ARRAY OF CHAR): BOOLEAN;
  VAR i, matches: CARDINAL;
  BEGIN
    i := 0;
    matches := 0;
    WHILE (i <= lastfield) DO
      IF (M2Strings.CompareStr(fields[i].name, testname) = 0) THEN
        INC(matches)
      END;
      INC(i)
    END;
    RETURN matches = 1;
  END UniqueName;

BEGIN
  WindowPrims.PushColors();
  SmartScreen.ClearScreen();
  i := 0;
  pagetop := i;
  pagebottom := i+29;
  confirmed := 'N';
  Say(2, 5, 'NAME------  TYPE  SIZE  DEC');
  SmartScreen.SetAttribOrColor( SmartScreen.red,
      SmartScreen.blue, SmartScreen.ReverseVideo );
  REPEAT
    crow := (i MOD 15) + 4;
    ccol := 5+((i DIV 15) * 35);
    Say(crow, ccol, fields[i].name);
    Say(crow, ccol+12, fields[i].fldtype);
    StrConv.CardinalToStr(fields[i].size, 3, sizestring);
    Say(crow, ccol+18, sizestring);
    StrConv.CardinalToStr(fields[i].decplaces, 3, decstr);
    Say(crow, ccol+24, decstr);
    INC(i);
  UNTIL (NOT FieldName(fields[i].name)) OR (i >= pagebottom);
  lastfield := i-1;
  REPEAT
    i := 0;
    REPEAT
      REPEAT
        crow := (i MOD 15) + 4;
        ccol := 5+((i DIV 15) * 35);
        Get(crow, ccol, fields[i].name);
        Get(crow, ccol + 12, fields[i].fldtype);
        ReadGets;
        fields[i].fldtype := CAP(fields[i].fldtype);
        Upper(fields[i].name);
        Say(crow, ccol, fields[i].name);
        Say(crow, ccol + 12, fields[i].fldtype);
      UNTIL (FieldName(fields[i].name) AND UniqueName(fields[i].name))
            AND (ValidType(fields[i].fldtype))
            OR (fields[i].name[0] = ' ')
            OR (lastdirection = Escape);
      IF ((fields[i].name[0]) # ' ') AND (lastdirection # Back) THEN
        CASE fields[i].fldtype OF
          'D' : fields[i].size := 8  |
          'M' : fields[i].size := 10 |
          'L' : fields[i].size := 1
        ELSE
           StrConv.CardinalToStr(fields[i].size, 3, sizestring);
           StrConv.CardinalToStr(fields[i].decplaces, 3, decstr);
           REPEAT
             Get(crow, ccol + 18, sizestring);
             ReadGets;
             Trim(sizestring);
             ok := StrConv.StrToCardinal(sizestring, 0, fields[i].size);
           UNTIL ok AND ValidSize(fields[i].size, fields[i].fldtype);
           IF fields[i].fldtype = 'N' THEN
             REPEAT
               Get(crow, ccol + 24,  decstr);
               ReadGets;
               Trim(decstr);
               ok := StrConv.StrToCardinal(decstr, 0, fields[i].decplaces);
             UNTIL ok AND ValidDec(fields[i].size, fields[i].decplaces);
           END;
         END; (* case *)
       END;
       IF (i < lastfield) AND (fields[i].name[0] = ' ') THEN
         (* the user has deleted a field in mid-record so the subsequent
            fields must be 'sucked up' *)
         FOR j := i TO lastfield DO
           fields[j] := fields[j+1]
         END (* for *);
       END;
       IF lastdirection = Ahead THEN
         IF i < MaxField-1 THEN
           IF i >= lastfield THEN INC(lastfield) END;
           INC(i)
         END;
       ELSIF lastdirection = Back THEN
         IF i > 0 THEN
           DEC(i)
         END;
       END;
    UNTIL (lastdirection = Escape)
          OR (fields[i-1].name[0] = ' ')
          OR (i < pagetop)
          OR (i > pagebottom);
    (* CONFIRM *)
    Say(24,5, 'Enter "Y" to confirm - ');
    Get(24, 28, confirmed);
    ReadGets;
  UNTIL CAP(confirmed) = 'Y';
  WindowPrims.PopColors();
END GetDescriptors;

PROCEDURE ModifyDBStruc(VAR alias: ModBase3.DBFile);
VAR displayoffset: CARDINAL;
    new: ModBase3.DBFile;
BEGIN
 (*  new = alias;
  ChangeExt(alias.name, 'BAK');
  (* Rename alias to *.bak *)
  Rename(alias.fileID, alias.name);
  CloseDBF(alias);

   (* Rename alias to *.bak *)
  GetDescriptors(new.fieldlist);
  BuildDBF(new.name, new.fieldlist, alias);
  CloseDBF(alias);
  (* UpDate from *.bak *)
*)
END ModifyDBStruc;

(*
PROCEDURE ChangeExt(VAR filename: ARRAY OF CHAR; ext: ARRAY OF CHAR);
(* add the ext after the last period in the filename *)
VAR i, j: CARDINAL;
BEGIN
  i := M2Strings.Length(filename)-1;
  WHILE (i > 0) AND (filename[i] # '.') DO
    DEC(i)
  END;
  IF i = 0 THEN
    i := M2Strings.Length(filename)-1;
  END;
  FOR j := i+1 TO i+M2Strings.Length(ext)+1 DO
    filename[j] := ext[j-(i+1)]
  END;
  IF HIGH(filename) > (i+M2Strings.Length(ext)+1) THEN
    filename[i+M2Strings.Length(ext)] := 0C;
  END;
END ChangeExt;
*)

PROCEDURE CreateDBF(dbfilename: ARRAY OF CHAR; VAR alias: ModBase3.DBFile);
VAR descarray: ARRAY [0..MaxField-1] OF ModBase3.DBFieldDescriptor;
    i: CARDINAL;
BEGIN
  (* initialize field descriptor array *)
  FOR i := 0 TO MaxField-1 DO
    WITH descarray[i] DO
      name := '          ';
      size := 0;
      fldtype := ' ';
      decplaces := 0;
      offset := 0;
    END;
  END;
  GetDescriptors(descarray);
  IF  ModBase3.BuildDBF(descarray,MaxField, alias) # 0 THEN
    ErrorManager.WARN('Unable to create DataBase File')
  END;
END CreateDBF;



PROCEDURE Row(): CARDINAL;
VAR row, col: CARDINAL;
BEGIN
  WindowPrims.GetCursorCoords( col, row );
  RETURN row;
END Row;

PROCEDURE Col(): CARDINAL;
VAR row, col: CARDINAL;
BEGIN
  WindowPrims.GetCursorCoords( col, row );
  RETURN col;
END Col;


PROCEDURE Say(row, col: CARDINAL; s: ARRAY OF CHAR);
  BEGIN
    WindowPrims.PushColors();
      (* Note that we don't push and pop the cursor size or
         position here or in Get, and we don't turn it off,
         because we don't want it to flash between fields as they
         are initially written.  Means you ought to turn it off
         before doing a series of Say and Get statements. *)
    SmartScreen.SetAttribOrColor( writeattr.fore, writeattr.back,
         writeattr.MonoAttr );
    SmartScreen.WriteAt( col, row, s );
    SmartScreen.GotoXY( SmartScreen.NominalCol,
        SmartScreen.NominalRow );
      (* The GotoXY guarantees consistent cursor placement between
         VideoMethods; in DMA mode, WriteAt doesn't move the
         cursor. See documentation for SmartScreen in the
         Repertoire manual. *)
    WindowPrims.PopColors();
  END Say;

PROCEDURE Get(row, col: CARDINAL; VAR s: ARRAY OF CHAR);
  BEGIN
    WindowPrims.PushColors();
    (* pad the string with trailing blanks *)
    WHILE M2Strings.Length(s) <= HIGH(s) DO
      StrEdit.Append( s, Blank );
    END;
    INC(lastget);
    input[lastget].row := row;
    input[lastget].col := col;
    input[lastget].len := HIGH(s)+1;
    input[lastget].val := SYSTEM.ADR(s);

    SmartScreen.SetAttribOrColor( readattr.fore, readattr.back,
         readattr.MonoAttr );

    SmartScreen.GotoXY( col, row );
    SmartScreen.WriteAt( col, row, s );
    SmartScreen.GotoXY( SmartScreen.NominalCol,
        SmartScreen.NominalRow );
    WindowPrims.PopColors();
  END Get;


PROCEDURE ReadGets;
  VAR
    tmpLen, currentget, CursorPos, LastKey : CARDINAL;
    ExitKeys: KbdInput.KeyNumSet;
    InsertMode: BOOLEAN;
    TmpStr: ARRAY [0..128] OF CHAR;
	tmpStrPtr: StrPtr;
    LocalInput: InputArray;
  BEGIN
    LocalInput := input;
      (* We do this to make the routine easier to follow in the
         runtime debugger.  The global input variable isn't
         normally visible there because it's global to a module
         outside the calling chain. *)
    WindowPrims.PushColors();
    WindowPrims.PushCursorCoords();
      (* Insulates calling procedures from the color choices and
         cursor-position changes we make here.  We don't need to
         push and pop the cursor size or turn it off because
         ReadWithEdits handles that internally. *)
    SmartScreen.SetAttribOrColor( readattr.fore, readattr.back,
         readattr.MonoAttr );
    InsertMode := TRUE;
    BigSets.InitSet( ExitKeys );
    BigSets.AppendSet( ExitKeys, '{8, 9, 13, 27, 271, 328, 329, 336, 337}' );
      (* Means BackSpace, TAB, BackTab, CR, ESC, and the arrow
         keys let you out of a field. *)
    IF lastget > 0 THEN
      currentget:= 1;
      lastdirection := Nowhere;
      WHILE (lastdirection # Escape) AND
            (currentget > 0) AND
            (currentget <= lastget) DO
        CursorPos := 0;
		tmpStrPtr := LocalInput[currentget].val;
		  (* Break out the steps because otherwise Stony Brook
		     generates code that causes a protection fault
			 when the pointer is dereferenced. *)
		tmpLen := LocalInput[currentget].len;
		LowLevel.Move(tmpStrPtr, SYSTEM.ADR(TmpStr), tmpLen);
          (* We have to do this to prevent overflows; since val
             points to an area of memory larger than what we are
             really considering the variable here, ReadWithEdits
             can't reliably tell whether it should put a length
             byte at the end of the string.  Notice that we can't
			 use M2Strings.Copy because it will begin by trying to
			 make a copy of all HIGH+1 bytes of the first argument
			 on the stack.  In this case, they aren't all there.*)
        StrInput.ReadWithEdits( VWindows.CurrentWindow, TmpStr,
            LocalInput[currentget].col, LocalInput[currentget].row,
            LocalInput[currentget].len, CursorPos, InsertMode, FALSE,
            LastKey, KbdInput.AnyKeyNum, ExitKeys );

        LowLevel.Move( SYSTEM.ADR(TmpStr), LocalInput[currentget].val,
            LocalInput[currentget].len );
        CASE LastKey OF
          BSPnum, BTBnum, LARWnum, UARWnum:
            DEC( currentget );
            lastdirection := Back;
        | CRnum, TABnum, RARWnum, DARWnum:
            INC(currentget);
            lastdirection := Ahead;
        | ESCnum:
            lastdirection := Escape
        ELSE (* nothing *)
        END;

      END; (*WHILE*)

      FOR currentget := 1 TO lastget DO
		tmpStrPtr := LocalInput[currentget].val;
		tmpLen := LocalInput[currentget].len;
		LowLevel.Move(tmpStrPtr, SYSTEM.ADR(TmpStr), tmpLen);
          (* Same problem here; the procedure that strips the
             blanks can't reliably determine where the end of the
             string is because we are trying to pass it only a
             part of the string.  So we copy into a local
             variable. *)
        StrEdit.CutTrailingChars( Blank, TmpStr );
        LowLevel.Move( SYSTEM.ADR(TmpStr), LocalInput[currentget].val,
            LocalInput[currentget].len );
      END;
      lastget := 0;
    END; (* if *)
    WindowPrims.PopCursorCoords();
    WindowPrims.PopColors();
    input := LocalInput;
  END ReadGets;

BEGIN (* main *)
  WITH readattr DO
    MonoAttr := SmartScreen.ReverseVideo;
    fore := SmartScreen.blue;
    back := SmartScreen.lightgrey;
  END;
  WITH writeattr DO
    MonoAttr := SmartScreen.plain;
    fore := SmartScreen.lightgrey;
    back := SmartScreen.blue;
  END;
  lastget := 0;
END DBScreen.