From arizona!stat.wisc.edu!owner-S-news  Thu Feb 13 23:04:04 1992
Received: from arizona by rupley via UUCP (911016.SGI/890607.SGI)
	(for local) id AA08671; Thu, 13 Feb 92 23:04:04 -0700
Resent-From: arizona!stat.wisc.edu!owner-S-news
Received: from optima.cs.arizona.edu by univers.cs.arizona.edu; Thu, 13 Feb 92 22:18:14 MST
Resent-Date: Fri, 14 Feb 92 00:11:59 EST
Resent-Message-Id: <9202140518.AA19468@optima.cs.arizona.edu>
Received: from jupiter.stat.wisc.edu by optima.cs.arizona.edu (4.1/15)
	id AA19468; Thu, 13 Feb 92 22:18:11 MST
Received: by jupiter.stat.wisc.edu; Thu, 13 Feb 92 23:12:26 -0600
Received: from hermes.stat.wisc.edu by jupiter.stat.wisc.edu; Thu, 13 Feb 92 23:12:09 -0600
Received: from fisher.stat.psu.edu by hermes.stat.wisc.edu; Thu, 13 Feb 92 23:12:04 -0600
Received: from wilks.stat.psu.EDU by fisher.stat.psu.edu (4.1/SMI-4.1/stat.3)
	id AA27291; Fri, 14 Feb 92 00:12:00 EST
Received: by wilks.stat.psu.EDU (5.52/1.110)
	id AA09893; Fri, 14 Feb 92 00:11:59 EST
Date: Fri, 14 Feb 92 00:11:59 EST
From: Colin Goodall <arizona!stat.psu.edu!colin>
Message-Id: <9202140511.AA09893@wilks.stat.psu.EDU>
To: S-news@stat.wisc.edu
Errors-To: arizona!stat.wisc.edu!owner-S-news
Resent-To: S-news-list@stat.wisc.edu
Resent-Reply-To: Colin Goodall <arizona!stat.psu.edu!colin>
Status: RO

Here is the S function of today.   For postscript output type
> postscript("filename",colors=seq(0,1,0.1))
> valentine("Your message")
For someone that extra bit special, try
> valentine("Your message",hcol=c(9,8,7))

valentine <- function(message = "To my Sweetheart",
	main = "Happy Valentine's Day",
	hcol = 9, acol = 10, msgcol = 1, mcol = 1)
{
#  call to postscript():  postscript(colors=seq(0,1,0.1))
#  colors for iris4d():	hcol=15,acol=2,msgcol=16,mcol=2){
	par(pty = "s")
	frame()
	par(usr = c(-1, 1, -2, 0.5))
	pg <- function(a, b, d)
	polygon(complex(arg = theta + pi/2, mod = exp(abs(theta)/a)/b), col = d
		)
	l <- 9
	for(i in hcol)
		pg(1.1, l <- l + 1, i)
	adjj <- (length(hcol)-1)*0.05
	par(usr = c(-1, 1, -1, 1))
	arrowp <- function(ll = 0.9, stfac = 0.8, ptfac = 1.2, enfac = 1.05,
		enofac = 1.15, hei = 0.085, htfac = 1.5,
		htofac = 1.5, trans = 0.05i, ...)
	{
		a <- complex(real = c( - ll * enofac,  - ll, ll * stfac, ll *
			stfac), imag = c(hei * htofac, hei, hei, hei * htfac))
		arrowp <- c(a, ll * stfac * ptfac, rev(Conj(a)),  - ll * enfac)
			
		polygon(arrowp * exp(((-45i) * pi)/180) - trans, ...)
	}
	arrowp(col = acol,ll=0.9-adjj,stfac=0.8+adjj,trans=0.05i-adjj*1i)
	message <- paste(message,paste(rep(" ",ceiling(nchar(message)/5)),
		collapse=""),sep="")
	text(-0.05i+adjj*1i,message, srt = -45, col = msgcol, cex = 1.5)
	text(0.9i, main, cex = 1.8, col = mcol)
}

