C------------------------------------------------------------------------
C	SELECT RANDOM CONTRASTING COLORS
C		Dale E. Coy         July, 1986
C		Los Alamos National Laboratory
C------------------------------------------------------------------------
	PROGRAM NEWCOLORS

	Include 'Color.Dat'

	Character*65 New
	Integer Color(4)
	Integer*4 Regis


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	SEED
	J = (Int(Secnds(0.0))*19752)+1

110 	Format (A,I3,A,I2,A,I3)
                                                        
C	Color 0 is selected to be "dark", and Color 3 is "light", based
C	on "L" value.  Color 0 is selected arbitrarily.  An attempt is then
C	made to select the other Colors so that:
C	(1) They are not duplicates (a requirement),
C	(2) The "L" value is appropriate,
C	(3) and then so that the "H" value differs significantly from the other
C		Colors, to provide visual contrast.
C	The selection trials stop after 64 iterations in each case.

                                 

C	SELECT BACKGROUND (0)
100	I = (64.0 * Ran(J)) + 1
C		PERSONAL PREFERENCE - USUALLY NOT BLACK:
C		If Color is black, try again once.
	If (I .EQ. 3) I = (64.0 * Ran(J)) + 1

C		LIGHTNESS SELECTION
	If (Color_Value(I,2) .LE. 25) then
	  	Write(H0,110) 'AH',Color_Value(I,1),
	1		       'L',Color_Value(I,2),
	2		       'S',Color_Value(I,3)
	  	Color_Selected(I) = .TRUE.  
	  	Color(1) = I
	  	Nhue0 = Color_Value(I,1)
	Else
	  	Go To 100
	End If
            
C	SELECT Color 1
C		Note: for Colors 1, 2, & 3, it is necessary to prevent an
C		infinite loop if there is no available Color meeting
C		the selection criteria.
	Iteration = 0
200	I = (64.0 * Ran(J)) + 1
C		DUPLICATE Color?
	If (Color_Selected(I)) Go To 200
		Iteration=Iteration+1
C		GIVE UP?
	If (Iteration .GE. 64) then
		Go To 205
	End If

C		LIGHTNESS SELECTION   
   	If ((Color_Value(I,2) .LT. 30) .OR. 
	1   (Color_Value(I,2) .GT. 55)) Go To 200
C		CHECK TO AVOID SIMILAR HUES
	Nhue1 = Color_Value(I,1)

C		The hues range from (theoretically 0-360) 0-340,
C		and 0 is "identical" to 360.  Therefore, we must make
C	      	checks for both ends of the hue range.
	NhueX = Iabs(Nhue1-Nhue0)
        If ((NhueX .LE. 50) .OR. (NhueX .GE. 310)) Go To 200

C		LOOKS OK TO ME... (or gave up)
205	  Write(H1,110) 'AH',Color_Value(I,1),
	1		 'L',Color_Value(I,2),
	2		 'S',Color_Value(I,3)
	  Color_Selected(I) = .TRUE.
	  Color(2)=i
	  Nhue1 = Color_Value(I,1)

                                
C	SELECT Color 2
		Iteration=0                                                 
300	I = (64.0 * Ran(J)) + 1
C		DUPLICATE Color?
	If (Color_Selected(I)) Go To 300
		Iteration=Iteration+1
C		GIVE UP?
	If (Iteration .GE. 64) then
		Go To 305
	End If

C		LIGHTNESS SELECTION
	If ((Color_Value(I,2) .LT. 55) .OR. 
	1   (Color_Value(I,2) .GT. 75)) Go To 300
C	    	CHECK TO AVOID SIMILAR HUES
	Nhue2 = Color_Value(I,1)
	NhueX = Iabs(Nhue2-Nhue0)
        If ((NhueX .LE. 50) .OR. (NhueX .GE. 310)) Go To 300
	NhueX = Iabs(Nhue2-Nhue1)
        If ((NhueX .LE. 50) .OR. (NhueX .GE. 310)) Go To 300

C		LOOKS OK TO ME... (or gave up)
305   	  Write(H2,110) 'AH',Color_Value(I,1),
	1		 'L',Color_Value(I,2),
	2		 'S',Color_Value(I,3)
	  Color_Selected(I) = .TRUE.
	  Color(3)=i
	  Nhue2 = Color_Value(I,1)

                                
C	SELECT Color 3
		Iteration=0                      
400	i=(64.0 * Ran(J)) + 1      
C		DUPLICATE Color?
	If (Color_Selected(I)) Go To 400
		Iteration=Iteration+1
C		GIVE UP?
C			(Increased to make absolutely sure)
	If (Iteration .GE. 128) then
		Go To 405
        End If
	
	
C		LIGHTNESS SELECTION
C	Most light Colors have "L" greater than 80.  The only exception
C	is light grey (66).  If we have made 120 tries, we loosen the
C	tolerance to 65, which almost assures a match - since lots of 
C	selections fit this criterion.  (8 tries this way)

	If ((Iteration .LE. 32) .AND. 
	1   (Color_Value(I,2) .LT. 80)) Go To 400

	If (Iteration .LT. 120) then
		If (Color_Value(I,2) .LT. 66) Go To 400
	Else
		If (Color_Value(I,2) .LT. 65) Go To 400
	End If
                                       
C		We have an acceptable "L" value, so
C		CHECK TO AVOID SIMILAR HUES
	Nhue3 = Color_Value(I,1)
	NhueX = Iabs(Nhue3-Nhue0)
        If ((NhueX .LE. 50) .OR. (NhueX .GE. 310)) Go To 400
	NhueX = Iabs(Nhue3-Nhue1)
        If ((NhueX .LE. 50) .OR. (NhueX .GE. 310)) Go To 400
	NhueX = Iabs(Nhue3-Nhue2)
        If ((NhueX .LE. 50) .OR. (NhueX .GE. 310)) Go To 400

C		LOOKS OK TO ME... (or gave up)
405	  Write(H3,110) 'AH',Color_Value(I,1),
	1		 'L',Color_Value(I,2),
	2		 'S',Color_Value(I,3)
	  Color(4)=i        

                              
C	CONSTRUCT OUTPUT STRING

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

 	Print *,Home//Regis_In//New//Regis_Out//Home23

                     


C		SHOW WHAT WE'VE GOT:
	Print *,' Your Colors Are: '//Bold//' Bold   '//Bold_Rev//
	1	' Bold Reverse '//Normal//'  '//Rev//
	2	' Normal Reverse '//Normal

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

1001	Format (I5,3I15)
1002	Format (A)

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)

9999    End

