brewcolordb.ado

********************************************************************************
* Description of the Program -												   *
* This program is used to build a dataset with the names and RGB values of all * 
* color styles defined by Stata that are part of the base installation of the  *
* program.  It will be used when proofing graphs from the perspective of 	   *
* different forms of color blindness.										   *
*                                                                              *
* Program Output -                                                             *
*                                                                              *
* Lines -                                                                      *
*     333                                                                      *
*                                                                              *
********************************************************************************
		
*! brewcolordb
*! v 1.0.3
*! 09NOV2016

// Drop the program from memory if loaded
cap prog drop brewcolordb

// Define a program
prog def brewcolordb, rclass

	// Version of Stata that should be used to interpret the code
	version 13.1

	// Defines syntax structure of program
	syntax [, DISplay REPlace OVERride]
	
	if `"`override'"' == "" {

		// Print warning message
		di as res "This program needs to clear all data currently in memory. "	 ///   
		"If this is ok hit enter, otherwise enter the letter 'n' and hit enter " ///  
		"to exit the program without clearing data from memory." _request(_perm)
	
		// Check response
		if lower(`"`perm'"') == "n" exit 
		
		// Or clear data from memory
		else clear
		
	} // End IF BLOCK for no override option
		
	// Clear data from memory
	else clear
	
	// Store the name of the personal subdirectory
	loc personal `c(sysdir_personal)'
	
	// Check to see if the personal ADOPATH directory exists
	qui: dirfile `: subinstr loc personal "personal/" "", all', p(personal)
	
	// Set the rebuild parameter conditional on the replace argument
	if `"`replace'"' != "" loc rebuild rebuild
	
	// Remove tilde and replace with HOME environmental variable for color db subdirectory
	qui: dirfile `c(sysdir_personal)', p(brewcolors) `rebuild'
	
	// Remove tilde and replace with HOME environmental variable for color db subdirectory
	qui: dirfile `c(sysdir_personal)', p(style) `rebuild'

	// Check for file
	cap confirm new file `"`c(sysdir_personal)'brewcolors/colordb.dta"'
	
	// If file does not exist or replace option passed
	if _rc == 0 | `"`replace'"' != "" {

		// Get list of color style file names
		loc colors `: dir `"`c(sysdir_base)'/style/"' files "color*.style", respect'

		// Clean up the file names
		loc colors : list clean colors
		
		// Remove quotation marks from color file names
		loc colors `: subinstr loc colors `"""' "", all'
		
		// Set observations
		qui: set obs 2

		// Create entry for color black
		qui: g id = "black"
		
		// Create RGB balues for color black
		qui: g v1 = cond(_n == 1, "sequence 1", "0 0 0")

		// Loop over the list of files
		forv i = 1/`: word count `colors'' {
			
			// Keep the current data preserved in memory
			preserve
				
				// Get the color style file name
				loc name `: word `i' of `colors''
				
				// Load the color style file into memory
				qui: insheet using `"`c(sysdir_base)'style/`name'"', clear
				
				// Get the color name
				getColorName `name'
				
				// Use the color name for the ID field
				qui: g id = "`r(colorname)'"
				
				// Reserve space for a temp file in memory
				tempfile `i'
				
				// Save the current data set in the tempfile reserved above
				qui: save ``i''.dta, replace

			// Restore memory to previous state (e.g., first color style file)
			restore

			// Append this color style to the existing data set
			qui: append using ``i''.dta

		} // End Loop over the color style files
		
		// Generate a file id (row number)
		qui: g fileid = _n

		// Count the number of lines per file
		qui: bys id (fileid): g lines = _N

		// Create a row id for the lines from each color style file
		qui: bys id (fileid): g linenum = _n

		// Get the sequence number
		qui: g seqid = v1 if regexm(v1, "^sequence") == 1

		// Remove the word sequence
		qui: replace seqid = trim(itrim(subinstr(seqid, "sequence ", "", .)))

		// Make the sequence ID variable numeric
		qui: destring seqid, replace
		
		// Carry the value for the rest of the color
		bys id (fileid): replace seqid = seqid[_n -1] if mi(seqid)
		
		// Keep only the records that contain the RGB values
		qui: keep if lines == linenum

		// Replace the value for the color style none
		qui: replace v1 = "" if id == "none"

		// Rename v1 to something more informative
		rename v1 rgb

		// Check display option
		if `"`display'"' != "" {

			// Write the table header
			di as text _dup(80) `"_"' _n _skip(10) "Color Name" _skip(10) 	 ///   
			"RGB" _n _dup(80) "_" _n 

		} // End If Block for Display Header
		
		// Loop over the observations
		forv v = 1/`: word count `colors'' {
		
			// Check display option
			if `"`display'"' != "" {

				// Print the data to the screen
				di as res _skip(10) id[`v'] _col(30) rgb[`v']

			} // End IF Block for display option
			
			// Return the color value in the name of the color
			ret loc `: di id[`v']' `"`: di rgb[`v']'"'
				
		} // End Loop
			
		// Check display option
		if `"`display'"' != "" {

			// Add footer
			di as text _dup(80) "_"
			
		} // End IF Block for display option
		
		// Set the display order of the variables
		order id rgb
		
		// Keep only the needed variables
		qui: keep id rgb seqid
		
		// Clean up rgb values
		qui: replace rgb = trim(itrim(rgb))
		
		// Rename variable 
		qui: rename id palette
		
		// Make sequence ID string
		qui: tostring seqid, replace
		
		// Make sequence ID follow logic used for rest of suite
		qui: replace seqid = palette + seqid
		
		// Generate meta data fields
		foreach v in colorblind print lcd photocopy {
		
			// Generate variables with null values
			qui: g `v' = .n
			
		} // End Loop over meta properties
		
		// Generate a meta data field
		qui: g meta = "Stata"
		
		// Create a max colors value
		qui: g maxcolors = 1
		
		// Create colorid 
		qui: g colorid = 1
		
		// Create palette ID
		qui: g pcolor = 1
		
		// Add metadata 
		la var palette "Name of Stata Colorstyle"
		la var rgb "RGB Value of Stata Colorstyle"
		
		// Optimize data storage
		qui: compress
		
		// Drop any duplicate values
		qui: duplicates drop
		
		// Translate colorblind equivalent RGB values
		qui: brewtransform rgb
		
		// Loop over value variables
		foreach v of var rgb achromatopsia protanopia deuteranopia		 ///   
		tritanopia {

			// Replace the value for the color style none
			qui: replace `v' = "none" if palette == "none"
			
			// Make sure black and white are constant
			qui: replace `v' = "0 0 0" if palette == "black"
			qui: replace `v' = "255 255 255" if palette == "white"

		} // End of loop over value columns
		
		// Save to the brewscheme created directories
		qui: save `"`c(sysdir_personal)'brewcolors/colordb.dta"', replace
		
		// Loop over records
		forv i = 1/`c(N)' {
	
			// open new files for named colors
			loc rootnm `: di palette[`i']'
	
			// Store filename in local macro
			loc styleroot `"`c(sysdir_personal)'style/color-"'
		
			// Create new file wit the color definition
			qui: file open achrom using `"`styleroot'`rootnm'_achromatopsia.style"', w replace
			
			// Create new file wit the color definition
			qui: file open protan using `"`styleroot'`rootnm'_protanopia.style"', w replace

			// Create new file wit the color definition
			qui: file open deuter using `"`styleroot'`rootnm'_deuteranopia.style"', w replace
			
			// Create new file wit the color definition
			qui: file open tritan using `"`styleroot'`rootnm'_tritanopia.style"', w replace
			
			// Loop over the file connections
			foreach fnm in achrom protan deuter tritan {
			
				// Write a version number
				qui: file write `fnm' `"*! v 0.0.0 `c(current_date)' `c(current_time)'"' _n
				
				// Write color attribution
				qui: file write `fnm' `"*! Color defined by the user: `c(username)'"' _n
				
				// Add a sequence ID to the file
				qui: file write `fnm' `"sequence `: di seqid[`i']'"' _n
			
			} // End Loop over Stata defined colors
			
			// Write the color name
			qui: file write achrom `"label "`rootnm'_achromatopsia""' _n(2)
			qui: file write protan `"label "`rootnm'_protanopia""' _n(2)
			qui: file write deuter `"label "`rootnm'_deuteranopia""' _n(2)
			qui: file write tritan `"label "`rootnm'_tritanopia""' _n(2)
			
			// Write the color definition to the file
			qui: file write achrom `"set rgb "`: di achromatopsia[`i']'""' _n(2)
			qui: file write protan `"set rgb "`: di protanopia[`i']'""' _n(2)
			qui: file write deuter `"set rgb "`: di deuteranopia[`i']'""' _n(2)
			qui: file write tritan `"set rgb "`: di tritanopia[`i']'""' _n(2)
			
			// Close the file
			qui: file close achrom
			qui: file close protan
			qui: file close deuter
			qui: file close tritan
						
		} // End Loop over records

	} // End IF Block for case where replace option is passed or file does not exist
	
	// Otherwise
	else {
	
		// Print message to console
		di as res `"The file "'											 ///   
		`"`c(sysdir_personal)'brewcolors/colordb.dta already exists "'	 ///   
		`"and will not be overwritten"' 
		
	} // End ELSE Block for existing file without overwrite
		
// end of program
end

// Utility subroutine to parse the color name from a color style file name
prog def getColorName, rclass

	// Accepts only single mandatory argument of the color style file name
	syntax anything(name = cfname id = "Color style file name")
	
	// Remove the opening of the color style file name
	loc cname `: subinstr loc cfname `"color-"' "", all'
	
	// Remove the file extension
	loc cname `: subinstr loc cname `".style"' "", all'

	// Return the value
	ret loc colorname `cname'
	
// End of subroutine
end