Google
 

Trailing-Edge - PDP-10 Archives - bb-r775d-bm_tops20_ks_upd_4 - 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) 1981, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		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 WHICH 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