Topspeed_JPI/TS-V3/REP16/ALTKEYS.MOD

IMPLEMENTATION MODULE AltKeys;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/altkeys.mov   1.5   10 Mar 1991 15:24:44   coleb  $
 *
 *)


IMPORT ErrorNames;
IMPORT GenLists;
IMPORT ListUtils;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT NdxBones;
IMPORT NdxFiles;
IMPORT NdxTypes;
IMPORT PosUtils;
IMPORT StrEdit;
IMPORT StrLogic;
IMPORT SYSTEM;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      ErrorNames.Init();
      GenLists.Init();
      ListUtils.Init();
      LowLevel.Init();
      M2Strings.Init();
      NdxBones.Init();
      NdxFiles.Init();
      NdxTypes.Init();
      PosUtils.Init();
      StrEdit.Init();
      StrLogic.Init();
    END Init;


PROCEDURE FieldLoaded( NdxFile: NdxTypes.NdxFileType; FieldName:
    ARRAY OF CHAR; VAR spot: CARDINAL): BOOLEAN;
(*FieldLoaded returns true if FieldName is found, false if not.
  If it returns a true, spot will represent the actual position
  of FieldName in the NameList.  If false, spot will represent
  the length of the NameList.*)

  VAR
    NameList: GenLists.GenList;
    TypeCode, NameListLen, TmpSpot: CARDINAL;
    TmpName: ARRAY [0..127] OF CHAR;
  BEGIN
    spot := 1;
    WITH NdxFile^ DO
      IF (NOT GenLists.Initialized(AltKeys))
          OR (GenLists.ListLength(AltKeys) = 0) THEN
        spot := 0;
        RETURN FALSE;
      END;
      GenLists.GetChildList( NdxFile^.AltKeys, 1, NameList );
    END;
    TmpSpot := 1;
    NameListLen := GenLists.ListLength( NameList );
    IF NameListLen > 0 THEN
      REPEAT
        GenLists.GetElmt( NameList, TmpSpot, TmpName, TypeCode );
        IF PosUtils.Equal( FieldName, TmpName ) THEN
          spot := TmpSpot;
          RETURN TRUE;
        END;
        INC(TmpSpot);
      UNTIL TmpSpot > NameListLen;
    END;
    spot := NameListLen;
    RETURN FALSE;
  END FieldLoaded;


PROCEDURE CreateAltList( VAR NdxFile: NdxTypes.NdxFileType; FieldName:
    ARRAY OF CHAR; VAR SpotUsed: CARDINAL);
  (*Each element of the AltKey list is, in turn, a list.  The
    first one contains a list of the field names associated with
    the others.  The others are lists of selected field values,
    each of which contains in its first two bytes a CARDINAL
    indicating the position of the corresponding record in the
    file's main Ndx list.  CreateAltList returns in its SpotUsed
    parameter the position in NdxFile^.AltKeys where it put the
    AltList.*)
  VAR
    FieldList, NameList: GenLists.GenList;
    spot, AltKeysLen: CARDINAL;
  BEGIN
    IF NOT GenLists.Initialized( NdxFile^.AltKeys ) THEN
      GenLists.NewList( NdxFile^.AltKeys );
    END;
    AltKeysLen := GenLists.ListLength( NdxFile^.AltKeys );
    IF AltKeysLen = 0 THEN
      (*Create the first list.*)
      GenLists.NewList( NameList );
      GenLists.ListInsert( NameList, GenLists.ListCode, NdxFile^.AltKeys, 1 );
      INC(AltKeysLen);
    ELSE
      GenLists.GetChildList( NdxFile^.AltKeys, 1, NameList );
      IF GenLists.ListLength(NameList) # (AltKeysLen - 1) THEN
        (*You could take this check out if you're not worried about
          corruption.*)
        ErrorNames.WarningName( 'BadAlt' );
        RETURN;
      END;
    END;
    GenLists.NewList( FieldList );
    IF FieldLoaded( NdxFile, FieldName, spot ) THEN
      SpotUsed := spot;
      GenLists.ListReplace(FieldList, GenLists.ListCode,
          NdxFile^.AltKeys, SpotUsed + 1);
        (*ListReplace will dispose of the old list.*)
    ELSE
      GenLists.ListInsert( FieldName, GenLists.StrCode, NameList,
          spot + 1);
      SpotUsed := spot + 1;
      GenLists.ListInsert( FieldList, GenLists.ListCode,
          NdxFile^.AltKeys, SpotUsed + 1 );
    END;
  END CreateAltList;


PROCEDURE CriteriaMet( NdxFile: NdxTypes.NdxFileType; Criteria:
    GenLists.GenList; VAR CriteriaValid: BOOLEAN ): BOOLEAN;
  VAR
    FieldSize, FieldSpot, lngth, ListSpot, TypeCode: CARDINAL;
    TmpCriterion: Criterion;
    RunningResult, TmpResult: BOOLEAN;
    FieldList: GenLists.GenList;
    FieldAdr: SYSTEM.ADDRESS;
  BEGIN
    CriteriaValid := TRUE;
    IF (NOT GenLists.Initialized(Criteria))
       OR (GenLists.ListLength(Criteria) = 0) THEN
      RETURN TRUE;
      (*Means that if you don't pass a criteria list, everything
        will match.*)
    END;
    ListSpot := 1;
    lngth := GenLists.ListLength(Criteria);
    RunningResult := FALSE;
    REPEAT
      GenLists.GetElmt( Criteria, ListSpot, TmpCriterion, TypeCode );
      FieldList := NdxFile^.ListBuf;
      FieldSpot := 0;
      IF (GenLists.ErrorFlag # GenLists.NoListError) OR
          (TypeCode # CriterionCode) THEN
        ErrorNames.WarningName( 'Crit' );
        TmpResult := FALSE;
      ELSIF NdxFiles.FindField(NdxFile^.StructLst,
          TmpCriterion.field, FieldList, FieldSpot) THEN
        GenLists.GetElmtAdr( FieldList, FieldSpot, FieldAdr,
            FieldSize, TypeCode );
        TmpResult := TmpCriterion.determiner( FieldAdr,
            FieldSize, TypeCode, TmpCriterion.rule, CriteriaValid );
      ELSE
        TmpResult := FALSE;
      END;
      CASE TmpCriterion.operator OF
        and: RunningResult := RunningResult AND TmpResult;
      | or: RunningResult := RunningResult OR TmpResult;
      | AndNot: RunningResult := RunningResult AND (NOT TmpResult);
      ELSE
        (*I'm assuming we can get here if range-checking is off.*)
        ErrorNames.WarningName( 'Crit' );
      END;
      INC( ListSpot );
    UNTIL ListSpot > lngth;
    RETURN RunningResult;
  END CriteriaMet;


PROCEDURE AddFieldContents( NdxFile: NdxTypes.NdxFileType; RecName,
    FieldName: ARRAY OF CHAR; ElmtAdr: SYSTEM.ADDRESS; ElmtSize: CARDINAL );
  VAR
    FieldList: GenLists.GenList;
    duml: LONGINT;
    TypeCode, spot, dumc: CARDINAL;
  BEGIN
    IF NOT FieldLoaded( NdxFile, FieldName, spot ) THEN
      ErrorNames.WarningName( 'AFC' );
      RETURN;
    END;
    IF NOT NdxBones.FindRecord(NdxFile, RecName, duml, dumc, dumc) THEN
      ErrorNames.WarningName( 'RecNam' );
      RETURN;
    END;
    GenLists.GetChildList( NdxFile^.AltKeys, spot + 1, FieldList );
    dumc := GenLists.ElmtNow( NdxFile^.Ndx );
    GenLists.ListInsertAdr( ElmtAdr, ElmtSize + 2, TypeCode, FieldList,
        GenLists.ListLength(FieldList) + 1 );
    GenLists.GetElmtAdr( FieldList, GenLists.ListLength(FieldList), ElmtAdr,
        ElmtSize, TypeCode );
      (*Get the element's new data area.*)
    LowLevel.ShiftArrayRight( ElmtAdr, ElmtSize, 2 );
      (*Make room for the record identifier at the start of the
        element's data area.*)
    LowLevel.PokeWord( dumc, LowLevel.seg(ElmtAdr), LowLevel.ofs(ElmtAdr) );
      (*Put the record identifier in the first two bytes of the
        data area.*)
  END AddFieldContents;


PROCEDURE LoadAltList( VAR NdxFile: NdxTypes.NdxFileType;
    InList: GenLists.GenList; FieldName: ARRAY OF CHAR; Criteria:
    GenLists.GenList): BOOLEAN;
  VAR
    ListType, ListSpot, NameListLength, InListLength, TypeCode,
        ElmtSize, AltFieldSpot, AltKeyListSpot: CARDINAL;
    ElmtAdr: SYSTEM.ADDRESS;
    AltFieldList, AltKeyList: GenLists.GenList;
    TmpNdxRec: NdxTypes.NdxElement;
    CriteriaValid: BOOLEAN;
    RecName: ARRAY [0..(NdxTypes.RecNameLength - 1)] OF CHAR;
  BEGIN
    (*LoadAltList*)
    CriteriaValid := TRUE;
    AltKeyListSpot := 1;
    InListLength := GenLists.ListLength(InList);
    IF InListLength = 0 THEN
      NameListLength := GenLists.ListLength(NdxFile^.Ndx);
      ListType := NdxTypes.NdxTypeCode;
      (*We set ListType to NdxTypeCode if there's no InList
        because we're going to use the file's entire Ndx in this
        situation.*)
    ELSE
      NameListLength := GenLists.ListLength(InList);
      ListType := ListUtils.TypeCheck( InList, 1 );
    END;
    ListSpot := 1;
    REPEAT
      CASE ListType OF
        NdxTypes.NdxTypeCode:
          IF GenLists.ListLength( NdxFile^.Ndx ) > 0 THEN
            GenLists.GetElmt( NdxFile^.Ndx, ListSpot, TmpNdxRec, TypeCode );
            StrEdit.AssignStr( TmpNdxRec.RecName, RecName );
          ELSE
            RETURN FALSE;
          END;
      | AltKeyCode:
        GetMatchingKey( NdxFile, InList, ListSpot, RecName );
      ELSE
        (*We assume we have a list of valid record names.*)
        GenLists.GetElmt( InList, ListSpot, RecName, TypeCode );
      END;
      IF (M2Strings.Length( RecName ) > 0) AND
         NdxBones.InitBuffer( NdxFile, RecName) THEN
        (*If Length(RecName) = 0, it's a garbage record.*)
        (*InitBuffer does the actual record read, and returns
          FALSE if the record does not exist *)
        IF NOT FieldLoaded( NdxFile, FieldName, AltKeyListSpot ) THEN
          (*AltKeyListSpot now represents the length of the
            NameList, but CreateAltList will INC it.*)
          CreateAltList( NdxFile, FieldName, AltKeyListSpot );
        END;
        IF PosUtils.Equal('KEY', FieldName) THEN
          (*They just want the matching record names.*)
          GenLists.GetChildList( NdxFile^.AltKeys, AltKeyListSpot + 1,
              AltKeyList );
          IF CriteriaMet(NdxFile, Criteria, CriteriaValid) THEN
            GenLists.ListInsert( RecName, GenLists.StrCode, AltKeyList,
                GenLists.ListLength(AltKeyList) + 1 );
          END;
        ELSE
          AltFieldList := NdxFile^.ListBuf;
          AltFieldSpot := 0;
          IF NdxFiles.FindField(NdxFile^.StructLst, FieldName, AltFieldList,
              AltFieldSpot) THEN
            IF CriteriaMet( NdxFile, Criteria, CriteriaValid ) THEN
              GenLists.GetElmtAdr( AltFieldList, AltFieldSpot, ElmtAdr,
                  ElmtSize, TypeCode );
              IF (NOT (TypeCode = GenLists.ListCode)) THEN
                AddFieldContents( NdxFile, RecName, FieldName,
                  ElmtAdr, ElmtSize );
              ELSE
                ErrorNames.WarningName( 'LstAlt' );
              END;
            END;
          END;
        END;
      END;
      INC(ListSpot);
    UNTIL (ListSpot > NameListLength) OR (NOT CriteriaValid);
      (*We're at the end of the InList.*)
    RETURN TRUE;
  END LoadAltList;


PROCEDURE DisposeAltList( VAR NdxFile: NdxTypes.NdxFileType; FieldName:
    ARRAY OF CHAR);
  VAR
    NameList: GenLists.GenList;
    spot: CARDINAL;
  BEGIN
    IF NOT GenLists.Initialized( NdxFile^.AltKeys ) THEN
      ErrorNames.WarningName('BadLst');
      RETURN;
    END;
    IF GenLists.ListLength( NdxFile^.AltKeys ) > 0 THEN
      IF FieldLoaded( NdxFile, FieldName, spot ) THEN
        GenLists.GetChildList( NdxFile^.AltKeys, 1, NameList );
        GenLists.ListDelete( NameList, spot, 1 );
          (*Delete the FieldName.*)
        GenLists.ListDelete( NdxFile^.AltKeys, spot + 1, 1 );
          (*Delete the list itself.*)
        RETURN;
      END;
    END;
    ErrorNames.WarningName( 'AltNam' );
  END DisposeAltList;


PROCEDURE TallyAltLists(NdxFile: NdxTypes.NdxFileType; VAR
    TheList: GenLists.GenList);
  (*Returns a list of the field names that have AltLists
    presently loaded.*)
  VAR
    NameList: GenLists.GenList;
  BEGIN
    IF (GenLists.Initialized( NdxFile^.AltKeys ))
       AND (GenLists.ListLength( NdxFile^.AltKeys ) > 0) THEN
      GenLists.GetChildList( NdxFile^.AltKeys, 1, NameList );
      GenLists.CopyList( NameList, TheList );
    ELSE
      ErrorNames.WarningName( 'AltNam' );
    END;
  END TallyAltLists;


PROCEDURE GetAltList( NdxFile: NdxTypes.NdxFileType; FieldName: ARRAY OF
    CHAR; VAR AltList: GenLists.GenList): BOOLEAN;
  (*Note that this returns the real AltList, so the first two
    bytes of each data area will be the record identifier.  You
    have to get rid of those things with ShiftArrayLeft.*)
  VAR
    spot: CARDINAL;
  BEGIN
    IF FieldLoaded( NdxFile, FieldName, spot ) THEN
      GenLists.GetChildList( NdxFile^.AltKeys, spot + 1, AltList );
      IF GenLists.ErrorFlag = GenLists.NoListError THEN
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    ELSE
      RETURN FALSE;
    END;
  END GetAltList;


PROCEDURE GetMatchingKey( NdxFile: NdxTypes.NdxFileType; AltList:
    GenLists.GenList; spot: CARDINAL; VAR RecName: ARRAY OF CHAR );

    (*Pass this procedure an AltKeyList (i.e., the kind of list
      that has a record number and a field value in every
      element) and the position of an element in that list, and
      it returns in RecName the name of the record from which the
      field value was read.*)
  VAR
    RecordNumber, AltKeySize, TypeCode: CARDINAL;
    AltKeyAdr: SYSTEM.ADDRESS;
    TmpNdxRec: NdxTypes.NdxElement;
  BEGIN
    GenLists.GetElmtAdr( AltList, spot, AltKeyAdr, AltKeySize, TypeCode );
    IF (TypeCode # AltKeyCode) THEN
      LowLevel.Move( AltKeyAdr, SYSTEM.ADR(RecName), AltKeySize );
        (* 28 Nov 88:  added this so that GetMatchingKey can be
           used with AltKeyLists that contain only record names. *)
    ELSE
      LowLevel.Move( AltKeyAdr, SYSTEM.ADR(RecordNumber), 2 );
      GenLists.GetElmt( NdxFile^.Ndx, RecordNumber, TmpNdxRec, TypeCode );
      StrEdit.AssignStr( TmpNdxRec.RecName, RecName );
    END;
  END GetMatchingKey;


PROCEDURE GetMatchingKeys( NdxFile: NdxTypes.NdxFileType; AltList:
    GenLists.GenList; VAR KeyList: GenLists.GenList): BOOLEAN;
  (*Returns a RecNameList that contains only records presently in
    the AltList.*)
  VAR
    spot, lngth: CARDINAL;
    RecName: ARRAY [0..(NdxTypes.RecNameLength - 1)] OF CHAR;
  BEGIN
    IF NOT GenLists.Initialized(AltList) THEN
      ErrorNames.WarningName('BadLst');
      RETURN FALSE;
    END;
    lngth := GenLists.ListLength( AltList );
    FOR spot := 1 TO lngth DO
      GetMatchingKey( NdxFile, AltList, spot, RecName );
      IF GenLists.ErrorFlag = GenLists.NoListError THEN
        GenLists.ListInsert( RecName, RecNameCode, KeyList, spot );
      END;
    END;
    RETURN TRUE;
  END GetMatchingKeys;


PROCEDURE StrSelector( TheAdr: SYSTEM.ADDRESS; TheSize, TypeCode:
    CARDINAL; TheRule: ARRAY OF CHAR; VAR CriteriaValid:
    BOOLEAN): BOOLEAN;
  (*This will be assigned to a SelectProc variable.*)
  VAR
    TmpStr: ARRAY [0..255] OF CHAR;
    TmpResult, SubSize, SubType, leng, cnt: CARDINAL;
    SubAddr: SYSTEM.ADDRESS;
    SubList: GenLists.GenList;
    found: BOOLEAN;
  BEGIN
    IF (TypeCode = GenLists.StrCode) THEN
      IF M2Strings.Length( TheRule ) = 0 THEN
        RETURN TRUE;
      END;
      IF TheSize > (HIGH(TmpStr)+1) THEN
        TheSize := (HIGH(TmpStr)+1);
      END;
      LowLevel.Move( TheAdr, SYSTEM.ADR(TmpStr), TheSize );
      TmpResult := StrLogic.ExpressionTest( TmpStr, TheRule );
      CriteriaValid := StrLogic.StrLogicErrorLevel = 0;
      RETURN ( TmpResult > 0);
    ELSIF (TypeCode = GenLists.ListCode) THEN
      IF NOT GenLists.AdrToList( TheAdr, TheSize, SubList ) THEN
        RETURN FALSE;
      END;
      leng := GenLists.ListLength(SubList);
      found := FALSE;
      cnt := 1;
      WHILE (cnt <= leng) AND (NOT found) DO
        GenLists.GetElmtAdr( SubList, cnt, SubAddr, SubSize, SubType );
          (*We ought to be able to do a recursive call here, but for
            some reason it causes a stack overflow.*)
        IF (SubType = GenLists.StrCode) THEN
          IF M2Strings.Length( TheRule ) = 0 THEN
            RETURN TRUE;
          END;
          IF SubSize > (HIGH(TmpStr)+1) THEN
            SubSize := (HIGH(TmpStr)+1);
          END;
          LowLevel.Move( SubAddr, SYSTEM.ADR(TmpStr), SubSize );
          TmpResult := StrLogic.ExpressionTest( TmpStr, TheRule );
          CriteriaValid := StrLogic.StrLogicErrorLevel = 0;
          found := TmpResult > 0;
        END;
        INC(cnt);
      END;
      RETURN found;
    END;
    RETURN FALSE;
  END StrSelector;


PROCEDURE AddCriteria( CriteriaList: GenLists.GenList; op: LogicOperator;
    TheSelectProc: SelectProc; TheRule, FieldName: ARRAY OF CHAR );
  VAR
    TmpCriterion: Criterion;
  BEGIN
    IF NOT GenLists.Initialized( CriteriaList ) THEN
      ErrorNames.WarningName('BadLst');
      RETURN;
    END;
    StrEdit.AssignStr( FieldName, TmpCriterion.field );
    StrEdit.AssignStr( TheRule, TmpCriterion.rule );
    TmpCriterion.operator := op;
    TmpCriterion.determiner := TheSelectProc;
    GenLists.ListInsert( TmpCriterion, CriterionCode,
        CriteriaList, GenLists.ListLength(CriteriaList) + 1 );
  END AddCriteria;

BEGIN
  Initialized := FALSE;
  Init();
END AltKeys.