#DBASE DIAGRAMS
#Version: 0.1
#Author: Filip Kral
#Contact: vydramail <at> quick <dot> cz, www.filipkral.wz.cz
#Date: 20090622
#License issues: Public domain, provided AS IS, with NO WARRANTY!
#Description: R script, "grid" package is required. Functions defined in this file enables user to create a simple diagram of database structure of similar diagrams. See example usage at the end of this file. Major part of this code has been written according to Murrel 2009.
#References: Murrel, P. (2009): Drawing Diagrams with R, The R Journal Vol. 1/1 May 2009. ISSN 2073-4859
#------------------------------------------------

require(grid)

tableBox<-function(labels, x=0.5, y=0.5, clrs=c("gray55","white","gray90")){
	nlabel<-length(labels)
	tablevp<-viewport(x=x,y=y, width=max(stringWidth(labels))+unit(4,"mm"),height=unit(nlabel,"lines"))
	pushViewport(tablevp)
	grid.rect()
	parity<-"odd"
	if ((nlabel %% 2)==0){parity<-"even"}
	if (nlabel>1){
		for (i in 1:nlabel-1){
			if (i==(nlabel-1)){
				fill<-clrs[1]
			}else{
				if ((nlabel %% 2)==0){
				fill<-clrs[2:3][i %% 2 + 1]
				} else {
				fill<-clrs[3:2][i %% 2 + 1]
				}
			}
			grid.clip(y=unit(i, "lines"), just="bottom")
			grid.rect(gp=gpar(fill=fill))
		}
	}
	grid.clip()
	grid.text(labels[1], x=unit(2,"mm"), y=unit(nlabel - 0.5, "lines"), just="left", gp=gpar(fontface="bold"))
	grid.text(labels[2:nlabel], x=unit(2,"mm"), y=unit((nlabel-1):1 - 0.5, "lines"), just="left")
	popViewport()
}

boxGrob<-function(labels, x=0.5, y=0.5){
	grob(labels=labels, x=x, y=y, cl="box")
}

drawDetails.box<-function(x,...){
	tableBox(x$labels, x$x, x$y)
}

xDetails.box<-function(x, theta){
	height<-unit(length(x$labels), "lines")
	width<-unit(4,"mm")+max(stringWidth(x$labels))
	grobX(rectGrob(x=x$x, y=x$y, width=width, height=height), theta)
}

yDetails.box<-function(x,theta){
	height<-unit(length(x$labels), "lines")
	width<-unit(4,"mm")+max(stringWidth(x$labels))
	grobY(rectGrob(x=x$x, y=x$y, width=width, height=height), theta)
}

connect<-function(box1, box2, lab1, lab2, arr=arrow(type="closed",angle=15,length=unit(2,"mm")), dir="up"){
	#lab1 is an index of item in the box1, headding has index 0
	xa<-grobX(box1, "east")
	ya<-grobY(box1, "north")-unit(lab1+0.5,"lines")
	xb<-grobX(box2, "west")
	yb<-grobY(box2, "north")-unit(lab2+0.5,"lines")
	c<-1
	if (dir!="up"){c<--1}
	grid.curve(xa,ya,xb,yb,curvature=c,inflect=TRUE,arrow=arr,gp=gpar(fill="black"))
}

drawLine<-function(snap=0,shp=1,arr=arrow(type="closed",angle=15,length=unit(2,"mm"))){
	#connects box1 and box2 with a user defined curve
	#snap=real from 0 to 0.2, recommanded 0.02 specifies snapping to imaginary grid
	#shp= 0 for rectangular curve, or 1 for "internal" curve, or -1 for "external" curve
	x<-numeric(0)
	y<-numeric(0)
	loc<-grid.locator(unit="npc")
	i<-1
	x[i]<-as.real(loc$x)
	y[i]<-as.real(loc$y)
	loc<-grid.locator(unit="npc")
	diff<-sqrt(((as.real(loc$x)-x[length(x)])^2)+((as.real(loc$y)-y[length(y)])^2))
	while (diff > 0.001){
		i<-i+1
		x[i]<-as.real(loc$x)
		y[i]<-as.real(loc$y)
		loc<-grid.locator(unit="npc")
		diff<-sqrt(((as.real(loc$x)-x[length(x)])^2)+((as.real(loc$y)-y[length(y)])^2))
	}
	#snap all vertexes in x,y except the first and the last vertex
	if (((snap>0) && (snap<0.2)) && (length(x)>2)){
		for (i in 2:(length(x)-1)){
			over<-x[i]%%snap
			if (over<snap) {x[i]<-x[i]-over} else {x[i]<-x[i]+over}
			over<-y[i]%%snap
			if (over<snap) {y[i]<-y[i]-over} else {y[i]<-y[i]+over}
		}
	}

	grid.xspline(x=x, y=y,
		shape=shp,
		arrow=arr,
		gp=gpar(fill="black")
	)	
}

addText<-function(txt="1:N",font="", fsize=1, angle=0,x=-1,y=-1){
	if (x==-1 || y==-1){
		loc<-grid.locator()
		if (x==-1){x=loc$x}
		if (y==-1){y=loc$y}
	}
	prm<-gpar(cex=fsize)
	if(font=="bold" || font=="b"){prm$fontface<-"bold"}
	if(font=="italic" || font=="i"){prm$fontface<-"italic"}
	grid.text(txt,x,y, rot=angle, gp=gpar(cex=prm$cex, fontface=prm$fontface))
}


### example usage ###
#box1<-boxGrob(c("HEADDING", "line1", "line2"), x=0.1, y=0.1)
#box2<-boxGrob(c("HEADDING2", "row1", "row2", "row3"), x=0.5, y=0.2)
#grid.draw(box1)
#grid.draw(box2)
#connect(box1, box2, 1, 3)
#drawLine(snap=0.02, shp=1)
#addText("1 : N",font="b", angle=90, fsize=0.8)