[comp.os.vms] Single character input in DCL

u3369429@murdu.OZ (Michael Bednarek) (01/08/88)

One could not fail to notice that some of you feel the need to do single
character input from DCL. While Jerry Leichter explained in his usual
luculent way why this can't be done, I offer a program which will overcome
DCL's limitation, using QIOW as Jerry suggested. (Unfortunately, my
I/O Manuals have gone walkabout, so there may be a more elegant way).

The accompanying procedure shows two applications, the first performs
the conventional prompt "Yes/No", the second is a bit more sophisticated
and prompts for a two-digit input and works only on VT100 or better.

Michael Bednarek
Institute of Applied Economic and Social Research (IAESR)
Melbourne University, Parkville 3052, AUSTRALIA, Phone : +61 3 344 5744
Domain: u3369429@{murdu.oz.au | ucsvc.dn.mu.oz.au}  or  mb@munnari.oz.au
"bang": ...UUNET.UU.NET!munnari!{murdu.oz | ucsvc.dn.mu.oz}!u3369429

"POST NO BILLS."

 
...................... Cut between dotted lines and save ......................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.03 07-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by U3369429 (Michael Bednarek)
$! on Friday 8-JAN-1988 13:46:18.87
$!
$! It contains the following 2 files:
$! GETCHAR.FOR GETCHAR.COM
$!=============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="GETCHAR.FOR"
$ Check_Sum_is=1867954285
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Options /Extend_Source
X`009Program GetChar
X
XC** Read one character from SYS$COMMAND`009`009`009       Michael Bednarek
XC`009`009`009`009`009`009`009       08-Jan-1988
X
XC Installation: GETCHAR=="$<somewhere>GETCHAR"
XC (The reason for not writing it as a command is that SET COMMAND is too
XC  expensive.)
X
XC Usage: GETCHAR symbol_name "prompt_string"
XC    or: GETCHAR "prompt_string" symbol_name
XC    or: GETCHAR symbol_name
X
XC Errors: no symbol name specified
XC`009  unbalanced quotes
X
VC Caution: ``GETCHAR A B C' will create a symbol ``A B C' which you will not b
Xe
XC`009   able to access.
XC`009   You can expect similar results from ``GETCHAR "prompt" A B C
XC`009   However, ``GETCHAR "prompt"A B C' will produce a symbol ``B C',
XC`009   which again, you can't access.
X
XC`009   Also, you will get the error message
XC`009   %SYSTEM-F-ILLIOFUNC, illegal I/O function code
XC`009   if SYS$COMMAND is not a terminal.
X
X`009Implicit  NONE
X`009Integer`009  Status,lCommandLine,Channel,Q1,Q2,lPrompt,
X`0091`009  LIB$Get_Foreign,SYS$Assign,SYS$QIOW,SYS$DASSGN,LIB$Set_Symbol
X`009Character CommandLine*255,SymbolName*255,Prompt*132,CHAR$*1
X`009Include   '($CLISERVDEF)/List'
X`009Include   '($IODEF)/List'
X
X`009Status=LIB$Get_Foreign(CommandLine,,lCommandLine,)
X`009If (Status) then
X`009 If (lCommandLine.lt.1) then
X`009  Write`009(*,*) '%GETCHAR-F-NOCMDLIN, No command line parameters given'
X`009 else
X! Find quoted string
X`009  Q1=Index(CommandLine,'"')
X`009  If (Q1.ne.0 .and. Q1.le.lCommandLine) then
X`009   Q2=Index(CommandLine(Q1+1:),'"')
X`009   If (Q2.eq.0 .or. Q1.eq.lCommandLine) then
X`009    Write (*,*) '%GETCHAR-F-UNBALQ, Unbalanced quotes'
X`009    Go to 9999
X`009   else
X! Extract the quoted string (sans quotes) from the command line
X`009    lPrompt=Q2-1
X`009    Q2=Q1+Q2
X! Is the Symbol Name after or before the quoted string?
X`009    If (lCommandLine.gt.Q2) then
X`009     SymbolName=CommandLine(MAX(Q2+1,
X`0091`009INDEX(CommandLine(Q2+1:lCommandLine),' ')+Q2+1):)
X`009    else
X`009     If (Q1.lt.2) then
X`009      Write (*,*) '%GETCHAR-F-NOSYMBNAM, No Symbol Name given'
X`009      Goto 9999
X`009     else
X`009      SymbolName=CommandLine(:Q1-1)
X`009     End If
X`009    End If
X`009   End If
X`009  else
X`009   SymbolName=CommandLine(:lCommandLine)
X`009  End If
X
X`009  If (lPrompt.gt.0) then
X`009   Prompt=CommandLine(Q1+1:Q2-1)
X`009   Write (*,'(1H$A)') Prompt(:lPrompt)
X`009  End If
X
XC** assign a channel to the terminal
X`009  Status=SYS$Assign('SYS$COMMAND',Channel,,)
X`009  If (Status) then
X
XC** read 1 character
X`009   Status=SYS$QIOW(,%VAL(Channel),%VAL(IO$_TTYREADALL),,,,
X`0091`009%REF(CHAR$),%VAL(1),,,,)
X`009   If (Status) then
X
Xc** deassign the i/o channel
X`009    Status=SYS$DASSGN(%VAL(Channel))
X`009    If (Status) then
X
X`009     Status=LIB$Set_Symbol(SymbolName,CHAR$,CLI$K_GLOBAL_SYM)
X
X`009    End If
X`009   End If
X`009  End If
X`009 End If
X`009End If
X
X9999`009Call Exit (Status)
X`009End
$ GoSub Convert_File
$ File_is="GETCHAR.COM"
$ Check_Sum_is=2020203834
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$! GETCHAR.COM example how to use GETCHAR
X$!
X$! Installation: GETCHAR=="$<somewhere>GETCHAR"
X$!
X$ say="Write SYS$Output"
X$ ESC[0,8]=27
X$ BEL[0,8]=7
X$ CSI=ESC+"["
X$! Get one character into a symbol
X$ GetChar Yes_or_No "Yes/No? "
X$!
X$! If required: translate to upper case
X$!Yes_or_No=F$Edit(Yes_or_No,"UpCase")
X$!
X$! Look at the returned result
X$ If Yes_or_No then goto True
X$ Say "False"
X$ Goto More
X$True: Say "True"
X$!
X$More: Delete/Symbol/Global Yes_or_No`009! Delete the used symbol
X$!
X$! Now let's try to get a 2-digit input:
X$ Digits="0123456789"
X$Get1: GetChar d "Enter two digits: "
X$ Gosub Check_Digit
X$ If .not.Status then goto Get1
X$ Number=F$Integer(d)
X$ GetChar d
X$Check2: Gosub Check_Digit
X$ If Status then goto OK
X$ GetChar d "Enter two digits: ''Number'"
X$ Goto Check2
X$OK: Number=Number*10+F$Integer(d)
X$ Say "You entered: ",Number
X$!
X$ Delete/Symbol/Global d`009`009! Delete the used symbol
X$ Exit
X$Check_Digit:
X$ Status=F$Locate(d,Digits).ne.10
X$ If Status then Return
X$ Say ESC,"7",CSI,"1;1H",CSI,"K",CSI,"1;4;5;7m",ESC,"#6A digit, you dummy",BEL
X$ Say ESC,"8",ESC,"M",CSI,"K",ESC,"M"
X$ Return
$ GoSub Convert_File
$ Exit