program define keyplot, rclass
*! 2.1.3 NJC 30 April 2001 
* 2.1.2 NJC 5 December 2000 
* 2.1.1 NJC 27 October 2000 
* 2.1.0 NJC 10 July 2000 
* 2.0.0 NJC 6 July 2000 
* 1.0.0 NJC 17 February 1999
        version 6.0
        syntax varlist(min=2 max=11) [if] [in] [aweight fweight iweight] /* 
        */ [ , Symbol(str) PEn(str) T1title(str) T2title(str) Saving(str) /* 
	*/ Keys(str asis) sep(str) varlbl BY(str) ROWpos(numlist int >0) /* 
	*/ COLpos(numlist int >0) KTFont(numlist int min=2 max=2 >0) /* 
	*/ t1pos(numlist int min=2 max=2 >0)  /* 
	*/ t1font(numlist int min=2 max=2 >0) /* 
	*/ t2pos(numlist int min=2 max=2 >0)  /*  
	*/ t2font(numlist int min=2 max=2 >0) /*  
	*/ t1pen(int 1) t2pen(int 1) *  ]
       
	if `"`t1title'"' != "" & "`t1pos'" == "" { 
		di in r "t1pos( ) option required" 
		exit 198 
	}

	if `"`t2title'"' != "" & "`t2pos'" == "" { 
		di in r "t2pos( ) option required" 
		exit 198 
	}	

	if "`by'" != "" { 
		di in r "by( ) option not available" 
		exit 198 
	} 

	if `"`keys'"' != "" & "`varlbl'" != "" { 
		di in r "choose between keys( ) and varlbl options" 
		exit 198 
	} 	
	
        local nvars : word count `varlist'
        local ny = `nvars' - 1

	if "`rowpos'" != "" { 
		local nr : word count `rowpos' 
		if `nr' != `ny' {
			if `nr' == 1 { 
				local rowpos : di _dup(`ny') "`rowpos' " 
			} 
			else { 
				local s1 = cond(`nr' != 1, "s", "") 
				local s2 = cond(`ny' != 1, "s", "")  
				di in r /* 
			*/ "`nr' row position`s1' for `ny' variable`s2'"
				exit 198 
			}	
		} 
	} 
	if "`colpos'" != "" { 	
		local nc : word count `colpos' 
		if `nc' != `ny' { 
			if `nc' == 1 { 
				local colpos : di _dup(`ny') "`colpos' " 
			} 
			else { 
				local s1 = cond(`nc' != 1, "s", "") 
				local s2 = cond(`ny' != 1, "s", "")  
				di in r /* 
			*/ "`nc' column position`s1' for `ny' variable`s2'" 
				exit 198
			} 	
		} 
	} 	
	
  	if `"`keys'"' != "" {
  		if trim(`"`keys'"') == "" { /* explicit blank => keys off */ 
  			local keysoff 1 
  		} 
  		else { 
  			local keysoff 0 
  	
  			if "`sep'" == "" { local sep " " } 
  			tokenize `"`keys'"', parse("`sep'") 

			local i = 0 
			while "`1'" != "" { 
				if "`1'" != "`sep'" { 
					local i = `i' + 1 
					local k`i' `"`1'"' 
				} 
				mac shift 
			} 

			if `i' != `ny' { 
				local s1 = cond(`i' != 1, "s", "") 
				local s2 = cond(`ny' != 1, "s", "")  
				di in r "`i' key`s1' for `ny' variable`s2'" 
				exit 198 
			} 
		}	
	} 	
	else { 
		tknz `varlist', stub(k)  

		if "`varlbl'" != "" { 
			local i = 1 
			while `i' <= `ny' { 
				local lbl : variable label `k`i'' 
				if `"`lbl'"' != "" { local k`i' `"`lbl'"' } 
				local i = `i' + 1 
			} 
		}

		local keysoff = cond(`"`k3'"' == "", 1, 0) 
	} 	

        /* symbol( ) doesn't care about too many symbols */
        if "`symbol'" == "" { local symbol "OTSpdo.OTS" }
	else if index("`symbol'","[") {
                di in r "sy([varname]) or sy([_n]) not supported: sorry"
                exit 198
        }
	else if index("`symbol'","i") {
                di in r "sy(i) not supported: sorry"
                exit 198
        }

        /* pen( ) is fussy: one pen too many and it complains */
        if "`pen'" == "" {
                local pen = substr("2345678923",1,`ny')
        }
        else {
                if `ny' != length("`pen'") {
                        di in r "pen( ) invalid"
                        exit 198
                }
        }

	if `"`saving'"' != "" { loc saving `", saving(`saving')"' }
	gph open `saving' 

        /* ignore any user t1( ) t2( ): they are added later */
        gr `varlist' `if' `in' [`weight' `exp'], `options' pen(`pen') /*
         */ sy(`symbol') t1(" ") t2(" ")
	 
	if `"`t1title'"' != "" { 
		if "`t1font'" == "" { local t1font "570 290" }
		gph pen `t1pen' 
		gph font `t1font' 
		gph text `t1pos' 0 -1 `t1title' 
	}
	
	if `"`t2title'"' != "" {
		if "`t2font'" == "" { local t2font "570 290" } 
		gph pen `t2pen' 
		gph font `t2font' 
		gph text `t2pos' 0 -1 `t2title' 
	} 
	
  	if `keysoff' { /* no keys: bail out now */  
  		gph close 
  		exit 0 
  	} 	

	if "`ktfont'" == "" { local ktfont "570 290" } 
	local ktfr : word 1 of `ktfont' 
	* nudge factor to move text down relative to symbol 
	local nudge = 250 * (`ktfr' / 570)^2 
        gph font `ktfont'

        /* point symbols at row r, column c */
	local c1 "5500" 
	local r1 "500" 
	local c2 "5500 18500" 
	local r2 "500 500" 
	local c3 "5500 13500 21500" 
	local r3 "500 500 500" 
	local c4 "5500 17500 5500 17500" 
	local r4 "500 500 1500 1500" 
	local c5 "5500 13500 21500 5500 13500 21500" 
	local r5 "500 500 500 1500 1500 1500" 
	local c6 "5500 13500 21500 5500 13500 21500" 
	local r6 "500 500 500 1500 1500 1500" 
	local c7 "5500 11500 17500 23500 5500 11500 17500 23500"
	local r7 "500 500 500 500 1500 1500 1500 1500"
	local c8 "5500 11500 17500 23500 5500 11500 17500 23500"
	local r8 "500 500 500 500 1500 1500 1500 1500"
	local c9 "5500 10500 15500 20500 25500 5500 10500 15500 20500 25500" 
	local r9 "500 500 500 500 500 1500 1500 1500 1500 1500" 
	local c10 "5500 10500 15500 20500 25500 5500 10500 15500 20500 25500" 
	local r10 "500 500 500 500 500 1500 1500 1500 1500 1500"
	
	if "`colpos'" != "" { local c`ny' "`colpos'" } 
	if "`rowpos'" != "" { local r`ny' "`rowpos'" } 

	tknz `c`ny'', stub(C) 
	tknz `r`ny'', stub(R) 

        Gphtrans `symbol'
	local symbol "`r(symbol)'" 

        local i = 1
        while `i' <= `ny' {
                local syi = substr("`symbol'",`i',1)
                local p = substr("`pen'",`i',1)
                gph pen `p'
                gph point `R`i'' `C`i'' 150 `syi'
                local R = `R`i'' + 150
                local C = `C`i'' + `nudge'
		gph pen 1
                gph text `R' `C' 0 -1 `k`i''
                local i = `i' + 1
        }

 
        gph close

	return local rowpos "`r`ny''" 
	return local colpos "`c`ny''" 
end

program def Gphtrans, rclass /* transliterate ".OSTodp" -> "0123456" */
* 1.0.3 NJC 30 April 2001 
* 1.0.2 NJC 1 March 1999
* 1.0.0 NJC 31 March 1998
    version 6.0
    args argin
    loc length = length("`argin'")

    loc i 1
    while `i' <= `length' {
        loc s = substr("`argin'", `i', 1)
        if "`s'" == "."      { loc s 0 }
        else if "`s'" == "O" { loc s 1 }
        else if "`s'" == "S" { loc s 2 }
        else if "`s'" == "T" { loc s 3 }
        else if "`s'" == "o" { loc s 4 }
        else if "`s'" == "d" { loc s 5 }
        else if "`s'" == "p" { loc s 6 }
	else if "`s'" == "x" { loc s 7 } 
        loc argout "`argout'`s'"
        loc i = `i' + 1
    }

    return loc symbol `argout'
end

program def tknz, rclass 
* NJC 1.1.0 2 June 2000 
	version 6.0 
	gettoken list 0 : 0, parse(",") 
	syntax , Stub(str) [ * ] 
	tokenize `"`list'"' , `options'  
		
	local i = 1 	
	while "``i''" != "" { 
		c_local `stub'`i' `"``i''"'  
		local i = `i' + 1 
	} 
end