Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

%TITLE 'Ask user questions'

MODULE DIUASK (IDENT = '253',
            LANGUAGE(BLISS36),
            ENTRY(ASK, ASKD)                   ! Routine to ask for & get input
            ) =
BEGIN
!++
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY:     DIU (Data Interchange Utility for TOPS-10/20)
!
! ABSTRACT:     Prompt for text string
!
! ENVIRONMENT:  TOPS-10 V7.02 or TOPS-20 V6.1, XPORT, BLISS-36 V4
!
! AUTHOR:	Andrew Nourse,                  CREATION DATE: 2-Jan-82

!
! HISTORY:      
!
!  253  Rename file to DIUASK.
!       Gregory A. Scott 1-Jul-86
!
!  174  Remove library of TOPS20.
!       Gregory A. Scott 20-May-86
! 
!	V01-001 DPR0001		Doug Rayner		       14-Aug-85
!		Minor modifications for TOPS-10.  Use GLXLIB routines
!		to emulate the TOPS-20 JSYS's.
!
!       V01-000 RDF0001         Rick Fricchione                22-Oct-1984
!               Original DIU version.  Convert to use DIU library and 
!               require files, new formats, etc.
!
!--

!*************************************************************************
!                     L I B R A R Y    F I L E S 
!*************************************************************************
     LIBRARY 'DIU';                     ! DIU Data Structures
     LIBRARY 'BLI:XPORT';               ! XPORT defs
%IF %SWITCHES (TOPS20)
%THEN
     LIBRARY 'MONSYM';                  ! TOPS-20 monitor symbols 
     REQUIRE 'JSYSDEF';                 ! TOPS-20 JSYS macros
%ELSE
     LIBRARY 'BLI:GLXMAC';              ! GLXLIB-10 Symbol definitions
%FI

!*************************************************************************
!                               A S K 
!*************************************************************************
GLOBAL ROUTINE ASK (prompt, ptr, len, flags) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       Prompt for and input a string
!
! FORMAL PARAMETERS:
!
!	prompt    : Pointer to prompt string
!       ptr       : Pointer to buffer
!       len       : Length of buffer
!       flags     : 1 to supress echo
!--

BUILTIN
       REPLACEN;

%IF %SWITCHES (TOPS10)
%THEN                                    ! TOPS-10 ONLY
LINKAGE                                 
    GLXLIB = PUSHJ (REGISTER=1,REGISTER=2 ; REGISTER=1,REGISTER=2) :
	LINKAGE_REGS(15,14,0)
	NOPRESERVE(0,1,2,3,4,5,6)
	PRESERVE(7,8,9,10,11,12,13);

EXTERNAL ROUTINE
    %NAME('K%TXTI') : GLXLIB,		! TEXTI JSYS simulator in GLXLIB-10
    %NAME('K%SOUT') : GLXLIB,		! PSOUT JSYS simulator in GLXLIB-10
    %NAME('K%ECHO') : GLXLIB;		! Turn ECHO on/off

BIND ROUTINE
    K$TXTI = %NAME('K%TXTI') : GLXLIB,	! TEXTI JSYS simulator in GLXLIB-10
    K$SOUT = %NAME('K%SOUT') : GLXLIB,	! PSOUT JSYS simulator in GLXLIB-10
    K$ECHO = %NAME('K%ECHO') : GLXLIB;	! Turn ECHO on/off

%FI                                     ! END TOPS-10 / TOPS-20 CONDITIONAL

LOCAL
        texti_block: VECTOR[$RDRTY+1]
                   INITIAL($RDRTY,0,($PRIIN^18)+$PRIOU);

%IF %SWITCHES (TOPS20)
%THEN
JSYS_PSOUT(.prompt);                            ! Type the prompt (TOPS-20)
%ELSE
 K$SOUT((CH$PLUS(.PROMPT, 1) AND %O'777777'));  ! Type the prompt (TOPS-10)
%FI

! Prepare the block for the TEXTI%

texti_block[$RDDBP]=.PTR;               ! Caller's pointer
texti_block[$RDDBC]=.LEN;
texti_block[$RDFLG]=RD_BEL+RD_CRF+RD_JFN;
texti_block[$RDRTY]=.PROMPT;

%IF %SWITCHES (TOPS20)                  ! TOPS-20 ONLY
%THEN
     IF .flags                          ! Turn echo off if requested
     THEN JSYS_SFMOD($PRIIN,TT_IGN+($TTASC^6));

     JSYS_TEXTI(texti_block);           ! Get the input

     IF .flags                          ! Turn on echo if it was off
     THEN BEGIN
          JSYS_SFMOD($PRIIN,TT_IGN+($TTASC^6)+TT_ECO);  ! turn echo on
          JSYS_PSOUT(CH$PTR(UPLIT(%CHAR(13,10))));      ! put out CRLF
          END;

%ELSE                                   ! TOPS-10 ONLY

     IF .flags                          ! Turn off ECHO if requested
     THEN K$ECHO(0);

     K$TXTI(TEXTI_BLOCK);               ! Get the input

     IF .flags
     THEN BEGIN
         LOCAL crlf;
         crlf = %CHAR(%O'15', %O'12', 0);
         K$SOUT(crlf);
         K$ECHO(1);			! Turn ECHO back on
         END;

%FI                                     ! END TOPS-10 / TOPS-20 CONDITIONAL

! Make ASCIZ by zeroing terminator

IF (.texti_block[$RDFLG] AND RD_BTM) NEQ 0
THEN REPLACEN(texti_block[$RDDBP],0);

CH$DIFF(.texti_block[$RDDBP],.ptr)-1    ! Return length of string

END;                                    ! End of ASK

GLOBAL ROUTINE ASKD( P_Prompt, P_Result, Flags ) =
BEGIN

BIND result = .p_result: $STR_DESCRIPTOR(CLASS=BOUNDED);

result[STR$H_LENGTH] = ASK(.p_prompt,
                           .result[STR$A_POINTER],
                           .result[STR$H_MAXLEN],
                           .flags )
END;                                    
END
ELUDOM                                  ! End of module