"Sdraw"<-
function(gui = options()$gui)
{
	switch(gui,
		"athena" = X11(),
		"motif" = motif(),
		"openlook" = openlook(),
		"windows" = win.graph(),
		stop("Unsupported graphical interface"))
	oldpar <- par(pty = "s")
	on.exit(par(oldpar))
	assign("Draw.window", dev.cur(), where = 0)
	on.exit({
		dev.off(Draw.window)
		remove("Draw.window", where = 0)
	}
	)
	frame()	#
	box()	#
	shape.list <- vector("list", 0)
	DrawPalette <- function(...)
	{
# Draw the palette for the drawing tools, including
# the "quit" box to provide exit from the function:
		polygon(c(0.90000000000000002, 1, 1, 0.90000000000000002), c(
			0.90000000000000002, 0.90000000000000002, 1, 1), 0, ...
			)
		text(0.94999999999999996, 0.94999999999999996, "quit", ...)	#
# The circle icon
		polygon(c(0.90000000000000002, 1, 1, 0.90000000000000002), c(
			0.80000000000000004, 0.80000000000000004, 
			0.90000000000000002, 0.90000000000000002), 0, ...)
		draw.circle(circle(c(0.94999999999999996, 0.84999999999999998), 
			radius = 0.025000000000000001), ...)	#
# The square icon
		polygon(c(0.90000000000000002, 1, 1, 0.90000000000000002), c(
			0.69999999999999996, 0.69999999999999996, 
			0.80000000000000004, 0.80000000000000004), 0, ...)
		polygon(c(0.93000000000000005, 0.96999999999999997, 
			0.96999999999999997, 0.93000000000000005), c(
			0.72999999999999998, 0.72999999999999998, 
			0.77000000000000002, 0.77000000000000002), 0, ...)	#
# The squiggle icon
		polygon(c(0.90000000000000002, 1, 1, 0.90000000000000002), c(
			0.59999999999999998, 0.59999999999999998, 
			0.69999999999999996, 0.69999999999999996), 0, ...)
		lines(c(0.92000000000000004, 0.93999999999999995, 
			0.95999999999999996, 0.97999999999999998), c(
			0.66000000000000003, 0.65000000000000002, 
			0.66000000000000003, 0.64000000000000001), ...)	#
# The "undo" box
		polygon(c(0.90000000000000002, 1, 1, 0.90000000000000002), c(0, 
			0, 0.10000000000000001, 0.10000000000000001), 0, ...)
		text(0.94999999999999996, 0.050000000000000003, "Undo", ...)	#
# The "print" box
		polygon(c(0.90000000000000002, 1, 1, 0.90000000000000002), c(
			0.10000000000000001, 0.10000000000000001, 
			0.20000000000000001, 0.20000000000000001), 0, ...)
		text(0.94999999999999996, 0.14999999999999999, "Print", ...)	#
	}
#
	DrawPalette()	#
# The repeat loop takes the latest mouse click, checks if it is in
# the quit box, and if not draws something.
#
	repeat {
		pos <- locator(1)
		if(pos$x > 0.90000000000000002) {
			if(pos$y > 0.90000000000000002) {
				return("Thanks for using S-PLUS Draw!")
			}
			else if(pos$y > 0 && pos$y <= 0.10000000000000001) {
				draw(shape, col = 0)
				pos <- NULL
				next
			}
			else if(pos$y > 0.10000000000000001 && pos$y <= 
				0.20000000000000001) {
				DrawPalette(col = 0)
				box()
				dev.print()
				DrawPalette()
				next
			}
			anchor.pos <- locator(1)
			if(anchor.pos$x > 0.90000000000000002) {
				warning("Anchor is outside drawing area!")
				next
			}
			if(pos$y > 0.80000000000000004) {
				assign("shape", circle(anchor.pos, locator(1)), 
				  frame = 1)
			}
			else if(pos$y > 0.69999999999999996) {
				assign("shape", square(anchor.pos, locator(1)), 
				  frame = 1)
			}
			else if(pos$y > 0.59999999999999998) {
				assign("shape", squiggle(locator(1), anchor.pos
				  ), frame = 1)
				repeat {
				  draw(shape)
				  next.vert <- locator(1)
				  if(next.vert$x < 0.90000000000000002) {
				    assign("shape", squiggle(next.vert, shape), 
				      frame = 1)
				    next
				  }
				  else break
				}
			}
			else {
				stop("Unknown option")
			}
		}
		draw(shape)
		shape.list <- c(shape, shape.list)
	}
}
"Sdraw.menu"<-
function(gui = options()$gui)
{
	switch(gui,
		"athena" = X11(),
		"motif" = motif(),
		"openlook" = openlook(),
		"windows" = win.graph(),
		stop("Unsupported graphical interface"))
	oldpar <- par(pty = "s")
	on.exit(par(oldpar))
	assign("Draw.window", dev.cur(), where = 0)
	on.exit({
		dev.off(Draw.window)
		remove("Draw.window", where = 0)
	}
	)
	frame()	#
	box()	#
	shape.list <- vector("list", 0)	#
# The repeat loop takes the latest menu choice, 
# then does the appropriate something.
#
	repeat {
		choices <- c("Quit", "Circles", "Squares", "Squiggles", "Print",
			"Undo")
		cat("Select the desired S-PLUS Draw option:\n")
		pick <- menu(choices)
		switch(pick,
			return("Thanks for using S-PLUS Draw!"),
			{
				assign("shape", circle(locator(2)), frame = 1)
				if(shape$radius < 0.00050000000000000001) {
				  assign("shape", circle(shape$center, locator(
				    1)), frame = 1)
				}
			}
			,
			{
				assign("shape", square(locator(2)), frame = 1)
				if(shape$sidelength < 0.00050000000000000001) 
				  {
				  assign("shape", square(shape$center, locator(
				    1)), frame = 1)
				}
			}
			,
			{
				assign("shape", squiggle(locator(2)), frame = 1
				  )
				repeat {
				  draw(shape)
				  next.vert <- locator(1)
				  if(next.vert$x < 0.90000000000000002) {
				    assign("shape", squiggle(next.vert, shape), 
				      frame = 1)
				    next
				  }
				  else break
				}
			}
			,
			{
				dev.print()
			}
			,
			draw(shape, col = 0))
		draw(shape)
		shape.list <- c(shape, shape.list)
	}
}
"draw"<-
function(x, ...)
UseMethod("draw")
"circle"<-
function(center, radius, point.on.edge)
{
	center <- as.point(center)
	val <- NULL
	if(length(center$x) == 2) {
		val <- list(center = list(x = center$x[1], y = center$y[1]), 
			radius = sqrt(diff(center$x)^2 + diff(center$y)^2))
	}
	else if(length(center$x) == 1) {
		if(missing(radius)) {
			point.on.edge <- as.point(point.on.edge)
		}
		else if(is.atomic(radius)) {
			val <- list(center = center, radius = abs(radius))
		}
		else {
			point.on.edge <- as.point(radius)
		}
		if(is.null(val)) {
			val <- list(center = list(x = center$x[1], y = center$y[
				1]), radius = sqrt((point.on.edge$x - center$x)^
				2 + (point.on.edge$y - center$y)^2))
		}
	}
	class(val) <- "circle"
	val
}
"draw.circle"<-
function(x, ...)
{
	center <- x$center
	radius <- x$radius
	symbols(center, circles = radius, add = T, inches = F, ...)
}
"square"<-
function(old.pos, new.pos)
{
	old.pos <- as.point(old.pos)
	oldx <- old.pos$x[1]
	oldy <- old.pos$y[1]
	if(length(old.pos$x) == 2) {
		sidelength <- sqrt((diff(old.pos$x)^2 + diff(old.pos$y)^2)/2)
		newx <- old.pos$x[2]
		newy <- old.pos$y[2]
	}
	else if(is.atomic(new.pos) && length(new.pos) == 1) {
		sidelength <- new.pos
		newx <- oldx + sidelength
		newy <- oldy + sidelength
	}
	else {
		sidelength <- distance(old.pos, new.pos)/sqrt(2)
		if(is.list(new.pos)) {
			newx <- new.pos$x
			newy <- new.pos$y
		}
		else {
			newx <- new.pos[1]
			newy <- new.pos[2]
		}
	}
	centerx <- (oldx + newx)/2
	centery <- (oldy + newy)/2
	return.val <- list(lrc = list(x = oldx, y = oldy), sidelength = 
		sidelength, center = list(x = centerx, y = centery))
	class(return.val) <- "square"
	return.val
}
"draw.square"<-
function(square, ...)
{
	lx <- square$center$x - (square$sidelength/2)
	rx <- square$center$x + (square$sidelength/2)
	ly <- square$center$y - (square$sidelength/2)
	uy <- square$center$y + (square$sidelength/2)
	polygon(c(lx, rx, rx, lx), c(ly, ly, uy, uy), 0, ...)
}
"distance"<-
function(old.pos, new.pos)
{
	if(is.list(old.pos)) {
		oldx <- old.pos$x
		oldy <- old.pos$y
	}
	else {
		oldx <- old.pos[1]
		oldy <- old.pos[2]
	}
	if(is.list(new.pos)) {
		newx <- new.pos$x
		newy <- new.pos$y
	}
	else {
		newx <- new.pos[1]
		newy <- new.pos[2]
	}
	sqrt((newx - oldx)^2 + (newy - oldy)^2)
}
"squiggle"<-
function(new.pos, prev)
{
	val <- as.point(new.pos)
	if(!missing(prev)) {
		val <- list(x = c(prev$x, val$x), y = c(prev$y, val$y))
	}
	class(val) <- "squiggle"
	val
}
"draw.squiggle"<-
function(squiggle, ...)
{
	lines(squiggle, ...)
}
"as.point"<-
function(p)
{
	if(is.numeric(p) && length(p) == 2)
		list(x = p[1], y = p[2])
	else if(is.list(p) && !is.null(p$x) && !is.null(p$y))
		p
	else if(is.matrix(p))
		list(x = p[, 1], y = p[, 2])
	else stop("Cannot interpret input as point")
}