From:	CSBVAX::MRGATE!vtcf@ncsc.ARPA@SMTP 13-APR-1988 03:16
To:	ARISIA::EVERHART
Subj:	SWING 5 OF 13


Received: from ncsc.ARPA by KL.SRI.COM with TCP; Mon 11 Apr 88 08:31:51-PDT
Received: by ncsc.ARPA id AA02838; Mon, 11 Apr 88 10:28:05 CST
Date: Mon, 11 Apr 88 10:28:05 CST
From: vtcf@ncsc.ARPA (Williams)
Message-Id: <8804111628.AA02838@ncsc.ARPA>
To: info-vax@kl.sri.com
Subject: SWING 5 OF 13

$Part05:
$ File_is="SWING_10.FOR"
$ Check_Sum_is=1378108493
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X        function        translate_logical (logical_name,translation)
X
Xc       Craig Young             3-AUG-87
X
X        implicit        none
X        include         '($lnmdef)'
X        include         '($ssdef)'
X
X
X        integer*4       translate_logical
X        character*(*)   translation
X        character*(*)   logical_name
X
X        integer*4       sys$trnlnm
X        integer*4       status
X        integer*4       attribute
X        integer*4       ret_buf_len
X        integer*4       n
X
X        structure /item_list/
X          integer*2     item_len
X          integer*2     item_code /lnm$_string/
X          integer*4     buffer_addr
X          integer*4     ret_buffer_addr /0/
X          integer*4     end_items /0/
X        end structure
X        record /item_list/ items
X
X        translation = ' '
X        attribute = lnm$m_case_blind
X        items.item_len = LEN(logical_name)
X        items.buffer_addr = %loc(translation)
X        call str$trim(logical_name,logical_name,n)
X
X        status = sys$trnlnm ( attribute, 'LNM$PROCESS', 
X     -          logical_name(1:n),,items)
X        if ( status .ne. ss$_normal ) then
X          status = sys$trnlnm ( attribute, 'LNM$JOB', 
X     -          logical_name(1:n),,items)
X          if ( status .ne. ss$_normal )
X     -      status = sys$trnlnm ( attribute, 'LNM$SYSTEM', 
X     -          logical_name(1:n),,items)
X        end if
X
X        translate_logical = status
X        return
X        end
X
X      subroutine update_file_window
X
Xc     Craig Young               3-AUG-87
X
Xc     This subroutine updates the filer window to reflect movement of the
Xc     cursor and scrolling.
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    ii
X
X      call smg$begin_pasteboard_update( board_id )
X
Xc     Check if scrolling required.  If so, scroll a half window.
X
X      if ( file_num .eq. bottom_file_line +1 ) then      !If cursor at bottom
X         top_file_line = top_file_line + 6               !Scroll up
X         bottom_file_line = bottom_file_line + 6
X
X         else if ( file_num .eq. top_file_line -1 ) then !If cursor at top
X         top_file_line = top_file_line - 6               !Scroll down
X         bottom_file_line = bottom_file_line - 6
X
X         else if ( file_num .gt. bottom_file_line ) then
X         top_file_line = file_num
X         bottom_file_line = top_file_line + 11
X
X         else if ( file_num .lt. top_file_line ) then
X         top_file_line = file_num
X         bottom_file_line = top_file_line + 11
X         end if
X
X      if ( bottom_file_line .gt. num_files ) then
X         top_file_line = num_files -11
X      end if
X
X      if ( top_file_line .lt. 1 ) then
X         top_file_line = 1
X         bottom_file_line = 12
X      end if
X
X      if ( bottom_file_line .gt. top_file_line + 11 )
X     .     bottom_file_line = top_file_line + 11
X
X      call smg$set_cursor_abs( file_window, 1, 1 )
X
X      do ii = top_file_line, bottom_file_line           !Reprint file names
X         call smg$put_line( file_window, fnode(ii).name )
X      end do                                            !for new range
X
X      call smg$change_rendition( file_window, 
X     .                           file_num - top_file_line + 1,
X     .                           2, 1, 24, smg$m_reverse )
X
X      call smg$end_pasteboard_update( board_id )
X
X      return
X      end
X      subroutine update_screen( old_line, old_level )
X
X      include    'swing.cmn'
X      include    '($smgdef)'
XC
XC`009To cope with strange terminal screen lengths
XC        19 --- > lenest - 5
XC        23 --- > lenest - 1
XC
XC       Added by EH Perkins, Aug 16, 1987
XC
X
X`009integer linest
X`009common /length/ linest
X
X      integer    old_line, old_level, ii, istat
X      integer    sys$setddir
X
X      node_num = node_pointer( cur_level, cur_line )
X
X      call smg$begin_pasteboard_update( board_id )
X
X      call smg$change_rendition( window2, old_line, old_level*17+1,
X     .                           1, 12, old_rend )
X      call smg$change_rendition( window2, cur_line, cur_level*17+1,
X     .                           1, 12,
X     .                           smg$m_bold + node(node_num).rend ) 
X
X      call update_window1
X                                          
X      call smg$end_pasteboard_update( board_id )
X
X      if ( cur_line .gt. bottom_line ) then
X         do ii = bottom_line+1, cur_line
X            call smg$move_virtual_display( window2, board_id,
X     .                                    (linest - 1)-ii,1)
X         end do                
X         top_line = cur_line - (linest - 5)
X         bottom_line = cur_line
X
X         else if ( cur_line .lt. top_line ) then
X         do ii = top_line-1, cur_line, -1
X            call smg$move_virtual_display( window2, board_id, 4-ii,1)
X         end do
X         top_line = cur_line
X         bottom_line = cur_line + (linest - 5)
X         end if
X
X      istat = sys$setddir( node(node_num).spec, %val(0), %val(0) )
X
X      return
X      end
X
X
Xc     Update SD stack (for Dale Coy version of SD)
X
X      Subroutine Update_Stack
X
X      Integer*2 CDevLen, CDirLen, EnvLen
X      Integer*2 SdirLen, SD_SP_Number, Stack_Depth
X      Character SD_Stack_Pointer*2, SD_Dir*256, SD_Slotnn*9
X      Character*256 Current_Directory, Environment, Current_Device
X      Include '($LIBCLIDEF)'
X      Data Stack_Depth /20/      ! How many SD_Slots
X
X      Istat = Lib$Get_Symbol ('SD_Stack_Pointer', SD_Stack_Pointer)
X
X      If (Istat .NE. 1) Return   ! SD is not initialized
X
X      SD_Slotnn = 'SD_SLOT' // SD_Stack_Pointer
X
X      Istat = Lib$Get_Symbol ( SD_Slotnn, SD_Dir, SdirLen)
X
X      Call Lib$Sys_TrnLog('SYS$DISK',%Ref(CDevLen),
X     1  %Descr(Current_Device))
X
X      Call Sys$SetdDir( %Val(0), %Ref(CDirLen),
X     1  %Descr(Current_Directory))
X
X      Environment = Current_Device(:CDevLen)
X      Environment(CDevLen+1:) = Current_Directory
X      EnvLen = CDevLen + CDirLen
X
X      If (Environment(:EnvLen) .NE. SD_Dir(:SdirLen)) Then
X
X        Read (SD_Stack_Pointer,910) SD_SP_Number
X910     Format(i2)
X
X        SD_SP_Number = MOD( SD_SP_Number + 1, Stack_Depth )
X
X        Write (SD_Stack_Pointer,108) SD_SP_Number
X108     Format (I2.2)
X
X        Call Lib$Set_Symbol (%Descr('SD_Stack_Pointer'),
X     1       %Descr(SD_Stack_Pointer) ,LIB$K_CLI_GLOBAL_SYM)
X
X        Write (SD_Slotnn(8:9),108) SD_SP_Number
X
X        Call Lib$Set_Symbol (%Descr(SD_Slotnn),
X     1      %Descr(Environment(:EnvLen)) ,LIB$K_CLI_GLOBAL_SYM)
X
X      End If
X
X      Return
X      End
X
X      subroutine update_window1
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    start
X
X      if ( use_window1 ) then
X
X      start = ( width - (len_disk + node(node_num).length) ) / 2
X      if ( start .le. 0 ) start = 1
X
X      call smg$erase_line( window1, 1, 1 )
X
X      call smg$put_chars( window1, 
X     .                    disk(1:len_disk)//
X     .                    node(node_num).spec(1:node(node_num).length),
X     .                    1, start,, smg$m_underline )
X
X      end if
X
X      return
X      end
$ GoSub Convert_File
$ Goto Part06
