Nothing
ExplodeSymbols<-function(XY, fsiz=1, STARTXY=NULL, MAP=NULL )
{
#### find a good way to explode symbols (focal mechanisms)
#### source("ExplodeSymbols.R")
if(missing(MAP)) { MAP = NULL }
if(missing(STARTXY))
{
STARTXY=NULL
}
if(is.null(STARTXY))
{
NEWXY = XY
STARTXY = XY
}
else
{
NEWXY =STARTXY
}
draw.circ<-function (x, y, r, ...)
{
CI = RPMG::circle(1)
for (i in 1:length(x)) {
Cx = x[i] + r * CI$x
Cy = y[i] + r * CI$y
lines(c(Cx, Cx[1]), c(Cy, Cy[1]), type = "l", ...)
}
}
EXPreplot<-function()
{
rx = range(c(NEWXY$x, XY$x))
ry = range(c(NEWXY$y, XY$y))
drx = diff(rx)
dry = diff(ry)
rx = c(rx[1]-XPCT*drx, rx[2]+XPCT*drx)
ry = c(ry[1]-XPCT*dry, ry[2]+XPCT*dry)
plot(rx , ry , type='n', asp=1, xlab="km", ylab="km")
if(!is.null(MAP) ) { plotGEOmap(MAP, LIM = c(rx[1],ry[1] , rx[2], ry[2]) , add = TRUE ) }
points(XY$x, XY$y, pch=3, col='blue')
points(NEWXY$x, NEWXY$y, pch=6, col='red')
segments(XY$x, XY$y, NEWXY$x, NEWXY$y)
u = par("usr")
focsiz = fsiz* (u[2]-u[1])
draw.circ(NEWXY$x, NEWXY$y, focsiz)
invisible(focsiz)
}
XPCT = 0
focsiz =EXPreplot()
labs = c("DONE", "QUIT", "SEL","CIRC", "RECT2","LINE","NOVER", "HAND", "RECT", "Xpand", "Zoom", "REFRESH", "RESTORE", "DOC" )
colabs = rep("blue", length = length(labs))
colabs[labs=="LINE"] = "green"
colabs[labs=="RECT2"] = "red"
colabs[labs=="CIRC"] = "red"
pchlabs = rep(0, length(labs))
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
NLABS = length(labs)
NOLAB = NLABS + 1000
SEL = NULL
iloc = locator(1, type = "p")
zloc = iloc
Nclick = length(iloc$x)
if (is.null(zloc$x)) {
return(NULL)
}
K = RPMG::whichbutt(zloc, buttons)
sloc = zloc
while (TRUE) {
##############################################################
if (K[Nclick] == match("DONE", labs, nomatch = NOLAB)) {
break
}
##############################################################
if (K[Nclick] == match("QUIT", labs, nomatch = NOLAB)) {
## message("Pressed Quit")
break
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("HAND", labs, nomatch = NOLAB)) {
message("Pressed Hand")
NP = length(zloc$x)-1
if(NP<2)
{
message("Must have at least 2 clicks on screen to move a symbol")
focsiz = EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc, collaps=' ') )
zloc = list(x = NULL, y = NULL)
next
}
kloc = list(x=zloc$x[1:NP], y=zloc$y[1:NP ])
message(paste(kloc, collaps=' ') )
for(k in seq(from=1, to = length(kloc$x), by=2) )
{
kpoint = which.min( (kloc$x[k]-NEWXY$x)^2 + (kloc$y[k]-NEWXY$y)^2)
NEWXY$x[kpoint] = kloc$x[k+1]
NEWXY$y[kpoint] = kloc$y[k+1]
}
message(NEWXY)
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc, collaps=' ') )
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("SEL", labs, nomatch = NOLAB)) {
#### select points in rect
NP = length(zloc$x)-1
if(NP<2)
{
warning("Must have at least 2 clicks on screen to select a set of symbols")
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc, collaps=' ') )
zloc = list(x = NULL, y = NULL)
next
}
else
{
### take last two clicks before clicking the RECT button
p1 = list(x=c(zloc$x[(NP-1):NP]), y=c(zloc$y[(NP-1):NP]))
SELX = which(NEWXY$x>min(p1$x) & NEWXY$x<max(p1$x) & NEWXY$y>min(p1$y) & NEWXY$y<max(p1$y))
SEL = SELX
rect(min(p1$x), min(p1$y), max(p1$x), max(p1$y), border="red", lty=2)
message("Selection is done, choose a button to apply to selection.")
## zloc = list(x = NULL, y = NULL)
}
}
##############################################################
if (K[Nclick] == match("NOVER", labs, nomatch = NOLAB)) {
NP = length(zloc$x)-1
if(NP<2)
{
warning("Must have at least 2 clicks on screen to select a set of symbols")
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc, collaps=' ') )
zloc = list(x = NULL, y = NULL)
next
}
else
{
bx = NEWXY$x
by = NEWXY$y
#######NXY = NoOverlap(x,y,focsiz, cenx=PL$x, ceny=PL$y)
NXY = NoOverlap(bx,by,focsiz, SEL=SEL, OLDx=XY$x, OLDy=XY$y)
NEWXY$x[SEL] =NXY$x[SEL]
NEWXY$y[SEL] =NXY$y[SEL]
}
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc, collaps=' ') )
zloc = list(x = NULL, y = NULL)
}
if (K[Nclick] == match("LINE", labs, nomatch = NOLAB)) {
message("Pressed Line")
NP = length(zloc$x)-1
if(NP<2)
{
warning("Must have at least 2 clicks on screen to select a set of symbols")
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc, collaps=' ') )
zloc = list(x = NULL, y = NULL)
next
}
else
{
bx = NEWXY$x[SEL]
by = NEWXY$y[SEL]
## bx = runif(10, -10, 10)
## by = runif(10, -10, 10)
## plot(c(-18, 18) , c(-18, 18), type='n', asp=1)
## points(bx, by)
## zloc = locator(4, type='p', col='red', pch=3)
## NP = length(zloc$x)-1
p1 = list(x=c(zloc$x[(NP-2):NP]), y=c(zloc$y[(NP-2):NP]))
## segments(p1$x[1], p1$y[1], p1$x[2], p1$y[2], col='red', lty=2, lwd=2)
mfxy = list(x=p1$x[1],y=p1$y[1])
## vector from P1 to P2
V1 = list(x=p1$x[2]-p1$x[1], y=p1$y[2]-p1$y[1])
V3 = list(x=p1$x[3]-p1$x[1], y=p1$y[3]-p1$y[1])
absV1= sqrt(V1$x^2+V1$y^2)
absV3= sqrt(V3$x^2+V3$y^2)
a3 = sqrt(V3$x^2 + V3$y^2)
c3 = (V1$x*V3$x + V1$y*V3$y)/absV1
V1vec = list(x=V1$x/absV1, y=V1$y/absV1)
V3vec = list(x=V3$x/absV3, y=V3$y/absV3)
## arrows(p1$x[1],p1$y[1], p1$x[1]+absV1*V1vec$x,p1$y[1]+absV1*V1vec$y)
## arrows(p1$x[1],p1$y[1], p1$x[1]+absV3*V3vec$x,p1$y[1]+absV3*V3vec$y)
## arrows(p1$x[1],p1$y[1], p1$x[1]+c3*V1vec$x,p1$y[1]+c3*V1vec$y, col='blue' )
width1 = sqrt( (p1$x[3]- (p1$x[1]+c3*V1vec$x))^2 + (p1$y[3]- (p1$y[1]+c3*V1vec$y))^2)
perpvec = list(x=-V1vec$y, y=V1vec$x)
## arrows(p1$x[1]+c3*V1vec$x,p1$y[1]+c3*V1vec$y ,
## p1$x[1]+c3*V1vec$x+width1*perpvec$x, p1$y[1]+c3*V1vec$y+width1*perpvec$y , col='purple' )
## cornsX = c(p1$x[1]+width1*perpvec$x, p1$x[2]+width1*perpvec$x, p1$x[2]-width1*perpvec$x,p1$x[1]-width1*perpvec$x,p1$x[1]+width1*perpvec$x )
## cornsY = c(p1$y[1]+width1*perpvec$y, p1$y[2]+width1*perpvec$y, p1$y[2]-width1*perpvec$y,p1$y[1]-width1*perpvec$y,p1$y[1]+width1*perpvec$y )
## lines(cornsX, cornsY)
#############
B1 = list(x=bx-p1$x[1], y=by-p1$y[1])
B3 = (V1$x*B1$x + V1$y*B1$y)/absV1
## points(p1$x[1]+B3*V1vec$x,p1$y[1]+B3*V1vec$y)
## plot(c(-18, 18) , c(-18, 18), type='n', asp=1)
## points(bx, by)
## segments(p1$x[1], p1$y[1], p1$x[2], p1$y[2], col='red', lty=2, lwd=2)
## arrows(p1$x[1]+B3*V1vec$x, p1$y[1]+B3*V1vec$y , bx,by, col="brown")
widthB = sqrt( (bx- (p1$x[1]+B3*V1vec$x))^2 + (by- (p1$y[1]+B3*V1vec$y))^2)
g1vec = list(x=(bx-(p1$x[1]+B3*V1vec$x))/widthB , y=(by-(p1$y[1]+B3*V1vec$y))/widthB)
## arrows(p1$x[1]+B3*V1vec$x, p1$y[1]+B3*V1vec$y , p1$x[1]+B3*V1vec$x+ widthB*g1vec$x , p1$y[1]+B3*V1vec$y + widthB*g1vec$y , col=grey(.8) )
## arrows(bx, by, bx+ (width1-widthB)*g1vec$x , by+ (width1-widthB)*g1vec$y)
## NEWXY$x[SEL]=bx+ (width1-widthB)*g1vec$x
## NEWXY$y[SEL]=by+ (width1-widthB)*g1vec$y)
NEWXY$x[SEL]=bx+ (width1)*g1vec$x
NEWXY$y[SEL]=by+ (width1)*g1vec$y
}
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc , collapse=' ') )
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("Xpand", labs, nomatch = NOLAB)) {
XPCT = XPCT + 0.1
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("Zoom", labs, nomatch = NOLAB)) {
XPCT = XPCT - 0.1
if(XPCT<0) { XPCT = 0 }
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("REFRESH", labs, nomatch = NOLAB)) {
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("RESTORE", labs, nomatch = NOLAB)) {
NEWXY = STARTXY
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("CIRC", labs, nomatch = NOLAB)) {
#### select points in rect
NP = length(zloc$x)-1
if(NP<2)
{
warning("Must have at least 2 clicks on screen to select center and radius of circle")
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc , collapse=' ') )
zloc = list(x = NULL, y = NULL)
next
}
else
{
p1 = list(x=c(zloc$x[(NP-1):NP]), y=c(zloc$y[(NP-1):NP]))
RAD = sqrt( (p1$x[1]-p1$x[2])^2 +(p1$y[1]-p1$y[2])^2)
bx = NEWXY$x[SEL]
by = NEWXY$y[SEL]
mfxy = list(x=p1$x[1],y=p1$y[1])
dis1 = sqrt( (bx-mfxy$x)^2 + (by-mfxy$y)^2)
dixplo = RAD
DX = (bx-mfxy$x)/dis1
DY = (by-mfxy$y)/dis1
PX = p1$x[1]+ dixplo* DX
PY = p1$y[1]+ dixplo* DY
NEWXY$x[SEL] = PX
NEWXY$y[SEL] = PY
}
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("RECT2", labs, nomatch = NOLAB)) {
#### select points in rect
NP = length(zloc$x)-1
if(NP<2)
{
warning("Must have at least 2 clicks on screen to select center and size of box")
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
#
message(paste(zloc , collapse=' ') )
zloc = list(x = NULL, y = NULL)
next
}
else
{
########## zloc = locator(2); NP = 2
p1 = list(x=c(zloc$x[(NP-1):NP]), y=c(zloc$y[(NP-1):NP]))
### rect(p1$x[1], p1$y[1], p1$x[2], p1$y[2])
diagon = sqrt( (p1$x[1]-p1$x[2])^2 +(p1$y[1]-p1$y[2])^2)
theta = atan2((p1$y[1]-p1$y[2]), (p1$x[1]-p1$x[2]))
digx = diagon*cos(theta)
digy = diagon*sin(theta)
#### plot(epos$x, epos$y)
#### points(NEWXY$x[SEL] , NEWXY$y[SEL] , col='red')
#### bx = NEWXY$x[SEL]
#### by = NEWXY$y[SEL]
rect(p1$x[1]-digx, p1$y[1]-digy, p1$x[1]+digx, p1$y[1]+digy)
bx = NEWXY$x[SEL]
by = NEWXY$y[SEL]
rekt = list(x=c(p1$x[1]-digx, p1$x[1]+digx, p1$x[1]+digx, p1$x[1]-digx),
y=c(p1$y[1]-digy, p1$y[1]-digy, p1$y[1]+digy,p1$y[1]+digy ))
pp = list(x1=rep(p1$x[1], length(bx)) , y1=rep(p1$y[1], length(bx)) , x2=bx , y2=by )
edges = rekt2line(rekt, pp )
#### points(edges, pch=6, col='brown')
#### segments(bx, by, edges$x, edges$y)
NEWXY$x[SEL] = edges$x
NEWXY$y[SEL] = edges$y
}
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
### source("ExplodeSymbols.R")
### NEWLOCS = ExplodeSymbols(SMXY, 0.03)
##############################################################
if (K[Nclick] == match("DOC", labs, nomatch = NOLAB)) {
exdoc = c(
"############################",
"############################",
"This is an interactive program. You must click on the screen",
"and on the buttons to get this working -",
" the program will not work in batch mode or run as a script",
"You click in the active screen area and then press a button",
"on top (or bottom) - the button takes your clicks and does something",
"Here are some hints:","\n",
"HAND:",
"If you want to move only one symbol (focal mech) click near it and then click",
"where you want it to go. Then click the HAND button",
"You may click several at once...but for each click oin a symbol",
"there has to be a click somewhere to relocate it.",
"(i.e. there must be an even number of clicks on the screen before hitting the",
" HAND button)","\n",
"SEL:",
"If you want to explode several symbols at once, first select them:",
" click lower left, then upper right of rectangle enclosing the selection.",
"Once a selection is made it remains active until another selection is made",
"so you can keep changing the radius and center for different explosions",
"Then click CIRC.","\n",
"RECT:",
"Choose a rectangle (lower left and upper right), then click RECT for an explosion",
"\n",
"RECT2:","After selecting, choose a center and a distance.",
"symbols will be moved to a rectangular perimeter defined by the two points",
"\n",
"CIRC:",
"After selection, click once for the circle center, and a second time for the radius, then click CIRC",
"\n",
"LINE:\n","After selection, three clicks: 1,2 for line, 3 for distance from line",
"############################",
"############################",
"\n",
"\n","\n"
)
for(kdoc in 1:length(exdoc)){ message(exdoc[kdoc], sep="\n") }
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
if (K[Nclick] == match("RECT", labs, nomatch = NOLAB)) {
#### select points in rect
NP = length(zloc$x)-1
if(NP<2)
{
warning("Must have at least 2 clicks on screen to move a symbol")
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
message(paste(zloc , collapse=' ') )
zloc = list(x = NULL, y = NULL)
next
}
else
{
### take last two clicks before clicking the RECT button
p1 = list(x=c(zloc$x[(NP-1):NP]), y=c(zloc$y[(NP-1):NP]))
SELX = which(NEWXY$x>min(p1$x) & NEWXY$x<max(p1$x) & NEWXY$y>min(p1$y) & NEWXY$y<max(p1$y))
bx = NEWXY$x[SELX]
by = NEWXY$y[SELX]
mfxy = list(x=mean(bx),y=mean(by ))
dis1 = sqrt( (bx-mfxy$x)^2 + (by-mfxy$y)^2)
mult = sqrt( (p1$x[1]-p1$x[2])^2 +(p1$y[1]-p1$y[2])^2)
dixplo = mult
DX = (bx-mfxy$x)/dis1
DY = (by-mfxy$y)/dis1
PX = bx+ dixplo* DX
PY = by+ dixplo* DY
NEWXY$x[SELX] = PX
NEWXY$y[SELX] = PY
}
focsiz =EXPreplot()
buttons = RPMG::rowBUTTONS(labs, col = colabs, pch = pchlabs)
zloc = list(x = NULL, y = NULL)
}
##############################################################
iloc = locator(1, type = "p")
zloc = list(x = c(zloc$x, iloc$x), y = c(zloc$y, iloc$y))
Nclick = length(iloc$x)
if (is.null(zloc$x)) {
return(sloc)
}
K = RPMG::whichbutt(iloc, buttons)
}
return(NEWXY)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.