#GoogleEarth with R Lib ver0.3.2 copyright by okinawa#####################

#ӁIKSJISŕۑ邱ƁB

##########################
#}쐬֐ GERLegend()#
##########################

GERLegend<-function(colFileName,FieldName,LegFileName){
jpeg(LegFileName,width=160,height=350,bg="black",pointsize=10)
#}e[u[h
options(digits=10)
ColorTable<<-read.csv(colFileName)
cols1<-ColorTable$LEGCOL
cols2<-paste("#",as.character(cols1),sep="")
cls1text<-paste("cls1<-sprintf('%5.1f',ColorTable$CLS1_",FieldName,")",sep="")
eval(parse(text=cls1text))
cls2text<-paste("cls2<-sprintf('%5.1f',ColorTable$CLS2_",FieldName,")",sep="")
eval(parse(text=cls2text))
cls3text<-paste("cls3<-ColorTable$CLS3_",FieldName,sep="")
eval(parse(text=cls3text))
clsname<<-paste(cls1,"-",cls2,cls3,sep="")#J[e[ůK
#colsno<<-length(cols2)#J[e[ůK
#}`
par(mai=c(0,0,0,0))
plot(1:5,0:4,ann=F,type='n')
legend(1,4,clsname,fill=cols2,title=FieldLabelsjis,bg="black",text.col="white",cex=1.3,)
text(3,0,labels=LegendCmt,col="white")
#}jpego
dev.off()

CT<-paste("cols<-ColorTable$PGCLR_",FieldName,sep="")
eval(parse(text=CT))

cols<<-rev(cols)#Invert ColorVector
ifelse(FieldName=="KENKYO",colsno<<-1,colsno<<-length(cols))
#cols<<-cols[!is.na(cols)]
#colsno<<-length(cols)#J[e[ůKĐݒ
}

################################
#kml^Op֐Q
################################
#kml function
GERKml<-function(value){
xml.version<-"<?xml version='1.0' encoding='UTF-8'?>"
kml.xmlns<-"<kml xmlns='http://earth.google.com/kml/2.0'>"
x<-c(xml.version,kml.xmlns,value,"</kml>")
return(x)
}
#Document function
GERDocument<-function(value,name){
x<-c("<Document>","<name>",name,"</name>",value,"</Document>")
return(x)
}
#Folder function
GERFolder<-function(value,name){
x<-c("<Folder>","<name>",name,"</name>",value,"</Folder>")
return(x)
}
#ScreenOverlay function
GERScreenOverlay<-function(name,legfilename){
x<-c("<ScreenOverlay>","<name>",name,"</name>","<Icon>","<href>",legfilename,"</href>","</Icon>","<overlayXY x='0' y='1' xunits='fraction' yunits='fraction'/>","<screenXY x='0' y='1' xunits='fraction' yunits='fraction'/>","<size x='0' y='0' xunits='fraction' yunits='fraction'/>","</ScreenOverlay>")
return(x)
}
#Style function
GERStyle<-function(linecolor,width,polygoncolor,outline,fill){
x<-c("<Style>","<LineStyle>","<color>",linecolor,"</color>","<width>",width,"</width>","</LineStyle>","<PolyStyle>","<color>",polygoncolor,"</color>","<outline>",outline,"</outline>","<fill>",fill,"</fill>","</PolyStyle>","</Style>")
return(x)
}
#Placemark function
GERPlacemark<-function(value,name,visibility){
x<-c("<Placemark>","<name>",name,"</name>","<visibility>",visibility,"</visibility>",value,"</Placemark>")
return(x)
}
#Polygon function
GERPolygon<-function(value,mode,visibility,extrude){
x<-c("<visibility>",visibility,"</visibility>","<Polygon>","<extrude>",extrude,"</extrude>",mode,"<outerBoundaryIs>","<LinearRing>",value,"</LinearRing>","</outerBoundaryIs>","</Polygon>")
return(x)
}
#coordinates function
GERCoordinates<-function(value){
x<-c("<coordinates>",value,"</coordinates>")
return(x)
}
#LookAt function
GERLookat<-function(heading,latitude,longitude,tilt,range){
x<-c("<LookAt>","<heading>",heading,"</heading>","<latitude>",latitude,"</latitude>","<longitude>",longitude,"</longitude>","<tilt>",tilt,"</tilt>","<range>",range,"</range>","</LookAt>")
return(x)
}
#AltitudeMode function
GERAltitudeMode<-function(value){
x<-c("<altitudeMode>",value,"</altitudeMode>")
return(x)
}
#tessellate function
GERTessellate<-function(value){
x<-c("<tessellate>",value,"</tessellate>")
return(x)
}

##########################
#Shp2Kml֐ GERshp2kml()#
##########################
GERshp2kml<-function(dfobject,dfparam,dflegend,path){
#input filename & fieldname& document label
FileName<-dfobject["FileName"]		#set filename
FieldName<<-dfobject["FieldName"]	#use fieldname
FieldLabel<-dfobject["FieldLabel"]	#Document name
LegendCmt<<-dflegend["Legendcmt"]
FieldLabelutf8<-iconv(FieldLabel,"shift-jis","utf-8")
FieldLabelsjis<<-iconv(FieldLabelutf8,"utf-8","shift-jis")
HostIp<-dfobject["HostIp"]
UniqueCode<-dfobject["uniquecode"]
UniqueFileName<-paste(UniqueCode,"result",sep="")
ScreenOverlayMode<-dflegend["ScreenOverlayMode"]
#print(ScreenOverlayMode)
#######################
#filename
dFileName<-paste(FileName,"DATA",sep="")#set datafile name
cFileName<-"Legend16" 			#legend table file name
lFileName<-paste(uniquecode,"legend",sep="")	#legend imagefile name
#######################
#path
path0<-path
Ipath<-paste(path0,"/geroot/shapefiles/",sep="")
Opath<-paste(path0,"/geroot/kml/",sep="")
Dpath<-paste(path0,"/geroot/data/",sep="")
Cpath<-paste(path0,"/geroot/etc/legend/",sep="")
Lpath<-paste(path0,"/geroot/etc/legend/",sep="")
Wpath<-paste(path0,"/geroot/etc/logs/",sep="")
L2path<-paste("c:/geroot/etc/legend/",sep="")

inpFileName<-paste(Ipath,FileName,"/",FileName,".shp",sep="")
outFileName<-paste(Opath,UniqueFileName,".kml",sep="")
datFileName<-paste(Dpath,dFileName,".csv",sep="")
colFileName<-paste(Cpath,cFileName,".csv",sep="")
LegFileName<-paste(Lpath,lFileName,".jpg",sep="")
LegFileName2<-paste(L2path,lFileName,".jpg",sep="")

######################
#default param
PolygonColor<-dfparam["PolygonColor"]		#polygon color( aabbggrr )
LineColor<-dfparam["LineColor"]			#polyline color
fill<-dfparam["fill"]				#polygon fill param
outline<-dfparam["outline"]			#polygon outline param
Latitude<-dfparam["Latitude"]			#LookAt param
Longitude<-dfparam["Longitude"]			#LookAt param
Range<-dfparam["Range"]				#LookAt param
Altitude<-dfparam["Altitude"]			#coordinates param
Ground<-dfparam["AltitudeMode"]			#AltitudeMode param
AltitudeMode<-GERAltitudeMode(value=Ground)
tessellate<-GERTessellate(value=1)		#???
Legend<-"Legend"				#Legend Folder name
######################
#}쐬֐#########
GERLegend(colFileName,FieldName,LegFileName)
######################
#ScreenOverlay
ScreenOverlay<-GERScreenOverlay(name=Legend,legfilename=LegFileName2)
ScreenOverlay<-GERFolder(value=ScreenOverlay,name=Legend)
######################
#LookAt
#Lookat<-GERLookat(heading=0,latitude=Latitude,longitude=Longitude,tilt=0,range=Range)
######################
#style
Style<-GERStyle(linecolor=LineColor,width=100,polygoncolor=PolygonColor,outline=outline,fill=fill)

######################
#shapefile operation##
######################
#load shapefile
Mapobject<-read.shape(inpFileName) 
xy<-get.Pcent(Mapobject)
x<-xy[,1]
y<-xy[,2]
Mapdata<-Mapobject$att.data
Mapdata1<-Mapdata
Mapdata2<-Mapdata

#load datafile
dat <- read.csv(datFileName)

#matched shapefile&datafile
datn1<-length(dat$JCODE)
datn2<-datn1+1
m<- match(Mapobject$att.data$JCODE,dat$JCODE,nomatch=datn2)
dat[datn2,]<-0
EvalParse0<-paste(FieldName,"<-","dat$",FieldName,"[m]",sep="")
eval(parse(text=EvalParse0))
EvalParse1<-paste("Mapdata<-cbind(Mapdata,",FieldName,")",sep="")
eval(parse(text=EvalParse1))
Mapdata2 <- merge(dat,Mapdata2,sort=F,by="JCODE",all=T)#data check
writefilename<-paste(Wpath,"outdata.csv",sep="")#data check
write.csv(Mapdata2,file=writefilename)#data check

#use fieldname
FieldName2<-paste("Mapdata$",FieldName,sep="")
EvalParse2<-paste("DD<-",FieldName2,sep="")
eval(parse(text=EvalParse2))

######################
#make color table
nn<-length(Mapdata$JCODE)

high.low2<-NULL
high.low3<-NULL
polylinecolor2<-NULL
polylinecolor3<-NULL

for(jj in 1:nn){
high.low<-NULL
polylinecolor<-NULL

for(ii in 1:colsno){

CLASS1<-paste("CLS1_",FieldName,sep="")
CLASS2<-paste("CLS2_",FieldName,sep="")
PGCLR<-paste("PGCLR_",FieldName,sep="")
PLCLR<-paste("PLCLR_",FieldName,sep="")

text1=paste("high.low<- paste(high.low,(ifelse(DD[jj]>=ColorTable$",CLASS1,"[ii] & DD[jj]<ColorTable$",CLASS2,"[ii],as.character(ColorTable$",PGCLR,"[ii]),'')),sep='')",sep="")
eval(parse(text=text1))

text2=paste("polylinecolor<- paste(polylinecolor,(ifelse(DD[jj]>=ColorTable$",CLASS1,"[ii] & DD[jj]<ColorTable$",CLASS2,"[ii],as.character(ColorTable$",PLCLR,"[ii]),'')),sep='')",sep="")
eval(parse(text=text2))
}

high.low2<-high.low
high.low3<-c(high.low3,high.low2)
polylinecolor2<-polylinecolor
polylinecolor3<-c(polylinecolor3,polylinecolor2)
}

#######################
#bind colortable
Mapdata<-cbind(Mapdata,high.low3)
Mapdata<-cbind(Mapdata,polylinecolor3)

#######################
#make porygons#
#get city number
n<-length(Mapobject$Shapes)

xxx<-NULL

for (j in 1:n){
x10<-NULL
#get polygon point in Mapobject
n2<-length(Mapobject$Shapes[[j]]$verts[,1])

#make list multipul polygon in a city
n3<-Mapobject$Shapes[[j]]$Pstart
n31<-c(n3,n2) 

#get multiple polygon number
n4<-length(Mapobject$Shapes[[j]]$Pstart)

#get city code
jcode<-as.character(Mapdata$JCODE[j])

#get city name shift-jis=>utf-8 transration
FileName2<-iconv(as.character(Mapdata$TOWN2[j]),"shift-jis","utf-8")
FileName21<-iconv(as.character(Mapdata$TOWN1[j]),"shift-jis","utf-8")

#make citycode&cityname
FileName3<-paste(jcode,FileName21,FileName2,sep="")

#make colorname
colorname<-as.character(Mapdata$high.low3[j])

#make style
Style<-GERStyle(linecolor=as.character(Mapdata$polylinecolor3[j]),width=1,polygoncolor=colorname,outline=outline,fill=fill)

#make height (prizm map)
#text4<-paste("Altitude<-((Mapdata$",FieldName,"[j]*1000*5)-69000*5)")
#eval(parse(text=text4))

#make multipul polygon in a city
xx=NULL
for(i in 1:n4)
	{
	x9<-NULL
	x<-Mapobject$Shapes[[j]]$verts[(n31[i]+1):n31[i+1],1:2]
	x[,1]<-rev(x[,1]) #clockwise
	x[,2]<-rev(x[,2]) #
	x2<-cbind(x,paste(as.character(x[,1]),",",as.character(x[,2]),",",Altitude,sep=""))
	x3<-x2[,3]
	x5<-GERCoordinates(value=x3)
	x7<-GERPolygon(value=x5,mode=NULL,visibility=1,extrude=1)
	x8<-c(Style,x7)
	x9<-GERPlacemark(value=x8,name=FileName3,visibility=1)
	x9<-c(xx,x9)
	xx<-x9
	}
	x10<-c(xxx,x9)
	xxx<-x10
}

#merge kmlheader&Footer
x11<-GERFolder(value=x10,name="Polygon")
x11<-c(x11,ScreenOverlay)
x11<-GERFolder(value=x11,name=paste(FileName," Prefecture",sep=""))
x12<-GERDocument(value=x11,name=FieldLabelutf8)
x12<-GERKml(value=x12)
#export file
write.table(x12,outFileName,quote=F,append=F,col.name=F,row.name=F)
print(outFileName)
}
#GERshp2kml#END##########

