language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/fieldedi.mod
IMPLEMENTATION MODULE FieldEditor;
(********************************************************)
(* *)
(* Screen editing utilities *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 21 February 1995 *)
(* Status: Seems to be OK *)
(* *)
(********************************************************)
FROM SYSTEM IMPORT
(* type *) BYTE;
FROM Storage1 IMPORT
(* proc *) ALLOCATE, DEALLOCATE;
FROM TerminationControl IMPORT
(* proc *) SetTerminationProcedure;
FROM NumericIO IMPORT
(* proc *) WriteHexByte, EditHexByte, WriteRJCard, EditCardinal;
FROM RealIO IMPORT
(* proc *) WriteReal, EditReal;
(************************************************************************)
TYPE
BytePtr = POINTER TO BYTE;
CardPtr = POINTER TO CARDINAL;
RealPtr = POINTER TO REAL;
FieldType = POINTER TO RECORD
FieldWriter: WriteProc;
FieldEditor: EditProc;
END (*RECORD*);
(************************************************************************)
(* SCREEN OUTPUT FOR THE PREDEFINED TYPES *)
(************************************************************************)
PROCEDURE WriteCardinalField (w: Window; address: CardPtr; width: CARDINAL);
BEGIN
WriteRJCard (w, address^, width);
END WriteCardinalField;
(************************************************************************)
PROCEDURE WriteByteField (w: Window; address: BytePtr; width: CARDINAL);
BEGIN
WriteHexByte (w, address^);
END WriteByteField;
(************************************************************************)
PROCEDURE WriteRealField (w: Window; address: RealPtr; width: CARDINAL);
BEGIN
WriteReal (w, address^, width);
END WriteRealField;
(************************************************************************)
(* EDITORS FOR THE PREDEFINED TYPES *)
(************************************************************************)
PROCEDURE EditByteField (w: Window; VAR (*INOUT*) address: BytePtr;
width: CARDINAL);
BEGIN
EditHexByte (w, address^);
END EditByteField;
(************************************************************************)
PROCEDURE EditCardinalField (w: Window; VAR (*INOUT*) address: CardPtr;
width: CARDINAL);
BEGIN
EditCardinal (w, address^, width);
END EditCardinalField;
(************************************************************************)
PROCEDURE EditRealField (w: Window; VAR (*INOUT*) address: RealPtr;
width: CARDINAL);
BEGIN
EditReal (w, address^, width);
END EditRealField;
(************************************************************************)
(* COMPARING TYPES *)
(************************************************************************)
PROCEDURE SameType (t1, t2: FieldType): BOOLEAN;
(* Returns TRUE iff t1 = t2. *)
BEGIN
RETURN t1 = t2;
END SameType;
(************************************************************************)
(* DEFINING A NEW TYPE *)
(************************************************************************)
PROCEDURE DefineFieldType (Writer: WriteProc; Editor: EditProc): FieldType;
(* Introduces a new field type into the system. Writer is a *)
(* user-supplied procedure to write a variable of the new type. *)
(* Editor is the user-supplied procedure for editing a variable of *)
(* that type. *)
VAR result: FieldType;
BEGIN
NEW (result);
WITH result^ DO
FieldWriter := Writer;
FieldEditor := Editor;
END (*WITH*);
RETURN result;
END DefineFieldType;
(************************************************************************)
PROCEDURE DiscardFieldType (type: FieldType);
(* A notification from the user that this type will not be used *)
(* again (unless it is redefined by another call to procedure *)
(* DefineFieldType). Use of this procedure is optional, but is *)
(* recommended for the sake of "clean" memory management. *)
BEGIN
DISPOSE (type);
END DiscardFieldType;
(************************************************************************)
(* SCREEN OUTPUT *)
(************************************************************************)
PROCEDURE WriteField (w: Window; address: ADDRESS; type: FieldType;
width: CARDINAL);
(* Writes address^ on the screen at the current cursor position in *)
(* window w. The width parameter specifies how many character *)
(* positions to use. Use width=0 for variable-width fields for *)
(* which the write procedure for that type must work out the width. *)
BEGIN
WITH type^ DO
FieldWriter (w, address, width);
END (*WITH*);
END WriteField;
(************************************************************************)
(* THE EDITOR *)
(************************************************************************)
PROCEDURE EditField (w: Window; VAR (*INOUT*) address: ADDRESS;
type: FieldType; width: CARDINAL);
(* Edits the variable at the given address, and of the given type, *)
(* at the current cursor position in window w. The width parameter *)
(* specifies how many character positions are to be used on the *)
(* screen. Set width=0 for variable-width fields where the editor *)
(* must determine the width. We leave this procedure on seeing a *)
(* keyboard character which does not belong to us. The cursor is *)
(* left just beyond the last character of the field as it is *)
(* displayed. The terminating keystroke is returned to the *)
(* keyboard driver so that it can still be read by the caller. *)
BEGIN
WITH type^ DO
FieldEditor (w, address, width);
END (*WITH*);
END EditField;
(************************************************************************)
(* SETTING UP THE PREDEFINED TYPES *)
(************************************************************************)
PROCEDURE FinalCleanup;
BEGIN
DiscardFieldType (Byte);
DiscardFieldType (Cardinal); DiscardFieldType (Real);
END FinalCleanup;
(************************************************************************)
BEGIN
Byte := DefineFieldType (WriteByteField, EditByteField);
Cardinal := DefineFieldType (WriteCardinalField, EditCardinalField);
Real := DefineFieldType (WriteRealField, EditRealField);
SetTerminationProcedure (FinalCleanup);
END FieldEditor.