C---------------------------------------------------------------------------
	SUBROUTINE SDTREE
C---------------------------------------------------------------------------
*
*	Alan L. Zirkle     Naval Surface Weapons Center
*			   Code K53
*			   Dahlgren, Virginia  22448
*
*  Modified by:                          Sept/Oct 1986 (V4.0A)
*					 February 1987 (V4.2A)
*					 	(V4.3A)
C 					 April 1988 (V4.4A - SDTREE_SUBS)
*	Dale E. Coy
*	Los Alamos National Laboratory
*
C---------------------------------------------------------------------------

	IMPLICIT INTEGER (A-Z)


	Include 'SD_Common.Dat'
	Include 'SD_SMG.Dat'
C---------------------------------------------------------------------------

	If (Do_ID) then      
		Print *,'        '//ReVideo//' SDTree Version 5.0A '//Dull
		Return
	End If

	Call SDTree_SMG

C	 	  Assign a channel to "Channel";
C
	Status = Sys$Assign (%Descr(Current_Device(:CDevLen)),
	1		%Ref(Channel),,)
C			NOTE THAT THE TRAILING COMMAS ARE REQUIRED

	IF (INDEX(Current_Directory(1:CDirLen),'.').EQ.0) THEN

	    CALL DIR1_READ('[000000]'//Current_Directory(2:CDirLen-1))

	ELSE

	    DO I=CDirLen-1,1,-1

		IF (Current_Directory(I:I).EQ.'.') GO TO 10

	    ENDDO

10	    Current_Directory(I:I) = ']'

	    CALL DIR1_READ(Current_Directory(1:CDirLen-1))
                                           
	ENDIF


	IF (Bottom_File(1) .GE. Top_File(1)) then    ! we got something

		Call Dirn_Read

		ChgLen = 0
		CALL DISPLAY

100		If (ChgLen .GT. 0) then  ! we're through here...
C		   Terminate, clearing the screen (SDMAIN will write output).
			Call SMG$Delete_Pasteboard (Pasteboard_ID)
			GoTo 9999

		Else If (ChgLen .EQ. 0) then   ! We should identify.
			Call SMG$Delete_Pasteboard (Pasteboard_ID)
			Print *
			Print *,'  ',Environment(:EnvLen)
			Print *
			GoTo 9999          

		Else           ! Less than 0
		   ChgLen = 0
	      	   If ((Cmd .EQ. 'a') .OR. (Cmd .EQ. 'A')) then
			Call SD_Gold_A
			Cmd = ' '
			Call Re_Display
			GoTo 100
		   Else If ((Cmd .EQ. 'p') .OR. (Cmd .EQ. 'P')) then
			Call SD_Print_Tree 
			Cmd = ' '
			Call Re_Display
			GoTo 100
		   Else
			GoTo 100    ! Will exit.
		   End If	


		End If
	ELSE

C			Terminate, clearing only the last lines
		Call SMG$UnPaste_Virtual_Display 
	1			(Level_Display(1), Pasteboard_ID)
		Call SMG$UnPaste_Virtual_Display 
	1			(Normal_Display, Pasteboard_ID)
		Call SMG$Set_Cursor_Abs(Main_Display,4,1)

		Print *,' No SubDirectories in this structure.'
		Print *
		Call SMG$Delete_Pasteboard (Pasteboard_ID,0)
		GoTo 9999
	END IF

9999	Continue


C 		Deassign the channel (note use of %Val);
	Status = Sys$Dassgn (%Val(Channel))
	Channel = -9999

	Call SMG$Delete_Virtual_Keyboard (Keyboard_ID)

	Return
	END

C----------------------------------------------------------------------
C------------------------------------------------------------------------
C	SET UP SMG ENVIRONMENT FOR SDTree PROGRAMS
C		Dale E. Coy         Sept/Oct, 1986
C		Los Alamos National Laboratory
C
C	Used by SDTree
C------------------------------------------------------------------------
	Subroutine SDTree_SMG

        Implicit Integer*4 (A - Z)
	Include 'SD_SMG.Dat'
	Include 'SD_Common.Dat'

C--------------------------------------------------------------------

	
	Call SMG$Create_Pasteboard
	1	 (Pasteboard_ID,,PB_Rows,PB_Columns)


C 		Use NoTabs, as SMG gets confused if we don't
	Call SMG$Control_Mode (Pasteboard_ID,
	1	,Entry_Control_Mode)
	Current_Control_Mode = Entry_Control_Mode + SMG$M_NOTABS
	Call SMG$Control_Mode (Pasteboard_ID,
	1	Current_Control_Mode)
	
	
	Call SMG$Create_Key_Table (Key_Table_ID)
	
	Call SMG$Create_Virtual_Keyboard (Keyboard_ID,
	1	'TT')

	Call SDTree_Displays (Pasteboard_ID, Keyboard_ID)

	Return
	End

C-------------------------------------------------------------------C
C Print the SD Directory Tree
C-------------------------------------------------------------------C
                       
        Subroutine SD_Print_Tree 

        Implicit Integer*4 (A - Z)

	Logical Special_Print, DEC_Standard
	
        Integer*2 NBytes	
	Integer*4 Line_Index, Ver
	
	Character*81 Line
	Character*80 Line2
	Equivalence (Line(2:), Line2(1:))
	
	Character*22 File(3)
	Character*9 Trans_Table, Match_Table

        Include 'SD_Common.Dat'
        Include 'SD_SMG.Dat'


	Character*(*) DEC_Printers
C 		List of printers which support line-drawing character set.
C 			Note trailing space
	Parameter (DEC_Printers = 'LN03 LA100 LP100 LA210 LA75 ')

	Character*(*) LDFont	! Load Line-Drawing Font
	Parameter (LDFont = ' '//Char(27)//'*0')
	Character*(*) PBold	! Print Bold
	Parameter (PBold = Char(27)//'[1m')
	Character*(*) PNormal	! Print Normal
	Parameter (PNormal = Char(27)//'[0m')
	
	Data File(1) /'SYS$LOGIN:DM$DIR.LIS;1'/
	Data File(2) /'SYS$LOGIN:DM$DIR.LIS;2'/
	Data File(3) /'SYS$LOGIN:DM$DIR.LIS;3'/
C-------------------------------------------------------------------C

C		Now, set up a printer.
	If (.NOT. Have_Printer_Data) Call Get_Print_Data
	
	
206	Match_Table = Char(1)//Char(4)//Char(5)//Char(10)//
	1		Char(3)//Char(11)//Char(13)//'`'//Char(0)

C 		Do we recognize the printer type as DEC "Standard"?
	Call Str$Trim(%Descr(Printer_Type),%Descr(Printer_Type),
	1			%Ref(NBytes))
	
	If (Index (DEC_Printers, Printer_Type(:NBytes)//' ') .GT. 0) then
		DEC_Standard = .TRUE.
	Else
		DEC_Standard = .FALSE.
	End If
	
	Special_Print = .TRUE.
	If (DEC_Standard) then
C 		Table for LN03 and other DEC Standard Printers
	    Trans_Table = Char(241)//Char(241)//Char(241)//Char(248)//
	1		  Char(237)//Char(244)//Char(247)//Char(224)//' '
C 
C 		Insert handling for other special printers here...
C	Else If (Printer_Type .EQ. 'ZZZZ') then
C	    Trans_Table = '...|\|.> '
	
	Else
C 		Table for Regular Line Printers
	    Trans_Table = '...|\|.> '
	    Special_Print = .FALSE.
	End If
	
	
	Line = ' '


C		Try to open one of 3 available files
	Do 10 Ver = 1,3
  	Open (Unit=1, File=File(Ver), Status='Unknown', Err=10)
	GoTo 50
10	Continue
	Print *,' Your SD Print Queue is full.'//
	1	'  Try again after these directories are printed.'
	GoTo 900

50	Continue
	

C		We got a file.  Now do the first line.
	Call SMG$Read_From_Display (%Ref(Top_Display)
	1	,%Descr(Line2),,%Ref(1))

	If (Special_Print) then
	    If (DEC_Standard) then
		Write (1,101) LDFont//PBold//Line2//PNormal
101			Format (A)
	
C 		Insert handling for other special printers here...
C	    Else If (Printer_Type .EQ. 'ZZZZ') then
C		Write (1,101) Whatever//Line//Whatever
	    End If
	
	Else		! Line Printer
		Write (1,100) Line
100		Format (A)
	End If
	
	Write (1,100)			  ! Empty line

	If (Highest_Level .LE. 4) then
		ND = Highest_Level
	Else
		ND = 4
	End If

C		The rest of the lines...
	Do 200 Line_Index = 2, Current_Display_Length
	  Line = ' '
	  Do 190 N = 1,ND
	    Call SMG$Read_From_Display (%Ref(Level_Display(N))
	1	,%Descr(Line2((N*20)-19:)),,%Ref(Line_Index))

190	  Continue
		Call STR$Translate (%Descr(Line2),%Descr(Line2),
	1		%Descr(Trans_Table),%Descr(Match_Table))
		IF (Line2 .EQ. ' ') then
			Write (1,100)
		Else
			Write (1,100) Line
		End If

200	Continue

C		How about above 4?

	If (Highest_Level .LE. 4) then
		GoTo 800
	Else
		ND = Highest_Level - 4
	End If

	Write (1,100) ' '//Char(12)       ! FF
	Write (1,100)			  ! Empty line

C		The rest of the lines...
 	Do 300 Line_Index = 2, Current_Display_Length
	  Line = ' '
	  Do 290 N = 1,ND
	    Call SMG$Read_From_Display (%Ref(Level_Display(N+4))
	1	,%Descr(Line2((N*20)-19:)),,%Ref(Line_Index))

290	  Continue
		Call STR$Translate (%Descr(Line2),%Descr(Line2),
	1		%Descr(Trans_Table),%Descr(Match_Table))
		IF (Line2 .EQ. ' ') then
			Write (1,100)
		Else
			Write (1,100) Line
		End If

300	Continue


800	Close (Unit=1)

	Call Str$Trim(%Descr(Print_Command),%Descr(Print_Command),
	1			%Ref(NBytes))

	Print_Command(NBytes+2:) = File(Ver)	
	Call SMG$Set_Cursor_Abs(Level_Display(1),Top_Line+2,1)
	Call LIB$Spawn (%Descr(Print_Command))
	Print_Command(NBytes+1:) = ' '
	Call SMG$Repaint_Screen (Pasteboard_ID)

900	Return
	End

C-------------------------------------------------------------------------
C	Change Print Command 
C-------------------------------------------------------------------------
	Subroutine SD_Gold_A                                   

        Implicit Integer*4 (A - Z)

        Integer*2 Old_Bytes, New_Bytes, NBytes
	Character*1 Com, UCMD
        Character*80 New_Command

        Include 'SD_Common.Dat'
        Include 'SD_SMG.Dat'

C-------------------------------------------------------------------C

C		Now, set up a printer.
	If (.NOT. Have_Printer_Data) Call Get_Print_Data
	


C		Now, set up the display area:
	Call SMG$Create_Virtual_Display
     1		 (2,80, SGA_Display,,BR_Mask)

	Call SMG$Create_Virtual_Display
     1		 (24,80, SGB_Display)

	Call SMG$Create_Virtual_Display
     1		 (1,132, SGC_Display,,BR_Mask)

	Call SMG$Create_Virtual_Display
     1		 (1,132, SGD_Display)

	Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
	
	Call SMG$Paste_Virtual_Display (SGB_Display,
	1	Pasteboard_ID,1,1)
	
	Call SMG$Paste_Virtual_Display (SGA_Display,
	1	Pasteboard_ID,23,1)

C		LABEL FOR THIS SCREEN
	Call SMG$Put_Line (SGB_Display,
	1	'        SD - Additional Options:  '//
	2	'Change settings for....                       '
	3	,,SMG$M_Reverse)

C		HEADINGS
        Call SMG$Put_Chars (SGB_Display,
	1	'#     Item           Current Value'
	2   	,3,2,,SMG$M_Bold)

	Call SMG$Put_Line(SGA_Display,
	1	'  Type the number or ''initial'' of '//
	2	'the item you want to change.')

	Call SMG$Put_Line(SGA_Display,
	1	'                                       '//
	2	'(Press Return to leave the Options menu)')

C		Selections
100	Call SMG$Put_Chars (SGB_Display,
	1   '1  Print Command   - '//Print_Command(:60)
	2   	,5,2)                                        
	Call SMG$Change_Rendition (SGB_Display,5,2,1,4,SMG$M_Bold)

        Call SMG$Put_Chars (SGB_Display,
	1   '2  Type of Printer - '//Printer_Type(:10)
	2   	,6,2)                                        
	Call SMG$Change_Rendition (SGB_Display,6,2,1,4,SMG$M_Bold)

200	Call SMG$End_Pasteboard_Update (Pasteboard_ID)

	Call SMG$Set_Cursor_Mode (Pasteboard_ID, 1)
        Com = ' '
	Call SMG$Read_Keystroke (Keyboard_ID, Terminator)
	Call SMG$Set_Cursor_Mode (Pasteboard_ID, 0)
	Com = Char(Terminator)
	Call Str$UpCase (%Descr(UCMD),%Descr(Com))

	If ((Com .EQ. '1') .OR. ( UCMD .EQ. 'P' )) then     
		Call SMG$Put_Line(SGC_Display,
	1	  ' New value for Print Command:')
		Call SMG$Erase_Display (SGD_Display)
	
		Call Str$Trim (%Descr(Print_Command),
	1	       %Descr(Print_Command),%Ref(Old_Bytes))
	
		Call SMG$Paste_Virtual_Display (SGC_Display,
	1		Pasteboard_ID,23,1)
		Call SMG$Paste_Virtual_Display (SGD_Display,
	1		Pasteboard_ID,24,1)
	
		Call SMG$Read_Composed_Line (Keyboard_ID, Key_Table_ID, 
	1		%Descr(New_Command),%Descr('> '),
	2		%Ref(New_Bytes),SGD_Display,,
	3		Print_Command(:Old_Bytes),,,,Terminator)
	
		Call SMG$UnPaste_Virtual_Display (SGC_Display,
	1		Pasteboard_ID)
		Call SMG$UnPaste_Virtual_Display (SGD_Display,
	1		Pasteboard_ID)
	
		Call Str$UpCase (%Descr(New_Command),%Descr(New_Command))
	
		If (New_Bytes .LE. 0) then                       
			GoTo 200
		Else If ((New_Command(:New_Bytes) .EQ. ' ')
	1	    .OR. (New_Command(:New_bytes) .EQ. Print_Command)) 
	2			then
			GoTo 200
		Else
			Print_Command = New_Command(:New_Bytes)
C				Set this as Global Symbol (Remember)
		        Call Lib$SET_Symbol(%Descr('DM$Print_Command'), 
	1				%Descr(Print_Command(:New_Bytes)),
	2				%Ref(2))
			Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
			GoTo 100
		End If

        Else If ((Com .EQ. '2') .OR. ( UCMD .EQ. 'T' )) then     
		Call SMG$Put_Line(SGC_Display,
	1	  ' New value for Type of Printer:')
		Call SMG$Erase_Display (SGD_Display)
	
		Call Str$Trim (%Descr(Printer_Type),
	1	       %Descr(Printer_Type),%Ref(Old_Bytes))
	
		Call SMG$Paste_Virtual_Display (SGC_Display,
	1		Pasteboard_ID,23,1)
		Call SMG$Paste_Virtual_Display (SGD_Display,
	1		Pasteboard_ID,24,1)
	
		Call SMG$Read_Composed_Line (Keyboard_ID, Key_Table_ID, 
	1		%Descr(New_Command),%Descr('> '),
	2		%Ref(New_Bytes),SGD_Display,,
	3		Printer_Type(:Old_Bytes),,,,Terminator)
	
		Call SMG$UnPaste_Virtual_Display (SGC_Display,
	1		Pasteboard_ID)
		Call SMG$UnPaste_Virtual_Display (SGD_Display,
	1		Pasteboard_ID)
	
		Call Str$UpCase (%Descr(New_Command),%Descr(New_Command))
	
		If (New_Bytes .LE. 0) then                       
			GoTo 200
		Else If ((New_Command(:New_Bytes) .EQ. ' ')
	1	    .OR. (New_Command(:New_Bytes) .EQ. Printer_Type)) 
	2			then
			GoTo 200
		Else
			Printer_Type = New_Command(:New_Bytes)
C				Set this as Global Symbol (Remember)
		        Call Lib$SET_Symbol(%Descr('DM$Printer_Type'), 
	1				%Descr(Printer_Type(:New_Bytes)),
	2				%Ref(2))
			Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
			GoTo 100
		End If

	Else 
		GoTo 500
	End If

500	Call SMG$Delete_Virtual_Display (SGB_Display)
	Call SMG$Delete_Virtual_Display (SGA_Display)

	Return
	End


C-------------------------------------------------------------------C
C Get data for printing subdirectory tree
C-------------------------------------------------------------------C
                       
        Subroutine Get_Print_Data

        Implicit Integer*4 (A - Z)

        Include 'SD_Common.Dat'
        Include 'SD_SMG.Dat'

	Character*5 	   Default_Print_Command
		Parameter (Default_Print_Command = 'PRINT')
	Character*2 	  Default_Printer_Type	
	       Parameter (Default_Printer_Type = 'LP')		

C-------------------------------------------------------------------C

C		Now, set up the printer.
C 	See if we can get the information from SYS$LOGIN:DM_DEFAULTS.COM
	
	Open (Unit=1, File='SYS$LOGIN:DM_DEFAULTS.COM', Readonly, Shared,
	1		Carriagecontrol='NONE', Organization='SEQUENTIAL',
	2		Status='OLD', Err=203)
210	Format (23X,A)	
	Read (1,210,End=203,Err=203) Print_Command	! Dummy read
	Read (1,210,End=203,Err=203) Print_Command	! Dummy read
	Read (1,210,End=203,Err=203) Print_Command
	Read (1,210,End=204,Err=204) Printer_Type
	GoTo 205
	
C Print Command:	

203	Print_Command = ' '

        Call Lib$GET_Symbol(%Descr('DM$Print_Command'), 
	1	%Descr(Print_Command))

C	   IFF DM$Print_Command was not defined or is empty, then use Default
                   
	If ((Ichar(Print_Command(1:1)) .EQ. 0) 
	1	.OR. (Print_Command .EQ. ' ')) then
		            Print_Command = Default_Print_Command
	End If 
	
C Printer Type
204	Printer_Type = ' '	
	Call Lib$GET_Symbol(%Descr('DM$Printer_Type'), 
	1	%Descr(Printer_Type))

C	   IFF DM$Printer_Type was not defined or is empty, then use Default
                   
	If ((Ichar(Printer_Type(1:1)) .EQ. 0) 
	1	.OR. (Printer_Type .EQ. ' ')) then
		            Printer_Type = Default_Printer_Type
	End If 

205	Close (Unit=1, Err=206)
	
206	Continue

	Have_Printer_Data = .TRUE.
	
	Return
	End
