[comp.os.vms] Need single character input on VAX Pascal...

jj1h+@ANDREW.CMU.EDU (Joseph Jackson) (04/04/88)

Sorry if this post is redundant -- mailer troubles again...

> In Message-Id: <7787@cisunx.UUCP>, Mike Stopper asks:
> "Does anyone out there have a routine for VAX Pascal to read a single char
>  from the terminal in VAX Pascal without having to press the ever-present
>  RETURN key??"

It just so happens that I have recently written some Pascal code that
does what you want to do.  In addition, I had some other procedures
which I thought might be useful.  The two files below call system
services to implement these functions:
   Single character input and output
   Terminal line typeahead setting
   Arbitrarily long delays using real timer routines

To run the program, extract the files from this message and build it as
follows.  Type a lowercase "e" to exit the program.

$ PASCAL MAIN, COMMUNICATIONS
$ LINK MAIN, COMMUNICATIONS
$ RUN MAIN

Good luck!

Joe Jackson.  ;-)

      ___________________________________________________________
     |                                                           |
     |                  Joseph L. Jackson, Jr.                   |
     |                Carnegie-Mellon University                 |
     |                                                           |
     |        Overland:                   Network:               |
     |  4705 Fifth Ave, Apt.#4M     JJ1h+@andrew.cmu.edu         |
     |  Pittsburgh, PA 15213-2937   Jackson@laurel.psy.cmu.edu   |
     |  (412) 268-5540              JJ1h+%andrew.cmu.edu@CMCCVMA |
     |___________________________________________________________|



*************** start of main.pas ***************

PROGRAM Main_Program;

TYPE string = varying [132] of char;

VAR  One_Char : Char;
[EXTERNAL] PROCEDURE Getchr (VAR One_Char : Char);         External;
[EXTERNAL] PROCEDURE Putchr (One_Char : Char);             External;
[EXTERNAL] PROCEDURE Delay (Delta_Time : String);          External;
[EXTERNAL] PROCEDURE Set_notypeahead (Turn_off: Boolean);  External;

BEGIN
  Set_notypeahead (FALSE);

  REPEAT
      Getchr (One_Char);
      Delay ('0 00:00:01.00');
      Putchr (One_Char);

  UNTIL One_char = 'e';

  Set_notypeahead (TRUE);
END.

*************** end of main.pas ***************

*************** start of communcations.pas ***************

[Inherit ('Scan_library:Starlet.pen')] MODULE Communications;

(*
COMMUNICATIONS.PAS

by Joe Jackson
16-MAR-1988

*)

(*
Buffer_type is the definition of Terminal mode buffer used when setting
terminal typeahead.  Note that the three byte Basic_term_characteristics
integer has been combined with the one byte Page_length to make a single
longword since the UOR function accepts only unsigned longwords as
parameters.
*)

[Hidden] TYPE
     String = Varying [132] OF Char;
     Byte_Integer = [Byte] 0..255;
     Word_Integer = [Word] 0..2**16-1;
     Long_Integer = [Long] Unsigned;
     Io_Status = RECORD
                   Io_Stat,
                   Count : Word_Integer;
                   Device_Info : Long_Integer;
                 END;

     Buffer_Type = RECORD
                     Dev_Class : Byte_Integer;
                     Dev_Type : Byte_Integer;
                     Page_Width : Word_Integer;
                     Basic_Chars : Long_Integer;
                     Extended_Chars : Long_Integer;
                   END;
[Hidden] VAR
    Channel_Assigned : [Static] Boolean := FALSE;
    Terminal_Channel : [Volatile] Word_Integer;
    Sys_Stat : Integer;
    Iostat_Block : [Volatile] Io_Status;
    Terminal_Mode_Buffer : Buffer_Type;

[Asynchronous] PROCEDURE Lib$Stop (%Immed Cond_Value: Integer);
Extern;

[Hidden] PROCEDURE Check_Status (Sys_Stat : Integer);
BEGIN
  IF NOT Odd (Sys_Stat)
    THEN
      Lib$Stop (Sys_Stat);
END;

[Hidden] PROCEDURE Assign_Channel;
BEGIN
  Sys_Stat := $Assign (Devnam := 'Sys$command',
              Chan := Terminal_Channel );
  Check_Status (Sys_Stat);
  Channel_Assigned := TRUE;
END;

[Global] PROCEDURE Getchr (VAR One_Char : Char);

BEGIN
  IF NOT Channel_Assigned
    THEN
      Assign_Channel;

  Sys_Stat := $Qiow (
              Chan := Terminal_Channel,
              Func := Io$_Readvblk + Io$M_Nofiltr + Io$M_Noecho,
              Iosb := Iostat_Block,
              P1 := One_Char,
              P2 := 1);

  Check_Status (Sys_Stat);
  Check_Status (Iostat_Block.Io_Stat);
END;

[Global] PROCEDURE Putchr (One_Char : Char);

BEGIN
  IF NOT Channel_Assigned
    THEN
      Assign_Channel;

  Sys_Stat := $Qiow (
              Chan := Terminal_Channel,
              Func := Io$_Writevblk + Io$M_Nofiltr + Io$M_Noecho,
              Iosb := Iostat_Block,
              P1 := One_Char,
              P2 := 1);

  Check_Status (Sys_Stat);
  Check_Status (Iostat_Block.Io_Stat)
END;

[Global] PROCEDURE Set_Notypeahead (Turn_Off : Boolean);

BEGIN
  IF NOT Channel_Assigned
    THEN
      Assign_Channel;

  Sys_Stat := $Qiow (
              Chan := Terminal_Channel,
              Func := Io$_Sensemode,
              Iosb := Iostat_Block,
              P1 := Terminal_Mode_Buffer,
              P2 := 12);

  Check_Status (Sys_Stat);
  Check_Status (Iostat_Block.Io_Stat);

  WITH Terminal_Mode_Buffer DO
    IF Turn_Off
      THEN
        Basic_Chars := Uand (Basic_Chars, Unot (Tt$M_Notypeahd))
      ELSE
        Basic_Chars := Uor (Basic_Chars, Tt$M_Notypeahd);

  Sys_Stat := $Qiow (
              Chan := Terminal_Channel,
              Func := Io$_Setmode,
              Iosb := Iostat_Block,
              P1 := Terminal_Mode_Buffer,
              P2 := 12);

  Check_Status (Sys_Stat);
  Check_Status (Iostat_Block.Io_Stat)
END;
[Global] PROCEDURE Delay (Delta_Time_String: String);
VAR Sys_Stat : Integer;

    Delta_Time : [Quad] RECORD
                   Part1 : [Long] Unsigned;
                   Part2 : [Long] Unsigned;
                 END;

BEGIN
  Sys_Stat := $Bintim (
              Timbuf := Delta_Time_String,
              Timadr := Delta_Time);
  Check_Status (Sys_Stat);

  Sys_Stat := $Setimr (
              Daytim := Delta_Time,
              Efn := 1);
  Check_Status (Sys_Stat);

  Sys_Stat := $Waitfr (
              Efn := 1);
  Check_Status (Sys_Stat);
END;
END.

*************** end of communcations.pas ***************