Topspeed_JPI/TS/REP16/FIELDTYP.MOD

IMPLEMENTATION MODULE FieldTypes;
(*
 *  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/fieldtyp.mov   1.7   10 Mar 1991 15:27:30   coleb  $
 *
 *)


(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)

IMPORT Hash;
IMPORT GenLists;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT Numbers;
IMPORT ScrnTypes;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT SYSTEM;
IMPORT ErrorManager;
IMPORT VStorage;

VAR
  Initialized : BOOLEAN;

CONST
  AfterLast = 65535;
  gotoConst = 'GOTO';
  stringConst = 'STRING';
  integerConst = 'INTEGER';
  realConst = 'REAL';
  groupConst = 'GROUP';
  choiceConst = 'CHOICE';
  editorConst = 'EDITOR';
  displayConst = 'DISPLAY';
  displayonlyConst = 'DISPLAYONLY';
  dateConst = 'DATE';
  booleanConst = 'BOOLEAN';

TYPE
  APromptTable = ARRAY [0..255] OF CARDINAL;

VAR
  TableHandle: VStorage.MemHandle;
  TablePointer: POINTER TO APromptTable;

  FieldTypeCodes : Hash.HashTable;
  TableInitialized : BOOLEAN;
  PromptList: GenLists.GenList;
  CharConstSize: CARDINAL;


  PROCEDURE DisposeTable();
    BEGIN
      Hash.Dispose( FieldTypeCodes );
      GenLists.DisposeList( PromptList );
    END DisposeTable;


  PROCEDURE SetPrompts();
    VAR
      tmpstr: ARRAY [0..79] OF CHAR;
    BEGIN
      SetDefaultPrompt( editorConst,
          'Alt-D deletes lines; Alt-U undeletes; Shift-F7 toggles wrapping.' );
      StrEdit.AssignStr( 'Enter selects the highlighted choice.',
          tmpstr );
      StrConv.AppendDecoded( tmpstr, '#',
          'Use #024 or #025 to move to another choice.');
      SetDefaultPrompt( gotoConst, tmpstr );
      StrEdit.SetLength(tmpstr, 0);
      StrConv.AppendDecoded(tmpstr, '#',
          'Use #017#196 or #196#016 to change the highlighted choice, or');
      StrConv.AppendDecoded(tmpstr, '#',
          ' #024#025 to move to another field.');
      SetDefaultPrompt( choiceConst, tmpstr );

      StrEdit.AssignStr('Fill in the blank and press',tmpstr);
      StrConv.AppendDecoded(tmpstr, '#',
          ' #024 or #025 to change fields, or F10 if finished.');
      SetDefaultPrompt( stringConst, tmpstr );

      StrEdit.AssignStr( 'Enter a number between MIN and MAX.',tmpstr);
        (* MAX and MIN are replaced with the true values at
           runtime. *)
      SetDefaultPrompt( integerConst, tmpstr );
      SetDefaultPrompt( realConst, tmpstr );

      SetDefaultPrompt( booleanConst,
          'Press space bar to select or deselect choice.' );
      SetDefaultPrompt( dateConst,
          'Enter a date in the form 12/25/88 or 12-25-1988.' );
    END SetPrompts;


  PROCEDURE FilledAssign( s1: ARRAY OF CHAR; VAR s2: ARRAY OF CHAR );
    VAR
      len : CARDINAL;
    BEGIN
      LowLevel.Fill( SYSTEM.ADR(s2), HIGH(s2) + 1, 0C );
      len := M2Strings.Length( s1 );
      IF len <= HIGH(s2) THEN
        LowLevel.Move( SYSTEM.ADR(s1), SYSTEM.ADR(s2), len );
      ELSE
        M2Strings.Assign( s1, s2 );
      END;
    END FilledAssign;


  PROCEDURE InitTableIfNecessary();
    (* We can't call this in the module's initialization block
       because it does dynamic memory allocation, and Repertoire
       doesn't know where dynamic memory comes from until after
       the initialization sequence is over. *)
    VAR
      TmpTypeName: ARRAY [0..15] OF CHAR;
    BEGIN
      IF TableInitialized THEN
        RETURN;
      END;
      TableInitialized := TRUE;
      Hash.Define( FieldTypeCodes, 10, CharConstSize );
      FilledAssign( gotoConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'J' );
      FilledAssign( stringConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'S' );
      FilledAssign( integerConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'I' );
      FilledAssign( realConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'R' );
      FilledAssign( groupConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'C' );
      FilledAssign( choiceConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'C' );
      FilledAssign( editorConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'E' );
      FilledAssign( displayConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'D' );
      FilledAssign( displayonlyConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'D' );
      FilledAssign( dateConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'T' );
      FilledAssign( booleanConst, TmpTypeName );
      Hash.Insert( FieldTypeCodes, TmpTypeName, 'B' );
      IF NOT VStorage.AllocMem( TableHandle, SYSTEM.TSIZE(APromptTable) ) THEN
      END;
      TablePointer := VStorage.LockMem( TableHandle );
      LowLevel.Fill( TablePointer, SYSTEM.TSIZE(APromptTable), 0C );
      VStorage.UnLockMem( TableHandle );
      GenLists.NewList( PromptList );
      SetPrompts();
      ErrorManager.AddTermProc( DisposeTable );
    END InitTableIfNecessary;


  PROCEDURE TypeCode( TypeName:
      ARRAY OF CHAR ): CHAR;
    VAR
      TmpTypeName: ARRAY [0..15] OF CHAR;
      tmpch : CHAR;
      hash1, hash2, hash3 : CARDINAL;
    BEGIN
      InitTableIfNecessary();
      FilledAssign( TypeName, TmpTypeName );

      (* We try to first spot the standard ones by simple string
         comparison for speed purposes. *)
      IF 0 = M2Strings.CompareStr( stringConst, TmpTypeName ) THEN
        RETURN 'S';
      ELSIF 0 = M2Strings.CompareStr( integerConst, TmpTypeName ) THEN
        RETURN 'I';
      ELSIF 0 = M2Strings.CompareStr( realConst, TmpTypeName ) THEN
        RETURN 'R';
      ELSIF 0 = M2Strings.CompareStr( editorConst, TmpTypeName ) THEN
        RETURN 'E';
      ELSIF 0 = M2Strings.CompareStr( dateConst, TmpTypeName ) THEN
        RETURN 'T';
      ELSIF 0 = M2Strings.CompareStr( gotoConst, TmpTypeName ) THEN
        RETURN 'J';
      ELSIF 0 = M2Strings.CompareStr( groupConst, TmpTypeName ) THEN
        RETURN 'C';
      ELSIF 0 = M2Strings.CompareStr( choiceConst, TmpTypeName ) THEN
        RETURN 'C';
      ELSIF 0 = M2Strings.CompareStr( displayConst, TmpTypeName ) THEN
        RETURN 'D';
      ELSIF 0 = M2Strings.CompareStr( displayonlyConst, TmpTypeName ) THEN
        RETURN 'D';
      ELSIF 0 = M2Strings.CompareStr( booleanConst, TmpTypeName ) THEN
        RETURN 'B';
      ELSIF Hash.KeyFind( FieldTypeCodes, TmpTypeName ) THEN
        Hash.GetData( FieldTypeCodes, tmpch );
      ELSE
        Hash.Compute( TmpTypeName, hash1, hash2, hash3 );
        IF Numbers.CardIsBetween( ORD('['), hash2, 255 ) THEN
          tmpch := CHR( hash2 );
        ELSE
          tmpch := CHR( (hash2 MOD (255 - 91)) + 91 );
            (*Force value into range 91 to 255.*)
        END;
        Hash.Insert( FieldTypeCodes, TmpTypeName, tmpch );
      END;
      RETURN tmpch;
    END TypeCode;


  PROCEDURE SetDefaultPrompt( TypeName: ARRAY OF CHAR;
      TheStr: ARRAY OF CHAR );
    VAR
      OrdOfType: CARDINAL;
    BEGIN
      InitTableIfNecessary();
      StrEdit.CAPstr( TypeName );
      TablePointer := VStorage.LockMem( TableHandle );
      OrdOfType := ORD( TypeCode(  TypeName ) );
      VStorage.UnLockMem( TableHandle );
      IF TablePointer^[ OrdOfType ] = 0 THEN
        GenLists.ListInsert( TheStr, GenLists.StrCode,
            PromptList, AfterLast );
        TablePointer := VStorage.LockMem( TableHandle );
        TablePointer^[ OrdOfType ] := GenLists.ListLength( PromptList );
        VStorage.UnLockMem( TableHandle );
      ELSE
        TablePointer := VStorage.LockMem( TableHandle );
        GenLists.ListReplace( TheStr, GenLists.StrCode,
            PromptList, TablePointer^[ OrdOfType ] );
        VStorage.UnLockMem( TableHandle );
      END;
    END SetDefaultPrompt;


  PROCEDURE GetDefaultPrompt( TypeCode: CHAR; VAR TheStr: ARRAY
      OF CHAR );
    VAR
      DumType, ListSpot : CARDINAL;
    BEGIN
      InitTableIfNecessary();
      StrEdit.SetLength( TheStr, 0 );
      TablePointer := VStorage.LockMem( TableHandle );
      VStorage.UnLockMem( TableHandle );
      ListSpot := TablePointer^[ ORD(TypeCode) ];
      IF ListSpot = 0 THEN
        RETURN;
      END;
      GenLists.GetElmt( PromptList, ListSpot, TheStr, DumType );
    END GetDefaultPrompt;


  PROCEDURE GetCharConstSize(theChar: ARRAY OF CHAR): CARDINAL;
  (* We don't know how many bytes a character constant really
     occupies.  Stony Brook now has an implicit null at the end
     of a char const.  JPI doesn't. *)
  BEGIN
    RETURN HIGH(theChar) + 1;
  END GetCharConstSize;


  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
(*EntryDiag:
      Diagnostics.Init();
:EntryDiag*)

      Hash.Init();
      GenLists.Init();
      LowLevel.Init();
      M2Strings.Init();
      Numbers.Init();
      ScrnTypes.Init();
      StrConv.Init();
      StrEdit.Init();
      ErrorManager.Init();
      VStorage.Init();
(*EntryDiag:
      Diagnostics.diagS( 'Entering FieldTypes', '' );
:EntryDiag*)

      CharConstSize := GetCharConstSize('A');
      TableInitialized := FALSE;
      GenLists.NilList( PromptList );
      VStorage.NilHandle( TableHandle );
      TablePointer := NIL;

(*EntryDiag:
      Diagnostics.diagS( 'Exiting FieldTypes', '' );
:EntryDiag*)
    END Init;

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