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