Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/keytrnchr.bli
There are 10 other files named keytrnchr.bli in the archive. Click here to see a list.
 %TITLE 'KEYTRNCHR - translate keypad key'
MODULE KEYTRNCHR (				! Translate keypad key
		IDENT = '3-002'			! File: KEYTRNCHR.BLI Edit: GB3002
		) =
BEGIN
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1988.  ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ONLY
!IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION OF 
!THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY OTHER COPIES THEREOF MAY 
!NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO TITLE
!TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE AND 
!SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
!SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Translate keypad key.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: April 7, 1979
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 24-Feb-1981.  This module was created by
!	extracting routine EDT$$TRN_KPADK  from module KEYTRAN.
! 1-002	- Regularize headers.  JBS 10-Mar-1981
! 1-003	- Add return values.  JBS 02-Oct-1981
! 1-004	- New implementation of defined keys.  JBS 13-Aug-1982
! 1-005	- Add conditional for VT220 support.  JBS 11-Feb-1983
! 3-001 - Treat KEYPAD as character string not a byte vector.  GB 08-Mar-1983
! 3-002 - Add updates from v3 sources.  GB-29-Apr-1983
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$TRN_KPADK;				! Translate a keypad key

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

LIBRARY 'EDTSRC:KEYPADDEF';

LIBRARY 'EDTSRC:TRANSLATE';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!+
! The following table is searched to find the meaning of
! any keypad key.  The ordinal position in the table
! corresponds to the definitions for special keypad keys.
!-

BIND
    KEY_PAD = UPLIT ('pqrstuvwxyQRABCDnSmlPM');

!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$TRN_KPADK  - translate a keypad key'

GLOBAL ROUTINE EDT$$TRN_KPADK (			! Translate a keypad key
	C					! Where to store the translation
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called when an escape character has been seen, the escape
!	sequence is read up to the terminator, and, if it is a sequence generated
!	by a keypad key, the numeric value for that key is returned, otherwise,
!	the terminator character is returned.
!
! FORMAL PARAMETERS:
!
!  C			The address of a fullword to receive the translated character.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	1 = ok, 0 = end of journal file
!
! SIDE EFFECTS:
!
!	Calls EDT$$TI_INPCH  to read from the keyboard.
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$TI_INPCH;

    EXTERNAL
	CHAR_INFO : BLOCKVECTOR [256, 1,];	! Information about characters

    LOCAL
	MY_C,
	K_PTR,
	FUN_VAL;

    FUN_VAL = 0;

!+
! Keep reading characters as long as they are intermediate characters of
! VT52 or VT100 keypad sequences.
!-

    DO
	BEGIN

	IF (EDT$$TI_INPCH (MY_C) EQL 0) THEN RETURN (0);

	IF .CHAR_INFO [.MY_C, CI_DIG]
	THEN
	    BEGIN
!+
! Accumulate a number.
!-
	    FUN_VAL = .FUN_VAL*10;
	    FUN_VAL = .FUN_VAL + (.MY_C - %C'0');

	    IF (.FUN_VAL GTR K_MAX_FUN_VAL) THEN FUN_VAL = 0;

	    END;

	END
    UNTIL ((.MY_C NEQ %C'?') AND
	   (.MY_C NEQ %C'O') AND
	   (.MY_C NEQ %C'[') AND
	   (NOT .CHAR_INFO [.MY_C, CI_DIG]));

!+
! If this is a function key, we know the value from the number accumulated.
!-

    IF (.MY_C EQL %C'~')
    THEN
	MY_C = K_FUN_BASE + .FUN_VAL
    ELSE
	BEGIN

!+
! Not a function key, search our table of keypad sequence terminators.
!-

	K_PTR = CH$PTR (KEY_PAD);

	INCR I FROM 0 TO 21 DO

	    IF (.MY_C EQL CH$RCHAR_A (K_PTR))
	    THEN
		BEGIN
!+
! The terminator was found, return it's equivalent.
!-
		MY_C = K_KPAD_BASE + .I;
		EXITLOOP;
		END;

	END;

!+
! Return the coded character.
!-
    .C = .MY_C;
    RETURN (1);
    END;					! of routine EDT$$TRN_KPADK

!<BLF/PAGE>
END						! of module EDT$KEYTRNCHR

ELUDOM