Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!utgpu!water!watnot!watmath!clyde!cbatt!ucbvax!u3369429@seismo.CSS.GOV@murdu.OZ.AU From: u3369429@seismo.CSS.GOV@murdu.OZ.AU Newsgroups: mod.computers.vax Subject: SWING (modified) part 5 of 6 Message-ID: <8703030254.10352@murdu.OZ> Date: Tue, 3-Mar-87 13:54:19 EST Article-I.D.: murdu.8703030254.10352 Posted: Tue Mar 3 13:54:19 1987 Date-Received: Thu, 5-Mar-87 19:27:49 EST Sender: daemon@ucbvax.BERKELEY.EDU Reply-To: munnari!u3369429@seismo.CSS.GOV (Michael Bednarek) Distribution: world Organization: I.A.E.S.R., Melbourne University Lines: 342 Approved: info-vax@sri-kl.arpa $write sys$error "extract SWING.FOR" $copy sys$input SWING.FOR $deck/dollars="870303:12:53:38" *======================================================================= * * Title: SWING * * Version: 1-001 * * Abstract: SWING is a VMS utility for displaying and manipulating * VMS directory trees. * * Environment: VMS * * Author: Eric Andresen of General Research Corporation * * Date: 24-SEP-1986 * *----------------------------------------------------------------------- program swing include '($smgdef)/List' include 'swing.cmn/List' integer ikey, old_level, old_line, isave, code, code_type logical crt, finished character key, choice*(PD_MAX_CHOICE_LEN) if ( .not. crt() ) . call print_message( 'You must use a DEC CRT terminal', 1 ) call load_nodes call define_smg_layout call load_display call draw_screen do while ( .not. finished ) call smg$read_keystroke( keyboard, ikey ) call print_message( ' ', 0 ) old_line = cur_line old_level = cur_level old_rend = node(node_num).rend if ( ikey .eq. smg$k_trm_do .or. ! Pulldown Menu . ikey .eq. smg$k_trm_ctrlp ) then call pd_get_choice( board_id, keyboard, width, . pull_choices, choice, code ) code_type = code / 10 else code_type = 0 code = 0 end if if ( ikey .eq. smg$k_trm_ctrlz .or. . ikey .eq. smg$k_trm_lowercase_x .or. . ikey .eq. smg$k_trm_uppercase_x .or. . ikey .eq. smg$k_trm_lowercase_e .or. . ikey .eq. smg$k_trm_uppercase_e .or. 1 ikey.eq.SMG$K_TRM_LowerCase_q .or. ! Michael Bednarek 1 ikey.eq.SMG$K_TRM_UpperCase_Q .or. ! added {q,Q,F10,} 1 ikey.eq.SMG$K_TRM_F10 .or. . ikey .eq. smg$k_trm_enter .or. 1 ikey.eq.SMG$K_TRM_CR .or. . code .eq. 91 ) then finished = .true. else if ( ikey .eq. smg$k_trm_up ) then ii = cur_level jj = cur_line - 1 ! find the next line upwards with a node_pointer !!! do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) ! Michael Bednarek changed to: do while (jj.ge.1 .and. node_pointer(ii,jj).eq.0) jj = jj - 1 end do if ( jj .ge. 1 ) cur_line = jj call update_screen( old_line, old_level ) else if ( ikey .eq. smg$k_trm_down ) then ii = cur_level jj = cur_line + 1 do while( node_pointer(ii,jj) .eq. 0 .and.jj .le. num_lines) jj = jj + 1 end do if ( jj .le. num_lines ) cur_line = jj call update_screen( old_line, old_level ) else if ( ikey .eq. smg$k_trm_right ) then ii = cur_level + 1 jj = cur_line do while( node_pointer(ii,jj) .eq. 0 .and.ii.le. MAX_LEVELS) ii = ii + 1 end do if ( ii .le. MAX_LEVELS ) cur_level = ii call update_screen( old_line, old_level ) else if ( ikey .eq. smg$k_trm_left .and. . cur_level .ge. 1 ) then ii = cur_level - 1 jj = cur_line do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) jj = jj - 1 end do if ( jj .ge. 1 ) then cur_level = ii cur_line = jj end if call update_screen( old_line, old_level ) else if ( code_type .eq. 1 .or. . ikey .eq. smg$k_trm_lowercase_c .or. . ikey .eq. smg$k_trm_uppercase_c ) then call create_directory( code ) else if ( code_type .eq. 2 .or. . ikey .eq. smg$k_trm_lowercase_r .or. . ikey .eq. smg$k_trm_uppercase_r ) then call rename_directory( 20 ) else if ( code_type .eq. 3 .or. . ikey .eq. smg$k_trm_lowercase_m .or. . ikey .eq. smg$k_trm_uppercase_m ) then call rename_directory( 30 ) else if ( code_type .eq. 4 .or. . ikey .eq. smg$k_trm_lowercase_d .or. . ikey .eq. smg$k_trm_uppercase_d ) then call delete_directory( code ) else if ( code_type .eq. 5 .or. . ikey .eq. smg$k_trm_lowercase_p .or. . ikey .eq. smg$k_trm_uppercase_p ) then call hardcopy( code ) else if ( code_type .eq. 6 .or. . ikey .eq. smg$k_trm_lowercase_s .or. . ikey .eq. smg$k_trm_uppercase_s ) then call record_structure( .true. ) else if ( code_type .eq. 7 .or. . ikey .eq. smg$k_trm_lowercase_o .or. . ikey .eq. smg$k_trm_uppercase_o ) then call change_options( 71 ) else if ( code_type .eq. 8 .or. . ikey .eq. smg$k_trm_pf2 .or. . ikey .eq. smg$k_trm_help .or. . ikey .eq. smg$k_trm_lowercase_h .or. . ikey .eq. smg$k_trm_uppercase_h ) then call help( code ) end if call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 ) end do call exit_swing end 870303:12:53:38 $write sys$error "extract UPDATE_SCREEN.FOR" $copy sys$input UPDATE_SCREEN.FOR $deck/dollars="870303:12:53:38" subroutine update_screen( old_line, old_level ) include '($smgdef)/List' include 'swing.cmn/List' integer old_line, old_level, sys$setddir node_num = node_pointer( cur_level, cur_line ) call smg$begin_pasteboard_update( board_id ) call smg$change_rendition( window2, old_line, old_level*17+1, . 1, 12, old_rend ) call smg$change_rendition( window2, cur_line, cur_level*17+1, . 1, 12, . smg$m_bold + node(node_num).rend ) call update_window1 call smg$end_pasteboard_update( board_id ) if ( cur_line .gt. bottom_line ) then do ii = bottom_line+1, cur_line call smg$move_virtual_display( window2, board_id,23-ii,1) end do top_line = cur_line - 19 bottom_line = cur_line else if ( cur_line .lt. top_line ) then do ii = top_line-1, cur_line, -1 call smg$move_virtual_display( window2, board_id, 4-ii,1) end do top_line = cur_line bottom_line = cur_line + 19 end if istat = sys$setddir( node(node_num).spec, %val(0), %val(0) ) return end 870303:12:53:38 $write sys$error "extract UPDATE_WINDOW1.FOR" $copy sys$input UPDATE_WINDOW1.FOR $deck/dollars="870303:12:53:38" subroutine update_window1 include '($smgdef)/List' include 'swing.cmn/List' integer start if ( use_window1 ) then start = ( width - (len_disk + node(node_num).length) ) / 2 if ( start .le. 0 ) start = 1 call smg$erase_line( window1, 1, 1 ) call smg$put_chars( window1, . disk(1:len_disk)// . node(node_num).spec(1:node(node_num).length), . 1, start,, smg$m_underline ) end if return end 870303:12:53:38 $write sys$error "extract PULLDOWN.CMN" $copy sys$input PULLDOWN.CMN $deck/dollars="870303:12:53:38" *======================================================================= * COMMONS FOR PULLDOWN.FOR *======================================================================= C CONSTRAINTS parameter PD_MAX_CHOICES=10 parameter PD_MAX_CHOICE_LEN=20 C THE PULL DOWN CHOICE STRUCTURE structure /pd_choice_type/ integer number character*(PD_MAX_CHOICE_LEN) choice(PD_MAX_CHOICES) integer code(PD_MAX_CHOICES) integer ptr(PD_MAX_CHOICES) end structure C PULL DOWN SCREEN INFORMATION integer pd_bar_id,pd_num_choices,pd_cell_size common /pd_common/ pd_bar_id, ! BAR DISPLAY ID 1 pd_num_choices, ! NUMBER OF POSSIBLE CHOICES 1 pd_cell_size ! LENGTH OF EACH CELL IN THE BAR 870303:12:53:38 $write sys$error "extract SWING.CMN" $copy sys$input SWING.CMN $deck/dollars="870303:12:53:38" *======================================================================= * COMMONS FOR SWING.FOR *======================================================================= include 'pulldown.cmn/List' parameter MAX_LINES = 300 parameter MAX_LEVELS = 7 parameter MAX_NODES = 600 integer line,last_level,last_line(0:MAX_LEVELS) integer last_node(0:MAX_LEVELS) integer node_pointer(0:MAX_LEVELS,MAX_LINES),lowest_level integer node_num,num_nodes,num_lines structure /node_type/ character*255 spec character*12 name integer*4 length integer*4 level integer*4 line integer*4 rend integer*4 child integer*4 sister end structure !!! record /node_type/ node(MAX_NODES) ! Michael Bednarek changed to : record /node_type/ node(0:MAX_NODES) common /node_info/ line, 1 last_level, 1 lowest_level, 1 last_line, 1 last_node, 1 num_lines, 1 node_pointer, 1 node, 1 node_num, 1 num_nodes integer window1,window2,window3,board_id,set_term_buf(3) integer width,cur_level,cur_line,bottom_line,top_line integer old_rend,len_disk,len_main,keyboard logical avo,using_screen,found,update,delete_problem logical use_window1,do_save,swing_file_exists character this_terminal*31,disk*31,root*255,main*50 record /pd_choice_type/ pull_choices common /smg_info/ board_id, 1 keyboard, 1 window1, 1 window2, 1 window3, 1 pull_choices, 1 this_terminal, 1 set_term_buf, 1 width, 1 avo, 1 old_rend, 1 disk, 1 len_disk, 1 root, 1 main, 1 len_main, 1 cur_level, 1 cur_line, 1 top_line, 1 bottom_line, 1 using_screen, 1 use_window1, 1 update, 1 found, 1 delete_problem, 1 do_save, 1 swing_file_exists 870303:12:53:38