sub fancy_selection( long dir_selection, string new_dir( ) )
!	Written by Michael W. Wheeler (mww@tntech.bitnet)
!	VAX Basic V3.1
!	Copyright (c) by Michael W. Wheeler, September 1987
!	This program is intended for Public Domain, and may not be sold or
!	marketed in any form without the permision and written consent
!	from the author Michael W. Wheeler.  I retain all copyrights to
!	this program, in either the original or modified forms, and no
!	violation, deletion, or change of the copyright notice is
!	allowed.  Futhermore, I will have no liability or responsibilty
!	to any user with respect to loss or damage caused directly or
!	indirectly by this program.

! Labels
!	Forever:

! Constants
%include "$rmsdef" %from %library "sys$library:basic$starlet.tlb"
%include "$smgtrmptr" %from %library "sys$library:basic$starlet.tlb"
external word constant	io$_readvblk, io$m_noecho, io$m_nofiltr,	&
			io$m_escape
declare word constant	num_field = 3%,					&
			max_recurse = 8%,				&
			max_jump = 9%,					&
			maxdirs = 2000%

! Types
record iosblk
    word		io_status, xfr_len
    word		terminator, terminator_len
end record

record terminatorblk
    long		mask_size
    long		mask_location        
end record

! Variables
declare real		x, y

declare long		sys_status, cur_row, cur_col, col_diff,		&
			terminator_mask(4%), i, page_number, 		&
			recurse_count, recurse_save(max_recurse,4%),	&
			context, page_size, jump_count,			&
			jump_save(max_jump,4%), dot, num_rows
declare word		io_function, logical_col, end_col, text_len

declare byte		recurse_flag

declare string		r_arrow, ctrl_f, h_tab, space, l_arrow, ctrl_b,	&
			ctrl_d, backspace, up_arrow, ctrl_p, dn_arrow,	&
			ctrl_n, ctrl_l, ctrl_w, ctrl_e, ctrl_a, ctrl_m,	&
			do_key, ctrl_v, next_scrn, prev_scrn,		&
			esc_low_v, esc_cap_v, ctrl_z, ctrl_r, ctrl_u,	&
			help, q_mark, delete_key, recurse_dir,		&
			search_dir, dir_file, ctrl_j, cur_dir,		&
			jump_dir(max_jump), start_dir, parent_dir

declare iosblk		iosb
declare terminatorblk	terminators

common (io_l) long	term_table, col_len, num_cols, tt_cols, tt_rows
common (io_w) word	chan, max_dir, cursor_len, start_row, start_col
common (txt) string	text = 5

! Procedures
external sub		read_dirs( string, string dim ( ) )
external sub		display_dirs( long, string dim ( ) )

! Functions
external long function	sys$qiow, lib$find_file
external word function	find_last by desc ( string, string )

! Initialize these variables (used as constants).
r_arrow = esc + "[C"
ctrl_f = chr$(6%)
h_tab = chr$(9%)
space = " "
l_arrow = esc + "[D"
ctrl_b = chr$(2%)
ctrl_d = chr$(4%)
backspace = chr$(8%)
delete_key = chr$(127%)
up_arrow = esc + "[A"
ctrl_p = chr$(16%)
dn_arrow = esc + "[B"
ctrl_n = chr$(14%)
ctrl_l = chr$(12%)
ctrl_w = chr$(23%)
ctrl_e = chr$(5%)
ctrl_a = chr$(1%)
ctrl_m = chr$(13%)
do_key = esc + "[29~"
ctrl_v = chr$(22%)
next_scrn = esc + "[6~"
prev_scrn = esc + "[5~"
esc_low_v = esc + "v"
esc_cap_v = esc + "V"
ctrl_z = chr$(26%)
ctrl_r = chr$(18%)
ctrl_u = chr$(21%)
help = esc + "[28~"
q_mark = chr$(63%)
ctrl_j = chr$(10%)
terminator_mask(1%) = X"FFFFFFFF"L	! All control keys          (31-0)
terminator_mask(2%) = X"FC00FFFF"L	! Everything but 0-9        (63-32)
terminator_mask(3%) = X"FFFFFFFF"L	! Everything im ascii range (95-64)
terminator_mask(4%) = X"FFFFFFFF"L	! EVeryghing in ascii range (127-96)
terminators::mask_size = 16%
terminators::mask_location = loc(terminator_mask(1%))
start_dir = mid(new_dir(dir_selection), 1%, find_last(".", new_dir(dir_selection)) - 1%) + "]"
page_size = (tt_rows - (start_row - 1%)) * num_cols

! Initialize variables.
recurse_count = 0%
page_number = 0%
cur_row = start_row
cur_col = start_col + cursor_len + num_field
dir_selection = 1%

! Set up ^C trapping.
when error use error_trap
y% = ctrlc
call display_dirs( page_number, new_dir( ) )
call set_cursor_abs( cur_row, cur_col, term_table, chan )

io_function = (io$_readvblk or io$m_noecho or io$m_escape or io$m_nofiltr)

forever:
sys_status = sys$qiow(,	chan by value, 			&
			io_function by value,		&
			iosb,,, 			&
			text by ref,			&
			5% by value,,			&
			terminators by ref,,)
if (sys_status and 1%) = 0% then call lib$signal(sys_status by value) end if
if iosb::xfr_len = 0 then
    text_len = iosb::terminator_len
else
    text_len = iosb::xfr_len
end if

select mid(text,1%,text_len)
    case = r_arrow, = ctrl_f, = h_tab, = space
	if dir_selection < max_dir then ! Can we advance?
	    if cur_col >= (col_len * (num_cols - 1%)) then ! At end of row?
		cur_col = start_col + cursor_len + num_field
		if cur_row = tt_rows then ! At last row of screen?
		    cur_row = start_row
		    page_number = page_number + 1%
		    call display_dirs( page_number, new_dir( ) )
		else ! Not at end of page just go to the next row.
		    cur_row = cur_row + 1%
		end if
	    else ! No special case exists just advance cursor to the next column.
		cur_col = cur_col + col_len
	    end if
	    dir_selection = dir_selection + 1% ! Increment array index.
	    ! Position the cursor.
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	end if
    case = l_arrow, = ctrl_b, = ctrl_d, = delete_key
	if dir_selection > 1% then ! Can we move backward?
	    ! Can we move left on the same row?
	    if cur_col > (start_col + cursor_len + num_field) then
	        cur_col = cur_col - col_len
	    else
		! Do we need to go back a page?
		if (page_number <> 0%) and (cur_row = start_row) then
		    page_number = page_number - 1%
		    cur_row = tt_rows
		    cur_col = col_len * (num_cols - 1%) + cursor_len + num_field + 1%
		    call display_dirs( page_number, new_dir( ) )
	    	else ! No. Just go to end of previous row.
		    cur_col = col_len * (num_cols - 1%) + cursor_len + num_field + 1%
		    cur_row = cur_row - 1%
		end if
	    end if
	    dir_selection = dir_selection - 1%
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	end if  
    case = dn_arrow, = ctrl_n
	if dir_selection < max_dir then ! Can we advance any?
	    ! Can we advance on the same page?
	    if (dir_selection + num_cols) <= (page_size * (page_number + 1%)) then
		! Can we advance by a full row?
		if dir_selection <= (max_dir - num_cols) then
		    cur_row = cur_row + 1%
		    dir_selection = dir_selection + num_cols
	            call set_cursor_abs(cur_row, cur_col, term_table, chan)
		else
		    end_col = mod(max_dir,num_cols)
		    logical_col = (cur_col / col_len) + 1%
		    if (end_col > 0%) and (logical_col > end_col) then
			dir_selection = dir_selection + end_col + (num_cols - logical_col)
			cur_col = (end_col - 1%) * col_len + cursor_len + num_field + 1%
			cur_row = cur_row + 1%
			call set_cursor_abs(cur_row, cur_col, term_table, chan)
		    end if
	        end if
	    else ! Advancing by row will put us on the next page. Display it.
		! Can we advance by a full row?
	      	if dir_selection <= (max_dir - num_cols) then
		    dir_selection = dir_selection + num_cols
		    page_number = page_number + 1%
		    cur_row = start_row
		    call display_dirs( page_number, new_dir( ) )
		    call set_cursor_abs(cur_row, cur_col, term_table, chan)
		else
		    end_col = mod(max_dir,num_cols)
		    logical_col = (cur_col / col_len) + 1%
		    if (end_col > 0%) and (logical_col > end_col) then
			dir_selection = dir_selection + end_col + (num_cols - logical_col)
			cur_col = (end_col - 1%) * col_len + cursor_len + num_field + 1%
			page_number = page_number + 1%
			cur_row = start_row
		        call display_dirs( page_number, new_dir( ) )
			call set_cursor_abs(cur_row, cur_col, term_table, chan)
		    end if
		    
                end if
	    end if
	end if
    case = up_arrow, = ctrl_p
	! Can we move up a row?
	if dir_selection > num_cols then
	    ! Are we at the top of a page?
	    if cur_row > start_row then ! No.
		cur_row = cur_row - 1%
		dir_selection = dir_selection - num_cols
		call set_cursor_abs(cur_row, cur_col, term_table, chan)
	    else ! Yes, at top of a page.
		! Is there a previous page?
		if page_number > 0% then
		    page_number = page_number - 1%
		    call display_dirs( page_number, new_dir( ) )
		    dir_selection = dir_selection - num_cols
		    cur_row = tt_rows
		    call set_cursor_abs(cur_row, cur_col, term_table, chan)
		end if
	    end if
	end if
    case = ctrl_e
	logical_col = (cur_col / col_len) + 1%
	col_diff = num_cols - logical_col
	end_col = mod(max_dir,num_cols)
	! Check to see if already at max column size.
	if col_diff > 0% then
	    ! Are we on the last row of directories?
	    if dir_selection > (max_dir - end_col) then
		! Last column position might be less than max column size.
		col_diff = end_col - logical_col
	    end if
	    ! Check to see if already at end of column.
	    if col_diff > 0% then
		cur_col = cur_col + (col_len * col_diff)
            end if
	    dir_selection = dir_selection + col_diff
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	end if
    case = ctrl_a, = backspace
	! Check to make sure we are not already at the first column.
	if cur_col > (start_col + cursor_len + num_field) then
	    logical_col = (cur_col / col_len) + 1%
	    cur_col = start_col + cursor_len + num_field
	    dir_selection = dir_selection - (logical_col - 1%)
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	end if
    case = ctrl_j
	! Should we really do an upward recursion or simply unwind one step.
	if recurse_count = 0% then
	    ! Nothing to unwind - check to see if there is room on the jump
	    ! stack to push another level.
	    if jump_count < 9% then
		context = 0%
		search_dir = "[" + string$(jump_count + 1%, 45%) + "]*.dir"
		sys_status = lib$find_file( search_dir, dir_file, context )
		! if status is not successful then user can't go up
		! another level.
		if sys_status = rms$_normal then
		    cur_dir = mid(new_dir(dir_selection), 1%, find_last(".", new_dir(dir_selection)) - 1%) + "]"
		    i = jump_count
		    ! Have we been here before? If so unwind the
		    ! stack to this point.
		    while (i > 0%) and (jump_dir(jump_count) <> cur_dir)
		    	i = i - 1%
		    next
		    if (jump_dir(i) = cur_dir) then
			! Unwind to here.
			jump_count = i
		    else
			if (cur_dir = start_dir) and (jump_count > 0%) then
			    ! Unwind to start.
			    jump_count = 0%
			else
			    ! Push where we were on the jump stacks.
			    jump_count = jump_count + 1%
		    	    jump_save(jump_count, 1%) = page_number
		    	    jump_save(jump_count, 2%) = cur_row
		    	    jump_save(jump_count, 3%) = cur_col
		    	    jump_save(jump_count, 4%) = dir_selection
		    	    jump_dir(jump_count) = cur_dir
			    dot = find_last(".", new_dir(dir_selection) )
			    if dot then
				parent_dir = mid(new_dir(dir_selection), 1%, dot - 1%) + "]"
			    else
				parent_dir = new_dir(dir_selection)
			    end if
		    	    call read_dirs( search_dir, new_dir( ) )
			    i = max_dir
			    ! Find the position of the directory that
			    ! we just came up from.
			    while (i > 0%) and (new_dir(i) <> parent_dir)
				i = i - 1%
			    next
			    if i = 0% then
				! Couldn't find it. (should get here...I hope.)
				! Go to top.
		    	        dir_selection = 1%
		    	    	cur_row = start_row
		    	    	cur_col = start_col + cursor_len + num_field
		    	    	page_number = 0%
			    else
				! Position cursor on top of the directory
				! that we just came up from.
				dir_selection = i
				page_number = dir_selection / (page_size + 1%)
				if dir_selection >= num_cols then
				    end_col = mod(dir_selection,num_cols)
				    if end_col = 0% then
					end_col = num_cols
				    end if
				else
				    end_col = dir_selection
				end if
				cur_col = (end_col - 1%) * col_len + start_col + cursor_len + num_field
				num_rows = tt_rows - start_row + 1%
				cur_row = (dir_selection / num_cols) - (num_rows * page_number) + start_row - 1%
				if end_col < num_cols then
				    cur_row = cur_row + 1
				end if
			    end if
		    	    call display_dirs( page_number, new_dir( ) )
		    	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
			end if
		    end if
		end if
	    end if
	else
	    ! Unwind one level from recursion stack.
	    page_number = recurse_save(recurse_count, 1%)
	    cur_row = recurse_save(recurse_count, 2%)
	    cur_col = recurse_save(recurse_count, 3%)
	    dir_selection = recurse_save(recurse_count, 4%)
	    recurse_count = recurse_count - 1%
	    dot = find_last(".", recurse_dir)
	    if dot then
	        recurse_dir = mid(recurse_dir, 1%, dot - 1%) + "]"
	    else
		recurse_dir = mid(recurse_dir, 1%, len(recurse_dir) - 1%) + ".-]"
	    end if
	    if recurse_flag then
		! Need to reconstruct the search directory.
		dot = find_last(".", recurse_dir)
		if dot then
		    recurse_flag = 0%
		    recurse_dir = mid(recurse_dir, 1%, dot - 1%) + "]"
		else
		    recurse_dir = mid(recurse_dir, 1%, len(recurse_dir) - 1%) + ".-]"
		end if
	    end if
	    call read_dirs ( recurse_dir, new_dir( ) )
	    call display_dirs( page_number, new_dir( ) )
	    call set_cursor_abs(cur_row, cur_col, term_table, chan )
	end if
    case = ctrl_r
	! Check to see if we need to perform a real downward recursion
	! or can we simply unwind one level from the jump stack.
	if new_dir(dir_selection) = jump_dir(jump_count) then
	    ! Unwind one level from jump stack.
	    page_number = jump_save(jump_count, 1%)
	    cur_row = jump_save(jump_count, 2%)
	    cur_col = jump_save(jump_count, 3%)
	    dir_selection = jump_save(jump_count, 4%)
	    search_dir = jump_dir(jump_count) + "*.dir"
	    jump_count = jump_count - 1%
	    call read_dirs( search_dir, new_dir( ) )
	    call display_dirs( 0%, new_dir( ) )
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	else
	    ! Is there room on the recursion stack to push another level?
	    if recurse_count < 8% then
		! Save current level on recursion stack.
		recurse_dir = new_dir(dir_selection)
		search_dir = mid(recurse_dir, 1%, instr(1%, recurse_dir, "]")) + "*.dir"
		recurse_flag = -1%
		context = 0%
		sys_status = lib$find_file( search_dir, dir_file, context )
		if sys_status = rms$_normal then
	            recurse_flag = 0%
		    recurse_count = recurse_count + 1%
		    recurse_save(recurse_count, 1%) = page_number
		    recurse_save(recurse_count, 2%) = cur_row
		    recurse_save(recurse_count, 3%) = cur_col
		    recurse_save(recurse_count, 4%) = dir_selection
		    recurse_dir = new_dir(dir_selection)
		    dir_selection = 1%
		    cur_row = start_row
		    cur_col = start_col + cursor_len + num_field
		    page_number = 0%
		    call read_dirs( recurse_dir, new_dir( ) )
		    call display_dirs( 0%, new_dir( ) )
		    call set_cursor_abs(cur_row, cur_col, term_table, chan)
		end if
	    end if
	end if
    case = ctrl_u
	! Control-X gets returned to us as a control-U (bummer)
	! Expand the directory name at top of screen.
	call set_cursor_abs(1%, 1%, term_table, chan)
	call output( smg$k_erase_to_end_line, term_table, chan )
	i = len(new_dir(dir_selection))
	if i <= tt_cols then
	    print #2%, new_dir(dir_selection);
	else
	    print #2%, mid(new_dir(dir_selection), i - tt_cols + 1%, tt_cols);
	end if
	call set_cursor_abs(cur_row, cur_col, term_table, chan)
    case = esc_low_v, = esc_cap_v, = prev_scrn
	! Can we go back a page?
	if page_number > 0% then
	    ! Yes. Decrement page number and redisplay the directories.
	    page_number = page_number - 1%
	    call display_dirs( page_number, new_dir( ) )
	    dir_selection = dir_selection - (tt_rows - (start_row - 1%)) * num_cols
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	else
	    ! No. Move to beginning of current page.
	    if dir_selection > 1% then
		dir_selection = 1%
		cur_row = start_row
		cur_col = start_col + cursor_len + num_field
		call set_cursor_abs(cur_row, cur_col, term_table, chan)
	    end if
	end if
    case = ctrl_v, = next_scrn
	! Is there a next page?
	if max_dir > ((page_number + 1%) * page_size) then
	    ! Yes. Display it.
	    page_number = page_number + 1%
	    ! Can we advance by a full page?
	    if dir_selection <= (max_dir - page_size) then
		! Yes. Increment array index by page_size.
		dir_selection = dir_selection + page_size
	    else
		! No. Go to bottom of next page.
		dir_selection = max_dir
		end_col = mod(max_dir,num_cols)
		if end_col > 0% then
		    cur_col = (end_col - 1%) * col_len + cursor_len + num_field + 1%
		else
		    cur_col = (num_cols - 1%) * col_len + cursor_len + num_field + 1%
		end if
		cur_row = max_dir / page_size
		if mod(max_dir,page_size) > 0% then
		    cur_row = cur_row + 1%
		end if
	    end if
	    call display_dirs( page_number, new_dir( ) )
	    call set_cursor_abs(cur_row, cur_col, term_table, chan)
	else
	    ! There is no next page. Move to bottom of current page.
	    if dir_selection < max_dir then
		dir_selection = max_dir
		end_col = mod(max_dir,num_cols)
		if end_col > 0% then
		    cur_col = (end_col - 1%) * col_len + cursor_len + num_field + 1%
		else
		    cur_col = (num_cols - 1%) * col_len + cursor_len + num_field + 1%
		end if
		cur_row = mod(max_dir,page_size)
		if cur_row <> 0% then
		    cur_row = cur_row / num_cols + start_row - 1%
		else
		    cur_row = tt_rows
		end if
		x = num_cols
		y = mod(max_dir,page_size)
		x = y / x + start_row - 1.0
		if x > cur_row then 
		    cur_row = cur_row + 1%
		end if
		call set_cursor_abs(cur_row, cur_col, term_table, chan)
	    end if
	end if
    case = ctrl_w, = ctrl_l
	! Refresh the screen.
	call display_dirs( page_number, new_dir( ) )
	call set_cursor_abs(cur_row, cur_col, term_table, chan)
    case = ctrl_z
	! Exit into the directory that contains the directories
	! that are currently being displayed.
	dir_selection = 1%
	dot = find_last(".",new_dir(1%))
	if dot = 0% then
	    new_dir(1%)=mid(new_dir(1%),1%,instr(0%,new_dir(1%),"["))+"000000]"
	    dot = len(new_dir(1%))
	end if
	new_dir(1%) = mid(new_dir(1%), 1%, dot - 1%) + "]"
	call set_cursor_abs(1%, 1%, term_table, chan)
	call output( smg$k_erase_whole_display, term_table, chan )
	exit sub
    case = help, = q_mark
	! Display help.
	call output( smg$k_erase_whole_display, term_table, chan )
	call set_cursor_abs( 1%, 1%, term_table, chan)
	call help
	! Continue where we were.
	call display_dirs( page_number, new_dir( ) )
	call set_cursor_abs(cur_row, cur_col, term_table, chan)
    case = ctrl_m, = do_key
	! The user has chosen the desired directory.
	call set_cursor_abs(1%, 1%, term_table, chan)
	call output( smg$k_erase_whole_display, term_table, chan )
	exit sub
    case else
	! Let's check to see if it's a number of a directory.
	! Better set error trapping just incase it's not.
	when error in
	    i = val(mid(text,1%,text_len))
	    if (i > 0%) and (i <= max_dir) then
	        dir_selection = i
		call set_cursor_abs(1%, 1%, term_table, chan)
		call output( smg$k_erase_whole_display, term_table, chan )
		exit sub
	    end if
	use
	    ! Oops. Not a number - must have been garbage.
	    ! Throw it away and continue.
	    continue forever
	end when
end select

! Let's make the compiler think that this might be false so it
! won't complain about unreachable code.
if (text <> ctrl_m) and (text <> do_key ) then goto forever end if
end when ! End when error for ^C trapping.

handler error_trap
    ! Is it a programmable ^C trap?
    if err=28% then
	! Yes. Clear screen and exit with successful status.
	y% = ctrlc
	call set_cursor_abs(1%, 1%, term_table, chan)
	call output( smg$k_erase_whole_display, term_table, chan )
	call sys$exit( 1% by value )
    else
	! Not expecting anything else...better report it.
	print #2%, ert$(err)
    end if
end handler

subend