.packageName <- "blighty"
# the blighty package by David Lucy - plots the coastline of the British Isles
# sadly doesn't do Ireland as I don't have the OS coordinates for Ireland.
# Copyleft - David Lucy January 2002

blighty <- function(
		    place="set.UK",
		    grid=FALSE,
		    xlimits, 
		    ylimits,
		    xpadding=0,
		    ypadding=0,
		    parcol=par("bg"),		# primary area colour
		    parbor=par("fg"),		# primary area border colour - "transparent" for invisible
		    parwdh=1,			# primary area border width
		    sarcol=par("bg"),		# secondary area colour
		    sarbor=par("fg"),		# secondary area border colour - "transparent" for invisible
		    sarwdh=1,			# secondary area border width
		    parang=NULL,		# angle of lines for primary areas
		    parden=NULL,		# lines per inch for primary areas
		    sarang=NULL,		# angle of lines for secondary areas
		    sarden=NULL,		# lines per inch for secondary areas
		    tlncol=par("fg"),		# colour of lines for non-area objects
		    tlnwdh=1,			# width of lines for non-area objects
		    grdcol=par("fg"),		# colour of grid lines
		    grdwdh=1)			# width of grid lines

{
cat("\nPlotting ", place, " be patient ...\n")

# get the vector of objectnames from the set file
data(list = place)
objectnames <- as.vector(get(place)[,1])

# assign the number of objects in the set
noobjects <- length(objectnames)

# read in the data from the object files
data(list = objectnames)

cat("Data loaded ...\n")

	# calculate x limits if not specified by the user
	# these are calculated from the map objects themselves
	if(missing(xlimits))
		{
		xlimits <- vector(mode="numeric", length=2)

			for(ctr in 1:noobjects)
				{
					if(ctr == 1)
						{
						len <- length(get(objectnames[1])$x)
						xlimits[1] <- min(get(objectnames[1])$x[2:len])
						xlimits[2] <- max(get(objectnames[1])$x[2:len])
						}

					if(ctr > 1)
						{
						len <- length(get(objectnames[ctr])$x)
						if(xlimits[1] > min(get(objectnames[ctr])$x[2:len])){xlimits[1] <- min(get(objectnames[ctr])$x[2:len])}
						if(xlimits[2] < max(get(objectnames[ctr])$x[2:len])){xlimits[2] <- max(get(objectnames[ctr])$x[2:len])}
						}
				}
		}


	# calculate x limits if not specified by the user
	# these are calculated from the map objects themselves
	if(missing(ylimits))
		{
		ylimits <- vector(mode="numeric", length=2)

			for(ctr in 1:noobjects)
				{
					if(ctr == 1)
						{
						len <- length(get(objectnames[1])$y)
						ylimits[1] <- min(get(objectnames[1])$y[2:len])
						ylimits[2] <- max(get(objectnames[1])$y[2:len])
						}

					if(ctr > 1)
						{
						len <- length(get(objectnames[ctr])$y)
						if(ylimits[1] > min(get(objectnames[ctr])$y[2:len])){ylimits[1] <- min(get(objectnames[ctr])$y[2:len])}
						if(ylimits[2] < max(get(objectnames[ctr])$y[2:len])){ylimits[2] <- max(get(objectnames[ctr])$y[2:len])}
						}
				}
		}


# test the plotting limits anything less than 200km in either direction
# leads to poor maps as the point resolution isn't that great
if(max(xlimits) - min(xlimits) < 200){cat("Less than 200km East-West - poor map resolution - proceeding\n")}
if(max(ylimits) - min(ylimits) < 200){cat("Less than 200km North-South - poor map resolution - proceeding\n")}

# add some padding around the figure if padding is specified 
# stops the figure from being hard up against the frame
xlimits[1] <- xlimits[1] - xpadding
xlimits[2] <- xlimits[2] + xpadding
ylimits[1] <- ylimits[1] - ypadding
ylimits[2] <- ylimits[2] + ypadding

# calculate suitable plot limits to keep the map with a more or less
# truly square grid
lims <- sqlimits(xlimits, ylimits)

cat("Correct aspect ratio calculated ...\n")

# setup the plot extremes
par(usr = c(lims$xlims[1], lims$xlims[2], lims$ylims[1], lims$ylims[2]))

# add to the plot all requested objects
#for(ctr in 1:noobjects){points(get(objectnames[ctr]), type="l")}
	for(ctr in 1:noobjects)
		{
		# 1 - area objects such as islands - landmasses etc
		if(get(objectnames[ctr])$x[1] == 1)
			{
			len <- length(get(objectnames[ctr])$x)
			polygon(get(objectnames[ctr])$x[2:len],
				get(objectnames[ctr])$y[2:len],
				angle=parang,
				density=parden,
				col=parcol,
				border=parbor,
				lwd=parwdh)
			}
		# 2 - area objects which sit on top of other area objects - things such as lakes
		if(get(objectnames[ctr])$x[1] == 2)
			{
			len <- length(get(objectnames[ctr])$x)
			polygon(get(objectnames[ctr])$x[2:len],
				get(objectnames[ctr])$y[2:len],
				angle=sarang,
				density=sarden,
				col=sarcol,
				border=sarbor,
				lwd=sarwdh)
			}
		# 3 - linear objects such as rivers - roads - railway lines
		if(get(objectnames[ctr])$x[1] == 3)
			{
			len <- length(get(objectnames[ctr])$x)
			points(get(objectnames[ctr])$x[2:len],
			       get(objectnames[ctr])$y[2:len],
			       type="l",
			       col=tlncol,
			       lwd=tlnwdh)
			}
		}

# if gridding has been requested put on the OS coordinates and gridlines and box
if(grid == "TRUE")
	{
	cat("Requested gridding applied ...\n")
	box(col=grdcol, lwd=grdwdh)
	xmarks <- pretty(lims$xlims)
	ymarks <- pretty(lims$ylims)

	axis(1, at=xmarks, labels=TRUE)
	abline(v=xmarks, col=grdcol, lwd=grdwdh)
	axis(2, at=ymarks, labels=TRUE)
	abline(h=ymarks, col=grdcol, lwd=grdwdh)
	}

# send the information to the global environment
blighty.mapinfo <- list(lims$xlims, lims$ylims, objectnames)
names(blighty.mapinfo) <- c("xlims", "ylims", "maps.used")
assign("blighty.mapinfo", blighty.mapinfo, env=.GlobalEnv)

# do a bit of tidying up
rm(list = objectnames, envir = .GlobalEnv)

cat("Map complete ...\n\n")
}
# file contains blighty() internal functions
# Copyright - David Lucy January 2002

# function which gets limits which make the plot square
# regardless of the shape of the plot area
# would stand being generalised to producing an arbitary
# aspect ratio for any plot for any plot window
#
# works by calculating new xlimts for any plot window
# to keep even axis within the plot
# it's main use is to get maps and plans with
# the correct aspect ratio - but can be used for
# other reasons
#
# input of two vectors one for the x one for the y
# in the order min x, max x -and- min y, max y
# output is in the same order only the new limits
#
# the output isn't quite accurate I suspect due to margins
# not being accounted for
sqlimits <- function(xlim, ylim)
{

# get the existing x and y limits
x1 <- xlim[1]
x2 <- xlim[2]
y1 <- ylim[1]
y2 <- ylim[2]

frame()
# calculate the existing figure aspect ratio
fig.ratio <- (x2 - x1)/(y2 - y1)
# grab the aspect ratio of the existing plot window
plot.ratio <- par("pin")[1] / par("pin")[2]

# if the x for the plot is larger than that for the
# existing window then we fix the x's and calculate
# new limits for the y
if(fig.ratio >= plot.ratio)
	{
	x1lim <- x1; x2lim <- x2
	ydist <- y2 - y1
	total.ydist <- (ydist * fig.ratio * (1/plot.ratio))
	diff.ydist <- (total.ydist - ydist) / 2
	y1lim <- y1 - diff.ydist; y2lim <- y2 + diff.ydist
	}

# if the x for the plot is smaller than that for the
# existing window then we fix the y's and calculate
# new limits for the x
if(fig.ratio < plot.ratio)
	{
	y1lim <- y1; y2lim <- y2
	xdist <- x2 - x1
	total.xdist <- (xdist * (1/fig.ratio) * plot.ratio)
	diff.xdist <- (total.xdist - xdist) / 2
	x1lim <- x1 - diff.xdist; x2lim <- x2 + diff.xdist
	}

xlims <- c(x1lim, x2lim)
ylims <- c(y1lim, y2lim)

return(xlims, ylims)
}

# Function to add a simple bar scale to a blighty() map
# Copyright - David Lucy January 2002

map.scale <- function(pos=AUTO, width=1)
{
# positively associate a value with a missing item
if(missing(pos)){pos <- "AUTO"}

# calculate base x and y for automatic selection of position
	if(pos == "AUTO")
		{
		xpos <- ((blighty.mapinfo$xlims[2] - blighty.mapinfo$xlims[1]) * 0.90) + blighty.mapinfo$xlims[1]
		ypos <- ((blighty.mapinfo$ylims[2] - blighty.mapinfo$ylims[1]) * 0.70) + blighty.mapinfo$ylims[1]
		}

# if the user has sent a vector describing where the centre of the scale should be
	if(is.numeric(pos))
		{
		if(length(pos) != 2){cat("\nWrong type for map scale coords\n"); stop}
		xpos <- pos[1]
		ypos <- pos[2]
		}

# if the user wishes to visually select the centre of the map scale
	if(pos == "select")
		{
		cat("\nUse the pointer to select where the map scale should be on the map\npress button 1 to select the point, then press button 2 to exit locator\n\n")
		pnts <- locator()
		xpos <- pnts$x
		ypos <- pnts$y
		}

# get a length for the scale bar
length <- round((blighty.mapinfo$ylims[2] - blighty.mapinfo$ylims[1]) * 0.10, 0)
vec <- pretty(seq(0, length, length=4))
length <- max(vec)

# draw a simple scale bar with annotation beneath it
segments(xpos - (length / 2), ypos, xpos + (length / 2), ypos, lwd=width)
text(xpos, ypos - (length / 5), labels=paste(length, "km", sep=" "), adj=0.5)
}
# Function to add a simple north-pointer to a blighty() map
# Copyright - David Lucy January 2002

north.pointer <- function(pos=AUTO)
{
# positively associate a value with a missing item
if(missing(pos)){pos <- "AUTO"}

# calculate base x and y for automatic selection of position
	if(pos == "AUTO")
		{
		xpos <- ((blighty.mapinfo$xlims[2] - blighty.mapinfo$xlims[1]) * 0.90) + blighty.mapinfo$xlims[1]
		ypos <- ((blighty.mapinfo$ylims[2] - blighty.mapinfo$ylims[1]) * 0.90) + blighty.mapinfo$ylims[1]
		}

# if the user has sent a vector describing where the centre of the "N" should be
	if(is.numeric(pos))
		{
		if(length(pos) != 2){cat("\nWrong type for North pointer coords\n"); stop}
		xpos <- pos[1]
		ypos <- pos[2]
		}

# if the user wishes to visually select the centre of the "N" of the pointer
	if(pos == "select")
		{
		cat("\nUse the pointer to select where the North pointer should be on the map\npress button 1 to select the point, then press button 2 to exit locator\n\n")
		pnts <- locator()
		xpos <- pnts$x
		ypos <- pnts$y
		}

# get a length for the vertical of the north pointer
length <- (blighty.mapinfo$ylims[2] - blighty.mapinfo$ylims[1]) * 0.10
# draw the "N"
text(xpos, ypos, labels="N", adj=0.5)
# Arrow up a north pointer
arrows(xpos, ypos - (1.5 * length), xpos, ypos - (0.2 * length), code=2, angle=20, length=0.1) 
# calculate the length of the cross bar
crossheight <- ypos - (0.85 * length)
crosslength <- length / 15
# draw the cross bar
segments(xpos - crosslength, crossheight, xpos + crosslength, crossheight)
}

cat("\nLoading blighty version 2.0-0\n")
cat("Copyright David Lucy 2001-2002\n\n")
