C	This program uses the up, down, left, right, Q, and
C	carrige return keys. All others are ignored. The four color 
C	attributes are displayed on the screen and the
C	up/down keys select one of them. The cursor is moved to that position
C	for the purpose of user feeback. The left right keys are used to
C	change color of the selected attribute.

C	files used:
C	Sys$Login:current_colors.scr       ,file of previous colors
C	Sys$Login:current_colors_cmd.scr   ,colors command
C	Sys$Login:Did_Colors.Before        ,indicator that colors exist
C
C	Thomas Beery  July 9, 1986
C	Modified by Dale E. Coy, September, 1986
C			Los Alamos National Laboratory

	Implicit Integer*4 (A - Z)
	Integer*4 Att_Index, Map, Color_pointer(4), Original_color(4)
	Integer*4 Display_ID(4)
	Data Att_Index /1/                        
	Integer*2 Terminator

        Character*65 New, Original
	Character*19 Single
                          
	Include 'Color.Dat'

	Parameter (Inst_Line           =  4)
	Parameter (Background_Line     = 12)
	Parameter (Reverse_Line        = 13)
	Parameter (Normal_Line         = 14)
	Parameter (Bold_Line           = 15)
	Parameter (Bold_Reverse_Line   =  1)

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

	Call Lib$GetDVI(%Ref(DVI$_TT_REGIS),,%Descr('TT:'),%Ref(Regis))
	If (.NOT.Regis) then
        	Print *,' This is not a REGIS terminal'
		GoTo 9999
	End If


C       Get 'old' color values and change screen
	Open (Unit=1,       
	1     File='SYS$LOGIN:Current_colors.scr',
	2     Status='old',
	3     Err=2)
	Read (1,1001,Err=1) Original_Color
	Read (1,1002,Err=1) Original
	Close (Unit=1)
	GoTo 500
1001	Format (I5,3I15)
1002	Format (A)
1	Close (Unit=1)

C		If we don't get the info....
2	Original_Color(1) = 7
	Original_Color(2) = 17
	Original_Color(3) = 20
	Original_Color(4) = 56
	Original =
	1 ' S(M0(AH40L35S60)1(AH150L50S100)'//
	2 '2(AH150L50S60)3(AH300L80S60))'

C		Make sure colors are set now.
500 	Print *,Home//Regis_In//Original//Regis_Out//Home23

	New = Original
	Do K = 1,4
		Color_Pointer(K) = Original_Color(K)
	End Do

C-------------------------------------------------------------------------
C	NOW SET UP SMG & GO FOR IT

	Call Color_SMG

	Display_ID(1) = Background_Display
	Display_ID(2) = Reverse_Display
	Display_ID(3) = Normal_Display
	Display_ID(4) = Bold_Display

	Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)

	Call SMG$Paste_Virtual_Display
     1		 (Bold_Reverse_Display,Pasteboard_ID,Bold_Reverse_Line,1)
  
	Call SMG$Paste_Virtual_Display
     1		 (Background_Display,Pasteboard_ID,Background_Line,1)
  
	Call SMG$Paste_Virtual_Display
     1		 (Reverse_Display,Pasteboard_ID,Reverse_Line,1)
  
	Call SMG$Paste_Virtual_Display
     1		 (Normal_Display,Pasteboard_ID,Normal_Line,1)
  
	Call SMG$Paste_Virtual_Display
     1		 (Bold_Display,Pasteboard_ID,Bold_Line,1)
                         
	Call SMG$Set_Cursor_Abs(Main_Display,%Ref(Inst_Line),1)
	Call SMG$Put_Line(Main_Display,
	1 '   Press  Up/Down   arrows to select attribute to change.')
	Call SMG$Put_Line(Main_Display,
	1 '   Press Left/Right arrows to change colors.')
	Call SMG$Put_Line(Main_Display,
	1 '   Press  RETURN    to exit, saving your changed colors.')
	Call SMG$Put_Line(Main_Display,
	1 '   Press   "Q"      to exit, restoring your original colors.')

	Call SMG$Put_Line(Background_Display ,'  Background Color')
	Call SMG$Put_Line(Reverse_Display,    '  Cursor and Reverse Video')
	Call SMG$Put_Line(Normal_Display,     '  Regular Text')
	Call SMG$Put_Line(Bold_Display,       '  Highlighted Text')

	Do K = 1,4
		Call SMG$Put_Chars (Display_ID(K),
	1		Color_Name(Original_Color(K)),1,50)
	End Do

	Call SMG$Put_Line(Bold_Reverse_Display,
	1 '  Color_Changer:                 '//
	2 '(This line is Bold-Reverse)')

	Call SMG$Set_Cursor_Abs(%Ref(Display_ID(Att_Index)),1,1)

	Call SMG$End_Pasteboard_Update (Pasteboard_ID)
	

C       Read in a keypad stroke. 
                  
80	Call SMG$Set_Cursor_Abs	(%Ref(Display_ID(Att_Index)),1,1)
	Call SMG$Read_KeyStroke (Keyboard_ID,Terminator)
                                   
		If (Terminator .eq. SMG$k_trm_up) then

			Att_Index = Att_Index - 1
			If (Att_Index .LE. 0) Att_Index = 4
			GoTo 80


		Else If (Terminator .eq. SMG$k_trm_down) then
			
			Att_Index = Att_Index + 1
			If (Att_Index .GT. 4) Att_Index = 1
			GoTo 80


		Else If (Terminator .eq. SMG$k_trm_left) then
                       
			K = Color_Pointer(Att_Index)-1
			If (K .LE. 0) K = 64
			Color_Pointer(Att_Index) = K
			Call SMG$Put_Chars (Display_ID(Att_Index),
	1			Color_Name(K),1,50)
			GoTo 580
			
		Else If (Terminator .eq. SMG$k_trm_right) then
                        
			K = Color_Pointer(Att_Index)+1
			If (K .GT. 64) K = 1
			Color_Pointer(Att_Index) = K
			Call SMG$Put_Chars (Display_ID(Att_Index),
	1			Color_Name(K),1,50)
			GoTo 580


		Else If (Terminator .eq. SMG$k_trm_cr) then
			Call SMG$Set_Cursor_Abs(%Ref(Main_Display),23,1)
			Call SMG$Put_Line(Main_Display,
	1 		 	' Saving New Colors')
			Goto 90

		Else If ((Terminator .EQ. 81) .OR. 
	1		 (Terminator .EQ. 113)) then
			Call SMG$Set_Cursor_Abs(%Ref(Main_Display),23,1)
			Call SMG$Put_Line(Main_Display,
	1 	 		' Restoring Original Colors')
			Call SMG$Set_Cursor_Abs	(%Ref(Main_Display),1,1)
 			Print *, Regis_In//Original//Regis_Out
			GoTo 590

		End If

C-----------------------------------------------------------------------
C		Change a single screen color
580	Map = Att_Index-1
C	K = color_pointer(Att_Index)

  	Write(H0,110) 'AH',Color_Value(K,1),
	1	       'L',Color_Value(K,2),
	2	       'S',Color_Value(K,3)
110 	Format (A,I3,A,I2,A,I3)

	Write (Single,70) Map
70	Format(I4)
	Single(1:3) = 'S(M'
	Single(5:)  = '('//H0//'))'
	Call SMG$Set_Cursor_Abs	(%Ref(Main_Display),1,1)
 	Print *, Regis_In//Single//Regis_Out
	GoTo 80   ! To get another command

C-----------------------------------------------------------------------
C		SAVE ORIGINAL COLORS
590	Do K = 1,4
		Color_Pointer(K) = Original_Color(K)
	End Do


C		SAVE CHANGED COLORS
90	continue

	K = Color_Pointer(1)
  	Write(H0,110) 'AH',Color_Value(K,1),
	1	       'L',Color_Value(K,2),
	2	       'S',Color_Value(K,3)
	K = Color_Pointer(2)
  	Write(H1,110) 'AH',Color_Value(K,1),
	1	       'L',Color_Value(K,2),
	2	       'S',Color_Value(K,3)
	K = Color_Pointer(3)
  	Write(H2,110) 'AH',Color_Value(K,1),
	1	       'L',Color_Value(K,2),
	2	       'S',Color_Value(K,3)
	K = Color_Pointer(4)
  	Write(H3,110) 'AH',Color_Value(K,1),
	1	       'L',Color_Value(K,2),
	2	       'S',Color_Value(K,3)

C	CONSTRUCT OUTPUT STRING

C		String to set Colors
	New=' S(M0('//H0//')1('//H1//')2('//H2//')3('//H3//'))'

C		WRITE A "HUMAN READABLE FILE"
	Open (Unit=1,
	1     File='SYS$LOGIN:Current_Colors.Scr',
	2     Status='Unknown')
	Write (1,1001) Color_Pointer
	Write (1,1002) New
	Close (Unit=1)


C		AND A "MACHINE READABLE FILE" (In case we need to restore)
	Open (Unit=1,
	1     File='SYS$LOGIN:Current_Colors_Cmd.Scr',
	2     Status='Unknown')

	Write (1,1002) ' '//Home//Regis_In//New//Regis_Out//Home24
	Close (Unit=1)

C		AND AN "INDICATOR FILE"
	Open (Unit=1,
	1     File='SYS$LOGIN:Did_Colors.Before',
	2     Status='Unknown')
	Close (Unit=1)


9998	Call SMG$Delete_Pasteboard (Pasteboard_ID)

9999	End

