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 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 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.