! reader.TPU - minimal read only VAXTPU interface

PROCEDURE tpu$init_procedure

! Check for screen of line mode operations

    display := GET_INFO( COMMAND_LINE, "display");

! Create Buffers and Windows for messages

    IF display 
    THEN
	MESSAGE_BUFFER := CREATE_BUFFER("Message Buffer");
	SET (NO_WRITE, MESSAGE_BUFFER);
	SET (SYSTEM, MESSAGE_BUFFER);
	SET (EOB_TEXT, MESSAGE_BUFFER, "");
	message_window := CREATE_WINDOW(24,1,OFF);
	MAP( message_window, MESSAGE_BUFFER);

    ENDIF;

! Create useless buffer and window for SHOW [buffers] command

	SHOW_BUFFER := CREATE_BUFFER("Show Buffer");
	SET (NO_WRITE, SHOW_BUFFER);
	SET (SYSTEM, SHOW_BUFFER);

    IF display 
    THEN
	INFO_WINDOW := CREATE_WINDOW(1, 23, ON);
    ENDIF;

! Get parameters

        main_file := GET_INFO( COMMAND_LINE, "file_name");
	start_line := GET_INFO( COMMAND_LINE, "start_record");
	start_column := GET_INFO( COMMAND_LINE, "start_character");
        user_file := FILE_PARSE( main_file,"","",NAME,TYPE );

! housekeeping

	SET( MESSAGE_FLAGS, TPU$K_MESSAGE_TEXT);

! Create a buffer and window for the file we are reading

	main_buffer := CREATE_BUFFER (user_file,main_file);
	SET (NO_WRITE, main_buffer);
	SET (MODIFIABLE, main_buffer, OFF);
	SET (SYSTEM, main_buffer);

    IF display 
    THEN

! Create Buffer and WIndow for HELP

	HELP_BUFFER := CREATE_BUFFER("Help Buffer",
		FILE_PARSE("READER","SYS$HELP:.HELP_SCREEN"));
	SET (NO_WRITE, HELP_BUFFER);
	SET (SYSTEM, HELP_BUFFER);
	SET (EOB_TEXT, HELP_BUFFER, "");
	help_window := CREATE_WINDOW(1, 23,OFF);
	main_window := CREATE_WINDOW (1, 23, ON);
	MAP( main_window, main_buffer);
    ENDIF;

! Create an area on the screen for prompts

	SET (PROMPT_AREA, 24, 1, NONE);

!Put the "editing point" in the main buffer

	POSITION (main_buffer);
	MOVE_VERTICAL( start_line - 1);
	MOVE_HORIZONTAL( start_column - 1);

        user_find_string := "";
        SET (EOB_TEXT, main_buffer, "[End of File. Enter Control-Z to EXIT]");
!---------------------- Prompting version ---------------------------!
        SET (EOB_TEXT, main_buffer, "[End of File. Enter E to EXIT, B to go Back one screen]");
!--------------------------------------------------------------------!
	tpu$local_init;

    IF display 
    THEN

        SET (STATUS_LINE, main_window, REVERSE, 
	  "Enter CONTROL-Z to EXIT, ? for a list of commands [" +
	  user_file + "]"
	  );
!---------------------- Prompting version ---------------------------!
	command_string := 
	  "[" + user_file + "]";
	command_string := 
	  "E-xit N-ext screen P-revious screen H-elp F-ind B-ack" 
		+ fao("!#* ",26-LENGTH(command_string))
		+" "+ command_string;
        SET (STATUS_LINE, main_window, REVERSE, 
		command_string
	  );
!--------------------------------------------------------------------!
	SET( SCROLLING, main_window, ON,11,11,0);
    ELSE
	command_string := 'EXIT';
   	LOOP
		user_display_20;

		command_string := READ_LINE( 'Exit, Next, Back, or Find ?  ');
		command_char := SUBSTR(command_string,1,1);
                CHANGE_CASE( command_char, UPPER);
		IF LAST_KEY = CTRL_Z_KEY THEN user_exit; ENDIF;
		IF command_char = "E" THEN user_exit; ENDIF;
		IF LENGTH(command_string) = 0 THEN user_down_20;
		ELSE IF command_char = "N" THEN user_down_20; 
		ELSE IF command_char = "B" THEN user_up_20;
		ELSE IF command_char = "F" THEN user_find;
		ELSE MESSAGE(' '); MESSAGE(' Unknown Command '); MESSAGE(' ');
		ENDIF; ENDIF; ENDIF; ENDIF;

        ENDLOOP;
	user_exit;
    ENDIF;

ENDPROCEDURE;

PROCEDURE user_display_20;
LOCAL here;
LOCAL count;
    here := MARK(NONE);
    IF here = END_OF ( CURRENT_BUFFER )
    THEN
	MESSAGE('At end of file; enter EXIT when done');
	RETURN;
    ELSE
        count := 0;
    ENDIF;
    LOOP
    MESSAGE (CURRENT_LINE);
    MOVE_VERTICAL(1);
    count := count + 1;
    EXITIF MARK(NONE) = END_OF ( CURRENT_BUFFER );
    EXITIF count > 19;
    ENDLOOP;
    POSITION (here);
ENDPROCEDURE;

PROCEDURE user_down_20;
LOCAL count;
    IF MARK(NONE) = END_OF ( CURRENT_BUFFER )
    THEN
	MESSAGE('At end of file; enter EXIT when done');
	RETURN;
    ELSE
	count := 0;
    ENDIF;
    LOOP
    MOVE_VERTICAL(1);
    count := count + 1;
    EXITIF MARK(NONE) = END_OF ( CURRENT_BUFFER );
    EXITIF count > 19;
    ENDLOOP;
ENDPROCEDURE;
PROCEDURE user_down_screen;

	MOVE_VERTICAL(+20);

ENDPROCEDURE;

PROCEDURE user_up_20;
LOCAL count;    

    IF MARK(NONE) = BEGINNING_OF ( CURRENT_BUFFER )
    THEN
	MESSAGE('At beginning of file; enter EXIT when done');
	RETURN;
    ELSE
	count := 0;
    ENDIF;
    LOOP
    MOVE_VERTICAL(-1);
    count := count + 1;
    EXITIF MARK(NONE) = BEGINNING_OF ( CURRENT_BUFFER );
    EXITIF count > 19;
    ENDLOOP;
ENDPROCEDURE;
             
PROCEDURE user_up_screen;

	MOVE_VERTICAL(-20);

ENDPROCEDURE;


PROCEDURE tpu$local_init	! Procedure to allow users to add private
				! extensions

ENDPROCEDURE;

PROCEDURE user_find;

LOCAL find_string;
LOCAL find_range;
LOCAL find_here;
LOCAL find_next;
LOCAL find_last;
LOCAL find_on_down;
LOCAL find_on_up;
LOCAL message_string;

find_here := MARK(NONE);
IF find_here = END_OF( CURRENT_BUFFER)
THEN 
	find_next := END_OF(CURRENT_BUFFER);
ELSE                                    
	MOVE_HORIZONTAL(1);
	find_next := MARK(NONE);
ENDIF;
IF find_here = BEGINNING_OF( CURRENT_BUFFER )
THEN 
	find_last := BEGINNING_OF( CURRENT_BUFFER);
ELSE
	MOVE_HORIZONTAL(-2);
	find_last := MARK(NONE);
ENDIF;
POSITION(find_here);
find_on_down := CREATE_RANGE( find_next, END_OF( CURRENT_BUFFER ) );
find_on_up := CREATE_RANGE( find_last, BEGINNING_OF( CURRENT_BUFFER ) );
find_string := READ_LINE('String to search for:  ');
if find_string = ''
THEN
find_string := user_find_string;
ELSE
user_find_string := find_string;
ENDIF;
message_string := 'Searching for ' + find_string;
MESSAGE( message_string );
find_range := SEARCH_QUIETLY( find_string, FORWARD, NO_EXACT, find_on_down);
IF find_range <> 0 
THEN                          
    POSITION( find_range );
    message_string := 'Found ' + find_string ;
    MESSAGE( message_string );
    RETURN 1;
ENDIF;                        
    MESSAGE( 'Not found below; looking above' );
    find_range := SEARCH_QUIETLY( find_string, FORWARD, NO_EXACT, find_on_up);
IF find_range <> 0
THEN 
    POSITION( find_range );   
    message_string := 'Found ' + find_string + ' above';
    MESSAGE( message_string );
    RETURN 1;
ENDIF;

POSITION( find_here );
message_string := "Could not find " + find_string;
MESSAGE( message_string );
RETURN 0;

ENDPROCEDURE;

PROCEDURE user_exit;

    QUIT( OFF, 1);

! Create window to erase the screen 

    IF display 
    THEN
	MESSAGE_BUFFER := CREATE_BUFFER("Erase Screen");
	SET (NO_WRITE, MESSAGE_BUFFER);
	SET (SYSTEM, MESSAGE_BUFFER);
	SET (EOB_TEXT, MESSAGE_BUFFER, "");
	message_window := CREATE_WINDOW(1,24,OFF);
	MAP( message_window, MESSAGE_BUFFER);
	POSITION( MESSAGE_BUFFER );
	UPDATE (ALL);
        REFRESH;
    ELSE
        MESSAGE( ASCII(12) );
    ENDIF;                                  
    QUIT( OFF, 1);


ENDPROCEDURE;

PROCEDURE user_help;
LOCAL here;
LOCAL return_line;
	here := MARK(NONE);
	MAP( help_window, HELP_BUFFER);
	POSITION(HELP_BUFFER);
	UPDATE (ALL);
	return_line := READ_LINE('Strike RETURN to continue ');
	IF LAST_KEY = CTRL_Z_KEY THEN user_exit; ENDIF;
	CHANGE_CASE(return_line,UPPER);
	UNMAP( help_window); !, HELP_BUFFER);
	IF SUBSTR(return_line,1,1) = 'E'
	THEN user_exit;
	ELSE POSITION(here);
	ENDIF;
ENDPROCEDURE;

! Define editing keys

section := GET_INFO( COMMAND_LINE, "section");

IF section = 0 
THEN         
        CAPITAL_H_KEY := KEY_NAME("H");
        SMALL_H_KEY := KEY_NAME("h");
	QUESTION_MARK := KEY_NAME("?");
	DEFINE_KEY ("user_help", HELP);
	DEFINE_KEY ("user_help", QUESTION_MARK);
	DEFINE_KEY ("user_help", CAPITAL_H_KEY);
	DEFINE_KEY ("user_help", SMALL_H_KEY);


        CAPITAL_N_KEY := KEY_NAME("N");
        SMALL_N_KEY := KEY_NAME("n");                   
	PLUS_KEY := KEY_NAME("+");                      
                                                        
	DEFINE_KEY ("USER_DOWN_SCREEN", E6);
	DEFINE_KEY ("USER_DOWN_SCREEN", CAPITAL_N_KEY);
	DEFINE_KEY ("USER_DOWN_SCREEN", SMALL_N_KEY);
	DEFINE_KEY ("USER_DOWN_SCREEN", RET_KEY);       
	DEFINE_KEY ("USER_DOWN_SCREEN", PLUS_KEY);      
	DEFINE_KEY ("USER_DOWN_SCREEN", TAB_KEY);       
	DEFINE_KEY ("USER_DOWN_SCREEN", ENTER);       
                                                        
	MINUS_KEY := KEY_NAME("-");                     
        CAPITAL_P_KEY := KEY_NAME("P");
        SMALL_P_KEY := KEY_NAME("p");
        CAPITAL_B_KEY := KEY_NAME("B");
        SMALL_B_KEY := KEY_NAME("b");
	DEFINE_KEY ("USER_UP_SCREEN", E5);
	DEFINE_KEY ("USER_UP_SCREEN", CAPITAL_P_KEY);
	DEFINE_KEY ("USER_UP_SCREEN", SMALL_P_KEY);
	DEFINE_KEY ("USER_UP_SCREEN", CAPITAL_B_KEY);
	DEFINE_KEY ("USER_UP_SCREEN", SMALL_B_KEY);
	DEFINE_KEY ("USER_UP_SCREEN", DEL_KEY);
	DEFINE_KEY ("USER_UP_SCREEN", BS_KEY);          
	DEFINE_KEY ("USER_UP_SCREEN", MINUS_KEY);       
	DEFINE_KEY ("USER_UP_SCREEN", MINUS);	! KEYPAD

!	DEFINE_KEY ("EXECUTE(READ_LINE('VAXTPU Statement:  '))", TAB_KEY);

        CAPITAL_E_KEY := KEY_NAME("E");
        SMALL_E_KEY := KEY_NAME("e");
        DEFINE_KEY ("user_exit", CAPITAL_E_KEY);
        DEFINE_KEY ("user_exit", SMALL_E_KEY);
	DEFINE_KEY ("user_exit", CTRL_Z_KEY);

        CAPITAL_F_KEY := KEY_NAME("F");
        SMALL_F_KEY := KEY_NAME("f");
	DEFINE_KEY ("user_find", E1);
        DEFINE_KEY ("user_find", CAPITAL_F_KEY);
        DEFINE_KEY ("user_find", SMALL_F_KEY);
                          
	DEFINE_KEY ("MOVE_VERTICAL (-1)", UP);
	DEFINE_KEY ("MOVE_VERTICAL (1)", DOWN);
	DEFINE_KEY ("MOVE_HORIZONTAL (1)", RIGHT);
	DEFINE_KEY ("MOVE_HORIZONTAL (-1)", LEFT);
                                                        
! Create a section file and then quit

	SAVE ("disk$sg:[tihor.sg.reader]reader");
	QUIT;
ENDIF;
!ENd of mini.TPU