From:	CSBVAX::MRGATE!JSOTTILE%LOYVAX.BITNET@CUNYVM.CUNY.EDU@SMTP 16-FEB-1988 06:14
To:	ARISIA::EVERHART
Subj:	Alex Woo's Question on INKEY operation in PASCAL


Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Fri 12 Feb 88 09:47:38-PST
Received: from LOYVAX.BITNET by CUNYVM.CUNY.EDU ; Fri, 12 Feb 88 12:47:44 EST
Date:     Fri, 12 Feb 88 12:46 EST
From:     <JSOTTILE%LOYVAX.BITNET@CUNYVM.CUNY.EDU>
Subject:  Alex Woo's Question on INKEY operation in PASCAL
To:       info-vax@kl.sri.com
X-Original-To:  info-vax@kl.sri.com, JSOTTILE

>Can someone send me a VMS routine (preferably PASCAL) which
>acts like the BASIC routine INKEY?  I just want to know if
>a key as been depressed, and what character or arrow or
>function key?
>
>Alex Woo
>
>P.S.  Don't blame me for this, I'm asking for a friend.
>
Alex, here's a few routines I wrote a while ago.  try them, no flames, please,
just CONSTRUCTIVE CRITICISM.

- John Sottile
Student Systems Programmer
Loyola College in Maryland
(jsottile@loyvax.bitnet)
-----------------------------[CUT HERE]----------------------------------------
[inherit ('SYS$LIBRARY:STARLET')]

MODULE user (input, output);

{ The following routines have been compiled for use by the users at
  large for Loyola College.  Such routines can be used in any language
  that has the following data types :

         Character Data
         String Data (whether Absolute or Varying String of Characters)

  A small documentation should be included instructing the user of how
  to call these routines.  Each language will have to call it differently.
  Because of this, the exact calling syntax should be looked up in the
  LANGUAGE REFERENCE MANUAL for that particular language. }

CONST
  term            = 'TT:';        { The current terminal }
  blank           = ' ';          { Just for Readability }
  username_length =  15;          { Actually, it's 12, but just in case }
  jpi_username    = 514;          { The SYS$JPI code for getting the Username }

TYPE
 username_type   = VARYING [username_length] OF char; { This is Non-Standard,
                                                        But then again, so is
                                                        this whole module }

  unsigned_word  = [word] 0..65535;

{ ** Our Status Block is Defined Next                              ** }

  $uquad         = [quad,unsafe] RECORD
                                   l0,
                                   l1 : unsigned
                                 END;

  { ** The following RECORD Matches exactly (Bit for Bit) with the
       VAX/VMS 4.1 System Services Manual                          ** }

  item_list_type = [ byte(12) ]  RECORD
                                   return_len : [pos(0)] unsigned_word;
                                   itm_code   : [pos(16)] unsigned_word;
                                   username   : [pos(32),unsafe] ^username_type;
                                   user_len   : [pos(64),unsafe] ^unsigned
                                 END;









[global]

FUNCTION getkey : char;

{ *********************************************************

Programmers: Kevin Rittie
             John  Sottile

  This FUNCTION will read a single key from the keyboard and return
  it without and type of string terminator.  This routine will wait
  for the key to be hit.

************************************************************}

VAR
  status  : integer;
  ch      : integer;
  channel : integer;


BEGIN {getkey}
  ch     := 0;
  status := $assign(term,%ref channel,,);             { We need the channel
                                                        number of the Terminal }
  status := $qiow(,channel,io$_readvblk,,,,ch,1,,,,); { Get a key, put it in CH}
  status := $dassgn(channel);                         { We're done with the
                                                        channel}
  getkey := chr (ch)                                  { Return the character }
END; {getkey}








[global]

FUNCTION inkey : char;

{ *********************************************************

Programmers: Kevin Rittie
             John  Sottile

  This FUNCTION will read a single key from the keyboard and return
  it without any type of string terminator.  This routine will check
  the buffer for a key.  If no key has been hit, a null character is
  passed back.

************************************************************}

VAR
  status  : integer;
  ch      : integer;
  channel : integer;

BEGIN {inkey}
  ch     := 0;                                         { We don't have a key }
  status := $assign(term,%ref channel,,);              { Get terminal channel }
  status := $qio(,channel,io$_readvblk,,,,ch,1,,,,);   { Check for a key }
  status := $dassgn(channel);                          { We're done }
  inkey  := chr (ch)                                   { Return the character }
END; {inkey}








PROCEDURE get_user (VAR return_username : username_type);

{ *********************************************************

Programmer : John  Sottile

  This Routine will get the username of the current process
  working at this terminal.  This routine can be used for
  such things as accounting information on public programs or
  a "Friendly" way to keep Nicknames from appearing in
  programs which require a Name.  Each username is unique from
  the other.  All characters which cannot be processed by a
  language (like NUL) are taken out, and letters are capitalized
  to give it a better appearance.

************************************************************}

VAR
  i,
  status   : integer;
  item_list : item_list_type;

[asynchronous,external (sys$getjpi)]

FUNCTION $getjpi (%immed efn      : integer := %immed 0;
                  pidadr          : integer := %immed 0;
                  prcnam          : [class_s] PACKED ARRAY [$l3..$u3:integer]
                                              OF char := %immed 0;
                  VAR itmlst      : item_list_type;
                  VAR iosb        : [volatile]$uquad  := %immed 0;
                  %immed [unbound,asynchronous]
                                    procedure astadr  := %immed 0;
                  %immed astprm   : unsigned          := %immed 0;
                  %immed reserved : unsigned          := %immed 0) : integer;
                                                                  EXTERNAL;

BEGIN {get_user}
  new (item_list.username);                  { Find a Place to Put it }
  item_list.return_len := username_length;   { How long? }
  item_list.itm_code := jpi_username;        { We want the username }
  status := $getjpi(itmlst := item_list);    { Call System Services }
  FOR i := 1 TO username_length DO           { Remove Non-standard Characters}
    IF NOT (item_list.username^ [i] IN ['A'..'Z','_','0'..'9']) THEN
      item_list.username^ [i] := blank;
  return_username := item_list.username^     { Pass back the username }
END; {get_user}
END.

