Relay-Version: version nyu B notes v1.6.1 1/11/90; site acf3.NYU.EDU
From: 00mjstum@bsu-ucs.uucp (Matthew J. Stum)
Date: 18 Mar 91 05:19 EST
Date-Received: 19 Mar 91 11:59 EST
Subject: vax pascal
Message-ID: <1991Mar18.101944.150@bsu-ucs.uucp>
Path: acf3!cmcl2!cmcl2!yale!think.com!zaphod.mps.ohio-state.edu!caen!news.cs.indiana.edu!bsu-cs!bsu-ucs.uucp!00mjstum
Newsgroups: comp.os.vms
References: <1991Mar17.200353.10532@bronze.ucs.indiana.edu>
Lines: 201

In article <1991Mar17.200353.10532@bronze.ucs.indiana.edu>, sl243017@silver.ucs.indiana.edu (SSowder Utils) writes:
> Hello I am a Pc users that has been transplanted.  I am used to my
>                 While NOT keypress do;
> lines in turbo pascal.  Can someone mail me the equivilant in vax pascal?
> Thanks I just wish to have the computer wait until a key is pressed.
> -Sid

Below my sig is a sample program using the "GETKEY" procedures that I include
in most/all of my programs...

-- 
   .                  /                | Matt Stum
  . .                /                 | 00MJSTUM@BSUVAX1.BITNET
|/-\/-\ |/-\ |/-\   /    |/-\ |/-\/-\  | 00MJSTUM@bsu-ucs.bsu.edu
|  /  / |  / |  /   \__/ |  / |  /  /  |
        |    |           |             | Ball State University, Muncie IN USA
        |    |           |/\/          | VAX Systems Programmer


{
This is an example of implementing GETKEY in PASCAL.  The three procedures/
functions can be included in any VAX pascal program, provided that the necessary
declarations are made in the CONST, TYPE, and VAR sections (don't forget
the INHERIT statement).

Nothing special is required to compile and/or link this program.

NOTE: It might be of interest to use the following command to see more
about the SMG$ definitions used:  $ SEARCH SYS$LIBRARY:STARLET SMG$K_TRM_*

{------------------------  CUT HERE  ------------------------}

[INHERIT ('sys$library:starlet')]
PROGRAM GETKEY_STUFF(INPUT,OUTPUT);
const
	esc = chr(27); { The <ESC> character }
type
	uword = [word] 0..65535;
var
	stat : unsigned;
	iochan : uword;
	special : integer;
	key : char;

(*----------------------------------------------------------------------------*)
function rawgetkey(iochan:uword):char;
const
 esc = chr(27);
var
 stat : uword;
 ch : char;
begin
 stat := $qiow (chan:=iochan,
		func:=io$_readvblk+io$m_noecho+io$m_nofiltr+io$m_timed,
		p1:=ch,
		p2:=1,
		p3:=0); {0 second wait for timeout}
 if stat=ss$_timeout then ch:=esc;
 rawgetkey := ch;
end;

function parse_func_key(iochan:uword):integer;
var
	key:integer;
	key1,key2,key3:char;
	num:integer;
begin
	key := 0;
	key1 := rawgetkey(iochan);
	if key1 in ['A'..'D','P'..'S'] then
	   begin
		case key1 of
		  'P': key := smg$k_trm_pf1;
		  'Q': key := smg$k_trm_pf2;
		  'R': key := smg$k_trm_pf3;
		  'S': key := smg$k_trm_pf4;
		  'A': key := smg$k_trm_up;
		  'B': key := smg$k_trm_down;
		  'C': key := smg$k_trm_right;
		  'D': key := smg$k_trm_left;
		end (* case *)
	   end
	  else
	if (key1='O')or(key1='?') then
	   begin
		key1 := rawgetkey(iochan);
		case key1 of
		  'M': key := smg$k_trm_enter;
		  'P': key := smg$k_trm_pf1;
		  'Q': key := smg$k_trm_pf2;
		  'R': key := smg$k_trm_pf3;
		  'S': key := smg$k_trm_pf4;
		  'l': key := smg$k_trm_comma;
		  'm': key := smg$k_trm_minus;
		  'n': key := smg$k_trm_period;
		  'p': key := smg$k_trm_kp0;
		  'q': key := smg$k_trm_kp1;
		  'r': key := smg$k_trm_kp2;
		  's': key := smg$k_trm_kp3;
		  't': key := smg$k_trm_kp4;
		  'u': key := smg$k_trm_kp5;
		  'v': key := smg$k_trm_kp6;
		  'w': key := smg$k_trm_kp7;
		  'x': key := smg$k_trm_kp8;
		  'y': key := smg$k_trm_kp9;
		end; (* case *)
	   end
	  else
	if key1='[' then
	   begin
		key1 := rawgetkey(iochan);
		if key1 in ['A'..'D'] then
			case key1 of
			  'A': key := smg$k_trm_up;
			  'B': key := smg$k_trm_down;
			  'C': key := smg$k_trm_right;
			  'D': key := smg$k_trm_left;
			end (* case *)
		  else
		   begin
			num:=0;
			key2 := rawgetkey(iochan);
			if key2='~' then
			   num:=ord(key1)-ord('0')
			  else
			   begin
				key3 := rawgetkey(iochan);
				if key3='~' then
					num:=10*(ord(key1)-ord('0')) +
						(ord(key2)-ord('0'));
			   end;
			case num of
			   1: key := smg$k_trm_e1;
			   2: key := smg$k_trm_e2;
			   3: key := smg$k_trm_e3;
			   4: key := smg$k_trm_e4;
			   5: key := smg$k_trm_e5;
			   6: key := smg$k_trm_e6;
			  18: key := smg$k_trm_f7;
			  19: key := smg$k_trm_f8;
			  20: key := smg$k_trm_f9;
			  21: key := smg$k_trm_f10;
			  23: key := smg$k_trm_f11;
			  24: key := smg$k_trm_f12;
			  25: key := smg$k_trm_f13;
			  26: key := smg$k_trm_f14;
			  28: key := smg$k_trm_help;
			  29: key := smg$k_trm_do;
			  31: key := smg$k_trm_f17;
			  32: key := smg$k_trm_f18;
			  33: key := smg$k_trm_f19;
			  34: key := smg$k_trm_f20;
			end;
		   end;
	   end;
	
	parse_func_key := key;
end;

function getkey(iochan:uword; var spec :[truncate] integer):char;
const
 esc = chr(27);
var
 stat : uword;
 ch : char;
 ret_val : integer;
begin
 stat := $qiow (chan:=iochan,
		func:=io$_readvblk+io$m_noecho+io$m_nofiltr,
		p1:=ch,
		p2:=1);
 ret_val:=0;
 if ch=esc then
	ret_val:=parse_func_key(iochan);
 if present(spec) then
	spec:=ret_val;
 getkey := ch;
end;

begin
	stat := $assign('TT:',iochan);  {assign a channel to the terminal}
	repeat
		key := getkey(iochan,special);
		if key = esc then
		   begin
			case special of
			smg$k_trm_up:writeln('UP ARROW');
			smg$k_trm_down:writeln('DOWN ARROW');
			smg$k_trm_right:writeln('RIGHT ARROW');
			smg$k_trm_left:writeln('LEFT ARROW');
			smg$k_trm_kp5:writeln('KEY PAD 5');{in application mode}
			smg$k_trm_e1:writeln('FIND KEY');
			smg$k_trm_pf1:writeln('PF1');
			OTHERWISE
				writeln('Special: ',special:1);
			end;
		   end
		  else
			writeln('Key: ',key);
	until key in ['q','Q'];
end.