C---------------------------------------------------------------------
	PROGRAM PIKCOLORS
C  Lets the user select colors from the list of 64 possibilities.
C---------------------------------------------------------------------
C	Dennis Hall,    June,  1986
C	Modified by Dale E. Coy, September, 1986
C			Los Alamos National Laboratory

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

        Character*65 New, Original
	Character*19 Single
	Character*6 Answer

	Include 'Color.Dat'


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,23,1)
  
	Call SMG$Paste_Virtual_Display
     1		 (Background_Display,Pasteboard_ID,24,1)
  
                         
	Call SMG$Set_Cursor_Abs(Main_Display,1,1)
	Do K = 1,21
	   	Call SMG$Put_Line(Main_Display,'   '//
	1  Color_Name(K)//'  '//Color_Name(K+21)//'  '//
	2  Color_Name(K+42))
	End Do
	Call SMG$Put_Line(Main_Display,'   '//
	1  '                        '//'  '//
	2  '                        '//'  '//
	3  Color_Name(64))


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

	Do K = 1,4
		Call SMG$Put_Chars (Display_ID(K),
	1		'Now:  '//
	2	       	Color_Name(Original_Color(K)),1,50)
		Call SMG$Put_Chars (Display_ID(K),
	1		'>',1,40)

	End Do

	Call SMG$Put_Line(Bold_Reverse_Display,
	1 ' Up/Down Arrows select attribute. '//
	2 ' Type Color Number.  RETURN Saves, "Q" Quits',0)

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

	Call SMG$End_Pasteboard_Update (Pasteboard_ID)
	
                     
C       Read in a keypad strokes 
                  
80	Digit = 1
	Call SMG$Put_Chars (Display_ID(Att_Index),'  ',1,42)
	Call SMG$Set_Cursor_Abs	(%Ref(Display_ID(Att_Index)),1,42)

81	Call SMG$Read_KeyStroke (Keyboard_ID,Terminator)


		If (Terminator .eq. SMG$k_trm_up) then

			Call SMG$End_Pasteboard_Update (Pasteboard_ID)
			Call SMG$UnPaste_Virtual_Display
	1	    		(Display_ID(Att_Index),Pasteboard_ID)
			Att_Index = Att_Index - 1
			If (Att_Index .LE. 0) Att_Index = 4
			Call SMG$Paste_Virtual_Display
	1	    		(Display_ID(Att_Index),Pasteboard_ID,24,1)
			GoTo 80


		Else If (Terminator .eq. SMG$k_trm_down) then
			
			Call SMG$UnPaste_Virtual_Display
	1	    		(Display_ID(Att_Index),Pasteboard_ID)
			Att_Index = Att_Index + 1
			If (Att_Index .GT. 4) Att_Index = 1
			Call SMG$Paste_Virtual_Display
	1	    		(Display_ID(Att_Index),Pasteboard_ID,24,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			'Now:  '//
	2			Color_Name(K),1,50)
			Call SMG$Put_Chars (Display_ID(Att_Index),
	1			'  ',1,42)
			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			'Now:  '//
	2			Color_Name(K),1,50)
			Call SMG$Put_Chars (Display_ID(Att_Index),
	1			'  ',1,42)
			GoTo 580


		Else If ((Terminator .GE. 48) .AND.
	1		 (Terminator .LE. 57))  then
			If (Digit .EQ. 1) then
			  Units = Terminator - 48
			  Tens  = Units * 10
			  Call SMG$Put_Chars (Display_ID(Att_Index),
	1			Char(Terminator),1,42)
			  Call SMG$Set_Cursor_Abs	
	1			(%Ref(Display_ID(Att_Index)),1,43)
			  Digit = 2
			  GoTo 81
			Else If (Digit .EQ. 2) then
			  Tens  = Units * 10
			  Units = Terminator - 48
			  Call SMG$Put_Chars (Display_ID(Att_Index),
	1			Char(Terminator),1,43)
			  Call SMG$Set_Cursor_Abs	
	1			(%Ref(Display_ID(Att_Index)),1,44)
			  Digit = 3
			  GoTo 81
			Else ! Overrun
			  GoTo 80
			End If


		Else If (Terminator .eq. SMG$k_trm_cr) then

			If (Digit .EQ. 1) then 
				Call SMG$Put_Line(Bold_Reverse_Display,
	1 			' Saving New Colors ',0)
				GoTo 90

			Else If (Digit .EQ. 2) then
			  	K = Units	
				Color_Pointer(Att_Index) = K
				Call SMG$Put_Chars (Display_ID(Att_Index),
	1		    	     Char(Terminator),1,43)
				Call SMG$Put_Chars(Display_ID(Att_Index),
	1				'Now:  '//
	1				Color_Name(K),1,50)
				GoTo 580

			Else
			  	K = Tens+Units	
				If (K .GT. 64) GoTo 80
				If (K .LT.  1) GoTo 80
				Color_Pointer(Att_Index) = K
				Call SMG$Put_Chars(Display_ID(Att_Index),
	1			 	'Now:  '//
	2			 	Color_Name(K),1,50)
				GoTo 580
			End If

		Else If ((Terminator .EQ. 292) .OR. 
	1		 (Terminator .EQ. 127) .OR.
	2		 (Terminator .EQ. 177)) then
			If (Digit .EQ. 1) then
				GoTo 81
			Else If (Digit .EQ. 2) then
				GoTo 80
			Else
				Units = Tens/10
				Tens = 0
			  	Call SMG$Put_Chars (Display_ID(Att_Index),
	1			' ',1,43)
			  	Call SMG$Set_Cursor_Abs	
	1			 (%Ref(Display_ID(Att_Index)),1,43)
			  	Digit = 2
			  	GoTo 81
		        End If		


		Else If ((Terminator .EQ. 81) .OR. 
	1		 (Terminator .EQ. 113)) then

			Call SMG$Put_Line(Bold_Reverse_Display,
	1 			' Restoring Original Colors ',0)
			GoTo 590


		Else If (Terminator .EQ. 23) then
			Call SMG$RePaint_Screen (Pasteboard_ID)
			GoTo 80
		Else
			GoTo 80
		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
	Call SMG$Put_Chars(Display_ID(Att_Index),'  ',1,42)
	GoTo 80   ! To get another command

C-----------------------------------------------------------------------
C		SAVE ORIGINAL COLORS
590	Call SMG$Set_Cursor_Abs	(%Ref(Main_Display),1,1)
	Print *, Regis_In//Original//Regis_Out
	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)
	Call SMG$Delete_Virtual_Keyboard (Keyboard_ID)

9999    End

