Topspeed_JPI/TS/REP16/USEROPS.MOD

IMPLEMENTATION MODULE UserOps;
(*
 *  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/userops.mov   1.7   10 Mar 1991 15:34:08   coleb  $
 *
 *)


(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)

IMPORT BigSets;
IMPORT ByteFiddler;
IMPORT ControlUtils;
IMPORT DateFunctions;
IMPORT Editor;
IMPORT ErrorManager;
IMPORT FieldTypes;
IMPORT FramePainter;
IMPORT GenLists;
IMPORT Hash;
IMPORT InputManager;
IMPORT KbdInput;
IMPORT Key;
IMPORT ListUtils;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT MsgBox2;
IMPORT Numbers;
IMPORT NumInput;
IMPORT NumTypes;
IMPORT PosUtils;
IMPORT ScrnTypes;
IMPORT ScrnUtl1;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT StrInput;
IMPORT SYSTEM;
IMPORT VEditor;
IMPORT VStorage;
IMPORT VWindows;

VAR
  Initialized : BOOLEAN;

  PROCEDURE ShowMemory( TheFrame: ScrnTypes.DisplayFrame );
    VAR
      tmpstr: ARRAY [0..31] OF CHAR;
      msgstr: ARRAY [0..127] OF CHAR;
    BEGIN
      msgstr[0] := 0C;
      IF VStorage.UsingEms() THEN
        StrEdit.Append( msgstr,
            'Expanded memory now available (in bytes): ' );
        StrConv.LongIntegerToStr( VStorage.AvailMem(), 0, tmpstr );
        StrEdit.Append( msgstr, tmpstr );
        StrEdit.Append( msgstr, '.  ' );
      ELSE
        msgstr := 'Expanded memory not in use.  ';
      END;
      StrEdit.Append(msgstr, 'Stack available: ' );
      StrConv.CardinalToStr(LowLevel.ofs(SYSTEM.ADR(msgstr))-127, 0, tmpstr);
      StrEdit.Append(msgstr, tmpstr);
      MsgBox2.StrMsgBoxExterior( TheFrame, VWindows.NE, msgstr );
    END ShowMemory;


CONST
  OldFunction = "Non-numeric frame name used with old function";
  ExitMessage =
    'You pressed the function key that terminates the program. Please confirm.';


  PROCEDURE BetweenLongs( TheTxt: ARRAY OF CHAR; LoLong, HiLong: LONGINT) :
      BOOLEAN;
    VAR
      lvalue: LONGINT;
    BEGIN
      IF NOT StrConv.StrToLongInteger( TheTxt, 0, lvalue) THEN
        (*StrToLongInteger skips over leading non-numeric
          characters.*)
        RETURN FALSE;
      END;
      RETURN (lvalue >= LoLong) AND (lvalue <= HiLong);
    END BetweenLongs;


  PROCEDURE BetweenReals( TheTxt: ARRAY OF CHAR; LoReal, HiReal:
      NumTypes.Real8) : BOOLEAN;
    VAR
      rvalue: NumTypes.Real8;
    BEGIN
      IF NOT StrConv.StrToReal( TheTxt, 0, rvalue) THEN
        (*StrToReal skips over leading non-numeric
          characters.*)
        RETURN FALSE;
      END;
      RETURN (rvalue >= LoReal) AND (rvalue <= HiReal)
    END BetweenReals;


  PROCEDURE DefaultKeyHandler( FrameRec : ScrnTypes.DisplayFrame;
      VAR LastKey: CARDINAL; VAR NextFrame: ScrnTypes.AFrameName
      );
    VAR
      SavedKeyValue, keyhit: CARDINAL;
      FieldRec: ScrnTypes.InputFieldRecord;
      BlankFrame : BOOLEAN;
      HelpFrame: ScrnTypes.AFrameName;
    BEGIN
      StrEdit.AssignStr( ScrnTypes.ContinueInput, NextFrame );
      BlankFrame := ScrnUtl1.FieldGroupTotal( FrameRec ) = 0;
      IF NOT BlankFrame THEN
        ScrnUtl1.GetFieldRec( FrameRec, FrameRec^.CurrentField, FieldRec );
      END;
      IF LastKey = HelpKey THEN
        IF (NOT BlankFrame) AND
            (M2Strings.Length(FieldRec.HelpFrame) > 0) THEN
          M2Strings.Assign( FieldRec.HelpFrame, HelpFrame );
          ControlUtils.FrameSeq2( FrameRec^.FromFile,
              FrameRec^.ThisFrame, HelpFrame );
        ELSIF M2Strings.Length(FrameRec^.HelpFrame) > 0 THEN
          M2Strings.Assign( FrameRec^.HelpFrame, HelpFrame );
          ControlUtils.FrameSeq2( FrameRec^.FromFile,
              FrameRec^.ThisFrame, HelpFrame );
        ELSIF NOT ListUtils.IsBlankList(FrameRec^.HelpList) THEN
          MsgBox2.LstMsgBoxExterior( FrameRec, VWindows.NW,
              FrameRec^.HelpList );
        END;
        InputManager.LookAlive( FrameRec );
          (* Restores pointer bar, correct prompt, highlighting,
             etc., in case the input focus went somewhere else
             during the help sequence. *)
        LastKey := 0;
          (*We don't want ControlFrame to do anything else with
            this keystroke.  We just want it to keep going.*)
      ELSIF LastKey = TimeKey THEN
        SavedKeyValue := LastKey;
        TimeKey := 65535;
          (*Disable MemoryKey while in the MemAvail box itself.*)
        ShowMemory( FrameRec );
        TimeKey := SavedKeyValue;
        LastKey := 0;
      ELSIF LastKey = BackupKey THEN
        M2Strings.Assign( FrameRec^.parent, NextFrame );
      ELSIF LastKey = SubmitKey THEN
        IF NOT BlankFrame THEN
          IF FieldRec.typ = ScrnTypes.GotoCode THEN
            M2Strings.Assign( FieldRec.ReturnVal, NextFrame );
          ELSE
            M2Strings.Assign( FrameRec^.normlnext, NextFrame );
          END;
        ELSE
          M2Strings.Assign( FrameRec^.normlnext, NextFrame );
        END;
      ELSIF LastKey = ExitKey THEN
        SavedKeyValue := ExitKey;
        ExitKey := 65535;
          (* Disables ExitKey while user is in the ExitKey
             message box itself. *)
        IF MsgBox2.MsgOkay( FrameRec, VWindows.SW, ExitMessage ) THEN
          ErrorManager.CallHalt('');
(*
  Logitech users
  may want to do
  this instead of
  StraitToDOS if
  it's important
  that Logitech
  TermProcs get
  executed before
  returning to DOS.
          ErrorManager.DoTermProcs();
          RTSMain.Terminate(RTSMain.Normal);
*)
        END;
        InputManager.LookAlive( FrameRec );
        ExitKey := SavedKeyValue;
        LastKey := 0;
      END;
    END DefaultKeyHandler;


  PROCEDURE DefaultFieldHandler( FrameRec :
      ScrnTypes.DisplayFrame; col1, row1: CARDINAL; VAR LastKey :
      CARDINAL; VAR NextFrame: ScrnTypes.AFrameName );
    VAR
      ChangeCheck1, ChangeCheck2, ChangeCheck3, Check1, Check2,
          Check3, keyhit, CursorPos, width, spot: CARDINAL;
      ok, done, InDecimals: BOOLEAN;
      LocalNextFrame: ScrnTypes.AFrameName;
      TmpLegalKeys, InterestingKeys: KbdInput.KeyNumSet;
      FieldRec : ScrnTypes.InputFieldRecord;
      ImageRec : ScrnTypes.ImageElement;
      TheList : GenLists.GenList;
      date : DateFunctions.Date;
      EdRec : VEditor.AnEdControlRec;
      minusOK : BOOLEAN;

    BEGIN
      ScrnUtl1.GetFieldRec( FrameRec, FrameRec^.CurrentField, FieldRec );
      ScrnUtl1.GetFieldImageRec( FrameRec, FrameRec^.CurrentField, ImageRec );
      Hash.Compute( ImageRec.text, ChangeCheck1, ChangeCheck2, ChangeCheck3 );
      width := M2Strings.Length(ImageRec.text);
      InDecimals := FALSE;
      CursorPos := 0;
      BigSets.SetUnion( FieldExitKeySet, FunctKeySet, InterestingKeys );
      ScrnUtl1.SetPointerBarColors( FrameRec );

      IF FieldRec.typ = FieldTypes.TypeCode( 'STRING' ) THEN
        TmpLegalKeys := StringKeySet;
          (* If you want to change which keys are legal in
             particular kinds of string fields, insert code here
             that looks for the field type or the name of the field you're
             interested in changing, and modify TmpLegalKeys with
             routines from BigSets if you find it. *)
        REPEAT
          ScrnUtl1.SetPointerBarColors( FrameRec );
          StrInput.ReadWithEdits( FrameRec^.WindowHandle,
              ImageRec.text, col1, row1, width, CursorPos,
              InsertMode, TRUE, LastKey, TmpLegalKeys,
              InterestingKeys );

            (* This is where you insert field validation code.
               It's also where you put code to update a frame
               dynamically as the user completes certain fields--
               use ChangeField, RedrawField, or RedrawArea to do
               the latter.*)

          ScrnUtl1.PutFieldImageRec( ImageRec, FrameRec,
              FrameRec^.CurrentField );
            (*Updates ImageList so that present state of the
              string will be visible in TheKeyHandler.*)
          TheKeyHandler( FrameRec, LastKey, LocalNextFrame );
        UNTIL BigSets.InSet(FieldExitKeySet, LastKey);

      ELSIF FieldRec.typ = FieldTypes.TypeCode(  'INTEGER' ) THEN
        done := FALSE;
        REPEAT
          ScrnUtl1.SetPointerBarColors( FrameRec );
          (* Distinguish bewteen integers and cardinals based on iMin *)
          IF FieldRec.iMin < NumTypes.L0 THEN (* JDM/MBC *)
            minusOK := TRUE;                  (* JDM/MBC *)
          ELSE                                (* JDM/MBC *)
            minusOK := FALSE;                 (* JDM/MBC *)
          END; (* if FieldRec.iMin *)         (* JDM/MBC *)
          NumInput.ReadNumericField( FrameRec^.WindowHandle,
              ImageRec.text, col1, row1, width, 0, minusOK,
              LastKey, InterestingKeys );  (* JDM/MBC  *)
            (* The user can't tell that we're exiting and re-
               entering ReadNumeric every time she presses one of
               the InterestingKeys. *)
          ScrnUtl1.PutFieldImageRec( ImageRec, FrameRec,
              FrameRec^.CurrentField );
          TheKeyHandler( FrameRec, LastKey, LocalNextFrame );
          IF BigSets.InSet(FieldExitKeySet, LastKey) THEN
            IF (LastKey = ExitKey) OR (LastKey = BackupKey) THEN
              done := TRUE;
            ELSE
              done := PosUtils.IsBlank(ImageRec.text) OR
                 BetweenLongs( ImageRec.text, FieldRec.iMin,
                 FieldRec.iMax );
              IF NOT done THEN
                MsgBox2.StrMsgBox( FrameRec, VWindows.NE,
                    "Entry out of range.  Press <Enter> to continue." );
              END;
            END;
          END;
        UNTIL done;

      ELSIF FieldRec.typ = FieldTypes.TypeCode( 'REAL' ) THEN
        done := FALSE;
        REPEAT
          ScrnUtl1.SetPointerBarColors( FrameRec );
          (* As with integers, range determines whether minus allowed *)
          IF FieldRec.rMin < 0.  THEN           (* JDM/MBC *)
            minusOK := TRUE;                    (* JDM/MBC *)
          ELSE                                  (* JDM/MBC *)
            minusOK := FALSE;                   (* JDM/MBC *)
          END; (* if FieldRec.rMin *)           (* JDM/MBC *)
          NumInput.ReadNumericField( FrameRec^.WindowHandle,
              ImageRec.text, col1, row1, width, FieldRec.decimalPlace,
              minusOK, LastKey, InterestingKeys );    (* JDM/MBC *)
          ScrnUtl1.PutFieldImageRec( ImageRec, FrameRec,
              FrameRec^.CurrentField );
          TheKeyHandler( FrameRec, LastKey, LocalNextFrame );
          IF BigSets.InSet(FieldExitKeySet, LastKey) THEN
            IF (LastKey = ExitKey) OR (LastKey = BackupKey) THEN
              done := TRUE;
            ELSE
              done := PosUtils.IsBlank(ImageRec.text) OR
                 BetweenReals( ImageRec.text, FieldRec.rMin,
                 FieldRec.rMax );
              IF NOT done THEN
                MsgBox2.StrMsgBox( FrameRec, VWindows.NE,
                    "Entry out of range.  Press <Enter> to continue." );
              END;
            END;
          END;
        UNTIL done;

      ELSIF FieldRec.typ = FieldTypes.TypeCode( 'DATE' ) THEN
        TmpLegalKeys := StringKeySet;
        LOOP
          StrInput.ReadWithEdits( FrameRec^.WindowHandle,
              ImageRec.text, col1, row1, width, CursorPos,
              InsertMode, TRUE, LastKey, TmpLegalKeys,
              InterestingKeys );

          ScrnUtl1.PutFieldImageRec( ImageRec, FrameRec,
              FrameRec^.CurrentField );
          TheKeyHandler( FrameRec, LastKey, LocalNextFrame );
          IF BigSets.InSet(FieldExitKeySet, LastKey) THEN
            IF PosUtils.IsBlank(ImageRec.text) THEN
              EXIT;
            END;
            DateFunctions.StrToDate(ImageRec.text, date, ok);
            IF ok OR (LastKey = BackupKey) THEN
              EXIT;
            END;
            MsgBox2.StrMsgBox( FrameRec, VWindows.NE,
                    "Invalid Date.  Press any key." );
          END;
        END (*loop *);

      ELSIF FieldRec.typ = FieldTypes.TypeCode( 'BOOLEAN' ) THEN
        LOOP
          LastKey := KbdInput.KeyHit( KbdInput.AnyKeyNum );
          IF (LastKey = Key.Space) OR (LastKey = Key.Return) THEN
            FieldRec.selected:= NOT FieldRec.selected;
            IF width # 0 THEN
              IF FieldRec.selected THEN
                ImageRec.text[0]:=CHR(251);(* û *)
              ELSE
                ImageRec.text[0]:=' '
              END;
            END;
            ScrnUtl1.PutFieldRec( FieldRec, FrameRec,
               FrameRec^.CurrentField );
            ScrnUtl1.PutFieldImageRec( ImageRec, FrameRec,
                FrameRec^.CurrentField );
            FramePainter.RedrawField(FrameRec,FrameRec^.CurrentField,TRUE);
          END;
          TheKeyHandler( FrameRec, LastKey, LocalNextFrame );
          IF BigSets.InSet(FieldExitKeySet, LastKey) THEN
            EXIT;
          END;
        END (*loop *);

      ELSIF FieldRec.typ = FieldTypes.TypeCode( 'EDITOR' ) THEN
        ScrnUtl1.GetEdRec( FrameRec, FrameRec^.CurrentField, TheList, EdRec );
        EdRec.overwriting := NOT InsertMode;
        VEditor.TheEditor( TheList, EdRec );
        ScrnUtl1.PutEdRec( FrameRec, FrameRec^.CurrentField, TheList, EdRec );
        M2Strings.Assign( EdRec.NextFrame, NextFrame );
        InsertMode := NOT EdRec.overwriting;
        LastKey := EdRec.EdLastKey;
        RETURN;

      ELSE
        ErrorManager.WARN( 'Unexpected field type entered' );
      END;

      Hash.Compute( ImageRec.text, Check1, Check2, Check3 );
      IF (ChangeCheck1 # Check1) OR (ChangeCheck2 # Check2)
          OR (ChangeCheck3 # Check3) THEN
        FieldRec.ChangeMade := TRUE;
      END;
      ScrnUtl1.PutFieldRec( FieldRec, FrameRec,
          FrameRec^.CurrentField );

      M2Strings.Assign( LocalNextFrame, NextFrame );
    END DefaultFieldHandler;


  PROCEDURE DoFunctions( FrameRec : ScrnTypes.DisplayFrame; VAR LastKey:
      CARDINAL ) : INTEGER;
    VAR
      NextFrame: ScrnTypes.AFrameName;
      tmpint: INTEGER;
    BEGIN
      NextFrame := '';
      DefaultKeyHandler( FrameRec, LastKey, NextFrame );
      IF PosUtils.Equal( NextFrame, ScrnTypes.ContinueInput ) THEN
        tmpint := ContinueCode;
      ELSIF NOT StrConv.StrToInteger( NextFrame, 0, tmpint ) THEN
        ErrorManager.WARN( OldFunction );
      END;
      RETURN tmpint;
    END DoFunctions;


  PROCEDURE DoFieldInput( FrameRec : ScrnTypes.DisplayFrame; col1, row1:
      CARDINAL; VAR LastKey : CARDINAL ) : INTEGER;
    VAR
      NextFrame: ScrnTypes.AFrameName;
      tmpint: INTEGER;
    BEGIN
      NextFrame := '';
      DefaultFieldHandler( FrameRec, col1, row1,
          LastKey, NextFrame );
      IF PosUtils.Equal( NextFrame, ScrnTypes.ContinueInput ) THEN
        tmpint := ContinueCode;
      ELSIF NOT StrConv.StrToInteger( NextFrame, 0, tmpint ) THEN
        ErrorManager.WARN( OldFunction );
      END;
      RETURN tmpint;
    END DoFieldInput;

(*
  PROCEDURE OldKeyHandler( FrameRec : ScrnTypes.DisplayFrame; VAR
      LastKey: CARDINAL; VAR NextFrame: ScrnTypes.AFrameName );
    (*If you want to continue using procedures that you assigned
      to the Release 1.4 version of TheFunctProc, assign this
      procedure to TheKeyHandler.*)
    VAR
      tmpint: ScrnTypes.FrameKey;
    BEGIN
      tmpint := TheFunctProc( FrameRec, LastKey );
      IF tmpint = ContinueCode THEN
        StrEdit.AssignStr( ScrnTypes.ContinueInput, NextFrame );
      ELSE
        StrConv.IntegerToStr( tmpint, 0, NextFrame );
      END;
    END OldKeyHandler;

  PROCEDURE OldFieldHandler( FrameRec : ScrnTypes.DisplayFrame;
      col1, row1: CARDINAL; VAR LastKey : CARDINAL; VAR
      NextFrame: ScrnTypes.AFrameName );
    (*If you want to continue using procedures that you assigned
      to the Release 1.4 version of TheFieldProc, assign this
      procedure to TheFieldHandler.*)
    VAR
      tmpint: ScrnTypes.FrameKey;
    BEGIN
      tmpint := TheFieldProc( FrameRec, col1, row1, LastKey );
      IF tmpint = ContinueCode THEN
        StrEdit.AssignStr( ScrnTypes.ContinueInput, NextFrame );
      ELSE
        StrConv.IntegerToStr( tmpint, 0, NextFrame );
      END;
    END OldFieldHandler;
*)

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

      BigSets.Init();
      ByteFiddler.Init();
      ControlUtils.Init();
      DateFunctions.Init();
      Editor.Init();
      ErrorManager.Init();
      FieldTypes.Init();
      FramePainter.Init();
      GenLists.Init();
      Hash.Init();
      InputManager.Init();
      KbdInput.Init();
      Key.Init();
      ListUtils.Init();
      LowLevel.Init();
      M2Strings.Init();
      MsgBox2.Init();
      Numbers.Init();
      NumInput.Init();
      NumTypes.Init();
      PosUtils.Init();
      ScrnTypes.Init();
      ScrnUtl1.Init();
      StrConv.Init();
      StrEdit.Init();
      StrInput.Init();
      VEditor.Init();
      VStorage.Init();
      VWindows.Init();

(*EntryDiag:
      Diagnostics.diagS( 'Entering UserOps', '' );
:EntryDiag*)

      VEditor.TheEditor := Editor.DefaultEditor;
      Exiting := FALSE;
      InsertMode := FALSE;

      DoPrompting := TRUE;
        (* whether or not to use prompts *)
      PromptRow := VWindows.EndRow(VWindows.CurrentWindow) - 1;
      PromptCol := 2;
        (* the screen row and column to show prompts if they are used *)
      PromptLength := VWindows.EndCol(VWindows.CurrentWindow) - 2;
        (* the maximum length of prompts used.  *)

      TheKeyHandler := DefaultKeyHandler;
      TheFieldHandler := DefaultFieldHandler;
        (* The routine that processes function keys in
           ControlFrame; see OldKeyHandler and OldFieldHandler,
           above, if you are having problems with upgrading 1.4
           code. *)

      TheFieldProc := DoFieldInput;
      TheFunctProc := DoFunctions;

      (* Now, define valid keys for function, screen actions,
         and string fields *)

      BigSets.InitSet( FunctKeySet );
      BigSets.AppendSet( FunctKeySet, "{27, 315, 316, 317, 324}" );
        (* extra keys we define as valid: ESC, F1, F2, F9, F10 *)

      BigSets.InitSet( ScreenKeySet );
        (* These are the keys that are legal when the pointer is
           not in an input field -- i.e., when it's in a choice
           field or goto field.  ScreenInput.ControlFrame adds to
           it the FunctKeySet and the selection characters for each
           frame. *)
      BigSets.AppendSet( ScreenKeySet,
          "{13, 9, 271, 328, 336, 329, 331, 333, 337, 374, 388}" );
        (* CR, TAB, BTB, UARW, DARW, PGUP, RARW, LARW, PGDN, CtrlPgDn, CtrlPgUp *)
      FieldExitKeySet := ScreenKeySet;
      BigSets.AppendSet( FieldExitKeySet, "{27, 317, 324}" );

      BigSets.InitSet( StringKeySet );
      BigSets.AppendSet( StringKeySet, "{8, ' '..'~', 128..175, 224..253}" );
      BigSets.AppendSet( StringKeySet,
          "{274, 288, 338, 339, 327, 335, 371, 372}" );
        (* regular ASCII characters, foreign language characters,
           math characters, backspace, AltE, AltD, Ins, Del,
           Home, End, CTL arrows *)

      HelpKey := Key.F1;
      ExitKey := Key.F2;
      TimeKey := Key.F3;
      SubmitKey := Key.F10;
      BackupKey := Key.Escape;

(*EntryDiag:
      Diagnostics.diagS( 'Exiting UserOps', '' );
:EntryDiag*)

    END Init;


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