%title 'AUX Help routines'
%sbttl 'Introduction'
MODULE aux_help(	!
		IDENT = '1',
    		addressing_mode(external=general,nonexternal=general)
		) =
BEGIN

!
!			  COPYRIGHT (c) 1983 BY
!		Project Software & Development, Inc.
!
! 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 PROJECT SOFTWARE
! AND DEVELOPMENT, INC.
!
! PROJECT SOFTWARE assumes no responsibility for the use or  reliability  
! of its software on equipment which is not supplied by PROJECT SOFTWARE.
!

!++
! FACILITY: AUXiliary Keypad DCL 
!
! ABSTRACT: This module contains the routines which display help for the
!	AUXiliary Keypad DCL program.
!
! ENVIRONMENT: VMS Native mode.
!
! AUTHOR: M. Erik Husby, CREATION DATE: April 1983
!
! MODIFIED BY:
!
! 	, : VERSION
! 01	- 
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    aux_help_keypad,
    aux_help_keys,
    display_escape_keys,
    display_control_keys,
    write_line			: novalue,
    press_return_for_more,
    aux_xy
	;		!

!
! INCLUDE FILES:
!
library
    'sys$library:starlet';
Require
    'sys$library:psdi';
Library
    'Auxlib';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!
literal
    keypad_truncate	= 14,	! Truncation limit for keypad display
    command_column	= 17,
    display_column	= 60
    ;
!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
external
    clear_line	: block[,byte],
    bold_off	: block[,byte],
    reverse	: block[,byte],
    aux_keypad_outline : block[,byte],
    aux_keypad_outline2 : block[,byte],
    aux_keypad_outline3 : block[,byte],
    aux_tables	: ref vector[5],
    aux_tt_chan : word
    ;

external literal
    aux_nokeys,
    lib$_nosuchsym
    ;
EXTERNAL ROUTINE
    aux_clear_screen,
    lib$get_symbol	: addressing_mode(general)
	;		!

%sbttl 'Aux_help_keypad'
Global ROUTINE Aux_help_keypad =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This TPARSE action routine displays the keypad diagram and all the
!	associated key definitions.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	aux_tables	: a vector that contains the addresses of the current
!			symbol tables.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    bind
	escape_table	= .aux_tables[0] : symbol_table,
	gold_escape_table= .aux_tables[2] : symbol_table,
	auxkey_name	= $descriptor('AUXKEY') : block[,byte],
	key_title	= static_descriptor(
		    %char(escape),'[7;4m',	! Reverse, underscore
    		'AUXiliary key definitions from file:')
	    : block[,byte]
	;
    local
	count,
	title		: dynamic_descriptor,
	buffer		: dynamic_descriptor
	;
    local_descriptor(auxkey_result,64);
    init_descriptor(auxkey_result,64);
    !
    ! Translate AUXKEY so that we know the source of definitions.
    perform($trnlog(lognam=auxkey_name,
		rsllen=auxkey_result_desc[dsc$w_length],
		rslbuf=auxkey_result_desc));
    !
    ! Clear the screen
    aux_clear_screen();
    !
    ! Write the initial line
    concat((title,key_title,auxkey_result_desc,bold_off));
    write_line(2,1,title,buffer);
    !
    ! And then the outline.
    write_line(3,1,aux_keypad_outline,buffer);
    write_line(13,1,aux_keypad_outline2,buffer);
    write_line(19,1,aux_keypad_outline3,buffer);
    ! 
    ! And flush the buffer.
    write_line(0,0,0,buffer);
    free1_dx((buffer));
    !
    ! Now display the keypad
    count = display_escape_keys(escape_table,buffer);
    write_line(2,1,reverse,buffer);
    if (.count + display_escape_keys(gold_escape_table,buffer)) eql 0 then
	begin
	aux_clear_screen();
	signal(aux_nokeys,1,$descriptor('Keypad'));
	end
    else
	begin
	append((buffer,bold_off));
	write_line(0,0,0,buffer);
	end;
    return 1;
    END;			!End of Aux_help_keypad

%sbttl 'Display_escape_keys'
ROUTINE Display_escape_keys (
    escape_table : ref symbol_table,
    buffer : ref block[,byte]
    ) =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This routine displays the escape key definitions at their appropriate
!	keypad positions.
!
! FORMAL PARAMETERS:
!
!	escape_table	: Address of a symbol table to be scaned for 
!			definitions.
!	buffer		: Address of a dynamic descriptor to be used for
!			buffering the output.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    local
	command		: dynamic_descriptor,
	displays	: dynamic_descriptor,
	count		: initial(0),
	i		: initial(0)
	;
    while .escape_table[.i,sym_b_char] neq 0 do
	begin
	bind
	    keyname	= .escape_table[.i,sym_a_keyname] : block[,byte],
	    command_sym	= .escape_table[.i,sym_a_command] : block[,byte],
	    display	= .escape_table[.i,sym_a_display] : block[,byte],
	    row		= escape_table[.i,sym_b_row] : byte,
	    column	= escape_table[.i,sym_b_column] : byte
	    ;
	local
	    offset,
	    status
	    ;
	!
	! See if this key is defined.
	if (status=lib$get_symbol(command_sym,command)) then
	    begin
	    !
	    ! Got a command, see if there is a display value.
	    count = .count + 1;
	    if not (status = lib$get_symbol(display,displays)) then
		if .status neq lib$_nosuchsym then
		    signal(.status);
	    !
	    ! Use the display version if one exists
	    if .displays[dsc$w_length] gtr 0 then 
		copy_dx((command,displays));
	    !
	    ! Now compute centering, truncate at Keypad_Truncate characters 
	    ! if too long.
	    if .command[dsc$w_length] gtr Keypad_Truncate then
		left((command,command,%ref(Keypad_Truncate)));
	    offset = (Keypad_Truncate-.command[dsc$w_length])/2;
	    write_line(.row,.column+.offset,command,.buffer);
	    end
	else if .status neq lib$_nosuchsym then
	    signal(.status);
	!
	! Free up symbols for next time.
	free1_dx((command));
	free1_dx((displays));
	!
	! Advance to next table entry
	i = .i + 1;
	end;

    return .count;

    END;			!End of Display_escape_keys

%sbttl 'Aux_Help_keys'
Global ROUTINE Aux_Help_keys =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This TPARSE action routine will display a screen showing the 
!	complete definitions of all the keys.
!
! FORMAL PARAMETERS:
!
!	Tpa$l_param = 0 then show the escape keys, 1 show the control keys
!
! IMPLICIT INPUTS:
!
!	aux_tables	: a vector that contains the addresses of all the 
!			current symbol tables.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    tparse_args;
    bind
	key_types	= uplit(
		    $descriptor('Keypad'),
		    $descriptor('Control'),
		    $descriptor('Gold Keypad'),
		    $descriptor('Gold Control') )
		: vector[],
	title_line	= static_descriptor(
		    %char(escape),'[7;4m',	! Reverse, underscore
		    'Key',
		    %char(escape),'[2;17H','Command',
		    %char(escape),'[2;60H','Displays',
		    %char(escape),'[0m')	! Revese, underscore OFF
		: block[,byte]
	;
    local
	status,
	buffer	: dynamic_descriptor
	;
    !
    ! Write the titles
    aux_clear_screen();
    write_line(2,1,title_line,buffer);	! Start buffering
    !
    ! Do the first screen full
    status=display_control_keys(.aux_tables[.ap[tpa$l_param]],buffer);
    write_line(0,0,0,buffer);		! Flush buffer
    if .status eql 0 then
	signal(aux_nokeys,1,key_types[.ap[tpa$l_param]]);
    free1_dx((buffer));
    !
    ! And then the second screen full
    ! If status is a multiple of 21 then we filled the screen exactly and
    ! the display_control_keys routine has all ready asked to press return
    ! for more.  Thus we do not need to do it again
    if (.status mod 21 ) neq 0 then status = press_return_for_more();
    if .status then
	begin
	!
	! Write the titles
	aux_clear_screen();    
	write_line(2,1,title_line,buffer);
	status=
	  (display_control_keys(.aux_tables[2+.ap[tpa$l_param]],buffer) leq 0);
	write_line(0,0,0,buffer);
	if .status then 
	    signal(aux_nokeys,1,.key_types[2+.ap[tpa$l_param]]);
	end;
    free1_dx((buffer));
    return 1;
    END;			!End of Aux_Help_keys

%sbttl 'Write_line'
ROUTINE Write_line (
	row,
	column,
	display_line	: ref block[,byte],
	buffer		: ref block[,byte]
    ) :NOVALUE =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This module outputs the specified line.
!
! FORMAL PARAMETERS:
!
!	row		: value of row to display the line on.
!	column		: value of the column to begin the display in.
!	display_line	: Address of a descriptor pointing at the line to be
!			displayed.
!	buffer		: Address of a descriptor to be used as a buffer.  
!			If row=0 then flush the buffer.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    !
    ! If the row is 0 then flush the buffer 
    if .row eql 0 then
	begin
	!
	! If line exceeds 1024 bytes, write it out in multiple parts
	while .buffer[dsc$w_length] gtr 1024 do
	    begin
	    perform($qio(
		chan = .aux_tt_chan,
		efn = write_flag,
		func = (io$_writelblk or io$m_noformat),
		p1 = .buffer[dsc$a_pointer],
		p2 = 1024
		));
	    right((.buffer,.buffer,%ref(1025)));
	    end;
	!
	! And write it out.
	perform($qio(
	    chan = .aux_tt_chan,
	    efn = write_flag,
	    func = (io$_writelblk or io$m_noformat),
	    p1 = .buffer[dsc$a_pointer],
	    p2 = .buffer[dsc$w_length]
	    ));
	end
    !
    ! Otherwise Concatenate the XY format and the display line
    else
	begin
	local
	    xy_desc		: dynamic_descriptor
	    ;
	concat((.buffer,.buffer,aux_xy(xy_desc,.row,.column),.display_line));
	!
	! Free the local string
	free1_dx((xy_desc));
	!
	! If line exceeds 1024 bytes, write it out in multiple parts
	while .buffer[dsc$w_length] gtr 1024 do
	    begin
	    perform($qio(
		chan = .aux_tt_chan,
		efn = write_flag,
		func = (io$_writelblk or io$m_noformat),
		p1 = .buffer[dsc$a_pointer],
		p2 = 1024
		));
	    right((.buffer,.buffer,%ref(1025)));
	    end;
	end;
    return ;
    END;			!End of Write_line

%sbttl 'Display_control_keys'
ROUTINE Display_control_keys (
    control_table : ref symbol_table,
    buffer : ref block[,byte]
    ) =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This routine will display the values of the keys from the specified
!	symbol table.
!
! FORMAL PARAMETERS:
!
!	control_table	: address of a symbol table used for the control keys.
!	buffer		: address of a dynamic descriptor used to buffer
!			the output.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    local
	command		: dynamic_descriptor,
	displays	: dynamic_descriptor,
	line_number	: initial(3),
	count		: initial(0),
	i		: initial(0)
	;
    while .control_table[.i,sym_b_char] neq 0 do
	begin
	bind
	    keyname	= .control_table[.i,sym_a_keyname] : block[,byte],
	    command_sym	= .control_table[.i,sym_a_command] : block[,byte],
	    display	= .control_table[.i,sym_a_display] : block[,byte]
	    ;
	local
	    status
	    ;
	!
	! See if this key is defined.
	if (status=lib$get_symbol(command_sym,command)) then
	    begin
	    !
	    ! Got a command, see if there is a display value.
	    count = .count + 1;
	    if not (status = lib$get_symbol(display,displays)) then
		if .status neq lib$_nosuchsym then
		    signal(.status);
	    !
	    ! Display the definitions
	    write_line(.line_number,0,keyname,.buffer);
	    write_line(.line_number,command_column,command,.buffer);
	    if .displays[dsc$w_length] gtr 0 then 
		begin
		append((displays,clear_line));
		write_line(.line_number,display_column,displays,.buffer);
		end;
	    !
	    ! Advance to next line.
	    line_number = .line_number + 1;
	    if .line_number geq 24 then
		begin
		write_line(0,0,0,.buffer);
		free1_dx((.buffer));
		if not press_return_for_more() then return .count;
		aux_clear_screen();
		line_number = 2;
		end;
	    end
	else if .status neq lib$_nosuchsym then
	    signal(.status);
	!
	! Free up symbols for next time.
	free1_dx((command));
	free1_dx((displays));
	!
	! Advance to next table entry
	i = .i + 1;
	end;

    return .count;
    END;			!End of Display_control_keys

%sbttl 'Press_return_for_more'
ROUTINE Press_return_for_more =	!

!++
! FUNCTIONAL DESCRIPTION:
!	This routine issues a prompt on line 24, If terminated by a <RETURN>
!	it returns success, otherwise false.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	aux_tt_chan
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	1 of <return> hit, 0 otherwise
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    local
	input_buffer,
	io_status	: vector[4,word]
	;
    bind
	press_return_prompt = static_descriptor(
		    %char(escape),'[24;1H',	! Line 24, column 1
		    %char(escape),'[7m',	! Reverse video
		    'Press RETURN for more, Control-Z to terminate:',
		    %char(escape),'[0m')	! Reverse off.
		: block[,byte]
	;
    !
    ! Issue a read with prompt
    perform($qiow(
		func = (io$_readprompt or io$m_trmnoecho),
		chan = .aux_tt_chan,
		efn = read_flag,
		iosb = io_status,
		p1 = input_buffer,
		p2 = 1,
		p5 = .press_return_prompt[dsc$a_pointer],
		p6 = .press_return_prompt[dsc$w_length]
		));
    !
    ! function result depends on terminator
    return .io_status[2] eql cr;
    END;			!End of Press_return_for_more

%sbttl 'Aux_XY'
Global ROUTINE Aux_XY (
    desc	: ref block[,byte],
    x,
    y
    ) =	!

!++
! FUNCTIONAL DESCRIPTION:
!	Formats a string for VT100 positioning, returns address of the
!	descriptor.
!
! FORMAL PARAMETERS:
!
!	desc	: address of a dynamic descriptor to hold result.
!	x	: value of Row
!	y	: Value of column
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	address of the dynamic descriptor
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    local_descriptor(xy,8);
    init_descriptor(xy,8);
    !
    ! Format the positioning commands (Note FAO does not seem to like escapes
    ! in its format strings, therefore we will replace the leading dollar sign
    ! with an actual escape after formating it.
    perform($fao($descriptor('$[!2ZB;!2ZBH'),
		xy_desc[dsc$w_length],
		xy_desc,
		.x,
		.y
		));
    !
    ! Write the escape
    ch$wchar(escape,ch$ptr(xy));
    !
    ! Copy to the result string
    copy_dx((.desc,xy_desc));
    !
    ! And return the address of the result string.
    return .desc;
    END;			!End of Aux_XY

END				!End of module
ELUDOM