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 2 of 6
Message-ID: <8703030250.10180@murdu.OZ>
Date: Tue, 3-Mar-87 13:50:28 EST
Article-I.D.: murdu.8703030250.10180
Posted: Tue Mar  3 13:50:28 1987
Date-Received: Thu, 5-Mar-87 19:29:22 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: 828
Approved: info-vax@sri-kl.arpa

$write sys$error "extract CHECK_DIRECTORY_MOVE.FOR"
$copy sys$input CHECK_DIRECTORY_MOVE.FOR
$deck/dollars="870303:12:53:38"
      logical function check_directory_move( from_num, cur_num )

      include 'swing.cmn/List'

      integer from_num, cur_num, from_levels, ptr(0:7)

      from_levels = 1

      ptr(0) = from_num

      ptr(1) = node(ptr(0)).child
      do while( ptr(1) .ne. 0 )
	if ( from_levels .lt. 2 ) from_levels = 2
	ptr(2) = node(ptr(1)).child
	do while( ptr(2) .ne. 0 )
	  if ( from_levels .lt. 3 ) from_levels = 3
	  ptr(3) = node(ptr(2)).child
	  do while( ptr(3) .ne. 0 )
	    if ( from_levels .lt. 4 ) from_levels = 4
	    ptr(4) = node(ptr(3)).child
	    do while( ptr(4) .ne. 0 )
	      if ( from_levels .lt. 5 ) from_levels = 5
	      ptr(5) = node(ptr(4)).child
	      do while( ptr(5) .ne. 0 )
		if ( from_levels .lt. 6 ) from_levels = 6
		ptr(6) = node(ptr(5)).child
		do while( ptr(6) .ne. 0 )
		  if ( from_levels .lt. 7 ) from_levels = 7
		  ptr(7) = node(ptr(6)).child
		  do while( ptr(7) .ne. 0 )
		    if ( from_levels .lt. 8 ) from_levels = 8
		    ptr(7) = node(ptr(7)).sister
		  end do
		  ptr(6) = node(ptr(6)).sister
		end do
		ptr(5) = node(ptr(5)).sister
	      end do
	      ptr(4) = node(ptr(4)).sister
	    end do
	    ptr(3) = node(ptr(3)).sister
	  end do
	  ptr(2) = node(ptr(2)).sister
	end do
	ptr(1) = node(ptr(1)).sister
      end do

      if ( node(cur_num).level + from_levels .gt. 7 ) then
	 check_directory_move = .false.
	 else
	 check_directory_move = .true.
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract CREATE_DIRECTORY.FOR"
$copy sys$input CREATE_DIRECTORY.FOR
$deck/dollars="870303:12:53:38"
      subroutine create_directory( code )

      include    'swing.cmn/List'
      include    '($ssdef)/List'

      character  new_dir*42, term*5, string*39, message*255
      integer    iterm, len_string, lib$create_dir
      integer    sys$getmsg, istat, len_message, code

      call print_message( ' ', 0 )
      call smg$set_cursor_abs( window3, 1, 1 )
      call smg$read_string( keyboard, string,
     .		      'New subdirectory name: ',
     .		      39,,,,len_string,, window3 )

      new_dir = ' '
      jj = 0

      do ii = 1, len_string
	 if ( string(ii:ii) .ne. '[' .and. string(ii:ii) .ne. ']' .and.
     .	      string(ii:ii) .ne. '.' .and. string(ii:ii) .gt. ' ' ) then
	    jj = jj + 1
	    new_dir(jj:jj) = string(ii:ii)
	    end if
      end do

      call str$upcase( new_dir, new_dir )

      if ( jj .ne. 0 ) then
	 istat = lib$create_dir( '[.'//new_dir(1:jj)//']' )

	 if ( istat .eq. ss$_created ) then

	    do_save = .true.

	    call add_node( new_dir(1:jj), node_num )

	    call adjust_node_pointers

	    call load_display

	    call update_screen( cur_line, cur_level )

	    call print_message( 'Created new subdirectory', 0 )

	    else if ( .not. istat ) then
	    call sys$getmsg( %val(istat), len_message, message,
     .			     %val(1), )
	    call print_message( message(1:len_message), 0 )

	    else
	    call smg$erase_display( window3 )
	    end if

	 else
	 call smg$erase_display( window3 )
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract CRT.FOR"
$copy sys$input CRT.FOR
$deck/dollars="870303:12:53:38"
      logical function crt

      include    '($dvidef)/List'
      include    '($ttdef)/List'
      include    '($tt2def)/List'

      include    'swing.cmn/List'

      integer*2  b2(14)
      integer*4  b4(7), buf, len_buf, sys$trnlog, sys$getdvi, dev_type
      logical*4  for$bjtest, istat

      equivalence ( b4(1), b2(1) )

      b2(1) = 4
      b2(2) = dvi$_devdepend2
      b4(2) = %loc( buf )
      b4(3) = %loc( len_buf )

      b2(7) = 4
      b2(8) = dvi$_devtype
      b4(5) = %loc( dev_type )
      b4(6) = %loc( len_dev_type )

      b4(7) = 0

      istat = sys$getdviw( ,, 'SYS$COMMAND', b4,,,, )

      crt      = ( for$bjtest( buf, tt2$v_deccrt ) .or.
     .			dev_type .eq. tt$_vt52 )
      avo      = for$bjtest( buf, tt2$v_avo )

      return
      end
870303:12:53:38
$write sys$error "extract DEFINE_PASTE_BOARD.FOR"
$copy sys$input DEFINE_PASTE_BOARD.FOR
$deck/dollars="870303:12:53:38"
      subroutine define_paste_board

      include    '($smgdef)/List'
      include    'swing.cmn/List'

C     DEC FORGOT THIS PARAMETER IN $SMGDEF
      parameter  SMG$S_PASTEBOARD_INFO_BLOCK = '20'x

      integer    smg$create_pasteboard
      integer    smg$create_virtual_keyboard
      integer    smg$set_keypad_mode
      integer    smg$get_pasteboard_attributes

      record     /smgdef/ table

      call set_notab( 'SYS$COMMAND', set_term_buf )

      istat = smg$create_pasteboard( board_id )

      istat = smg$get_pasteboard_attributes(board_id, %ref(table),
     .		%ref(SMG$S_PASTEBOARD_INFO_BLOCK))

      width = table.smg$w_width

      istat = smg$create_virtual_keyboard( keyboard )
      istat = smg$set_keypad_mode( keyboard, 1 )

      call sm_allow_repaint

      return
      end
870303:12:53:38
$write sys$error "extract DEFINE_SMG_LAYOUT.FOR"
$copy sys$input DEFINE_SMG_LAYOUT.FOR
$deck/dollars="870303:12:53:38"
      subroutine define_smg_layout

      include    '($smgdef)/List'
      include    'swing.cmn/List'

      integer smg$create_virtual_display
      record /pd_choice_type/ sub_choices(9)

      call define_paste_board

c     CREATE THE WINDOWS

      istat = smg$create_virtual_display(  1, 132, window1 )

      istat = smg$create_virtual_display(  MAX_LINES, 132, window2 )

      istat = smg$create_virtual_display(  2, 132, window3 )

      pull_choices.number = 9
      pull_choices.choice(1) = 'Create'
      pull_choices.code(1) = 10
      pull_choices.ptr(1) = 0
      pull_choices.choice(2) = 'Rename'
      pull_choices.code(2) = 20
      pull_choices.ptr(2) = 0
      pull_choices.choice(3) = 'Move'
      pull_choices.code(3) = 30
      pull_choices.ptr(3) = 0
      pull_choices.choice(4) = 'Delete'
      pull_choices.code(4) = 40
      pull_choices.ptr(4) = 0
      pull_choices.choice(5) = 'Print'
      pull_choices.code(5) = 50
      pull_choices.ptr(5) = 0
      pull_choices.choice(6) = 'Save'
      pull_choices.code(6) = 60
      pull_choices.ptr(6) = 0
      pull_choices.choice(7) = 'Options'
      pull_choices.code(7) = 70
      pull_choices.ptr(7) = %loc( sub_choices(7) )
      pull_choices.choice(8) = 'Help'
      pull_choices.code(8) = 80
      pull_choices.ptr(8) = 0
      pull_choices.choice(9) = 'Exit'
      pull_choices.code(9) = 90
      pull_choices.ptr(9) = %loc( sub_choices(9) )

      sub_choices(1).number = 0
      sub_choices(2).number = 0
      sub_choices(3).number = 0
      sub_choices(4).number = 0

      sub_choices(5).number = 0

      sub_choices(6).number = 0

      sub_choices(7).number = 1
      sub_choices(7).choice(1) = 'display directory'
      sub_choices(7).code(1) = 71

      sub_choices(8).number = 0

      sub_choices(9).number = 2
      sub_choices(9).choice(1) = 'ok exit'
      sub_choices(9).code(1) = 91
      sub_choices(9).choice(2) = 'cancel'
      sub_choices(9).code(2) = 92

      call pd_load_bar( width, pull_choices)

      use_window1 = .false.

      return
      end
870303:12:53:38
$write sys$error "extract DELETE_DIRECTORY.FOR"
$copy sys$input DELETE_DIRECTORY.FOR
$deck/dollars="870303:12:53:38"
      subroutine delete_directory( code )

      include    'swing.cmn/List'
      include    '($ssdef)/List'

      character  spec(0:MAX_LEVELS)*255, search(0:MAX_LEVELS)*255
      character  term*5, string*3, message*255, name*50
      integer    iterm, len_string, code
      integer    sys$getmsg, istat, len_message, len(0:MAX_LEVELS)
!!!   integer    icont(MAX_LEVELS), lib$find_file, ii	! Michael Bednarek changed to:
      integer    icont(0:MAX_LEVELS), lib$find_file, ii
      logical    found_node

      call print_message( ' ', 0 )
      call smg$set_cursor_abs( window3, 1, 1 )
      call smg$read_string( keyboard, string,
     .		      'Enter YES to to delete this direc'//
     .		      'tory and all directories below it: ',
     .		      3,,,,len_string,, window3 )

      call str$upcase( string, string )

      if ( string .eq. 'YES' ) then

	 do_save = .true.

	 call print_message('Deleting current directory structure...',0)

	 delete_problem = .false.
	 search(0)=node(node_num).spec(1:node(node_num).length)//'*.dir'

	 icont(0) = 0
	 do while ( lib$find_file( search(0), spec(0), icont(0) ) )
	  call file_to_dir( spec(0), search(1), len(1), name )
	  search(1) = search(1)(1:len(1))//'*.dir'
	  icont(1) = 0
	  do while ( lib$find_file( search(1), spec(1), icont(1) ) )
	   call file_to_dir( spec(1), search(2), len(2), name )
	   search(2) = search(2)(1:len(2))//'*.dir'
	   icont(2) = 0
	   do while ( lib$find_file( search(2), spec(2), icont(2) ) )
	    call file_to_dir( spec(2), search(3), len(3), name )
	    search(3) = search(3)(1:len(3))//'*.dir'
	    icont(3) = 0
	    do while ( lib$find_file( search(3), spec(3), icont(3) ) )
	     call file_to_dir( spec(3), search(4), len(4), name )
	     search(4) = search(4)(1:len(4))//'*.dir'
	     icont(4) = 0
	     do while ( lib$find_file( search(4), spec(4), icont(4) ) )
	      call file_to_dir( spec(4), search(5), len(5), name )
	      search(5) = search(5)(1:len(5))//'*.dir'
	      icont(5) = 0
	      do while ( lib$find_file( search(5), spec(5), icont(5) ) )
	       call file_to_dir( spec(5), search(6), len(6), name )
	       search(6) = search(6)(1:len(6))//'*.dir'
	       icont(6) = 0
	       do while ( lib$find_file( search(6), spec(6), icont(6) ))
		call file_to_dir( spec(6), search(7), len(7), name )
		call delete_files( search(7)(1:len(7)) )
	       end do
	       call lib$find_file_end( icont(6) )
	       call delete_files( search(6)(1:len(6)) )
	      end do
	      call lib$find_file_end( icont(5) )
	      call delete_files( search(5)(1:len(5)) )
	     end do
	     call lib$find_file_end( icont(4) )
	     call delete_files( search(4)(1:len(4)) )
	    end do
	    call lib$find_file_end( icont(3) )
	    call delete_files( search(3)(1:len(3)) )
	   end do
	   call lib$find_file_end( icont(2) )
	   call delete_files( search(2)(1:len(2)) )
	  end do
	  call lib$find_file_end( icont(1) )
	  call delete_files( search(1)(1:len(1)) )
	 end do
	 call lib$find_file_end( icont(0) )
	 call delete_files( search(0)(1:node(node_num).length) )

	 if ( 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
	       node_num = node_pointer(ii,jj)
	       else
	       node_num = 1
	       end if
	    else
	    node_num = 1
	    end if

	 call adjust_node_pointers
	 call load_display

	 cur_level = node(node_num).level
	 cur_line = node(node_num).line

	 call update_screen( cur_line, cur_level )

	 if ( delete_problem ) then
	    call print_message( 'Attempted to delete subdirectory - '//
     .	   'but some files could not be deleted', 0 )
	    else
	    call print_message( 'Deleted subdirectory structure', 0 )
	    end if
	 else

	 call print_message( 'No directories deleted', 0 )
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract DELETE_FILES.FOR"
$copy sys$input DELETE_FILES.FOR
$deck/dollars="870303:12:53:38"
      subroutine delete_files( dir_spec )

      include    'swing.cmn/List'
      include    '($smgdef)/List'

      integer    icontext, lib$delete_file, modify_file_prot, ptr
      character  dir_spec*(*), spec*255
      logical    find_node, found_node

      ii = len( dir_spec )
      do while ( dir_spec(ii:ii) .eq. ' ' .and. ii .gt. 0 )
	 ii = ii - 1
      end do

      if ( find_node( dir_spec(1:ii), ptr ) ) then
	 found_node = .true.
	 call smg$change_rendition( window2, node(ptr).line,
     .			      node(ptr).level*17+1,
     .			      1, 12,
     .			      smg$m_blink + node(ptr).rend )
	 else
	 found_node = .false.
	 end if

      icontext = 0
      do while( lib$find_file( dir_spec(:ii)//'*.*;*', spec, icontext ))
	 if ( .not. lib$delete_file( spec ) ) then
	    call str$trim( spec, spec, len_spec )
	    if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
	       istat = lib$delete_file( spec )
	       if ( .not. istat ) delete_problem = .true.
	       else
	       call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
     .			 dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
	       istat = lib$delete_file( spec )
	       if ( .not. istat ) delete_problem = .true.
	       end if
	    end if
      end do
      call lib$find_file_end( icontext )

      call dir_to_file( dir_spec, ii,
     .		  spec, ipos )
      if ( .not. lib$delete_file( spec ) ) then
	 call str$trim( spec, spec, len_spec )
	 if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
	    istat = lib$delete_file( spec )
	    if ( .not. istat ) delete_problem = .true.
	    else
	    call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
     .		      dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
	    istat = lib$delete_file( dir_spec(1:ii) )
	    if ( .not. istat ) delete_problem = .true.
	    end if
	 end if

      if ( .not. delete_problem ) then
	 if ( found_node ) call delete_node( ptr )
	 else
	 if ( found_node )
     .      call smg$change_rendition( window2, node(ptr).line,
     .				 node(ptr).level*17+1,
     .				 1, 12,
     .				 node(ptr).rend )
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract DELETE_NODE.FOR"
$copy sys$input DELETE_NODE.FOR
$deck/dollars="870303:12:53:38"
      subroutine delete_node( ptr )

      include    'swing.cmn/List'
      include    '($smgdef)/List'

      logical    found_node
      integer    ptr, ii

      found_node = .false.
      ii = 1

      do while ( .not. found_node .and. ii .le. num_nodes )
	 if ( node(ii).sister .eq. ptr ) then
	    found_node = .true.
	    node(ii).sister = node(ptr).sister

	    else if ( node(ii).child .eq. ptr ) then
	    found_node = .true.
	    node(ii).child = node(ptr).sister
	    end if
	 ii = ii + 1
      end do

      if ( found_node ) then
	 node(ptr).name = ' '
	 call smg$put_chars( window2, node(ptr).name,
     .				node(ptr).line,
     .				node(ptr).level * 17 + 1,,
     .				node(ptr).rend )
	 node(ptr).level = 0
	 node(ptr).length = 0
	 node(ptr).sister = 0
	 node(ptr).child = 0
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract DIR_TO_FILE.FOR"
$copy sys$input DIR_TO_FILE.FOR
$deck/dollars="870303:12:53:38"
      logical function dir_to_file( dir, len_dir, file, ipos )

      character dir*(*), file*(*)
      integer   len_dir, ii, ipos

      ii = len_dir
      do while ( dir(ii:ii) .ne. '.' .and. ii .gt. 0 )
	 ii = ii - 1
      end do

      if ( ii .ne. 0 ) then
	 dir_to_file = .true.
	 file = dir
	 file(ii:ii) = ']'
	 file(len_dir:) = '.dir;1'
	 ipos = ii

	 else
	 call print_message( 'Operation not allowed on main directory',
     .		       0 )
	 dir_to_file = .false.
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract DRAW_SCREEN.FOR"
$copy sys$input DRAW_SCREEN.FOR
$deck/dollars="870303:12:53:38"
      subroutine draw_screen

      include    '($smgdef)/List'
      include    'swing.cmn/List'

      integer    ii, jj, kk, smg$change_pbd_characteristics
      integer    smg$change_rendition

      call smg$begin_pasteboard_update( board_id )

      call smg$paste_virtual_display( window2, board_id, 3, 1 )
      call smg$paste_virtual_display( window1, board_id, 2, 1 )
      call smg$paste_virtual_display( window3, board_id, 23, 1 )

      call smg$set_display_scroll_region( window3, 1, 2 )

      call pd_draw_bar( board_id )

      top_line = 1
      bottom_line = 20

      node_num = node_pointer( cur_level, cur_line )

      call smg$change_rendition( window2, cur_line, cur_level*17+1,
     .			   1, 12,
     .			   smg$m_bold + node(node_num).rend )

      if ( cur_line .gt. bottom_line ) then
	 top_line = cur_line - 19
	 bottom_line = cur_line
	 call smg$move_virtual_display( window2, board_id,
     .				  23 - cur_line, 1 )
	 else if ( cur_line .lt. top_line ) then
	 top_line = cur_line
	 bottom_line = cur_line + 19
	 call smg$move_virtual_display( window2, board_id,
     .				     cur_line, 1 )
	 end if

      call update_window1

      call smg$end_pasteboard_update( board_id )

      call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )

      update = .true.

      return
      end
870303:12:53:38
$write sys$error "extract EXIT_SWING.FOR"
$copy sys$input EXIT_SWING.FOR
$deck/dollars="870303:12:53:38"
      subroutine exit_swing

      include    'swing.cmn/List'

      character  string*3
      integer    len_string

      if ( do_save .and. swing_file_exists ) then
	 call record_structure( .false. )
	 end if

      call smg$delete_pasteboard( board_id, 1 )

      call smg$change_pbd_characteristics( board_id, 80,, 24 )

      call reset_terminal( 'SYS$COMMAND', set_term_buf )

      stop ' '
      end
870303:12:53:38
$write sys$error "extract FILE_TO_DIR.FOR"
$copy sys$input FILE_TO_DIR.FOR
$deck/dollars="870303:12:53:38"
      logical function file_to_dir( file, dir, len_dir, name )

      character dir*(*), file*(*), name*(*)
      integer   len_dir, kk, ii, len_node

      kk = 1
      do while ( file(kk:kk) .ne. '[' )
	 kk = kk + 1
      end do
      dir = file(kk:)

      ii = 1
      do while ( dir(ii:ii) .ne. ']' )
	 ii = ii + 1
      end do

      jj = ii
      do while ( dir(jj:jj) .ne. '.' )
	 jj = jj + 1
      end do

      dir(ii:ii) = '.'
      dir(jj:) = ']'

      len_dir = jj

      len_node = jj - ii - 1
      if ( len_node .le. 9 ) then
	 name = '['//dir(ii:jj)
	 else
	 name = '['//dir(ii:ii+9)//'*'
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract FIND_NODE.FOR"
$copy sys$input FIND_NODE.FOR
$deck/dollars="870303:12:53:38"
      logical function find_node( dir_spec, ptr )

      include    'swing.cmn/List'

      character  dir_spec*(*)
      integer    ii, jj, ptr
      logical    found_node

      ii = len( dir_spec )
      do while ( dir_spec(ii:ii) .eq. ' ' .and. ii .gt. 0 )
	 ii = ii - 1
      end do

      jj = 1
      found_node = .false.
      do while ( .not. found_node )
	 if ( node(jj).spec(1:node(jj).length) .eq. dir_spec(1:ii) )then
	    found_node = .true.
	    ptr = jj
	    end if
	 jj = jj + 1
      end do

      find_node = found_node

      return
      end
870303:12:53:38
$write sys$error "extract FREE_NODE.FOR"
$copy sys$input FREE_NODE.FOR
$deck/dollars="870303:12:53:38"
      integer function free_node

      include 'swing.cmn/List'

      integer ii

      if ( num_nodes .lt. MAX_NODES ) then
	 num_nodes = num_nodes + 1
	 node(num_nodes).length = 0
	 node(num_nodes).child = 0
	 node(num_nodes).sister = 0
	 free_node = num_nodes

	 else
	 ii = 1
	 do while ( ii .le. MAX_NODES )
	    if ( node(ii).length .eq. 0 ) then
	       node(ii).length = 0
	       node(ii).child = 0
	       node(ii).sister = 0
	       free_node = ii
	       return
	       end if
	    ii = ii + 1
	 end do
	 if ( num_nodes .gt. MAX_NODES .or. num_lines .gt. MAX_LINES )
     .      call print_message( 'Directory structure is too large', 1 )
	 end if

      return
      end
870303:12:53:38
$write sys$error "extract GET_LOCATION.FOR"
$copy sys$input GET_LOCATION.FOR
$deck/dollars="870303:12:53:38"
      subroutine get_location( disk, len_disk, root, len_root )

      integer*2  len_root
      integer*4  sys$setddir, len_disk
      character  root*255, disk*31

      call lib$sys_trnlog( 'SYS$DISK', len_disk, disk )
      istat = sys$setddir( 0, len_root, root )

      root = root(1:len_root)

      return
      end
870303:12:53:38
$write sys$error "extract HARDCOPY.FOR"
$copy sys$input HARDCOPY.FOR
$deck/dollars="870303:12:53:38"
      subroutine hardcopy( code )

      include    '($smgdef)/List'
      include    'swing.cmn/List'

      integer    column, num, ii, jj, level, ikey, start, end, len
      integer    code
      character  hard_node*12, dashes*12, out_line(MAX_LINES)*132
      character  one_line*200

      data dashes / '------------' /

      open( unit=1,
     .      name='swing.lis',
     .      carriagecontrol='list',
     .      status='new',
     .      err=99 )

      call print_message( 'Creating hardcopy listing in SWING.LIS', 0 )

      last_level = 1
      line = 0
      do ii = 0, MAX_LEVELS
	 last_line(ii) = 1
      end do
      do ii = 1, num_lines
	 out_line(ii) = ' '
      end do

      do jj = 1, num_lines
	 do level = 0, MAX_LEVELS
	    if ( node_pointer(level,jj) .ne. 0 ) then
	       num = node_pointer(level,jj)

	       column = level * 17 + 1
	       line = node(num).line

	       call str$trim( hard_node, node(num).name, len )
	       if ( level .lt. 7 ) then
		  if ( node_pointer(level+1,jj) .ne. 0 )
     .			hard_node = hard_node(1:len)//dashes(len+1:12)
		  end if

	       out_line(line)(column:column+11) = hard_node
	       if ( level .gt. 0 ) then
		  out_line(line)(column-3:column-1) = '---'

		  if ( level .le. last_level ) then
		     out_line(line)(column-3:column-3) = '+'
		     if ( out_line(line-1)(column-3:column-3) .eq. '+' )
     .			out_line(line-1)(column-3:column-3) = '|'

		     else if ( level .eq. last_level + 1 ) then
		     out_line(line)(column-5:column-2) = '----'
		     end if

		  if ( level .lt. last_level ) then
		     if ( out_line(last_line(level))(column-3:column-3)
     .			  .eq. '+' ) then
			ll = last_line(level)
			else
			ll = last_line(level) + 1
			end if
		     do kk = ll, line-1
			out_line(kk)(column-3:column-3) = '|'
		     end do
		     end if
		  end if

	       last_level = level
	       last_line(level) = line
	       end if
	 end do
      end do

      do ii = 1, num_lines
	 call str$trim( out_line(ii), out_line(ii), len )
	 write( 1, 100 ) out_line(ii)(1:len)
100      format( a )
      end do

      call print_message( 'Finished creating SWING.LIS',0 )

      close( unit=1 )

      return

99    call print_message( 'Unable to open file for hardcopy', 0 )
      return
      end
870303:12:53:38