#  Copyright (C)  2014  Setsuo Takato, KETCindy Japan project team
#
#This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>


#########################################

ThisVersion<- "KeTpic for R  v5_2_4(18.02.26)" 

print(ThisVersion)

# 2018.02.26
#  Sfcutparadata changed
#  Partcrv3 debugged
#  Projcurve rewritten
#  Nohiddenparadata debugged 
#  PthiddenQ debugged
# 2018.02.24
#  Sfcutdata added ( for functions )
#  Meetpoints debugged  (case Norm(PtB-PtA)<Eps0)
# 2018.02.23
#  Makevaltable2 added ( for functions )
# 2018.02.23
#  Crvonsfparadata,Crv3onsfparadata added
#  Wireparadata added
# 2018.02.22
#  PthiddenQ,Nohiddenpara2 changed (Eps2)
# 2018.02.21
#  PthiddenQ,Meetpoints debugged
#  Crvsfparadata debugged (OTHERPARTITION)
#  Partitionseg debugged (for non-list) and changed (Ns=0)
#  Intersectcrvsf added
# 2018.02.19
#  Groupnearpt added
#  Collectnear debugged
#  Meetpoints,PthiddenQ debugged and changed (Groupnearpt used )
#  Parapt changed (for point list )
#  Partitionseg changed (remove close value )
#  Fullformfunc changed (Initialization of ADDPOINT)
#  Addpoints added
# 2018.02.18
#   Projpara debugged ( for empty data, Mix replace )
#   WriteOutData debugged (for emply data )
#   Sfbdparadata,Cuspparadata debugged 
#   Meetpoints replaced
# 2018.02.17
#   PthiddenQ replaced
# 2018.02.15
#   Cancoordpara debugged  (X=-... )
# 2018.02.14
#   Paramoncrv,Pointoncrv renamed to ...curve
# 2018.02.12
#   Nohiddenpara2 debugged  ( CUSPPT should be a list )
#   Dropnumlistcrv changed  (Eps)
# 2018.02.11
#   Paramocrv debugged ( case N=Length(PtL) )
#   Sfbdparadata, Borderparadata, Makexybdy, Partitionseg, 
#     Evlptablepara, Fullformfunc, Dropnumlistcrv, Cuspsplitpara,
#     PthiddenQ, Nohiddenpara2 added
#   Crvsfparadata, Meetpoints, Clipdomain added
# 2018.02.10
#   Partcrv3 debugged
# 2018.02.09
#   Ptstart,Ptend changed ( for the case fig is empty)
#   Norm changed  (Dotprod used )
# 2018.02.07
#   Collectnear debugged (Looprange )
#    Intersectcurves debugged (sum)
# 2018.02.06
#   Kukeiiwake debugged ( ParamonCurve -> Paramoncrv )
# 2018.02.05
#   Dotprod changed ( crossprod not used )
#   Intersectpartseg changed ( case of length of result =1)
# 2018.02.04
#   Diff added  ( func, withvar, (varnamevalue1,... ))
#   Funvalue added ( for an expression )
# 2018.02.02
#   Enclosing2 changed ( for distant curves, startpt option removed )
# 2018.02.01
#   Intersectline,Intersectseg,...,Intersectcuves added
#   Quicksort added
#   Enclosing2 added (incomplete)
# 2018.01.29
#   Length added
# 2017.12.24
#   Objpolyhedron added
# 2017.12.23
#   Objsymb, symb3data added
#   Objrecs, Objpolygon debugged
#   Objthicksurf added
# 2017.12.22
#   Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added
#   Crossprod added
#   Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added
#   Spacecurve  debugged
# 2017.12.17
#   Setunitlen debugged  ( MEMORI )
# 2017.12.13
#   ReadOutData debugged
# 2017.12.11
#   Enclosing debugged  ( appendrow -> Appendrow )
# 2017.11.29
#   Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included )
# 2017.11.27
#   Anglemark changed ( Scilab 16.12.29)
#   Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13)
#   Enclosing changed ( Scilab 16.10.09)
#   Arrowhead,Arrowline changed ( Scilab 15.06.11)
#   Definecolor added ( Scilab 15.05.04)
# 2017.11.26
#   Exprrot, Letterrot debugged  ( `)
# 2017.11.24
#  Deqplot debugged (Looprange)
# 2017.11.20
#  InWindow debugged (for length=1)
# 2017.10.28
#  Openfile changed (Creator)
# 2017.10.23
#  ReadOutData greatly changed
# 2017.10.11
#  Drwpt debugged  (Flattenlist )
# 2017.10.08
#  Bezier debugged  ( Num )
# 2017.10.07
#  ReadOutData debugged  ( for null data )
# 2017.10.06
#  Deqdata, Deqplot added
#  Connectseg  remade(bug)
# 2017.09.30
#  Bezierpt, Bezier added
# 2017.09.29
#  Ptcrv debugged
# 2017.09.28
#  Openfile changed
# 2017.09.24
#  Circledata debugged
#  Kyoukai changed (Eps)
#  Shade updated
# 2017.09.22
#  Setcolor changed
#  Plotdata,Paramplot,Spacecurve changed (N-1 -> N)
# 2017.09.21
#  Shade changed (Sci 17.01.09)
# 2017.09.17
#  Ovaldata,Assignadd changed
#  Dist added
#  Cicledata changed
#  Bowdata debugged  (Circledata,etc)

# 2015.11.05
#  WriteOutData changed

# 2015.10.29
#  WriteOutData changed  ( endmark //// )

# 2015.10.24
#  ReadOutData changed  ( in case of listlength=1 )

# 2014.12.23
#  ReadOutData added

# 2014.12.17
#  WriteOutData added

# 2014.0905
# Unscaling debugged  MARKLENI => MARKLEN
# 2014.03.31
# PhHiddenData added
# 2014.03.30
# Facesdata changed ( for Hiddendata )
# 2014.03.23
# MARKLEN separated, Rotate3data debugged

# 2013.12.19
# Openfile, Closefile, Bowname, Bownamerot

# 2013.11.13
#  Arrowhead, Arrowheaddata

# 2013.08.07
# Cancoordpara added

# 2013.08.07
# Integrate added

# 2013.05.20
# Openfile changed

# 2013.05.03
# Tabledata, Pointdata changed
# Dividetable, Partframe added

# 2013.02.10
# Ketinit added

# 2012.01.07
# Arrowline, Arrowhead  ( Cut implemented )

# 2011.12.18
# Framedata  ( compliant for list )

# 2011.12.12
# Skeletonparadata...   ( Flattellist used)

# 2011.11.27
# drwboxframe

# 2011.11.07
# metacommands added

# 2011.11.02
# Joingraphics ( for list structure )

# 2011.08.24
# Setcolor   ( c(1,0,0,0.5) etc )
# Rotate3data  ( Point is available )

# 2011.07.19
# Drwline, Letter, Expr
# Drwboxplot( etc ) min,max  => outliners
# Drwline  ( unfinished  in the case of "integer" )

# 2011.06.25
# joincrvs debugged

#  synchro  with ketpict2e

# 2011.06.01
#  Bowdata debugged

#2011.05.28
#  Ratiocmyk, Setcolor ( new )

#2011.04.28
# Htickmark, Vtickmark debugged 

#2011.03.08
# Drwboxframe debugged 
# Putrow, Putrowexpr debugged  (Dpos )

#2011.03.02
# Tabledata  ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged
# Texcom changed  ( // => backslash )

#2011.01.07
# Dividegraphics, Splinedat are changed significantly
# Readtextdata is  changed 

#2011.01.04
# Derivative, Integrate are added

#2010.12.07
# Translatedata, Scaledata, Reflectdata changed  ( efficient for vector )
# Rotatedata changed  ( deg : logical )
# HIstplotdata, Drwhistplot   ( type => freq , fpplot (added) )

# 2010.12.04
# WindispT  changed  ( tickmark )
# Lineplot  changed  ( mag=> length )
# Plotdata debugged ( 'E=fun', 'D=')
# Enclosing changed  (return PD)

# 2010.12.02
# WindispT  changed
# Makecurves debugged  

# 2010.11.27
# Pointdata changed ( efficient for matrix and data.frame )
# WindispT
# Setwindow  ( decide from data )
# Assign debugged    ( strsplit => gsub(fixed=T))

# 2010.11.20
# Flattenlist, WindispT
# Splinedata  changed( efficient for data.frame )

#2010.08.19  ( Maybe not finished )
# Stripblanks
# Fullformfunc, Sf3data

#2010.08.17
# Phparadata, Phpersdata, Phspersdata, Phsparadata
# Facesdata, MakeveLfaceL, Menkakusi2
# Rotate3data
# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata
# Embed

#2010.08.16
# Spacecurve  changed
# CameracoordCurve, Partcrv3, Projpers, CameraCurve,
# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt

# 2010.08.15
# Phcutoffdata added

# 2010.08.13
# Phcutdata, Spacecurve debugged
# Setangle changed

# 2010.08.09
# Spacecurve
# Rotate3data, Rotate3pt
# Phcutdata

# 2010.08.08
#        Implementing 3d
# Initangle, Setangle, Setpers, SetstereoL, SetstereoR
# Mixlength
# Spaceline, Projpara, ProjCurve, Parapt
# Xyzax3data, Xyzaxparaname
# Cancoordpers, Invparapt, ProjcoordCurve
# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki

# 2010.07.25
# Rotatedata changed
# Drwline changed (list of list)

# 2010.04.09
# Stat package added

# 2010.04.02
# Putcolexpr, Putrowexpr

# 2010.04.02

# Windisp, Op  changed
# Execmd  added
# Texnewcmd, Texrenewcmd, Texend,
# Texctr, Texnewctr, Texsetctr
# Kyoukai debugged

# 2010.01.20
# Partcrv, Makeshasen  : debugged

# 2010.01.23
# Ovaldata, Ovalbox added

# 2010.01.27
# Readtextdata changed
# Putrow, PutcoL debugged  ( Putcol is OK)

# 2010.01.31
# Writetextdata added

# 2010.02.12
# Texvalctr, Texthectr added

# 2010.02.22
# Execmd changed

# 2010.02.23
# Op, Windisp changed

# 2010.02.24
# Execmd changed

# 2010.03.07
# Dotfilldata  (Kosa>1)

# 2010.03.21
# Mixjoin 
# Koutenlist  (bug)


# 2010.03.24
# Arrowhead  ( bug in the case of "l" )

# 2010.03.28
# Tabledata
# Diagcelldata ( New )

# 2010.03.30
# Tabledata

###########################################

XMIN<- -5
XMAX<- 5
YMIN<- -5 ; YMAX<- 5
ZIKU<- "line"
ARROWSIZE<- 1
XNAME<- "$x$"
XPOS<- "e"
YNAME<- "$y$"
YPOS<- "n"
ONAME<- "O"
OPOS<- "sw"
ULEN<- "1cm"
MilliIn<- 1/2.54*1000
PenThick<- round(MilliIn*0.02)
PenThickInit<- PenThick
TenSizeInit<<- 0.02*2 #17.10.07
TenSize<- TenSizeInit
Wfile<-""
MEMORI<- 0.05
MEMORIInit<- MEMORI
MEMORINow<- MEMORI
MARKLEN<- 0.05
MARKLENInit<- MARKLEN
MARKLENNow<- MARKLEN
GENTEN<- c(0,0)
YaSize<- 1
YaAngle<- 18
YaPosition<- 1
YaThick<- 1
YaStyle<- "tf"
PHI<- 30*pi/180
THETA<- 60*pi/180
FocusPoint<- c(0,0,0)
EyePoint<- c(5,5,5)
ASSIGNLIST<- list("`","'")

SCALEX<- 1
SCALEY<- 1
LOGX<- 0
LOGY<- 0

TEXFORLEVEL<- 0
TEXFORLAST<- list()

#######################

Ketinit<- function(){
XMIN<<- -5
XMAX<<- 5
YMIN<<- -5 ; YMAX<<- 5
ZIKU<<- "line"
ARROWSIZE<<- 1
XNAME<<- "$x$"
XPOS<<- "e"
YNAME<<- "$y$"
YPOS<<- "n"
ONAME<<- "O"
OPOS<<- "sw"
ULEN<<- "1cm"
MilliIn<<- 1/2.54*1000
PenThick<<- round(MilliIn*0.02)
PenThickInit<<- PenThick
TenSizeInit<<- 0.02*2 #17.10.07
TenSize<<- TenSizeInit
Wfile<<-""
MEMORI<<- 0.05
MEMORIInit<<- MEMORI
MEMORINow<<- MEMORI
MARKLEN<<- 0.05
MARKLENInit<<- MARKLEN
MARKLENNow<<- MARKLEN
GENTEN<<- c(0,0)
YaSize<<- 1
YaAngle<<- 18
YaPosition<<- 1
YaThick<<- 1
YaStyle<<- "tf"
PHI<<- 30*pi/180
THETA<<- 60*pi/180
FocusPoint<<- c(0,0,0)
EyePoint<<- c(5,5,5)
ASSIGNLIST<<- list("`","'")

SCALEX<<- 1
SCALEY<<- 1
LOGX<<- 0
LOGY<<- 0

TEXFORLEVEL<<- 0
TEXFORLAST<<- list()
}

#-------------------------------------------------------

Appendrow<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Out<-c()
  Nc<- 0
  for (I in 1:Nargs)
  {
    Dt<- varargin[[I]]
    Nc<- max(Nc,Ncol(Dt))
    if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt))
    Out<- c(Out,Dt)
  }
  if(Nc>0)
  {
    Out<-matrix(Out, nrow=Nc)
    Out<-t(Out)
  }
  else
  {
    Out<-c()
  }
  return(Out)
}

Crossprod<-function(a,b)
{
  if(length(a)==3)
  {
    Tmp1<-a[2]*b[3]-a[3]*b[2]
    Tmp2=a[3]*b[1]-a[1]*b[3]
    Tmp3=a[1]*b[2]-a[2]*b[1]
    Out=c(Tmp1,Tmp2,Tmp3)
  }
  else
  {
    Out=a[1]*b[2]-a[2]*b[1]
  }
  return(Out)
}

Datalength<-function(Data)
{
  if(length(Data)==0) return(0)
  if(mode(Data)=="numeric") return(Nrow(Data))
  if(mode(Data)=="character") return(nchar(Data))
  if(mode(Data)=="list") return(length(Data))
}

Crossprod<- function (a,b){ # 17.12.22
  if(length(a)==3){
    Tmp1=a[2]*b[3]-a[3]*b[2]
    Tmp2=a[3]*b[1]-a[1]*b[3]
    Tmp3=a[1]*b[2]-a[2]*b[1]
    Out=c(Tmp1,Tmp2,Tmp3)
  }else{
    Out=a[1]*b[2]-a[2]*b[1]
  }
}

Dotprod<-function(a,b){ # 18.02.05
  nn=min(length(a),length(b))
  out=0
  for(jj in Looprange(1,nn)){
    out=out+a[jj]*b[jj]
  }
  return(out)
}

Dist<- function(...) # 17.09.17
{
  varargin<- list(...)
  a=varargin[[1]]
  if(length(varargin)==1){
    tmp=sqrt(Dotprod(a,a))
	return(as.vector(tmp))
  }
  else{
    b=varargin[[2]]
    tmp=sqrt(Dotprod(b-a,b-a))
    retun(as.vector(tmp))
  }
}

Member<-function(A,L)
{
  N<-length(L);
  if(length(N)==0) return(FALSE)
  for (I in 1:N)
  {
    if(class(L)=="list")
    {
      Tmp<-L[[I]]
    }
    else
    {
      Tmp<-L[I]
    }
    if(mode(A)=="numeric")
    {
      if(Norm(A-Tmp)==0) return(TRUE)
    }
    else
    {
      if(A==Tmp) return(TRUE)
    }
  }
  return(FALSE)
}

Norm<-function(V)
{
  Tmp=Dotprod(V,V) #18.02.09
#  Tmp<-as.vector(V);
#  Tmp<-crossprod(Tmp,Tmp)
  Tmp<-sqrt(Tmp)
#  as.numeric(Tmp)
}

Ncol<-function(P)
{
  if(class(P)=="matrix") return(ncol(P))
  else return(length(P))
}

Nrow<-function(P)
{
  if(length(P)==0) return(0)
  if(class(P)=="matrix") return(nrow(P))
  else return(1)
}

Looprange<- function(a,b)
{
if(a<=b) return(a:b)
return(c())
}

Stripblanks<- function(Ch){
  Tmp<- gsub(" ","",Ch,fixed=TRUE)
  return(Tmp)
}

Quicksort<- function(seqL,key){ #18.02.01
  if(length(seqL)<2){
    out=seqL
  }else{
    tmp1=Op(1,seqL)
    tmp2=Op(2,seqL)
    if(Op(key,tmp1)>=Op(key,tmp2)){
      pivot = tmp1
    }else{
      pivot=tmp2
    }
    left = list()
    right = list()
    for(ii in 1:length(seqL)){
      tmp=Op(ii,seqL)
      if(Op(key,tmp)< Op(key,pivot)){
        left=c(left,list(tmp))
      }else{
        right=c(right,list(tmp))
      }
    }
    left = Quicksort(left,key)
    right = Quicksort(right,key)
    out=c(left,right)
  }
  return(out)
}

Derivative<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Fstr<- varargin[[1]]
  Vstr<- varargin[[2]]
  NvaL<- length(Vstr)
  Flg<- 0
  if(Nargs>=3){
    VaL<- varargin[[3]]
    Flg<- 1
  }
  Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="")
  for(J in Looprange(2,NvaL)){
    Str<- paste(Str,",'",Vstr[J],"'",sep="")
  }
  Str<- paste(Str,")",sep="")
  if(NvaL<=3){
    Str<- paste(Str,",func=TRUE)",sep="")
  }
  else{
    Str<- paste(Str,")",sep="")
  }  
  f<- eval(parse(text=Str))
  if(Flg==1){
    if(NvaL<=3){
      if(NvaL==1){V<- f(VaL[1])}
      if(NvaL==2){V<- f(VaL[1],VaL[2])}
      if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])}
    }
    else{
      for(J in 1:NvaL){
        Tmp<- paste(Vstr[J],'<-',as.character(VaL[J]))
        eval(parse(text=Tmp))
      }
      V<- eval(f)
    }
    Out<- attr(V,'gradient')
    Out<- Out[1,]
  }
  else{
    Out<- f
  }
  return(Out)
}

Diff<- function(...){ #18.02.04
  varargin=list(...)
  Nargs=length(varargin)
  fun=varargin[[1]]
  withvar=varargin[[2]]
  tmp=paste("f<- expression(",fun,")",sep="")
  eval(parse(text=tmp))
  nn=nchar(withvar)
  for(jj in Looprange(1,nn)){
    tmp=substring(withvar,jj,jj)
    f=D(f,tmp)
  }
  var=c()
  val=""
  for(jj in Looprange(3,Nargs)){
    tmp=strsplit(varargin[[jj]],"=")
    var=c(var,tmp[[1]][1])
    val=paste(val,tmp[[1]][2],",",sep="")
  }
  if(Length(val)>1){
    val=substring(val,1,Length(val)-1)
    f=deriv(f,var,func=TRUE)
    tmp=paste("out=f(",val,")",sep="")
    out=eval(parse(text=tmp))
    return(out[1])
  }else{
    return(f)
  }
}

Funvalue<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  df=varargin[[1]]
  var=c()
  val=""
  for(jj in Looprange(2,Nargs)){
    tmp=strsplit(varargin[[jj]],"=")
    var=c(var,tmp[[1]][1])
    val=paste(val,tmp[[1]][2],",",sep="")
  }
  val=substring(val,1,Length(val)-1)
  dfun=deriv(df,var,func=TRUE)
  tmp=paste("out=dfun(",val,")",sep="")
  eval(parse(text=tmp))
  return(out[1])
}

Integrate<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Fstr<- varargin[[1]]
  Vstr<- varargin[[2]]
  IntvL<- varargin[[3]]
  Str<- 'Tmpfun<- function('
  Str<- paste(Str,Vstr,'){',sep='')
  Str<- paste(Str,Fstr,'}',sep='')
  eval(parse(text=Str))
  Tmpfunv<- function(x){sapply(x,Tmpfun)}
  Out<- 0
  for (J in 1:(length(IntvL)-1)){  
    Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1])
    Out<- Out+Tmp[[1]]
  }
  return(Out)
}

#--------------------------------------

#########################

Anglemark<- function(...)
{
  varargin<- list(...) 
  Nargs<- length(varargin)
  Eps<- 10^(-3)
  PA<- varargin[[1]]
  PB<- varargin[[2]]
  PC=varargin[[3]]
  r <-  0.5
  if(Nargs>=4){
    r<-  varargin[[4]]*r  
  }
  Out=c()
  if(r>min(Norm(PA-PB),Norm(PC-PB))){
    return(Out)
  }
  Cir<- Circledata(c(PB,r)) #17.11.29
  Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB))
  P1<- Op(2,Op(1,Tmp))
  Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB))
  P2<- Op(2,Op(1,Tmp))
  if(abs(P1-P2)<Eps){
    Out<-c()
    return(Out)
  }
  if(P1<P2-Eps){
    Out<- Partcrv(P1,P2,Cir)
  }
  else{  
    Tmp<- Numptcrv(Cir)
    Tmp1<- Partcrv(P1,Tmp,Cir)
    Tmp2<- Partcrv(1,P2,Cir)
    Out<- Joincrvs(Tmp1,Tmp2)
  }
}

##############################################

Arrowdata<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  P<- varargin[[1]]
  Q<- varargin[[2]]
  R<- Q
  Futosa<- YaThick
  Ookisa<- YaSize
  Thickness<- 1
  Hiraki<- YaAngle
  Yapos<- YaPosition
  Position<- 1
  Str<- YaStyle
  Flg<- 0
  for (I in Looprange(3,Nargs)){
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric"){
      if(length(Tmp)>1){
        R<- Tmp
      }
      else{
        if(Flg==0){
          Ookisa<- Ookisa*Tmp
        }
        if(Flg==1){
          if(Tmp<5){ 
            Hiraki<- Tmp*Hiraki
          }
          else{
            Hiraki<- Tmp
          }
        }
        if(Flg==2){
          R<- P+Tmp*(Q-P)
        }
        else{
          R<- P+Yapos*(Q-P)
        }
        if(Flg==3){
          Futosa<- Tmp
        }
        Flg<- Flg+1
      }
    }
    if(mode(Tmp)=="character"){
      Tmp<- grep("=", Tmp)
      if(length(Tmp)>0){
        eval(parse(text=Tmp))
        Futosa<- Futosa*Thickness
        R<- P+Position*(Q-P)
      }
      else{
        Str<- Tmp
      }
    }
  }
  Tmp1<- Listplot(c(P,Q))
  Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str)
  Out<- Joingraphics(Tmp1,Tmp2)
}

######################################

#  2013.11.13   No Intersect debugged

Arrowhead<-function(...)
{       ## Scaling is implemented
        ## 12.01.08  Kirikomi 
  varargin<-list(...)
  Nargs<-length(varargin)
  P<-varargin[[1]]
  Houkou<-varargin[[2]]
  Ookisa<-0.2*YaSize
  Hiraki<-YaAngle
  Futosa<-0.5*YaThick
  Cut<- 0
  Str<-YaStyle
  Flg<- 0
  for (I in Looprange(3,Nargs)){
   Tmp<-varargin[[I]]
   if(is.character(Tmp)){ 
      Equal<- grep("=",Tmp,fixed=TRUE)  # 12.01.07 from
      if(length(Equal)>0){
        Tmp1<- strsplit(Tmp,"=",fixed=TRUE)
        Tmp2<- Tmp1[[1]]
        if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){
         Tmp<- paste("Cut=",Tmp2[2],sep="")
          eval(parse(text=Tmp))
       }
      }else{
        Str<- Tmp
      }  #  12.01.07 upto
    }
    if(is.numeric(Tmp) && length(Tmp)==1){
      if(Flg==0) Ookisa<-Ookisa*Tmp
      if(Flg==1){
        if(Tmp<5) Hiraki<-Tmp*Hiraki
        else Hiraki<-Tmp
      }
      if(Flg==2) Futosa<-Tmp
      Flg<-Flg+1
    }
  }
  Ookisa<-1000/2.54/MilliIn*Ookisa
  Theta<-Hiraki*pi/180
  if(Nrow(Houkou)>1){
    P<- Doscaling(P)
    Houkou<- Doscaling(Houkou)
    Tmp<-Nearestpt(P,Houkou)
    A<-Tmp[[1]]
    I<-floor(Tmp[[2]])
    G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29
    Flg<- 0  # 13.11.13
    JL<-seq(I,1,by=-1)
    for (J in JL){
      B<-Ptcrv(J,Houkou)
      Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G)
      if(length(Tmp)>0){
         Flg<- 1
         break
      }
      A<-B
    }
    if(Flg==0){ # 13.11.13
	   print("Arrowhead may be too large (no intersect)")
       return(P)
    }
    Houkou<-P-Op(1,Tmp[[1]])
    Houkou<- Unscaling(Houkou)
    P<- Unscaling(P)
  }
  P<- Doscaling(P)
  Houkou<- Doscaling(Houkou)  
  Ev<--1/Norm(Houkou)*Houkou
  Nv<-c(-Ev[2],Ev[1])
  if(length(grep("c",Str))>0){
    P<-P-0.5*Ookisa*cos(Theta)*Ev
  }
  if(length(grep("b",Str))>0){
    P<-P-Ookisa*cos(Theta)*Ev
  }
  A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv
  B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv
  if(length(grep("l",Str))>0){
    Tmp<-Listplot(list(A,P,B))
    Tmp1<- Unscaling(Tmp)  
    Drwline(Tmp1,Futosa)
  }
  else{
    C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07
    Tmp<- Listplot(list(A,P,B,C,A))   # 12.01.07
    Tmp1<- Unscaling(Tmp)
    Shade(Tmp1)
    Tmp=Listplot(c(A,P,B,C,A,P))  # 15.6.20
    Tmp1=Unscaling(Tmp)
    Drwline(Tmp1,0.1)  # 15.06.11, 15.06.14
  }
}

############################################

#  2013.11.13  No intersect debugged

Arrowheaddata<- function(...)
{  ## Scaling is implemented
  varargin<- list(...)
  Nargs<- length(varargin)
  P<- varargin[[1]]
  Houkou<- varargin[[2]]
  Ookisa<- 0.2*YaSize
  Hiraki<- YaAngle
  Futosa<- 0
  Thickness<- 1
  Str<- YaStyle
  Flg<- 0
  for (I in Looprange(3,Nargs)){
    Tmp<-varargin[[I]]
    if(mode(Tmp)=="character"){
      Tmp1<-grep("=",Tmp)
      if(length(Tmp1)>0){
        eval(parse(text=Tmp))
        Futosa<- Thickness
      }
      else{
        Str<- Tmp
      }
    }
    if(mode(Tmp)=="numeric" && length(Tmp)==1){
      if(Flg==0) Ookisa<-Ookisa*Tmp
      if(Flg==1){
        if(Tmp<5) Hiraki<-Tmp*Hiraki
        else Hiraki<-Tmp
      }
      if(Flg==2) Futosa<-Tmp
      Flg<-Flg+1
    }
  }
  Theta<- Hiraki*pi/180
  if(Nrow(Houkou)>1){
    P<- Doscaling(P)
    Houkou<- Doscaling(Houkou)
    Tmp<-Nearestpt(P,Houkou)
    A<-Tmp[[1]]
    I<-floor(Tmp[[2]])
    G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29
    Flg<- 0  # 13.11.13
    JL<-seq(I,1,by=-1)
    for (J in JL){
      B<- Ptcrv(J,Houkou)
      Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G)
      if(length(Tmp)>0){
        Flg<- 1
        break
      }
      A<-B
    }
    if(Flg==0){ # 13.11.13
	   print("Arrowhead may be too large (no intersect)")
       return(P)
    }
    Houkou<-P-Op(1,Tmp[[1]])
    Houkou<- Unscaling(Houkou)
    P<- Unscaling(P)
  }
  P<- Doscaling(P)
  Houkou<- Doscaling(Houkou)  
  Ev<- -1/Norm(Houkou)*Houkou
  Nv<- c(-Ev[2],Ev[1])
  if(length(grep("c",Str))>0){
    P<-P-0.5*Ookisa*cos(Theta)*Ev
  }
  if(length(grep("b",Str))>0){
    P<-P-Ookisa*cos(Theta)*Ev
  }
  A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv
  B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv
  Tmp<- Listplot(A,P,B)
  Out<- Unscaling(Tmp)
  return(Out)
}

##########################################

Arrowline<- function(...)
{    # 12.01.07 kirikomi
  varargin<- list(...)
  Nargs<- length(varargin)
  P<- varargin[[1]]
  Q<- varargin[[2]]
  Futosa<- YaThick
  Ookisa<- YaSize
  Hiraki<- YaAngle
  Yapos<- YaPosition
  Cutstr<- "Cut=0"
  Str<- YaStyle
  Flg<- 0
  for (I in Looprange(3,Nargs)){
    Tmp<- varargin[[I]]
    if(is.character(Tmp)){
      Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from
      if(length(Equal)>0){
        Tmp1<- strsplit(Tmp,"=")
        Tmp2<- Tmp1[[1]]
        if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){
          Tmp<- paste("Cut=", Tmp2[2],sep="")
          Cutstr<- Tmp
        }
      }
      else{
        Str<- Tmp
      }  # 12.01.07 upto
    }
    if(is.numeric(Tmp) && length(Tmp)==1){
      if(Flg==0) Ookisa<- Ookisa*Tmp
      if(Flg==1){
        if(Tmp<5) Hiraki<- Tmp*Hiraki
        else Hiraki<- Tmp
      }
      if(Flg==2) Yapos<- Tmp
      if(Flg==3) Futosa<- Tmp
      Flg<- Flg+1
    }
  }
  R<- P+Yapos*(Q-P)
  Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24
  Drwline(Listplot(c(P,Tmp)),Futosa)
  Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str)
}

#########################################

Assign<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0){
    ASSIGNLIST<<- list("`",Prime())
    Out<- ASSIGNLIST
    return()
#    return("Assign reset done");
  }
  L<- list("`","'")
  if(Nargs%%2==0){
    L<- Mixjoin(L,varargin)
    ASSIGNLIST<<- L
    Out<- L
    return()
#    return("Assign set done");
  }
  if(Nargs==1){
    Fnstr<- varargin[[1]]
    if(nchar(Fnstr)==0){ # case of "" 
      L<- ASSIGNLIST
      Out<- c()
      for (I in seq(1,length(L),by=2)){
        Tmp1<- L[[I]]
        Tmp2<- L[[I+1]]
        if(length(Tmp2)==1){
          Tmp3<- as.character(Tmp2)
        }
        else{
          if(mode(Tmp2)=="character"){
            Tmp3<- Tmp2
          }
          else if(mode(Tmp2)=="list"){
            Tmp3<- makeliststr(Tmp2)
          }
          else if(mode(Tmp2)=="numeric"){
            Tmp3<- "c("
            for (J in Looprange(1,length(Tmp2))){
              Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="")
              if(J<length(Tmp2)){
                Tmp3<- paste(Tmp3,",",sep="")
              }
            }
            Tmp3<- paste(Tmp3,")",sep="")
            if(class(Tmp2)=="matrix"){
              Nr<- as.character(nrow(Tmp2))
              Tmp3<- paste("matrix(",Tmp3,"nrow=",Nr,")",sep="")
            }
          }
        }
        Tmp<- paste(Tmp1,"=",Tmp3,sep="")
        Out<- c(Out,Tmp)
      }
      return(Out);
    }
    if(substr(Fnstr,1,1)=="?"){
      Fnstr<- substr(Fnstr,2,nchar(Fnstr))
      for (I in seq(1,length(ASSIGNLIST),by=2)){
        Tmp<- ASSIGNLIST[[I]]
        if(Tmp==Fnstr){
          Out<- Mixjoin(list(I),ASSIGNLIST[I+1])
          return(Out)
        }
      }
      Out<- "Not found"
      return(Out);
    }
    L<- ASSIGNLIST
  }
  else{
    if(mode(varargin[[2]])=="numeric"){
      Fnstr<- varargin[[Nargs]]
      for (I in Looprange(1,Nargs-1)){
        L[[I]]=varargin[[I]]
      }
    }
    else{
      Fnstr<- varargin[[1]]
      for (I in Looprange(2,Nargs)){
        L[[I-1]]<- varargin[[I]]
      }
    }
  }
  for (I in seq(1,length(L),by=2)){
    Vname<- L[[I]]
    Val<- L[[I+1]]
    if(mode(Val)=="numeric"){
      if(Nrow(Val)==1){ 
        for (K in Looprange(1,length(Val))){
          Tmp<- paste(Vname,"[", as.character(K),"]",sep="")
          if(mode(Val[K])=="numeric"){
            Tmp1<- paste("(",as.character(Val[K]),")",sep="")
          }
          else{
            Tmp1<- Val[K]
          }
          Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE)
        }
      }
      else{
        for (J in Looprange(1,Nrow(Val))){
          for (K in Looprange(1,Ncol(Val))){
            Tmp<- paste(Vname,"(",as.character(J),",",as.character(K),")",sep="")
            if(mode(Val[J,K])=="numeric"){
              Tmp1<- paste("(",as.character(Val[J,K]),")",sep="")
            }
            else{
              Tmp1<- Val[J,K]
            }
            Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE)
          }
        }
      }
      if(length(Val)==1){
        Rep<- as.character(Val)
      }
      else{
        Rep<-""
        if(class(Val)=="matrix"){
          Rep<- "matrix("
        }
        Rep<- paste(Rep,"c(",sep="")
        for (J in Looprange(1,length(Val))){
          Rep<- paste(Rep,as.character(Val[J]),sep="")
          if(J<length(Val)){
            Rep<- paste(Rep,",",sep="")
          }
          else{
            Rep<- paste(Rep,")",sep="")
          }
        }
        if(class(Val)=="matrix"){
          Rep<- paste(Rep,",nrow=",as.character(nrow(Val)),")",sep="")
        }
      }
      Tmp1<- paste("(",Rep,")",sep="")
    }
    if(mode(Val)=="character"){
      Tmp1<- Val
    }
    if(mode(Val)=="list"){
      Tmp1<- Makeliststr(Val)
    }
    Fnstr<- gsub(Vname,Tmp1,Fnstr,fixed=TRUE)  # 10.11.20
  }
  return(Fnstr)
}

#########################################

Assignadd<- function(...) 
{
  varargin<- list(...)
  L<- ASSIGNLIST
  L<- Mixjoin(L,varargin)
  ASSIGNLIST<<- L
#  return("assign add done"); #17.09.17
}

#########################################

Assignrep<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  L<-  ASSIGNLIST
  for (I in seq(1,Nargs,by=2)){
    Vname<- varargin[[I]]
    Val<- varargin[[I+1]]
    Tmp1<- paste("?",Vname,sep="")
    Tmp<- Assign(Tmp)
    if(mode(Tmp)=="character"){
      next
    }
    I<- Tmp[[1]]
    L<- Mixjoin(L,list(Val))
  }
   ASSIGNLIST<<- L
}

#########################################

 Assignset<- function(...)
{
  Assign(...)
}

#########################################

Beginpicture<-function(ul)
{    ## Scaling is implemented
  Tmp<- Doscaling(c(XMIN,YMIN))
  Xm<- Tmp[1]
  Ym<- Tmp[2]
  Tmp<- Doscaling(c(XMAX,YMAX))
  XM<- Tmp[1]
  YM<- Tmp[2]
  Dx<- XM-Xm
  Dy<- YM-Ym
  Sym<-".0123456789 +-*/"
  SL<-Sym
  OL<-"+-*/"
  if(ul!=""){
    ULEN<<-ul;
  }
  Is<-1;
  VL<-"";
  Ucode<-ULEN
  for (I in Looprange(1,nchar(Ucode))){
    C<-substring(Ucode,I,I);
    if(length(grep(C,SL))>0){
      if(length(grep(C,OL))>0){
        Tmp<-substring(Ucode,Is,I-1);
        Str<-paste(VL,Tmp,C,sep="")
        VL<-Str
        Is<-I+1;
      }
    }
    else{
      Unit<-substring(Ucode,I,I+1)
      Str<-substring(Ucode,Is,I-1)
      VL<-paste(VL,Str,sep="")
      break;
    }
  }
  Valu<-eval(parse(text=VL))
  Str<-as.character(Valu);
  ULEN<<- paste(Str,Unit,sep="")
  if(Unit=="cm") MilliIn<<-1000/2.54*Valu
  if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10
  if(Unit=="in") MilliIn<<-1000*Valu
  if(Unit=="pt") MilliIn<<-1000/72.27*Valu
  if(Unit=="pc") MilliIn<<-1000/6.022*Valu 
  if(Unit=="bp") MilliIn<<-1000/72*Valu
  if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
  if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu;
  if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
  MARKLEN<<- MARKLENNow*1000/2.54/MilliIn;
  Str<-paste("{\\unitlength=",ULEN,"%\n",sep="")
  cat(Str,file=Wfile,append=TRUE)
  cat("\\begin{picture}%\n",file=Wfile,append=TRUE)
  Str<-"("
  Tmp<-as.character(round(Dx,digits=6))
  Str<-paste(Str,Tmp,",",sep="")
  Tmp<-as.character(round(Dy,digits=6))
  Str<-paste(Str,Tmp,")(",sep="")
  Tmp<-as.character(round(Xm,digits=6))
  Str<-paste(Str,Tmp,",",sep="")
  Tmp<-as.character(round(Ym,digits=6))
  Str<-paste(Str,Tmp,")%\n",sep="")
  cat(Str,file=Wfile,append=TRUE)
  Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="")
  cat(Str,file=Wfile,append=TRUE)
  cat("%\n",file=Wfile,append=TRUE)
}

#################################################

Bowdata<- function(...)  #17.09.17
{       
 varargin <- list(...) 
 Nargs <- length(varargin)
 PA <- varargin[[1]]
 PB <- varargin[[2]]
 Cut <- 0
 D <- 1/2*Norm(PB-PA)  
 if(Nargs>=3) {
   H <- varargin[[3]]*D*0.2 
 }
 else {
   H <- D*0.2
 }
 H <- min(H,D)
 if(Nargs>=4){  
   Cut <- varargin[[4]]
 }
 Ydata <- MakeBowdata(PA,PB,H) 
 C <- Op(1,Ydata)  
 r <- Op(2,Ydata)  
 R1 <- Op(3,Ydata)  
 R2 <- Op(4,Ydata)  
 Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="")  
 Theta <- (R1+R2)*0.5
 BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta)  
 M <- Op(1,BOWMIDDLE)  
 ThetaM <- Op(2,BOWMIDDLE)  
 BOWSTART <<- PA  
 BOWEND <<- PB
 if(Cut==0){
   Pd<- Circledata(c(C,r),Rng)
 }
 else{
   Alpha <- R1; Beta <- ThetaM-Cut/(2*r)
   Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="") 
   Pd <- Circledata(c(C,r),Rng)
   Alpha <- ThetaM+Cut/(2*r); Beta <- R2
   Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="")  
   Tmp <- Circledata(c(C,r),Rng)
   Pd <- Appendrow(Pd,c(Inf,Inf),Tmp)  
 }
}

Bowmiddle <- function(...)
{
 varargin <- list(...)
 Nargs <- length(varargin)
 if( Nargs==0) {
   M <- BOWMIDDLE
   return(M)   
 }
 if(Nargs==1) {
   Bdata <- varargin[[1]]
   A <- Bdata[1,]  
   Dind <- Dataindex(Bdata)
   Dc <- Nrow(Dind)
   Tmp <- Dind[Dc,2]  
   B <- Bdata[Tmp,]  
   if(Dc==1) {
     Tmp1 <- round(Tmp/2)
   }
   else {
     Tmp1 <- Dind[1,2]  
   }
   D <- Bdata[Tmp1,]  
   B <- B-A
   D <- D-A
   Tmp1 <- B[1]*D[2]-D[1]*B[2]  
   Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2  
   Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2  
   C <- c(Tmp2,Tmp3)/Tmp1+A
   R <- Norm(C-A)
   B <- B+A
   V <- (A+B)/2-C
   V <- V/Norm(V)
   M <- C+R*V
 }
 else {
   A <- varargin[[1]]; B <- varargin[[2]]
   D <- 1/2*Norm(B-A)
   H <- 0.2*D;
   if(length(varargin)>=3) {
     Tmp <- varargin[[3]]
     H <- Tmp*D*0.2
   }
   H <- min(H,D)
   Ydata <- MakeBowdata(A,B,H)
   C <- Op(1,Ydata)
   R <- Op(2,Ydata)
   T <- (Op(3,Ydata)+Op(4,Ydata))/2
   P <- C+R*c(cos(T),sin(T))  
   #M <- list(P,T)  
   M <- P  
 }
 return(M)
}

##########################
# 13.12.19  small movement supported

Bowname<- function(...)
{
  varargin <- list(...) 
  Nargs <- length(varargin)
  Siki <- varargin[[Nargs]]
  Nargs<- Nargs-1
  Dr<- "c"
  if(Nargs>=1){
    Tmp<- varargin[[Nargs]]
    if(is.character(Tmp)){
      Dr<- Tmp
      Nargs<- Nargs-1
    }
  }
  if(Nargs==0){
   Siki <- varargin[[1]]
   P <- Op(1,BOWMIDDLE)  
 }
 else if(Nargs==1){  
   Bdata <- varargin[[1]]
   P <- Bowmiddle(Bdata)
 }
 else{
   A <- varargin[[1]]; B <- varargin[[2]]
   D <- 1/2*Norm(B-A)  
   Tmp <- varargin[[3]]
   if(is.character(Tmp)){  
     H <- D*0.2
   }
   else {
     H <- Tmp*D*0.2
   }
   H <- min(H,D)
   Ydata <- MakeBowdata(A,B,H)
   Tmp <- Bowmiddle(Ydata)
   P <- Op(1,Tmp)  
 }
 Expr(P,Dr,Siki)
}

##########################
# 13.12.19  small movement supported
#                    A,B, ... no longer supported

Bownamerot <- function(...)
{
 varargin <- list(...)
 Nargs <- length(varargin)
 Eps <- 10^(-6)
 Flg <- 1
 Tmp <- varargin[[Nargs]]
 if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){  
   Flg <- Tmp
   Nargs <- Nargs-1
 }
 Siki <- varargin[[Nargs]]
 Nargs<- Nargs-1
 Dr<- "c"
 if(Nargs>=1){
   Tmp<- varargin[[Nargs]]
   if(is.character(Tmp)){
     Dr<- Tmp
     Nargs<- Nargs-1
   }
 }
 if(Nargs==0) {
   P <- Op(1,BOWMIDDLE)
   A <- BOWSTART
   B <- BOWEND
 }
 else{
   Bdata<- varargin[[1]]
   P<- Bowmiddle(Bdata)
   A=Bdata[1,]
   B=Bdata[nrow(Bdata),]
   Tm<- 0; Tv<- 0
   if(Nargs>1){
     Tm<- varargin[[2]]
     if(Nargs>2){
       Tv<- varargin[[3]]
     }
   }
 }
# else if(Nargs==2) {  
#   Bdata <- varargin[[1]]
#  P <- Bowmiddle(Bdata)
#   A <- Bdata[1,]  
#   B <- Bdata[Nrow(Bdata),]  
#   Siki <- varargin[[2]]
# }
# else {
#   A <- varargin[[1]]; B <- varargin[[2]]
#   D <- 1/2*Norm(B-A)  
#   Tmp <- varargin[[3]]
#   if(mode(Tmp)=="character") {  
#     H <- 0.2*D; Siki <- Tmp
#   }
#   else {
#     H <- Tmp*D*0.2; Siki <- varargin[[4]]
#   }
#   H <- min(H,D)
#   Ydata <- MakeBowdata(A,B,H)
#   C <- Op(1,Ydata)
#   R <- Op(2,Ydata)
#   T <- (Op(3,Ydata)+Op(4,Ydata))/2
#   P <- C+R*c(cos(T),sin(T))
# }
 if(A[1]>B[1]+Eps){
   Tmp <- A
   A <- B
   B <- Tmp
 }
 if(Flg>0) {
   Tmp <- B-A
 }
 else{
   Tmp <- A-B
 }
 Exprrot(P,Tmp,Tm,Tv,Siki)
}

CalcHeight<-function(Hoko,Moji)
{
  D<-0
  H<-substring(Hoko,1,1)
  Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="")
  Str<-c(Tmp)
  Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="")
  Str<-c(Str,Tmp)
  if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}")
  if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}")
  if(H=="c")
  {
    Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}")
    Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}")
    Str<-c(Str,"\\addtolength{\\Height}{\\Depth}")
  }
  for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE)
  cat("%\n",file=Wfile,append=TRUE)
}

#########################

CalcWidth<-function(Hoko,Moji)
{
  D<-0;
  H<-substring(Hoko,2,2)
  if(H=="e") D<-0 
  if(H=="w") D<--1.0
  if(H=="c") D<--0.5
  Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="")
  Tmp<-as.character(D)
  Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="")
  cat(Str1,file=Wfile,append=TRUE)
  cat(Str2,file=Wfile,append=TRUE)
  cat("%\n",file=Wfile,append=TRUE)
}

#########################
# 17.09.17
# 17.09.24

Circledata<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Cr<- varargin[[1]]
  C=Cr[1:2]
  if(length(Cr)==4){
    ra=Norm(C-Cr[3:4])
    Nop=2
  }
  else{
    ra=Cr[3]
    Nop=2
  }
  R=c(0,2*pi)
  N=50
  for (I in Looprange(Nop,Nargs)){
    Tmp<- varargin[[I]]
    if(is.character(Tmp)){
      Tmp1=regexpr("=",Tmp)  #17.09.24from
      Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp))
      Tmp1=substring(Tmp,1,Tmp1)
      Tmp1=gsub("NUM", "N", toupper(Tmp1))
      Tmp1=gsub("RNG", "R", Tmp1)
      Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24upto
      eval(parse(text=Tmp))
    }
  }
  Dt<- (R[2]-R[1])/N
  T <- seq(R[1],R[2],by=Dt) 
  X <- C[1]+ra*cos(T)
  Y <- C[2]+ra*sin(T)
  XY<- c(X,Y)
  P<- matrix(XY,ncol=2)
  return(P) 
}

#########################
# 13.12.19

Closefile<-function(...)
{
  varargin<- list(...)
  if(length(varargin)>=1){
    Pa<- varargin[[1]]
    if(is.character(Pa)){
      if(Pa=="1") Endpicture(1)
      if(Pa=="0") Endpicture(0)
    }
  }
  Wfile<<-""
}

#########################

Closepar<- function()
{
  S<- "%\n\\end{minipage}"
  cat(S,file=Wfile,append=TRUE)
  Closephr()
}


####################################

Closephr<- function()
{
  cat("%\n}%\n",file=Wfile,append=TRUE)
}

#####################################

Dataindex<-function(P)
{
  #  Inf;Inf : Terminator
  Ndm<-c()
  if(length(P)==0) return(Ndm)
  N1<-1
  Flg<-0
  for (J in 1:Nrow(P))
  {
    if(P[J,1]==Inf)
    {
      Ndm<-Appendrow(Ndm,c(N1,J-1))
      N1<-J+1;
      if(P[N1,1]==Inf)
      {
        Flg<-1;
        break;
      }
    }
  }
  if(Flg==0)
  {
    Ndm<-Appendrow(Ndm,c(N1,Nrow(P)))
  }
  if(class(Ndm)=="numeric")
  {
    Tmp<-matrix(Ndm,nrow=1)
    Ndm<- Tmp
  }
  return(Ndm)
}

################################

Dashline<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Nall<- Nargs; Sen<- 1 ; Gap<- 1
  Tmp<- varargin[[Nall]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){
    Tmp1<- varargin[[Nall-1]]
    if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){
      Sen<- Tmp1; Gap<- Tmp
      Nall<- Nall-2
    }
    else{
       Sen<- Tmp; Gap<- Sen
       Nall<- Nall-1
    }
  }
  Sen<- 1000/2.54/MilliIn*Sen
  Gap<- 1000/2.54/MilliIn*Gap
  for (N in Looprange(1,Nall)){
    Pdata<- varargin[[N]]
    if(is.numeric(Pdata)==1){
      Pdata<- list(Pdata)
    }
    for (II in 1:length(Pdata)){
      Figdata<- Op(II,Pdata)
      Makehasen(Figdata,Sen,Gap,0)
    }
  }
}

##############################################
#  17.11.27

Definecolor<- function(Name,Data){
  Tmp1=length(Data)
  if((Tmp1<3) || (Tmp1>4)){
    cat("Size of data should be 3 or 4.")
    return()
  }
  if(Tmp1==4){
    Tp="cmyk"
  }else{
    Tp="rgb"
  }
  Tmp=""
  for(J in 1:Tmp1){
    Tmp=paste(Tmp, as.character(Data[J]),sep="")
    if(J<Tmp1){
      Tmp=paste(Tmp,",",sep="")
    }
  }
  Tmp=paste("\\definecolor{",Name,"}{",Tp,"}{",Tmp,"}",sep="")
  Texcom(Tmp)
}

##############################################

Diagcelldata<- function(Tb,Nc,Nr)
{
  Tmp<- Findcell(Tb,Nc,Nr)
  C<- Tmp[[1]]
  Dx<- Tmp[[2]]
  Dy<- Tmp[[3]]
  Pne<- C+c(Dx,Dy)
  Pnw<- C+c(-Dx,Dy)
  Psw<- C+c(-Dx,-Dy)
  Pse<- C+c(Dx,-Dy)
  Tmp1<- Listplot(Pnw,Pse)
  Tmp2<- Listplot(Pne,Psw)
  list(Tmp1,Tmp2)
}

##############################################
# 11.01.07

Dividegraphics<- function(Pd)
{
  if(length(Pd)==0){
    return(Pd)
  }
  DtL<- Flattenlist(Pd)
  OutL<- list()
  for (J in 1:length(DtL)){
    Dt<- as.matrix(DtL[[J]])
    Ndm<- Dataindex(Dt)    
    for (I in Looprange(1,Nrow(Ndm))){
      Fd<- Dt[Ndm[I,1]:Ndm[I,2],]
      OutL<- c(OutL,list(Fd))
    }
  }
  return(OutL)
}

##############################################
# 13.05.03

Dividetable<- function(Tb)
{
  G<- Tb[[1]]
  Gw<- G[[1]]
  Gt<- G[Tb[[2]]]
  Gy<- G[Tb[[3]]]
  list(Gw,Gt,Gy)
}

################################################

Doscaling<- function(G)
{
  GLg<- G
  if(class(GLg)=="numeric")
  {
    if(LOGX==1) GLg[1]<- log(G[1], base=10)
    if(LOGY==1) GLg[2]<- log(G[2], base=10)
    Tmp<-c(SCALEX*GLg[1],SCALEY*GLg[2])
    return(Tmp)
  }
  else
  {
    if(LOGX==1) GLg[,1]<- log(G[,1],base=10)
    if(LOGY==1) GLg[,2]<- log(G[,2],base=10)
    Tmp1<-matrix(c(SCALEX,0,0,SCALEY),nrow=2)
    Tmp<-GLg %*% Tmp1
    return(Tmp)
  }
}

########################################

Dotfilldata<- function(...)
{     ## Scaling is implemented
  varargin<- list(...)
  Nargs<- length(varargin)
  ShaL<- list()
  Eps<- 0.01
  Kakudo<- 45
  Kosa<- 0.5
  Tmp<- Doscaling(c(XMIN,YMIN))
  Xmn<- Tmp[1]; Ymn<- Tmp[2]
  Tmp<- Doscaling(c(XMAX,YMAX))
  Xmx<- Tmp[1]; Ymx<- Tmp[2]
  for (N in seq(Nargs,1,by=-1)){
    Tmp<- varargin[[N]]
    if(Mixtype(Tmp)!=1){
      break
    }
  }
  if(N<Nargs){
    Kosa<- varargin[[N+1]]
  }
#  Kosa<- min(Kosa,1)
  Tmp<- 1/(2*Kosa)
  Kankaku<- Tmp*0.100*1000/2.54/MilliIn
  NaitenL<- varargin[[1]]
  if(Mixtype(NaitenL)==1){
    NaitenL<- list(NaitenL)
  }
  Ns<- 2
  StartP<- Op(1,NaitenL)
  if(mode(StartP)=="character"){
    StartP<- c((Xmn+Xmx)/2,(Ymn+Ymx)/2)
  }
  else{
    StartP<- Doscaling(StartP)
  }
  Tmp<- varargin[[2]]
  if(Mixtype(Tmp)==1){
    StartP<- Doscaling(Tmp)
    Ns<- 3
  }
  Tmp<- list()
  for (I in Looprange(Ns,N)){
    Tmp<- Mixjoin(Tmp,list(varargin[[I]]))
  }
  Bdy<- Kyoukai(Tmp)
  Bdys<-list()
  for (I in 1:length(Bdy)){
    Tmp1<- Bdy[[I]]
    Tmp2<- Doscaling(Tmp1)
    Bdys<- Mixjoin(Bdys,list(Tmp2))
  }
  Bdy<- Bdys
  PtnL<- list()
  for (I in Looprange(1,length(NaitenL))){
    Tmp<- Op(I,NaitenL)
    if(mode(Tmp)=="numeric"){
      Tmp1<- Naigai(Tmp,Bdy)
      PtnL<- Mixjoin(PtnL,list(Tmp1))
    }
    else{
      if(mode(Tmp)!="character"){
        return("Mode Error")
      }
      Ptn<- c()
      for (J in Looprange(1,nchar(Tmp))){
        if(substr(Tmp,J,J)=="i"){
          Ptn<- c(Ptn,1)
        }
        else{
          Ptn<- c(Ptn,0)
        }
      }
      PtnL<- Mixjoin(PtnL,list(Ptn))
    }
  }
  Call<- length(Bdy)
  Ptn<- c(seq(0, 0, length=Call))
  if(Member(Ptn,PtnL)){
    Wn<- Doscaling(Framedata())
    Bdy<- Mixjoin(Bdy,list(Wn))
    Tmp<- list()
    for (I in Looprange(1,length(PtnL))){
      Tmp1<- c(Op(I,PtnL),1)
      Tmp<- Mixjoin(Tmp,list(Tmp1))
    }
    PtnL<- Tmp
  }
  V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180))
  Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180))
  Tmp<- Op(1,NaitenL)
  if(mode(Tmp)=="numeric" && length(Tmp)==2){
    Tmp<- Doscaling(Tmp)
    Delta<- Tmp-StartP
    K<- trunc(Dotprod(Delta,Vm)/Kankaku)
    PA<- StartP+K*Kankaku*Vm
    P<- PA
    Sha<- Makeshasen(PtnL,P,V,Bdy)
    Sha<- Dividegraphics(Sha)
    I<- 1
    while (length(Sha)>0){
      for (J in Looprange(1,length(Sha))){
        Tmp<- Op(J,Sha)
        Q<- Tmp[1,]
        R<- Tmp[2,]
        Tmp<- Dotprod(Q-P,V)/Kankaku
        K1<- ceiling(Tmp)
        if(abs(K1-Tmp)<Eps) K1=K1+1
        Tmp<- Dotprod(R-P,V)/Kankaku
        K2<- floor(Tmp)
        if(abs(Tmp-K2)<Eps) K2=K2-1
        for (K in Looprange(K1,K2)){
          Tmp1<- Pointdata(P+K*Kankaku*V)
          ShaL<- Mixjoin(ShaL, list(Tmp1))
        }
      }
      P<- PA+I*Kankaku*Vm
      Sha<- Makeshasen(PtnL,P,V,Bdy)
      Sha<- Dividegraphics(Sha)
      I<- I+1
    }
    P<- PA-Kankaku*Vm
    Sha<- Makeshasen(PtnL,P,V,Bdy)
    I<- 2
    while (length(Sha)>0){
      for (J in 1:length(Sha)){
        Tmp<- Op(J,Sha)
        Q<- Tmp[1,]
        R<- Tmp[2,]
        Tmp<- Dotprod(Q-P,V)/Kankaku
        K1<- ceiling(Tmp)
        if(abs(K1-Tmp)<Eps) K1<- K1+1
        Tmp<- Dotprod(R-P,V)/Kankaku
        K2<- floor(Tmp)
        if(abs(Tmp-K2)<Eps) K2<- K2-1
        for (K in Looprange(K1,K2)){  
          Tmp1<- Pointdata(P+K*Kankaku*V)
          ShaL<- Mixjoin(ShaL, list(Tmp1))
        }
      }
      P<- PA-I*Kankaku*Vm
      Sha<- Makeshasen(PtnL,P,V,Bdy)
      I<- I+1
    }
  }
  else{
    Delta<- c(Xmn,Ymn)-StartP
    K1<- trunc(Dotprod(Delta,Vm)/Kankaku)
    Delta<- c(Xmx,Ymn)-StartP
    K2<- trunc(Dotprod(Delta,Vm)/Kankaku)
    Delta<- c(Xmx,Ymx)-StartP
    K3<- trunc(Dotprod(Delta,Vm)/Kankaku)
    Delta<- c(Xmn,Ymx)-StartP
    K4<- trunc(Dotprod(Delta,Vm)/Kankaku)
    IM<- max(K1,K2,K3,K4)
    Im<- min(K1,K2,K3,K4)
    for (I in Im:IM){
      P<- StartP+I*Kankaku*Vm
      Sha<- Makeshasen(PtnL,P,V,Bdy)
      Sha<- Dividegraphics(Sha)
      if(length(Sha)>0){
        for (J in 1:length(Sha)){
          Tmp<- Op(J,Sha)
          Q<- Tmp[1,]
          R<- Tmp[2,]
          Tmp<- Dotprod(Q-P,V)/Kankaku
          K1<- ceiling(Tmp)
          if(abs(K1-Tmp)<Eps) K1=K1+1
          Tmp<- Dotprod(R-P,V)/Kankaku
          K2<- floor(Tmp)
          if(abs(Tmp-K2)<Eps) K2=K2-1
          for (K in Looprange(K1,K2)){
            Tmp1<- Pointdata(P+K*Kankaku*V)
            ShaL<- Mixjoin(ShaL, list(Tmp1))
          }
        }
      }
    }
  }
  ShaLs<-list()
  for (I in Looprange(1,length(ShaL)))
  {
    Tmp<- ShaL[[I]]
    Tmp1<- Unscaling(Tmp)
    ShaLs<- Mixjoin(ShaLs,Tmp1)
  }
  ShaL<- ShaLs
  return(ShaL)
}

#############################################

Dottedline<- function(...)
{
  varargin <- list(...)     
  Nall <- length(varargin)
  Nagasa <- 0.1
  Ookisa <- PenThick
  I <- Nall
  Tmp <- varargin[[I]]
  while (mode(Tmp)=="numeric" && length(Tmp)==1 ) {
    I <- I-1
    Tmp <- varargin[[I]]
  }
  if(I==Nall-1) {
    Nagasa<-Nagasa*varargin[[Nall]]
    Nall <- Nall-1
  }
  if(I==Nall-2) {
    Nagasa <- Nagasa*varargin[[Nall-1]]
    Ookisa <- round(Ookisa*varargin[[Nall]])
    Nall <- Nall-2
  }
  Nagasa <- 1000/2.54/MilliIn*Nagasa
  for (N in 1:Nall) {
    Pdata <- varargin[[N]]
    if(mode(Pdata)=="numeric") {
      Pdata <- list(Pdata)             
    }
    for (II in 1:length(Pdata)) {  
      Clist <- MakeCurves(Op(II,Pdata))
      DinM <- Dataindex(Clist)
      for (n in Looprange(1,Nrow(DinM))) {    
        Tmp <- DinM[n,] 
        Data <- Clist[Tmp[1]:Tmp[2],]
        Len <- 0
        Lenlist <- c(0)                    
        for (I in Looprange(2,Nrow(Data))) {       
          Len <- Len+Norm(Data[I,]-Data[I-1,])  
          Lenlist <- c(Lenlist,Len)      
        }
        Lenall <- Lenlist[length(Lenlist)]    
        if(Lenall==0) {
          next
        }
        Naga <- Nagasa
        Nten <- round(Lenall/Naga)+1
        if(Nten > 1) {
          Seg <- Lenall/(Nten-1)
        }              
        else {
          Seg <- Lenall
        }
        Eps <- 10^(-6)*Seg
        PPd<-c()
        Hajime <- 1
        for (I in Looprange(0,Nten-1)) {     
          Len <- Seg*I
          if(I>0) {
            J <- Hajime
            while( Len>=Lenlist[J]+Eps) {     
              J <- J+1
            }
            Hajime <- J-1
          }
          T <- (Len-Lenlist[Hajime])/     
                           (Lenlist[Hajime+1]-Lenlist[Hajime])   
          P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) 
          PPd<-Appendrow(PPd,P)
          if(I==Nten-1) {
            if(Norm(P-Data[1,])<Eps) {         
              next
            }
          } 
        }
        Str<-paste("\\special{pn ", as.character(Ookisa),"}%\n",sep="")
        cat(Str,file=Wfile,append=TRUE)
        for (I in Looprange(1,Nrow(PPd))){
          P<- Op(I,PPd)
          if(Nrow(PPd)==1){
            V<- c(1,0)
          }
          else if(I==1){
            Tmp<- Op(I+1,PPd)-P
            V<- 1/Norm(Tmp)*Tmp
          }
          else if(I==Nrow(PPd)){
            Tmp<- P-Op(I-1,PPd)
            V<- 1/Norm(Tmp)*Tmp
          }
          else{
            Tmp1<- Op(I+1,PPd)-P
            Tmp2<- P-Op(I-1,PPd)
            Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2
            V<- 1/Norm(Tmp3)*Tmp3
          }
          Tmp<- round(MilliIn*P[1]-1/2*Ookisa*V[1])
          X<- as.character(Tmp)
          Tmp<- -round(MilliIn*P[2]-1/2*Ookisa*V[2])
          Y<- as.character(Tmp)
          Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
          cat(Str,file=Wfile,append=TRUE)
          Tmp<- round(MilliIn*P[1]+1/2*Ookisa*V[1])
          X<- as.character(Tmp)
          Tmp<- -round(MilliIn*P[2]+1/2*Ookisa*V[2])
          Y<- as.character(Tmp)
          Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
          cat(Str,file=Wfile,append=TRUE)
          cat("\\special{fp}",file=Wfile,append=TRUE)
          if(I%%2==0){
            cat("%\n",file=Wfile,append=TRUE)
          }
        }
      }
    }
  }
  Tmp<-PenThick/PenThickInit
  Setpen(Tmp);
}

###########################################

Drwline<-function(...)
{
  varargin<-list(...)
  Nall<-length(varargin)
  Thick<-0
  Tmp<-varargin[[Nall]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1){
    Thick<-round(Tmp*PenThickInit)
    Str<-paste("\\special{pn ", as.character(Thick),"}%\n",sep="")
    cat(Str,file=Wfile,append=TRUE)
    Nall<-Nall-1
  }
  for (N in 1:Nall){
    Pdata<-varargin[[N]]
    if(length(Pdata)==0) next
    if(mode(Pdata)!="list") Pdata<-list(Pdata)
    while(Mixtype(Pdata)==3){         # 10.07.25
      Tmp1<- list()
      for(II in Looprange(1,length(Pdata))){
        Tmp1<- Mixjoin(Tmp1,Pdata[[II]])
      }
      Pdata<- Tmp1
    }                                  # 10.07.25
    for (II in Looprange(1,length(Pdata))){
      Clist<-MakeCurves(Pdata[[II]])
      DinM<-Dataindex(Clist)
      for (n in Looprange(1,Nrow(DinM))){
        Tmp<-DinM[n,]
        Data<-Clist[Tmp[1]:Tmp[2],]
        Mojisu<-0
        for (I in Looprange(1,Nrow(Data))){
          Tmp<-Data[I,]
          X<- sprintf("%5.0f",MilliIn*Tmp[1])   # 11.07.19
          Y<- sprintf("%5.0f",-MilliIn*Tmp[2])   # 11.07.19
          Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
          cat(Str,file=Wfile,append=TRUE)
          Mojisu<-Mojisu+nchar(Str)
          if(Mojisu>80){
            cat("%\n",file=Wfile,append=TRUE)
            Mojisu<-0
          }
        }
        if(Mojisu!=0){
           cat("%\n",file=Wfile,append=TRUE)
        }
        cat("\\special{fp}%\n",file=Wfile,append=TRUE)
      }
    }
  }
  Str<-"%"
  if(Thick>0){
    Tmp<-PenThick/PenThickInit
    Setpen(Tmp)
  }
}

###########################################

Drwpt<-function(...)
{       ##  Scaling is implemented
  varargin<-list(...)
  Nargs<-length(varargin)
  if(TenSize>TenSizeInit){
    N<- round(6*sqrt(TenSize/TenSizeInit))
  }
  else{
    N<-4
  }
  Tmp<- varargin[[Nargs]]
  if(mode(Tmp)=="numeric"){
    if(length(Tmp)>1){
      Kosa<- 1; All<- Nargs
    }
    else{
      Kosa<- Tmp; All<- Nargs-1
    }
  }
  else if(mode(Tmp)=="list"){
      Kosa<- 1; All<- Nargs
  }
  CL<-c()
  for (J in 0:N){
    Tmp<- TenSize*0.5*1000/2.54/MilliIn
    Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N))
    CL<- append(CL,Tmp)
  }
  CL<- matrix(CL,nrow=2)
  CL<- t(CL)
  for (II in Looprange(1,All)){
    MS<- varargin[[II]]
    MS=Flattenlist(MS) #17.10.11
    if(mode(MS)=="numeric"){
      MS<- list(MS)
    }
    for (I in Looprange(1,length(MS))){
      P<- MS[[I]]
      if(InWindow(P)!="i") next
      P<- Doscaling(P)
      PL<-c()
      for (J in 0:N){
        PL<- c(PL,P+CL[J+1,])
      }
      PL<-matrix(PL,nrow=2)
      PL<-t(PL)
      Mojisu<-0
      for (J in 1:Nrow(PL)){
        Q<- PL[J,]
        X<- as.character(round(MilliIn*Q[1]))
        Y<- as.character(-round(MilliIn*Q[2]))
        Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
        cat(Str,file=Wfile,append=TRUE)
        Mojisu<- Mojisu+nchar(Str)
        if(Mojisu>80){
          cat("#\n",file=Wfile,append=TRUE)
        }
        Mojisu=0
      }
      Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
      Str2<- "\\special{fp}%\n"
      cat(Str1,file=Wfile,append=TRUE)
      cat(Str2,file=Wfile,append=TRUE)
    }
  }
}

######################################################

Drwxy<-function(...)
{
  varargin<-list(...)
  Nargs <- length(varargin)
  Tmp<-grep("arrow", ZIKU)
  if(length(Tmp)>0)
  { 
    Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE)
    Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE)
  }
  else
  {
    Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2])))
    Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX)))
  }
  Letter(c(XMAX,GENTEN[2]),XPOS,XNAME)
  Letter(c(GENTEN[1],YMAX),YPOS,YNAME)
  Letter(GENTEN,OPOS,ONAME);
}

##########################################
# 10.12.04

Enclosing<- function(...)
{
  Eps=10^(-7) # Scilab 16.12.05
  varargin<- list(...)
  Nargs<- length(varargin)
  P<- varargin[[1]]
  if(Mixtype(P)==2){
    Tmp<- Op(1,P)
    if(mode(Tmp)!="numeric" || length(Tmp)>1){
      AnsL<- EnclosingS(...)
	  AnsL<- Joincrvs(AnsL)  # 10.12.04
    }
  }
  Tmp1=Op(1,AnsL) # Scilab 16.12.05from
  Tmp2=Op(nrow(AnsL),AnsL)
  if(Norm(Tmp2-Tmp1)>Eps){
    AnsL=Appendrow(AnsL,Tmp1)
  }
  return(AnsL)
}

#########################################

EnclosingS<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  AnsL<- list()
  PdataL<- varargin[[1]]
  Nall<-length(PdataL)
  Eps<- 10^(-3)
  EEps<- 0.1
  S<- c()
  Flg<- 0
  for (I in Looprange(2,Nargs)){
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
      S<- Tmp
    }
    if(mode(Tmp)=="numeric" && length(Tmp)==1){
      if(Flg==0){
        Eps<- Tmp
        Flg=Flg+1
      }
      else{
        EEps<- Tmp
      }
    }
  }
  F<- Op(1,PdataL); G<- Op(Nall,PdataL)
  KL<- IntersectcrvsPp(F,G)
  if(length(KL)==1){
    Tmp<- Op(1,KL)
    P<- Op(1,Tmp)
    T1<- Op(2,Tmp)
  }
  if(length(KL)==0){
    if(Numptcrv(F)>Numptcrv(G)){
      Tmp<- Nearestpt(F,G)
      P<- Op(1,Tmp)
      T1=Op(2,Tmp)
    }
    else{
      Tmp<- Nearestpt(G,F)
      P<- Op(3,Tmp)
      T1<- Op(4,Tmp)
    }
  }
  if(length(KL)>=2){
    if(length(S)==0){
      return("No Start Point")
    }
    Tmp<- Op(1,KL)
    P<- Op(1,Tmp)
    T1<- Op(2,Tmp)
    Tmp<- Norm(P-S)
    for (I in Looprange(2,length(KL))){
      Tmp1<- Op(1,Op(I,KL))
      Tmp2<- Norm(Tmp1-S)
      if(Tmp2<Tmp){
        P<- Tmp1
        T1<- Op(2,Op(I,KL))
        Tmp<- Tmp2
      }
    }
  }
  S<- P
  AnsL<- list()
  for (N in Looprange(1,Nall)){
    F<- Op(N,PdataL)
    if(N>1) P<- Q 
    if(N==Nall){
      Q=S
    }
    else{
      Flg<- 0
      G<- Op(N+1,PdataL)
      KL<- IntersectcrvsPp(G,F)
      if(length(KL)==1){
        Tmp<- Op(1,KL)
        Q<- Op(1,Tmp)
        T3<- Op(2,Tmp)
        Flg<- 10
      }
      if(length(KL)==0) Flg<- 1
      if(length(KL)>=2){ # Maple bug?
        Tmp1<- Op(1,Op(1,KL))
        Tmp2<- Op(1,Op(2,KL))
        Tmp<- Norm(Tmp1-Tmp2)
        if(Tmp<Eps*10) Flg<- 1 
      }
      if(Flg==1){
        if(Numptcrv(F)>Numptcrv(G)){
          Tmp<- Nearestpt(F,G)
          Q<- Op(1,Tmp)
          T3<- Op(4,Tmp)
          Flg<- 10
        }
        else{
          Tmp<- Nearestpt(G,F)
          Q<- Op(3,Tmp)
          T3<- Op(2,Tmp)
          Flg<- 10
        }
      }
      if(Flg<10){
        T2<- Inf
        for (I in Looprange(1,length(KL))){
          Dt<- Op(I,KL)
          Tmp1<- Op(1,Dt)
          Tmp<- Op(3,Dt)
          Tmp2<- Paramoncurve(Tmp1,Tmp,F)
          Tmp3<- Op(2,Dt)
          if(Tmp2>T1+Eps && Tmp2<T2-Eps){
            Q<- Tmp1
            T2<- Tmp2
            T3<- Tmp3
          }
        }
      }
    }
    Tmp<- Partcrv(P,Q,F)
    T1<- T3
    AnsL<- Mixjoin(AnsL,list(Tmp))
  }
  return(AnsL)
}

########################################

Endpicture<-function(...)
{
  varargin<-list(...)
  Nargs<-length(varargin)
  if(Nargs==0)
  {
    Drwxy()
  }
  else
  {
  if(varargin[[1]]==1) Drwxy()
  }
  cat("\\end{picture}}%",file=Wfile,append=TRUE)
#  MEMORI<<-MEMORINow*1000/2.54/MilliIn
  Setunitlen("1cm")
}

#########################################

Execmd<- function(StrL)
{
  if(mode(StrL)=="character" && length(StrL)==1){
    StrL<- list(StrL)
  }
  for (I in Looprange(1,length(StrL))){
    if(!is.na(Op(I,StrL)) && nchar(Op(I,StrL))>0){
      eval(parse(text=Op(I,StrL)))
    }
  }
}

#########################################

Expr<-function(...)
{     ## Scaling is implemented
  varargin<-list(...)
  Nargs<-length(varargin)
  Irng<-c(seq(from=1,to=Nargs,by=3))
  for (I in Irng)
  {
    Tmp<-varargin[[I]]
    P<- Doscaling(Tmp)
    X<-P[1]
    Y<-P[2]
    Houkou<-varargin[[I+1]]
    Mojiretu<-paste("$",varargin[[I+2]],"$",sep="")
    Hset<-Houkou
    Vhoko<-"c"
    if(length(grep("n",Hset))>0)
    {
      Vhoko<-"n"; Y<-Y+MEMORI
    }
    if(length(grep("s",Hset))>0)
    {
      Vhoko<-"s"; Y<-Y-MEMORI
    }
    Hhoko<-"c"
    if(length(grep("e",Hset))>0)
    {
      Hhoko<-"e"; X<-X+MEMORI
    }
    if(length(grep("w",Hset))>0)
    {
      Hhoko<-"w"; X<-X-MEMORI
    }
    Hoko<-paste(Vhoko,Hhoko,sep="")
    Suu<-"+-.0123456789"
    SuuL<-Suu
    J<-1; Dstr<-""
    while (J<=nchar(Houkou))
    {
      Tmp<-substring(Houkou,J,J)
      if(length(grep(Tmp,Suu))>0)
      {
        if(Dstr=="") Hk<-substring(Houkou,J-1,J-1)
        Dstr<-paste(Dstr,Tmp,sep="")
      }
      else
      {
        if(Dstr!="")
        {
          Nmbr<-as.numeric(Dstr)
          D<-Nmbr*MEMORI
          if(Hk=="n") Y<-Y+D
          if(Hk=="s") Y<-Y-D
          if(Hk=="e") X<-X+D
          if(Hk=="w") X<-X-D
          Dstr<-""
        }
      }
      J<-J+1
    }
    if(Dstr!="")
    {
      Nmbr<-as.numeric(Dstr)
      D<-Nmbr*MEMORI;
      if(Hk=="n") Y<-Y+D
      if(Hk=="s") Y<-Y-D
      if(Hk=="e") X<-X+D
      if(Hk=="w") X<-X-D
    }
    CalcWidth(Hoko,Mojiretu)
    CalcHeight(Hoko,Mojiretu)
    cat("\\put(",file=Wfile,append=TRUE)
    Tmp1<- sprintf("%7.7f",X)  # 11.07.19
    Tmp2<- sprintf("%7.7f",Y)  # 11.07.19
    Str<-paste(Tmp1,",",Tmp2,sep="")
    cat(Str,file=Wfile,append=TRUE)
    Tmp<-"){\\hspace*{\\Width}"
    Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") 
    cat(Str,file=Wfile,append=TRUE)
    cat("%\n",file=Wfile,append=TRUE)
  }
}

##########################################

Exprrot<- function(...)
{
  varargin<- list(...)
  P<- varargin[[1]]
  V<- varargin[[2]]; N<- 3
  P<- Doscaling(P)
  V<- Doscaling(V)
  Tmov<- 0
  Tmp<- varargin[[N]]
  if(mode(Tmp)=="numeric"){
    Tmov<- Tmp; N<- N+1
  }
  Nmov<- 0
  Tmp<- varargin[[N]]
  if(mode(Tmp)=="numeric"){
    Nmov<- Tmp; N<- N+1
  }
  Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26
  Tv<- 1/Norm(V)*V
  Nv<- c(-Tv[2],Tv[1])
  P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv
  Tmp<- acos(V[1]/Norm(V))
  Theta<- round(Tmp*180/pi)
  if(V[2]>=0){
    Units<- ""
  }
  else{
    Units<- "units=-360,"
  }
  Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="")
  Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="")
  Letter(P,"c",Tmp)
}

######################################################

Findcell<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  TbL<- varargin[[1]]
  Ag<- varargin[[2]]
  Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  if(mode(Ag)=="character"){
    Clm<- c()
    Rstr<- ""
    for (I in Looprange(1,nchar(Ag))){
      C<- substr(Ag,I,I)
      C<- toupper(C) 
      Tmp<- strsplit(Alpha,C)
      Tmp<- Tmp[[1]]
      if(length(Tmp)>1){
        Tmp1<- nchar(Tmp[1])
        Clm<- c(Clm,Tmp1)
      }
      else{
        Rstr<- paste(Rstr,C,sep="")
      }
    }
    Nrg<- 0
    for (I in seq(length(Clm),1,by=-1)){
      Tmp<- Clm[I]
      Tmp1<- length(Clm)-I
      Nrg<- Nrg+Tmp*26^Tmp1
    }
    Mrg<- eval(parse(text=Rstr))
    if(Nargs>=3){
      Ag<- varargin[[3]]
      Clm<- c()
      Rstr<- ""
      for (I in Looprange(1,nchar(Ag))){
        C<- substr(Ag,1,1)
        C<- toupper(C)
        Tmp<- strsplit(Alpha,C)
        if(length(Tmp)>1){
          Clm<- c(Clm,Tmp+1)
        }
        else{
          Rstr<- paste(Rstr,C,sep="")
        }
      }
      Nrg2<- 0
      for (I in seq(length(Clm),1,by=-1)){
        Tmp<- Clm[I]
        Tmp1<- length[Clm]-I
        Nrg2<- Nrg2+Tmp*26^Tmp1
      }
      Nrg<- c(Nrg,Nrg2)
      Tmp=eval(parse(text=Rstr))
      Mrg<- c(Mrg,Tmp)
    }
  }
  else{
    Nrg<- varargin[[2]]
    Mrg<- varargin[[3]]
  }
  if(length(Mrg)==1){
    m1<- Mrg; m2<- m1+1
  }
  else{
    m1<- Mrg[1]; m2<- Mrg[2]  # 10.12.12
  }
  if(length(Nrg)==1){
    n1<- Nrg; n2<- n1+1
  }
  else{
    n1<- Nrg[1]; n2<- Nrg[2]
  }
  n1<- n1+1; n2<- n2+1
  m1<- m1+1; m2<- m2+1
  Hind<- TbL[[2]]
  Vind<- TbL[[3]]
  Tmp<- TbL[[1]]
  HL<- Tmp[Hind]
  Tmp1<- Op(1,TbL[[4]])
  Tmp2<- Op(2,TbL[[4]])
  HL<- Mixjoin(list(Tmp1),HL,list(Tmp2))
  VL<- Tmp[Vind]
  Tmp1<- Op(1,TbL[[5]])
  Tmp2<- Op(2,TbL[[5]])
  VL<- Mixjoin(list(Tmp1),VL,list(Tmp2))
  Tmp<- TbL[[6]]
  Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp)))
  Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp)))
  HL<- Mixjoin(list(Tmp1),HL,list(Tmp2))
  Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp)))
  Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp)))  
  VL<- Mixjoin(list(Tmp1),VL,list(Tmp2))
  Tmp<- HL[[n1]]
  if(mode(Tmp)=="numeric"){
    H1<- Tmp[1,1]
  }
  else{
    Tmp1<- Tmp[[1]]
    H1<- Tmp1[1,1]
  }
  Tmp<- HL[[n2]]
  if(mode(Tmp)=="numeric"){
    H2<- Tmp[1,1]
  }
  else{
    Tmp1<- Tmp[[1]]
    H2<- Tmp1[1,1]
  }
  Tmp<- VL[[m1]]
  if(mode(Tmp)=="numeric"){
    V1<- Tmp[1,2]
  }
  else{
    Tmp1<- Tmp[[1]]
    V1<- Tmp1[1,2]
  }
  Tmp<- VL[[m2]]
  if(mode(Tmp)=="numeric"){
    V2<- Tmp[1,2]
  }
  else{
    Tmp1<- Tmp[[1]]
    V2<- Tmp1[1,2]
  }
  Pt<- c((H1+H2)/2,(V1+V2)/2)
  High<- (V1-V2)/2
  Wide<- (H2-H1)/2
  Out<- list(Pt,Wide,High)
  return(Out)
}

############################################

Flattenlist<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Out<- list()
  for(N in Looprange(1,Nargs)){
    D<- varargin[[N]]
    if(is.data.frame(D) || !is.list(D)){  # modify
      Out<- c(Out,list(D))
    }
    else{
      for(I in Looprange(1,length(D))){
        Ds<- D[[I]]
        Tmp<- Flattenlist(Ds)
        Out<- c(Out,Tmp)
      }
    }
  }
  return(Out)
}

############################################

Fontsize<- function(Ookisa)
{
  Str<- "%"
  S<- substr(Ookisa,1,1)
  if(S=="n"){
    Str<- "\\normalsize%"
  }
  if(S=="s"){
    if(nchar(Ookisa)==1){
      Tmp<- "n"
    }
    else{
      Tmp<- substr(Ookisa,2,2)
    }
    if(Tmp=="s"){
      Str<- "\\scriptsize%"
    }
    else{
      Str<- "\\small%"
    }
  }
  if(S=="f"){
    Str<- "\\footnotesize%"
  }
  if(S=="t"){
    Str<- "\\tiny%"
  }
  if(S=="l"){
    Str<- "\\large%"
  }
  if(S=="L"){
    if(nchar(Ookisa)==1){
      Tmp<- "a"
    }
    else{
      Tmp<- substr(Ookisa,2,2)
    }
    if(Tmp=="a"){
      Str<- "\\Large%"
    }
    else{
      Str<- "\\LARGE%"
    }
  }
  if(S=="h"){
    Str<- "\\huge%"
  }
  if(S=="H"){
    Str<- "\\Huge%"
  }
  cat(Str,file=Wfile,append=TRUE)
  cat("\n",file=Wfile,append=TRUE)
}

##########################################

Fracform<- function(...)
{
  varargin<- list(...)
  Eps<- 10^(-10)
  Nmax<- 1/Eps
  Nargs<- length(varargin)
  X<- varargin[[1]]
  Nr<- Nrow(X)
  X<- as.matrix(X,nrow=Nr)
  for (I in Looprange(2,Nargs)){
    Tmp<- varargin[[I]]
    if(mode(Tmp)!="numeric"){
      next
    }
    if(Tmp>1){
      Nmax<- Tmp
    }
    else if(Tmp>0){
      Eps<- Tmp
    }
  }
  Tmp<- rep("",length(X))
  Out<- matrix(Tmp,nrow=nrow(X))
  for (I in Looprange(1,nrow(X))){
    for (J in Looprange(1,ncol(X))){
      Dt<- X[I,J]
      if(mode(Dt)=="character"){
        Dt<- eval(parse(text=Dt))
      }
      R<- 1
      N<- 0
      Rmin<- R
      Nr<- N
      while (R>Eps && N<Nmax){
        N<- N+1
        M<- round(Dt*N)
        R<- abs(Dt-M/N)
        if(R<Rmin){
          Rmin<- R
          Nr<- N
        }
      }
      if(N==Nmax){
        N<- Nr
        M<- round(Dt*N)
      }
      Tmp<- as.character(M)
      if(N!=1){
        Tmp<- paste(Tmp,"/",as.character(N),sep="")
      }
      Out[I,J]<- Tmp
    }
  }
  if(nrow(Out)==1){
    Out<- as.character(Out)
  }
  return(Out)
}

##############################################
#   2011.12.17 ( list )

Framedata<-function(...)
{
  varargin<- Flattenlist(list(...))
  N<-length(varargin)
  if(N<= 1){
    H<- 1.0*10^(-4);
    PA<-c(XMIN+H,YMIN+H)
    PB<-c(XMAX-H,YMIN+H)
    PC<-c(XMAX-H,YMAX-H)
    PD<-c(XMIN+H,YMAX-H)
  }
  else{
    Tmp<-varargin[[N]]
    if(is.numeric(Tmp) && length(Tmp)==1){
      Dy<-Tmp; Dx<-Dy
      Tmp<-varargin[[N-1]]
      if(is.numeric(Tmp) && length(Tmp)==1){
         Dx<-Tmp
      }
      Tmp<-varargin[[1]]
      X<-Tmp[1]; Y<-Tmp[2]
      X1<-X-Dx; X2<-X+Dx; Y1<-Y-Dy; Y2<-Y+Dy
    }
    else{
      Tmp<-varargin[[1]]
      X1<-Tmp[1]; X2<-Tmp[2]
      Tmp<-varargin[[2]]
      Y1<-Tmp[1]; Y2<-Tmp[2]
    }
    PA<-c(X1,Y1); PB<-c(X2,Y1)
    PC<-c(X2,Y2); PD<-c(X1,Y2)
  }
  Out<- Listplot(c(PA,PB,PC,PD,PA))
  return(Out)
}

###################################

Hatchdata<- function(...)
{      ## Scaling is implemented
  varargin<- list(...)
  ShaL<- list()
  Nargs<- length(varargin)
  Kakudo<- 45
  Kankaku<- 0.125*1000/2.54/MilliIn
  Tmp<- Doscaling(c(XMIN,YMIN))
  Xmn<- Tmp[1]; Ymn<- Tmp[2]
  Tmp<- Doscaling(c(XMAX,YMAX))
  Xmx<- Tmp[1]; Ymx<- Tmp[2]
  for (N in seq(Nargs,1, by=-1))
  {
    Tmp<- varargin[[N]]
    if(mode(Tmp)=="list")
    {
      break
    }
  }
  if(N<Nargs)
  {
    Kakudo<- varargin[[N+1]]
    if(N==Nargs-2)
    {
      Kankaku<- 0.125*varargin[[Nargs]]
    }
  }
  NaitenL<- varargin[[1]]
  if(mode(NaitenL)!="list")
  {
    NaitenL<- list(NaitenL)
  }
  Ns<- 2
  StartP<- Op(1,NaitenL)
  if(mode(StartP)=="character")
  {
    StartP<- c((Xmn+Xmx)/2, (Ymn+Ymx)/2)
  }
  if(mode(varargin[[2]])=="numeric")
  {
    StartP<- varargin[[2]]
    StartP<- Doscaling(StartP)
    Ns<- 3
  }
  Tmp<- list()
  for ( I in Looprange(Ns,N))
  {
    Tmp1<- list(varargin[[I]])
    Tmp2<- Mixjoin(Tmp, Tmp1)
    Tmp<- Tmp2
  }
  Bdy<- Kyoukai(Tmp)
  Bdys<-list()
  for (I in 1:length(Bdy))
  {
    Tmp1<- Bdy[[I]]
    Tmp2<- Doscaling(Tmp1)
    Bdys<- Mixjoin(Bdys,list(Tmp2))
  }
  Bdy<- Bdys
  PtnL<- list()
  for (I in Looprange(1,length(NaitenL)))
  {
    Tmp<- Op(I, NaitenL)
    if(mode(Tmp)=="numeric")
    {
      Tmp1<- Naigai(Tmp,Bdy)
      Tmp2<- Mixjoin(PtnL, list(Tmp1))
      PtnL<- Tmp2
    }
    else
    {
      if(mode(Tmp)!="character")
      {
        return("Mode Error")
      }
      Ptn<-c()
      for (J in 1:nchar(Tmp))
      {
       if(Op(J,Tmp)=="i")
        {
          Ptn<- c(Ptn,1)
        }
        else
        {
          Ptn<- c(Ptn,0)
        }
      }
      PtnL<- Mixjoin(PtnL, list(Ptn))
    }
  }
  Call<- length(Bdy)
  Ptn<- c(seq(0, 0, length=Call))
  if(Member(Ptn,PtnL))
  {
    Wn<- Doscaling(Framedata())
    Tmp<- Mixjoin(Bdy,list(Wn))
    Bdy<- Tmp
    Tmp<- list()
    for (I in Looprange(1, length(PtnL)))
    {
      Tmp1<- c(Op(I,PtnL),1)
      Tmp2<- Mixjoin(Tmp,list(Tmp1))
      Tmp<- Tmp2
    }
    PtnL<- Tmp
  }
  V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180))
  Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180))
  Tmp<- Op(1,NaitenL)
  if(mode(Tmp)=="numeric" && length(Tmp)==2)
  {
    Tmp<- Doscaling(Tmp)
    Delta<- Tmp-StartP
    K<- trunc(Dotprod(Delta,Vm)/Kankaku)
    PA<- StartP+K*Kankaku*Vm
    Sha<- Makeshasen(PtnL,PA,V,Bdy)
    I <- 1
    while (length(Sha)>0)
    {
      Tmp<- Mixjoin(ShaL, list(Sha))
      ShaL <- Tmp
      Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy)
      I <- I+1
    }
    Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy)
    I<- 2
    while (length(Sha)>0)
    {
      for (J in 1:length(Sha))
      {
        Tmp<- Mixjoin(ShaL,list(Sha[[J]]))
        ShaL<- Tmp
      }
      Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy)
      I<- I+1
    }
  }
  else
  {
    Delta<- c(Xmn,Ymn)-StartP
    K1<- trunc(Dotprod(Delta,Vm)/Kankaku)
    Delta<- c(Xmx,Ymn)-StartP
    K2<- trunc(Dotprod(Delta,Vm)/Kankaku)
    Delta<- c(Xmx,Ymx)-StartP
    K3<- trunc(Dotprod(Delta,Vm)/Kankaku)
    Delta<- c(Xmn,Ymx)-StartP
    K4<- trunc(Dotprod(Delta,Vm)/Kankaku)
    IM<- max(K1,K2,K3,K4)
    Im<- min(K1,K2,K3,K4)
    for (I in Im:IM)
    {
      Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy)
      for (J in Looprange(1,length(Sha)))
      {
        Tmp<- Mixjoin(ShaL, list(Sha[[J]]))
        ShaL<- Tmp
      }
    }
  }
  ShaLs<-list()
  for (I in Looprange(1,length(ShaL)))
  {
    Tmp<- ShaL[[I]]
    Tmp1<- Unscaling(Tmp)
    Tmp2<- Mixjoin(ShaLs, list(Tmp1))
    ShaLs<- Tmp2
  }
  ShaL<- ShaLs
  return(ShaL)
}

######################################

Htickmark<- function(...)
{  ## Scaling is implemented 
  varargin<- list(...)
  Nargs<- length(varargin)
  ArgsL<- varargin
  if(mode(ArgsL[[1]])=="character"){
    Str<- ArgsL[[1]]
    Tmp<- strsplit(Str,"m")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      I<- nchar(Tmp[1])+1
    }
    else{
      I<- 0
    }
    Tmp<- strsplit(Str,"n")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      J<- nchar(Tmp[1])+1
    }
    else{
      J<- 0
    }
    Tmp<- strsplit(Str,"r")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      K=nchar(Tmp[1])+1
    }
    else{
      K<- 0
    }
    if(K>0){
      S<- substr(Str,K+1,nchar(Str))
      R<-  as.numeric(S)
      if(is.na(R)){
        R<- 1
      }
    }
    else{
      R<- 1
      K<- nchar(Str)+1
    }
    if(J>0){
      S<- substr(Str,J+1,K-1)
      Dn<-  as.numeric(S)
      if(is.na(Dn)){
        Dn<- 1
      }
    }
    else{
      Dn<- 1000
      J<- nchar(Str)+1
    }
    S<- substr(Str,I+1,J-1)
    Dm<- as.numeric(S)
    if(is.na(Dm)){
      Dm<- 1
    }
    ArgsL<- list()
    for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
    for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
  }
  MemoriList<- list()
  Memori<- list()
  for (N in 1:length(ArgsL)){
    Dt<- ArgsL[[N]]
    if(mode(Dt)=="numeric" && length(Dt)>1){
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(Dt[1],Dt[2])
      next
    }
    if(mode(Dt)=="character"){
      Memori<- Mixjoin(Memori,Dt)
    }
    else{
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(Dt,GENTEN[2])
    }
  }
  MemoriList<- Mixjoin(MemoriList,list(Memori))
  for (N in 1:length(MemoriList)){
    Dt<- MemoriList[[N]]
    Ndt<- length(Dt)
    X=Op(1,Dt)
    Y=Op(2,Dt)
    Tmp<-Doscaling(c(X,Y))
    X<- Tmp[1]
    Y<- Tmp[2]
    Moji<- Op(Ndt,Dt)
    Tmp1<- Unscaling(c(X,Y+MARKLEN))
    Tmp2<- Unscaling(c(X,Y-MARKLEN))
    Fd<- Listplot(c(Tmp1,Tmp2))
    Drwline(Fd)
    if(Ndt==3){
      Tmp<-Unscaling(c(X,Y-MARKLEN))
      Expr(Tmp,"s",Moji)
    }
    if(Ndt==4){
      Houkou<- Op(3,Dt)
      Tmp<-grep("s",Houkou)
      if(length(Tmp)>0){
        Tmp<-Unscaling(c(X,Y-MARKLEN))
        Expr(Tmp,Houkou,Moji)
      }
      else{
        Tmp<- Unscaling(c(X,Y+MARKLEN))
        Expr(Tmp,Houkou,Moji)
      }
    }
      cat("%\n",file=Wfile,append=TRUE)
  }
}

#############################################
#  2013.08.07

Integrate<- function(Fs,Vs, Intv){
  if(is.function(Fs)){
    Fn<- Fs
  }
  else{
    Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="")
    eval(parse(text=Str))
  }
  Tmp<- integrate(Fn, Intv[[1]], Intv[[2]])
  Out<- Tmp[[1]]
  return(Out)
}

#############################################

Intersectcrvs<-function(...)
{
  varargin<-list(...)
  Nargs<-length(varargin)
  Eps<-10^(-4)
  Tmp<-varargin[[Nargs]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1)
  {
    Eps<-Tmp
  }
  G1<-varargin[[1]]
  if(mode(G1)=="numeric")
  {
    G1<-list(G1)
  }
  G2<-varargin[[2]]
  if(mode(G2)=="numeric")
  {
    G2<-list(G2)
  }
  PL<-list()
  for (N in 1:length(G1))
  {
    for (M in 1:length(G2))
    {
      KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps)
      for (I in Looprange(1,length(KL)))
      {
        Tmp<-KL[[I]]
        P<-Tmp[1]
        PL<-append(PL,P)
      }
    }
  }
  return(PL)
}

###########################################

IntersectcrvsPp<-function(...)
{
  varargin<-list(...)
  Nargs<-length(varargin)
  G1<-varargin[[1]]; G2<-varargin[[2]]
  Eps<- 10.0^(-4)
  if(Nargs>2) Eps<-varargin[[3]]
  SqEps<- 10.0^(-10)
  Eps2<- 0.1
  if(Nargs>3) Eps2<-varargin[[4]]
  Data1<-G1
  Data2<-G2
  if(Nrow(Data1)==Nrow(Data2))
  {
    Tmp<-seq(Nrow(Data2),1, by=-1)
    Tmp1<-Data2[Tmp,] 
    Eps0<-10^(-6)
    Tmp2<-Norm(Data1-Data2)
    Tmp3<-Norm(Data1-Tmp1)  
    if(Tmp2<Eps0||Tmp3<Eps0)
    {
      KL<-list()
      return(KL)
    }
  }
  KL1<-list()
  KL2<-list() 
  for (I in Looprange(1,Nrow(Data1)-1))
  { 
    A<-Data1[I,]
    B<-Data1[I+1,]
    for (J in Looprange(1,Nrow(Data2)-1))
    {
      P<-Data2[J,]; Q<-Data2[J+1,]
      Tmp<-Koutenseg(A,B,P,Q,Eps,Eps2)
      if(mode(Tmp)=="list")
      {
        if(Tmp[[3]]==0)
        {
          Tmp1<-list(Tmp[[1]],Tmp[[2]],I,J)
          KL1<-append(KL1,list(Tmp1))
        }
        else
        {
          Tmp2<-list(Tmp[[1]],Tmp[[2]],I,J)
          KL2<-append(KL2, list(Tmp2))
        }
      } 
    }
  }
  KL<-list()
  if(length(KL1)>0)
  {
    Tmp<-KL1[[1]]
    P<-Tmp[[1]]
    T<-Tmp[[2]]
    I<-Tmp[[3]]
    J<-Tmp[[4]]
    Tmp<-list(P,I+T,J)
    KL<-list(Tmp)
  }
  for (N in Looprange(2,length(KL1)))
  {
    Tmp<-KL1[[N]] 
    P<-Tmp[[1]]
    Flg<-0
    for (K in 1:length(KL))
    {
      if(1>length(KL)) break
      Tmp<-KL[[K]]
      if(Norm(P-Tmp[[1]])^2<SqEps)
      {
        Flg<-1
        break
      }
    }
    if(Flg==0)
    {
      Tmp<-KL1[[N]]
      T<-Tmp[[2]]
      I<-Tmp[[3]]
      J<-Tmp[[4]]
      Tmp<-list(P,I+T,J)
      KL<-append(KL,list(Tmp))
    }
  }
  for (N in Looprange(1,length(KL2)))
  {
    Tmp<-KL2[[N]]
    P<-Tmp[[1]] 
    Flg<-0
    for (K in Looprange(1,length(KL)))
    {
      Tmp<-KL[[K]]
      if(Norm(P-Tmp[[1]])^2<SqEps)
      {
        Flg<-1
        break
      }
    }
    if(Flg==0)
    {
      Tmp<-KL2[[N]]
      T<-Tmp[[2]]
      T<-min(max(T,0),1)
      I<-Tmp[[3]]
      J<-Tmp[[4]]
      Tmp<-list(P,I+T,J)
      KL<-append(KL,list(Tmp))
    }
  }
  return(KL)
}

###########################################
# 13.12.20  debugged

Invdashline<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Nall<- Nargs; Sen<- 1 ; Gap<- 1
  Tmp<- varargin[[Nall]]
  if(is.numeric(Tmp) && length(Tmp)==1 && Tmp>0){ # 13.12.20
    Tmp1<- varargin[[Nall-1]]
    if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20
      Sen<- Tmp1; Gap<- Tmp
      Nall<- Nall-2
    }
    else{
       Sen<- Tmp; Gap<- Sen
       Nall<- Nall-1
    }
  }
  Sen<- 1000/2.54/MilliIn*Sen
  Gap<- 1000/2.54/MilliIn*Gap
  for (N in Looprange(1,Nall)){
    Figdata<- varargin[[N]]
    Makehasen(Figdata,Sen,Gap,1)
  }
}

#########################################

Invert<- function(Pd)
{
  OutL=Pd[nrow(Pd):1,]
  return(OutL)
}

############################################

InWindow<-function(PA)
{
  Eps<-10.0^(-6);
  if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20
    X<-PA[1]; Y<-PA[2];
    if(X>XMIN-Eps && X<XMAX+Eps && Y>YMIN-Eps && Y<YMAX+Eps)
      Rx<-"i"
    else
      Rx<-"o"
    return(Rx)
  }else{
    return("o")
  }
}

#######################################

Joincrvs<- function(...)
{
  varargin<- list(...)
  Nall<- length(varargin)
  Eps<- 10^(-4)
  Tmp<- varargin[[Nall]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1){
    Eps<- Tmp
    Nall<- Nall-1
  }
  QdL<- Flattenlist(varargin[1:Nall])  # 11.06.25
  if(length(QdL)==0){
    PtL<-c()
    return(PtL)
  }
  PtL<- Op(1,QdL)
  for (I in Looprange(2,length(QdL))){
    Qd<- Op(I,QdL)
    if(Numptcrv(Qd)<=1){next}  # 11.06.25
    P<- Ptend(PtL)
    S<- Ptstart(PtL)
    Q<- Ptstart(Qd)
    R<- Ptend(Qd)
    MN<- min(Norm(P-Q),Norm(P-R),Norm(S-Q),Norm(S-R))
    if(MN==Norm(P-R)){
      Qd<- Invert(Qd)
    }
    else if(MN==Norm(S-Q)){
      PtL=Invert(PtL)
    }
    else if(MN==Norm(S-R)){
      PtL<- Invert(PtL)
      Qd<- Invert(Qd)
    }
    if(MN>Eps){
      PtL<- Appendrow(PtL,Qd)
    }
    else{
      if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)}
      PtL<- Appendrow(PtL,Qd[2:nrow(Qd),])  # 11.06.25
    }
  }
  return(PtL)
}

########################################
# 2011.11.02

Joingraphics<- function(...)
{
  varargin<- list(...)
  Ls<- Flattenlist(varargin)
  N<- length(Ls)
  Tp<- Ls[[N]]
  Listflg<- 0
  if( is.character(Tp)){
    Tmp<- toupper(substr(Tp,1,1))
    if(Tmp=="L"){
      Listflg<- 1
    }
    N<- N-1
    Ls<- Ls[1:N]
  }
  if(Listflg==1){
    P<- Ls
  }
  else{
    P<- c()
    for (I in 1:N){
      Tmp<- Ls[[I]]
      P<- Appendrow(P,c(Inf,Inf))
      P<- Appendrow(P,Tmp)
    }
    P<- P[2:nrow(P),]
  }
  return(P)
}

########################################

Kouten<- function(PA,V,P,Q)
{
  Eps<- 10.0^(-6)
  A1<- PA[1]; A2<- PA[2]
  V1<- V[1]; V2<- V[2]
  P1<- P[1]; P2<- P[2]
  U1<- Q[1]-P1; U2<- Q[2]-P2
  Tmp<- Norm(P-Q)*Norm(V)
  if(Tmp==0)
  {
    Out<- list(Inf,-Inf)
    return(Out)
  }
  D<- U1*V2-U2*V1
  if(abs(D)/Tmp<Eps)
  {
    Out<- list(Inf,-Inf)
    return(Out)
  }
  S<- ((-A2+P2)*V1+(A1-P1)*V2)/D
  if(S>1+Eps || S<Eps)
  {
    Out<-list(Inf,-Inf)
    return(Out)
  }
  T<- ((-A2+P2)*U1+(A1-P1)*U2)/D
  Tmp<- PA+T*V
  Out<- list(T,Tmp,sign(D))
  return(Out)
}

##########################################

KoutenList<- function(PA,V,Bdy)
{
  Eps<-10.0^(-6)
  TenL<-list()
  for (N in 1:length(Bdy))
  {
    KL<- Op(N,Bdy)
    for (K in Looprange(1, Nrow(KL)-1))
    {
      P<- Op(K,KL); Q<- Op(K+1,KL)
      if(P!="/" && Q!="/")
      {
        Tmp<- Kouten(PA,V,P,Q);
        if(Tmp[[1]]!=Inf)
        {
          Ten<- append(Tmp,N)
          Flg<- 0
          NN<- length(TenL)
          I<- 1
          while (Flg==0 && I<=NN)
          {
            Tmp<- Op(I,TenL)
            if(Op(1,Ten)<Op(1,Tmp)-Eps)
            {
              Tmp1<- TenL[Looprange(1,I-1)]
              Tmp2<- TenL[Looprange(I,length(TenL))]
              TenL<- Mixjoin(Tmp1,list(Ten),Tmp2)
              Flg<-1
            }
            else
            if(Op(1,Ten)<Op(1,Tmp)+Eps)
            {
              if(Op(4,Ten)!=Op(4,Tmp))
              {
                Tmp1<- TenL[Looprange(1,I-1)]
                Tmp2<- TenL[Looprange(I,length(TenL))]
                TenL<- Mixjoin(Tmp1,list(Ten),Tmp2)
                Flg<-1
              }
              else
              if(Op(3,Ten)!=Op(3,Tmp))
              {
                Tmp1<- TenL[Looprange(I,I-1)]
                Tmp2<- TenL[Looprange(I+1,length(TenL))]
                TenL<- Mixjoin(Tmp1,Tmp2)
              }
              Flg<- 1
            }
            I<- I+1
          }
          if(Flg==0)
          {
            TenL<- Mixjoin(TenL,list(Ten))
          }
        }
      }
    }
  }
  return(TenL)
}

##########################################

Koutenseg<-function(...)
{
  #pointdata on AB at which AB intersects CD
  varargin<-list(...)
  Nargs<-length(varargin)
  Eps0 <- 10^(-4)
  A<-varargin[[1]]; V<-varargin[[2]]-A
  Sv2 <- V[1]^2+V[2]^2
  if(Sv2<10^(-6))
  {
    Out<-Inf
    return(Out)
  }    
  P<-varargin[[3]]-A; Q<-varargin[[4]]-A
  Eps <- 10.0^(-3)
  if(Nargs>=5)
  {
    Eps<-varargin[[5]]
  }
  Eps2 <- 0.2
  if(Nargs>=6)
  {
    Eps2<-varargin[[6]]
  }
  Eps<-min(Eps2,Eps/sqrt(Sv2))
  P1<-(P[1]*V[1]+P[2]*V[2])/Sv2
  P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2
  Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2
  Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2
  m1 <- -Eps; M1 <- 1+Eps
  m2 <- -Eps; M2 <- Eps
  if(max(P1,Q1)<m1 || min(P1,Q1)>M1)
  {
    Out<-Inf
    return(Out)
  }
  if(max(P2,Q2)<m2 || min(P2,Q2)>M2)
  {
    Out<-Inf
    return(Out)
  }
  if(P2*Q2<0)
  {
    T<- P1-(Q1-P1)/(Q2-P2)*P2
    if(T>m1 && T<M1)
    {
      if(T > -Eps0 && T<1+Eps0)
      {
        Tmp1<-A+T*V
        Tmp2<-min(max(T,0),1)
        Out<-list(Tmp1,Tmp2,0)
      }
      else
      {
        Tmp1<-A+T*V
        Tmp2<-min(max(T,0),1)
        Out<-list(Tmp1,Tmp2,1)
      }
      return(Out)
    }
    if(P1<m1 || P1>M1 || P2<m2 || P2>M2)
    {
      if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
      {
        Out<-Inf
        return(Out)
      }
      T<-min(max(Q1,0),1)
      Tmp=A+T*V
      Out<-list(Tmp,T,1)
      return(Out)
    }
    T<-min(max(P1,0),1)
    Tmp<-A+T*V
    Out<-list(Tmp,T,1)
    return(Out)
  }
  if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0)
  {
    T<- P1
    Tmp<- A+T*V
    Out<- list(Tmp, T, 0)
    return(Out)
  }
  if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2<Eps0)
  {
     T<- Q1
     Tmp<-A+T*V
     Out<- list(Tmp,T,0)
     return(Out)
  }
  if(P1<m1 || P1>M1 || P2<m2 || P2>M2)
  {
    if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
    {
      Out<-Inf      
      return(Out)
    }
    T<-min(max(Q1,0),1)
    Tmp<-A+T*V
    Out<-list(Tmp,T,1)
    return(Out)
  }
  if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
  {
    T<-min(max(P1,0),1)
    Tmp<-A+T*V
    Out<-list(Tmp,T,1)
    return(Out)
  }
  if(abs(P2)<abs(Q2))
  {
    T<-min(max(P1,0),1)
  }
  else
  {
    T<-min(max(Q1,0),1)
  }
  Tmp<A+T*V
  Out<-list(Tmp,T,1)
  return(Out)
}

##########################################

Kukeiwake<- function(PL)
{
  Eps<-10.0^(-6)
  NW<- c(XMIN,YMAX); SW<-c(XMIN,YMIN)
  SE<- c(XMAX,YMIN); NE<-c(XMAX,YMAX)
  Tmp<-matrix(c(NW,SW,SE,NE,NW),nrow=2)  
  Sikaku<- t(Tmp)
  Kt<- IntersectcrvsPp(PL,Sikaku)
  if(length(Kt)!=2)
  {
    print("not two points")
    return(c())
  }
  Tmp<- Op(1,Kt)
  Pt1<- Op(1,Tmp)
  N1<- trunc(Op(2,Tmp))
  M1<- Op(3,Tmp)
  Tmp<- Op(2,Kt)
  Pt2<- Op(1,Tmp)
  N2<- trunc(Op(2,Tmp))
  M2<- Op(3,Tmp)
  T1<- Paramoncurve(Pt1,M1,Sikaku) #18.02.06
  T2<- Paramoncurve(Pt2,M2,Sikaku)
  QL<c()
  if(Norm(Pt1-Op(N1+1,PL))>Eps)
  {
    QL<-Pt1
  }
  Tmp<-Appendrow(QL,PL[(N1+1):N2,])
  QL<- Tmp
  if(Norm(Pt2-Op(N2,PL))>Eps)
  {
    Tmp<-Appendrow(QL,Pt2)
    QL<- Tmp
  }
  HidariL<- QL
  Ms<- M2+1; Me<- M1
  if(T1<T2+Eps) Me<- M1+4
  for (M in Looprange(Ms,Me))
  {
    Tmp<- Op(Nrow(HidariL),HidariL)
    P<-Op(((M-1) %% 4)+1,Sikaku)
    if(Norm(Tmp-P)>Eps)
    {
      Tmp<-Append(HidariL,P)
      HidariL<-Tmp
    }
  }
  Tmp<- Op(Nrow(HidariL),HidariL)
  if(Norm(Tmp-Pt1)>Eps)
  {
    Tmp<-Append(HidariL,Pt1)
    HidariL<-Tmp
  }
  MigiL<- QL
  Ms<- M2; Me<- M1+1
  if(T1>T2-Eps) Me<- Me-4
  for (Mm in Looprange(Me,Ms))
  {
    M<- Me+Ms-Mm
    Tmp<- Op(Nrow(MigiL),MigiL)
    P<- Op(((M-1) %% 4)+1,Sikaku)
    if(Norm(Tmp-P)>Eps)
    {
      Tmp<-Appendrow(MigiL,P)
      MigiL<-Tmp
    }
  }
  Tmp<- Op(Nrow(MigiL),MigiL)
  if(Norm(Tmp-Pt1)>Eps)
  {
    Tmp<-Appendrow(MigiL,Pt1)
    MigiL<-Tmp
  }
  Out<- list(HidariL,MigiL)
  return(Out)
}

###################################
#  17.09.24   Eps

Kyoukai<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Eps0<- 10^(-7)
  DataL<-list()
  for (I in 1:Nargs){
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric"){
      DataL<- Mixjoin(DataL,list(list(Tmp)))
    }
    if(mode(Tmp)=="list"){
      if(mode(Tmp[[1]])!="list"){
        DataL<- Mixjoin(DataL, list(Tmp))
      }
      else{
        DataL<-Mixjoin(DataL,Tmp)
      }
    }
  }
  Eps<- 10.0^(-4)   #17.09.24
  PLall<- list()
  Sflg<- 0
  N<- length(DataL)
  for (I in 1:N){
    Data<- Op(I, DataL)
    Tmp<- Op(length(Data),Data)
    if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
      Rg<-Tmp ; Nd<-length(Data)-1
    }
    else{
      if(mode(Tmp)=="character"){
        Rg<- Tmp ; Nd<-length(Data)-1
      }
      else{ 
        Rg<- "c" ; Nd<-length(Data)
      }
    }
    for (J in Looprange(1,Nd)){
      Tmp<- Op(J,Data)
      if(mode(Tmp)=="character"){
        Rg<- Tmp
        next
      }
      Points<- Tmp
      P1<- Ptstart(Points)
      P2<- Ptend(Points)
      if(J==1){
        PL<- Points
        Pfirst<- P1
        Plast<- P2
        if(Nd>=2){
          Tmp<- Data[[2]]
          P<- Ptstart(Tmp)
          Q<- Ptend(Tmp)
          if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){
            Tmp< Nrow(PL)
            PL<-PL[Tmp:1,]
            Pfirst<- Ptstart(PL)
            Plast<- Ptend(PL)
          }
        }
      }
      else{
        if(Norm(P1-Plast)<Eps){ 
          Stp<-1; Ks<-2; Ke=Nrow(Points)
        }
        else{
          if(Norm(P2-Plast)<Eps) {
            Stp<- -1; Ks<-Nrow(Points)-1; Ke=1
          }
          else{
            Tmp<-Appendrow(PL,c(Inf,Inf),Points)
            PL<- Tmp
            Sflg<- 1
            Pfirst<- P1
            Plast<- P2
            Stp<- 1; Ks<- Nrow(Points)-1; Ke<- 1
          }
        }
        for (K in seq(Ks,Ke, by=Stp)){
          Tmp<- Appendrow(PL,Op(K,Points))
          PL<-Tmp
        }
        Plast<- Op(Ke,Points)
      }
    }  
    if(Norm(Pfirst-Plast)>Eps){
      Np<- Nrow(PL)
      if(Rg=="c"){
        Tmp<- Appendrow(PL,Pfirst)
        PL<- Tmp
      }
      else if(Rg=="s"){
        Tmp<- c(PL[1:Np,2],YMIN)
        Y<- min(Tmp)-1
        P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y)
        Tmp<- Appendrow(PL,P,Q,Pfirst)
        PL<- Tmp
      }
      else if(Rg=="n"){
        Tmp<- c(PL[1:Np,2],YMAX)
        Y<-max(Tmp)+1
        P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y)
        Tmp<- Appendrow(PL,P,Q,Pfirst)
        PL<- Tmp
      }
      else if(Rg=="w"){
        Tmp<- c(PL[1:Np,1],XMIN)
        X<- min(Tmp)-1
        P<- c(X,Plast[2]); Q<- c(X,Pfirst[2])
        Tmp<- Appendrow(PL,P,Q,Pfirst)
        PL<- Tmp
      }
      else if(Rg=="e"){
        Tmp<- c(PL[1:Np,1],XMAX)
        X<- max(Tmp)+1
        P<- c(X,Plast[2]); Q<- c(X,Pfirst[2])
        Tmp<- Appendrow(PL,P,Q,Pfirst)
        PL<- Tmp
      }
      else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){
        Tmp<- Kukeiwake(PL)
        Tmp1<- Op(1,Tmp)
        Tmp2<- Naigai(Rg,list(Tmp1)) 
        if(Tmp2==c(1)){
          PL<-Op(1,Tmp)
        }
        else{
          PL<- Op(2,Tmp)
        }
      }
    }
    Tmp<- Ptstart(PL)
    for (J in 2:Nrow(PL)){
      P<- Op(J,PL)
      Q<- Op(Nrow(Tmp),Tmp)
      if(Norm(P-Q)>Eps){
        Tmp1<-Appendrow(Tmp,P)
        Tmp<-Tmp1
      }
    }
    PL<-Tmp
    PLall<-Mixjoin(PLall,list(PL))
  }
  if(length(PLall)==1 && Sflg==0){
    Tmp<- Op(1,PLall)
#    Tmp<- Op(1,Tmp)
    if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){
       Tmp1<- Appendrow(Tmp,Ptstart(Tmp))
       PLall<- list(Tmp1)
    }
  }
  return(PLall)
}

######################################

Letter<-function(...)
{     ## Scaling is implemented
  varargin<-list(...)
  Nargs<-length(varargin)
  Irng<-c(seq(from=1,to=Nargs,by=3))
  for (I in Irng)
  {
    Tmp<-varargin[[I]] 
    P<- Doscaling(Tmp)
    X<-P[1]
    Y<-P[2]
    Houkou<-varargin[[I+1]]
    Mojiretu<-varargin[[I+2]]
    Hset<-Houkou
    Vhoko<-"c"
    if(length(grep("n",Hset))>0)
    {
      Vhoko<-"n"; Y<-Y+MEMORI
    }
    if(length(grep("s",Hset))>0)
    {
      Vhoko<-"s"; Y<-Y-MEMORI
    }
    Hhoko<-"c"
    if(length(grep("e",Hset))>0)
    {
      Hhoko<-"e"; X<-X+MEMORI
    }
    if(length(grep("w",Hset))>0)
    {
      Hhoko<-"w"; X<-X-MEMORI
    }
    Hoko<-paste(Vhoko,Hhoko,sep="")
    Suu<-"+-.0123456789"
    SuuL<-Suu
    J<-1; Dstr<-""
    while (J<=nchar(Houkou))
    {
      Tmp<-substring(Houkou,J,J)
      if(length(grep(Tmp,SuuL))>0)
      {
        if(Dstr=="") Hk<-substring(Houkou,J-1,J-1)
        Dstr<-paste(Dstr,Tmp,sep="")
      }
      else
      {
        if(Dstr!="")
        {
          Nmbr<-as.numeric(Dstr)
          D<-Nmbr*MEMORI
          if(Hk=="n") Y<-Y+D
          if(Hk=="s") Y<-Y-D
          if(Hk=="e") X<-X+D
          if(Hk=="w") X<-X-D
          Dstr<-""
        }
      }
      J<-J+1
    }
    if(Dstr!="")
    {
      Nmbr<-as.numeric(Dstr)
      D<-Nmbr*MEMORI;
      if(Hk=="n") Y<-Y+D
      if(Hk=="s") Y<-Y-D
      if(Hk=="e") X<-X+D
      if(Hk=="w") X<-X-D
    }
    CalcWidth(Hoko,Mojiretu)
    CalcHeight(Hoko,Mojiretu)
    cat("\\put(",file=Wfile,append=TRUE)
    Tmp1<- sprintf("%7.7f",X)  # 11.07.19
    Tmp2<- sprintf("%7.7f",Y)  # 11.07.19
    Str<-paste(Tmp1,",",Tmp2,sep="")
    cat(Str,file=Wfile,append=TRUE)
    Tmp<-"){\\hspace*{\\Width}"
    Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") 
    cat(Str,file=Wfile,append=TRUE)
    cat("%\n",file=Wfile,append=TRUE)
  }
}

######################################################

Letterrot<- function(...)
{
  varargin<- list(...)
  P<- varargin[[1]]
  V<- varargin[[2]]; N<- 3
  P<- Doscaling(P)
  V<- Doscaling(V)
  Tmov<- 0
  Tmp<- varargin[[N]]
  if(mode(Tmp)=="numeric"){
    Tmov<- Tmp; N<- N+1
  }
  Nmov<- 0
  Tmp<- varargin[[N]]
  if(mode(Tmp)=="numeric"){
    Nmov<- Tmp; N<- N+1
  }
  Mojiretu<- Assign(varargin[[N]]) #2017.11.26
  Tv<- 1/Norm(V)*V
  Nv<- c(-Tv[2],Tv[1])
  P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv
  Tmp<- acos(V[1]/Norm(V))
  Theta<- round(Tmp*180/pi)
  if(V[2]>=0){
    Units<- ""
  }
  else{
    Units<- "units=-360,"
  }
  Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="")
  Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="")
  Letter(P,"c",Tmp)
}

###################################
#  10.12.04

Lineplot<-function(...)
{  
 varargin <- list(...)
 Nargs<-length(varargin)
 A<-varargin[[1]]
 if(is.numeric(A)) {           
   Tmp<-length(A)
   if(Tmp>3) { 
     B <- A[(Tmp/2+1):Tmp]      
     A <- A[1:(Tmp/2)]       
     Is <- 2
   }
   else {                 
     B<-varargin[[2]]
     Is <- 3
   }                   
 }
 else {                
   B<-A[[2]]
   A<-A[[1]]
   Is <- 2
 }    
 Mag <- 100 ; Semi <- ""    ## 10.12.04
 for (I in Looprange(Is,Nargs)) {       
   Tmp <- varargin[[I]]
   switch ( mode(Tmp),
     "numeric"= Mag <- Tmp,
     "character"= Semi <- Tmp
   )
 }
V<- Mag/Norm(B-A)*(B-A)      ## 10.12.04 from here
 if(Semi=="") {
   Out<- Listplot(c(A-V,A+V))
 }
 else if(Semi=="+") {
   Out<- Listplot(c(A,A+V))
 }
 else {
   Out<- Listplot(c(A-V,A))
 }                                                ## 10.12.04 to here
 return(Out)       
}

################################

Listplot<-function(...)
{
  varargin<-list(...);
  Z<-c();
  for (I in 1:length(varargin))
  {
    Data<-varargin[[I]];
    if(mode(Data)=="numeric")
    {
      if(class(Data)=="numeric")
      {
        Tmp<-matrix(Data,nrow=2);
        Tmp<-t(Tmp);
        Z<-Appendrow(Z,Tmp)
      }
      else
        Z<-Appendrow(Z,Data)
    }
    else
    {
      for (J in 1:length(Data))
      {
        Tmp<-Data[[J]];
        Z<-Appendrow(Z,Tmp)
      }
    }
  }
 return(Z)
}

##############################

MakeBowdata <- function(PA,PB,H) 
{
 Eps <- 10^(-5)
 BOWSTART <<- PA  
 BOWEND <<- PB  
 D <- 1/2*Norm(PB-PA)  
 R <- (H^2+D^2)/(2*H)
 A1 <- PA[1]; A2<-PA[2]
 B1 <- PB[1]; B2<-PB[2]
 if(abs(A2-B2)>Eps){
#   x <- poly(0,"X")
#   y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)
#   Eq1 <- (A1-x)^2+(A2-y)^2-R^2
#   Tmp <- coeff(Eq1)
#   C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3]
  C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2  
  C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2  
  C2<- 1+(A1-B1)^2/(A2-B2)^2  
  Det <- sqrt(C1^2-4*C0*C2)  
  Ansx1 <- (-C1+Det)/(2*C2)  
  Ansx2 <- (-C1-Det)/(2*C2)  
  Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)
  PC <- c(Ansx1,Tmp)  
  Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)  
  PC2 <- c(Ansx2,Tmp)
 }
 else{
   Tmp <- 0.5*(PA+PB)
   PC <- Tmp+c(0,R-H)   # 11.06.02
   PC2 <- Tmp-c(0,R-H)
 }
 VA <- PA-PC
 VB <- PB-PC
 if(VA[1]*VB[2]-VA[2]*VB[1]<0) {  
   PC <- PC2
 }
 AngA <- acos((PA[1]-PC[1])/R)  
 if(PA[2]-PC[2]<0){  
   AngA <- -AngA
 }
 AngB <- acos((PB[1]-PC[1])/R)  
 if(PB[2]-PC[2]<0){  
   AngB <- -AngB
 }
 if(AngA>AngB) {
   AngB <- AngB+2*pi
 }
 Out <- list(PC,R,AngA,AngB)  
 return(Out)
}

####################################################

MakeCurves<-function(...){        ## Scaling is implemented
  varargin<-list(...)
  Figdata<-varargin[[1]]
  if(class(Figdata)=="numeric"){
    Figdata<-matrix(Figdata,nrow=1)
  } 
  Ptout<-1
  if(length(varargin)>=2) Ptout<-varargin[[2]]
  Eps<-10.0^(-6)
  IndM<-Dataindex(Figdata)
  Atos<-c()
  for (Nd in 1:Nrow(IndM)){
    Tmp<-IndM[Nd,]
    Motos<-Figdata[Tmp[1]:Tmp[2],]
    All<-Nrow(Motos)
    if(Nrow(Motos)==1){ 
      if(InWindow(Motos)=="o"){
        next
      }
      Tmp1<- as.numeric(Motos)
      if(Ptout==1){
        Drwpt(Tmp1)
      }
      else{
        Tmp1<- Doscaling(Tmp1)
        Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1)
        next
      }
    }
   Crv<-c()
   for (I in Looprange(2,All)){
      P<- Op(I-1,Motos)
      Q<- Op(I,Motos)
      Snbn<-MeetWindow(P,Q)
      if(length(Snbn)==0){
        if(length(Crv)>0){
          Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
          Crv<-c()
        }
      }
      else{
        if(Norm(Snbn[1,]-Snbn[2,])<Eps){ next}  # naosi 101202
        if(length(Crv)==0){
          Crv<-Snbn
        }
        else{
          Tmp<-Op(Nrow(Crv),Crv)
          if(Norm(Tmp-Op(1,Snbn))<Eps){
            Crv<-Appendrow(Crv,Op(2,Snbn))
          }
          else{
            Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
            Crv<-Snbn
          }
        }
      }
   }
   if(Nrow(Crv)>=2)
   {
     Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
   }
 }
  Outdata<-Atos[2:Nrow(Atos),]
  if(class(Outdata)=="numeric")
  {
    Outdata<-matrix(Outdata,nrow=1)
  }
  return(Outdata)
}

######################################

Makehasen<- function(Figdata,Sen,Gap,Ptn)
{
  Eps<- 10.0^(-6)
  Clist<- MakeCurves(Figdata)
  DinM<- Dataindex(Clist)
  for (N in Looprange(1,Nrow(DinM))){
    Tmp<- DinM[N,]
    Data<- Clist[Tmp[1]:Tmp[2],]
    Dtall<- Nrow(Data)
    Len<- 0
    Lenlist<- c(0)
    for (I in Looprange(2,Dtall)){
      Len<- Len+Norm(Data[I,]-Data[I-1,])
      Lenlist<- c(Lenlist,Len)
    }
    Lenall<- Lenlist[Dtall]
    if(Lenall==0){
      next
    }
    Kari<- (Sen+Gap)*0.1
    Naga<- Sen*0.1
    Tobi<- Gap*0.1
    if(Norm(Data[1,]-Data[Dtall,])<Eps){
      Nsen<- max(ceiling(Lenall/Kari),3)
      SegUnit<- Lenall/Nsen
      Naga<- SegUnit*Sen/(Sen+Gap)
      Tobi<- SegUnit*Gap/(Sen+Gap)
      SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
    }
    else{
      if(Ptn==0){
        Nsen<- max(ceiling((Lenall+Tobi)/Kari),3)
        SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap)
        Naga<- SegUnit*Sen/(Sen+Gap)
        Tobi<- SegUnit*Gap/(Sen+Gap)
        SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
      }
      else{
        Nsen<- max(ceiling((Lenall+Naga)/Kari),3)
        SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap)
        Naga<- SegUnit*Sen/(Sen+Gap)
        Tobi<- SegUnit*Gap/(Sen+Gap)
        SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit))
      }
    }
    Hajime<- 1; Owari<- 1
    Mojisu<- 0
    for (I in Looprange(1,length(SegList))){
      Len<- SegList[I]
      J<- Owari
      while (Len>=Lenlist[J]-Eps){
        if(J==Dtall){
          break
        }
        J<- J+1
      }
      Hajime<- J-1
      J<- Hajime
      while (Len+Naga>Lenlist[J]-Eps){
        if(J==Dtall){
          break
        }
        J<- J+1
      }
      Owari<- J-1
      T<- (Len-Lenlist[Hajime])
      T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime])
      P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,])
      X<- as.character(round(MilliIn*P[1]))
      Y<- as.character(-round(MilliIn*P[2]))
      Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
      cat(Str,file=Wfile,append=TRUE)
      Mojisu<- Mojisu+nchar(Str)
      for (J in Looprange(Hajime+1,Owari)){
        P<- Data[J,]
        X<- as.character(round(MilliIn*P[1]))
        Y<- as.character(-round(MilliIn*P[2]))
        Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
        cat(Str,file=Wfile,append=TRUE)
        Mojisu<- Mojisu+nchar(Str)
      }
      T<- (Len+Naga-Lenlist[Owari])
      T<- T/(Lenlist[Owari+1]-Lenlist[Owari])
      P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,])
      X<- as.character(round(MilliIn*P[1]))
      Y<- as.character(-round(MilliIn*P[2]))
      Str1<- paste("\\special{pa ",X," ",Y,"}",sep="")
      Str2<- "\\special{fp}"
      cat(Str1,file=Wfile,append=TRUE)
      cat(Str2,file=Wfile,append=TRUE)
      Mojisu<- Mojisu+nchar(Str1)+nchar(Str2)
      if(Mojisu>80){
        cat("%\n",file=Wfile,append=TRUE)
        Mojisu<- 0
      }
    }
  }
  cat("%\n%\n",file=Wfile,append=TRUE);
}

######################################

Makeliststr<- function(L)
{
  Out="list("
  for (I in 1:length(L)){
    Dt<- L[[I]]
    if(mode(Dt)=="numeric"){
      if(length(Dt)==1){
        Dts<- as.character(Dt)
      }
      else{
        Dts<- "c("
        for (J in Looprange(1,Nrow(Dt))){
          for (K in 1:ncol(Dt)){
            Dts<- paste(Dts,as.character(Dt[J,K]),sep="")
            if(K< ncol(Dt)){
              Dts<- paste(Dts,",",sep="")
            }
          }
          if(J<Nrow(Dt)){
            Dts<- paste(Dts,";",sep="")
          }
          else{
            Dts<- paste(Dts,")",sep="")
          }
        }
      }
    }
    if(mode(Dt)=="character"){
      Dts<- paste(Prime(),Dt,Prime(),sep="")
    }
    if(mode(Dt)=="list"){
      Dts<- Makeliststr(Dt)
    }
    Out<- paste(Out,Dts,sep="")
    if(I<length(L)){
      Out<- paste(Out,",")
    }
    else{
      Out<- paste(Out,")",sep="")
    }
  }
  return(Out)
}

############################################

Makeshasen<- function(PtnL,PA,V,Bdy)
{
  Eps<- 10^(-6)
  TenL<- KoutenList(PA,V,Bdy)
  Nten<- length(TenL)
  Call<- length(Bdy)
  Ptn<- c(seq(0, 0, length=Call))
  Out<- list()
  GL<- c()
  Te<- -10^6
  for (I in Looprange(1,Nten-1)){
    TenP<- Op(I,TenL); TenQ<- Op(I+1,TenL)
    Ts<- Op(1,TenP)
    P<- Op(2,TenP); Q<- Op(2,TenQ)
    NC<- Op(4,TenP)
    Tmp<- (Op(NC,Ptn)+1) %% 2
    Ptn[NC]<- Tmp
    if(Op(1,TenQ)-Ts>Eps){
      if(Member(Ptn,PtnL)){
        if(abs(Te-Ts)>Eps){
          if(Nrow(GL)>0){
            Tmp<- Mixjoin(Out, list(GL))
            Out<- Tmp
          }
          GL<- Listplot(P,Q)
        }
        else{
          Tmp <- Appendrow(GL, Q)
          GL<- Tmp
        }
        Te<- Op(1,TenQ)
      }
    }
  }
  if(Nrow(GL)>0){
    Tmp<- Mixjoin(Out, list(GL))
    Out<- Tmp
  }
  return(Out)
}

#############################################

Mawarikomi<- function(...)
{
  varargin<- list(...)
  haba<- "10cm"
  Nargs<- length(varargin)
  if(Nargs>0){ 
    haba<- varargin[[1]]
  }
  cat("\\begin{mawarikomi}%\n",file="",append=TRUE)
  cat("%<1>[5](0,0)%\n",file="",append=TRUE)
  Str<- paste("{",haba,"}{%\n",sep="")
  cat(Str,file="",append=TRUE)
  cat("}%\n",file="",append=TRUE)
  cat("\\end{mawarikomi}",file="",append=TRUE)
}

##############################################

MeetWindow<-function(PA,PB)
{
  if(InWindow(PA)=="i" && InWindow(PB)=="i")
  {
    R<-Appendrow(PA,PB)
    return(R)
  };
  Horner<-function(n,t)
  {
    PT<-(1-t)*PA+t*PB;
    return(PT[n])
  }
  Eps<-10.0^(-6);
  Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1);
  if(PA[1]!=PB[1])
  {
    Txm<-(XMIN-PA[1])/(PB[1]-PA[1]);
    TxM<-(XMAX-PA[1])/(PB[1]-PA[1]);
  }
  if(PA[2]!=PB[2])
  {
    Tym<-(YMIN-PA[2])/(PB[2]-PA[2]);
    TyM<-(YMAX-PA[2])/(PB[2]-PA[2]);
  }
  Tmp<-Horner(2,Txm);
  if(Tmp<YMIN-Eps || Tmp>YMAX+Eps)
  {
    Txm<-(-1);
  }
 Tmp<-Horner(2,TxM); 
  if(Tmp<YMIN-Eps || Tmp>YMAX+Eps)
  {
    TxM<-(-1)
  }
  Tmp<-Horner(1,Tym);
  if(Tmp<XMIN-Eps || Tmp>XMAX+Eps)
  {
    Tym<--1
  }
  Tmp<-Horner(1,TyM);
  if(Tmp<XMIN-Eps || Tmp>XMAX+Eps)
  {
    TyM<--1
  }
  Tans<-sort(c(Txm,TxM,Tym,TyM));
  Tmp<-c();
  for (I in 1:length(Tans))
  {
    Tmp1<-Tans[I];
    if(Tmp1>-Eps && Tmp1<1+Eps)
    {
      if(length(Tmp)==0)
      {
        Tmp<-c(Tmp1);
      }
      else
      {
        if(abs(Tmp[length(Tmp)]-Tmp1)>Eps)
        {
          Tmp<-c(Tmp,Tmp1)
        }
      }
    }
  }
  Tans<-Tmp;
  if(length(Tans)==0)
  {
    R<-c();
    return(R);
  }
  if(length(Tans)==1)
  {
    Ten1<-Horner(1:2,Tans[1]);
    if(InWindow(PA)=="i")
    {
      R<-Appendrow(PA,Ten1)
      return(R)
    }
    else
    {
      R<-Appendrow(Ten1,PB)
      return(R)
    }
  }
  Ten1<-Horner(1:2,Tans[1])
  Ten2<-Horner(1:2,Tans[2])
  R<-Appendrow(Ten1,Ten2)
  return(R)
}

#########################################

# New  10.03.21

Mixjoin<-function(...)
{
  varargin<-list(...)
  Nargs<- length(varargin)
  M<- list()
  for (I in 1:Nargs)
  {
    Tmp<-varargin[[I]]
    if(length(Tmp)==0) next
    if(Mixtype(Tmp)==1)
    {
      Tmp<-list(Tmp)
    }
    if(length(M)==0){
      M <- Tmp 
    }
    else{
      M<- c(M,Tmp)
    }
  }
  return(M)
}

#################################

Mixlength<- function(PL){ 
  if(length(PL)==0){
    return(0)
  }
  if(Mixtype(PL)==1){
    Out<- Nrow(PL) 
  }
  else{
    Out<- length(PL)
  }
  return(Out)
}

###########################################

Mixtype<- function(D)
{
  if(mode(D)!="list") return(1)
  for (I in 1:length(D))
  {
    Tmp<- D[[I]]
    if(mode(Tmp)=="list") return(3)
  }
  return(2)
}

###########################################

Naigai<- function(A,Bdy)
{
  V<- c(1,1)
  Call<-length(Bdy)
  KL<- KoutenList(A,V,Bdy)
  Ptn<- seq(1,1,length=Call)
  for (K in Looprange(1,length(KL)))
  {
    Ten<- Op(K,KL)
    T<- Op(1,Ten); NC<- Op(4,Ten)
    if(T<0)
    {
      Tmp<- (Ptn[NC]+1) %% 2
      Ptn[NC]<- Tmp
    }
  }
  return(Ptn)
}

########################################

Nearestpt<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  PL1<- varargin[[1]]
  if(!is.matrix(PL1)){
    Tmp<- matrix(PL1);
    PL1<- t(Tmp)
  }
  if(Nrow(PL1)==1) Flg=0
  else Flg=1
  Eps<- 10.0^(-6)
  PL<- varargin[[2]]
  Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,]))
  for(N in Looprange(1,Nrow(PL1))){
    PA<- PL1[N,]
    Pm<- PL[1,]
    Im<- 1
    Sm<- Norm(Pm-PA)
    for(I in Looprange(1,Nrow(PL)-1)){
      A1<- PL[I,1]; A2<-PL[I,2]
      B1<- PL[I+1,1]; B2<-PL[I+1,2]
      V1<- B1-A1; V2<-B2-A2
      X1<- PA[1]; X2<-PA[2]
      Tmp<-V2^2+V1^2
      if(abs(Tmp)<Eps) next
      T<- (-A2*V2-V1*A1+V1*X1+X2*V2)/Tmp
      if(T< -Eps){
        P<- c(A1,A2)
      }else{
        if(T>1+Eps){
          P<- c(B1,B2)
        }else{
          P<- c(A1+T*V1,A2+T*V2)
        }
      }
      S<- Norm(P-PA)
      if(S<Sm-Eps){
        Tmp<- Paramoncurve(P,I,PL)
        Pm<- P; Im<- Tmp; Sm<- S
      }
    }
    if(Sm<Op(5,Ans)) Ans<- list(PA,N,Pm,Im,Sm)
    if(Flg==0){
      Ans<- Ans[3:5]
    }
  }
  return(Ans)
}

#########################################

Newlength<- function()
{
  Tmp1<- "\\newlength{\\Width}%\n"
  Tmp2<- "\\newlength{\\Height}%\n"
  Tmp3<- "\\newlength{\\Depth}%\n"
  cat(Tmp1,file="",append=TRUE); 
  cat(Tmp2,file="",append=TRUE); 
  cat(Tmp3,file="",append=TRUE); 
}

#########################################

Numptcrv<-function(Fig)
{
  return(Nrow(Fig))
}

# 2018.01.29
Length<- function(Data){
  if(is.matrix(Data)){return(nrow(Data))}
  if(is.character(Data)){return(nchar(Data))}
  return(length(Data))
}

#########################################

Op<-function(N,Data)
{
  C <- c()
  if(length(Data)==0) return(C)
  if(mode(Data)=="list"){
    if(class(Data)=="data.frame"){   # 10.02.23
      C<- Data[N,]
    }
    else{ 
      C<- Data[[N]]
    }
    return(C)
  }
  if(mode(Data)=="character"){
    if(length(Data)==1){
      C<- substring(Data,N,N)
    }
    else{
      C<- Data[N]
    }
    return(C)
  }
  if(mode(Data)=="numeric"){
    if(class(Data)=="matrix"){
      Din<- Dataindex(Data)
      if(nrow(Din)==1){
        C<- Data[N,]
      }
      else{
        Tmp1<- Din[N,1]
        Tmp2<- Din[N,2]
        C<- Data[Tmp1:Tmp2,]
      }
    }
    else{
      C=Data[N]
    }
  }
  return(C)
}

#########################################
#  2013.05.20  Changed  ( Creator recorded)
#  2013.12.18  Beginpicture inclued

Openfile<-function(...)
{
  varargin<- list(...) 
  File<- varargin[[1]]
  Bflg<- 0
  Wfile<<- File
  Creator<- ""
  Cflg<- 0
  Nargs<- length(varargin)
  for(N in Looprange(2,Nargs)){
    Tmp<- varargin[[N]]
    Tmp1<- strsplit(Tmp,"=",fixed=TRUE)
    Tmp1<- Tmp1[[1]]
    if(length(Tmp1)>1){
      Creator<- Tmp1[2]
      Cflg<- 1
    }
    else{
      Unitstr<- Tmp
      Bflg<- 1
    }
  }
  Recentf<- "" 
  Fv<- list.files()
  Nv<- grep("\\.r$", Fv)
  Rfiles<-  Fv[Nv]
  StrW<- paste("%%% ",File,sep="") #17.10.28
  StrC<- paste("%%% Generator=",Creator,sep="")
  if(Cflg==0){
  }	
  cat(StrW,"\n",file=Wfile)
  cat(StrC,"\n",file=Wfile,append=TRUE)
  if(Bflg==1){
    Beginpicture(Unitstr)
  }
}

#########################################

Openpar<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Tmp<- varargin[[1]]
  Tmp1<- substr(Tmp,1,1)
  if(Tmp1=="\\"){
    Namestr<- Tmp
    N<- 2
  }
  else{
    Namestr<- "\\tmp"
    N<- 1
  }
  Habastr<- varargin[[N]]
  if(Nargs>N){
    Posstr<- paste("[",varargin[[N+1]],"]",sep="")
  }
  else{
    Posstr<- "[c]"
  }
  Openphr(Namestr)
  S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="")
  cat(S,file=Wfile,append=TRUE)
}

###################################

Openphr<- function(Str)
{
  S<- paste("\\def",Str,"{%\n",sep="")
  cat(S,file=Wfile,append=TRUE)
}

#####################################

Ovalbox<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Pos<- varargin[[1]]
  Dr<- varargin[[2]]
  StrV<- varargin[[3]]
  R<- 0.2
  NDflg<- 0
  for (I in Looprange(4,Nargs)){
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric"){
      R<- Tmp
    }
    else{
      if(substr(Tmp,1,1)=="-"){
        NDflg<- 1
        Tmp1<- substr(Tmp,2,nchar(Tmp))
        Cmdstr<- chartr("*","G",Tmp1)
      }
    }
  }
  Xr<- c(XMIN,XMAX)
  Yr<- c(YMIN,YMAX)
  Uv<- 0.6; Uh<- 0.8
  N<- nchar(StrV)
  W<- Uh;H<- Uv*N
  Setwindow(c(-W/2,W/2),c(-H,0))
  G<- Ovaldata(c(0,-H/2),W/2,H/2,R)
  Openphr("\\ketpictmp")
    Beginpicture("1cm")
    if(NDflg==0){
      Drwline(G)
    }
    else{
      eval(parse(text=Cmdstr))  
    }
    for (I in Looprange(1,N)){
      Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV))
    }
    Endpicture(0)
  Closephr()
  Setwindow(Xr,Yr)
  Letter(Pos,Dr,"\\ketpictmp")
}

##########################################

Ovaldata<- function(...) #17.09.11
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==1){
    Eps<- 1.0*10^(-4)
    C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2)
    Dx<- XMAX-C(1)-Eps
    Dy<- YMAX-C(2)-Eps
    N<- 1
  }
  else{
    C<- varargin[[1]]
    Dx<- varargin[[2]]
    Dy<- varargin[[3]]
    N<- 4
  }
  Rc<- 0.2
  if(N<=Nargs){ #15.11.15
    Rc<- varargin[[N]]*Rc #15.11.15
  }
  Out<- c()
  P<- C+c(Dx-Rc,Dy-Rc)
  Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29
  Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy))
  Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc))
  G<- Joincrvs(Tmp3,Tmp1,Tmp2)
  Tmp<- Reflectdata(G,c(C,C+c(0,1)))
  G<- Joincrvs(G,Tmp)
  Tmp<- Reflectdata(G,c(C,C+c(1,0)))
  Out<- Joincrvs(G,Tmp)
}

#########################################

Paramark<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  PA<- varargin[[1]]
  PB<- varargin[[2]]
  PC<- varargin[[3]]
  R<- 0.5
  if(Nargs>=4){
    R<- varargin[[4]]*R
  }
  U<- R*(PA-PB)/Norm(PA-PB)
  V<- R*(PC-PB)/Norm(PC-PB)
  if(Crossprod(PA-PB,PC-PB)!=0){
    P<- Listplot(c(PB+U,PB+U+V,PB+V))
  }
  else{
    P<- c()
  }
}

###########################################

Paramoncurve<-function(...){
  varargin<-list(...)  
  Nargs<-length(varargin)
  Eps<-10^(-8)
  P<-varargin[[1]]
  Gdata<-varargin[[Nargs]]
  if(Nrow(P)>1){
    Tmp<-P; P<-Gdata; Gdata<-Tmp
  }
  if(Nargs==2){
    Tmp<-Nearestpt(P,Gdata)
    Out<-Tmp[[2]]
    return(Out)
  }
  N<-varargin[[2]]
  PtL<-Gdata
  N=min(N,Length(PtL)-1) #18.02.11from
  Pa<-Ptcrv(N,PtL)
  Pb<-Ptcrv(N+1,PtL)
  V<-Pb-Pa
  W<-P-Pa
  D2<-Norm(V)^2
  if(D2<Eps) return(0)
  S<-Dotprod(V,W)/D2
  S<-min(max(S,0),1)
  Out=N+S  #18.02.11upto
  return(Out)
}

##############################################

Paramplot<- function(...)
{
  varargin<- list(...)
  Eps<- 10^(-5)
  Nargs<- length(varargin)
  Fnflg<- 0
  Fnstr<- varargin[[1]]; Is=2
  Rgstr<- varargin[[Is]]; Is<- Is+1
  Range<- c(0,2*pi)
  N<- 50      # Numpoints
  E<-c()       # Exclusions
  D<- Inf      # Discont
  for (I in Looprange(Is,Nargs))
  {
    Tmp<- varargin[[I]]
    Tmp<- strsplit(Tmp,"=")
    K<- Tmp[[1]]
    Tmp<- K[1]
    Lhs<-  substring(Tmp,1,1)
    Tmp1<- K[2]
    Str<-paste(Lhs,"=",Tmp1,sep="")
    eval(parse(text=Str))
  }
  Tmp<- strsplit(Rgstr,"=")
  K<-Tmp[[1]]
  if(length(K)>1)
  {
    Vname<- K[1]
    Tmp1<- K[2]
    Rng<- eval(parse(text=Tmp1))
  }
  else
  {
    Vname<- Rgstr
    Rng<- c(0,2*pi)
  }
  T1<- Rng[1]; T2<- Rng[2]
  Dt<- (T2-T1)/N #17.09.22
   if(Fnflg==0)
  {
    Str<-  gsub(Vname,"t",Fnstr)
  }
  if(abs(Dt)<Eps){ # 16.12.13
    t=T1
    P=eval(parse(text=Str))
    return(P)
  }
  P<-c()
  if(length(E)>0)
  {
    E<-sort(E)
    E<E[length(E):1]
  }
  E<- c(E, Inf)
  Tmp<- sort(E)
  E<- E[length(Tmp):1]
  Ke<- 1
#  for (t in seq(T1, T2+Eps, by=Dt)){#18.02.05
  for(jj in 1:(N+1)){
    t=T1+(jj-1)*Dt
    Pa<- c()
    if(t-E[Ke]< Eps)
    {
      if(Fnflg==0)
      {
        Tmp<-eval(parse(text=Str))
        Pa<- Tmp
      }
      else
      {
      }
    }
    if(abs(t-E[Ke])<=Eps)
    {
      if(Nrow(P)>0 && Op(Nrow(P),P)!=c(Inf,Inf))
      {
        Pa<- c(Inf,Inf)
      }
    }
    if(t-E[Ke]>Eps)
    {
      if(Fnflg==0)
      {
        Tmp<- eval(parse(text=Str))
        Pa<- Tmp
      }
      else
      {
      }
      Ke<-Ke+1
    }
    if(length(Pa)>0)
    {
      if(Pa[1]==Inf)
      {
        Tmp<-Appendrow(P,Pa)
        P<-Tmp
      }
      else
      {
        if(Nrow(P)==0)
        {
          Tmp<- Appendrow(P,Pa)
          P<-Tmp
        }          
        else
        {
          Tmp<- Op(Nrow(P),P)
          if(Tmp[1]==Inf)
          {
            Tmp<- Appendrow(P,Pa)
            P<- Tmp
          }
          else
          {
            if(Norm(Tmp-Pa)<D)
            {
              Tmp<-Appendrow(P,Pa)
              P<-Tmp
            }
            else
            {
              Tmp<- Appendrow(P,c(Inf,Inf),Pa)
              P<- Tmp
            }
          }
        }
      }
    }
  }
  Tmp<- Nrow(P)
  Tmp1<- Op(Tmp,P)
  if(Tmp1[1]==Inf)
  {
    P<- P[1:(Tmp-1),]
  }
  return(P)
}

#####################################

Partcrv<- function(A,B,PkL)
{
  Eps<- 10.0^(-3)
  if(mode(A)=="numeric" && length(A)==1){
    if(A>B+Eps){
      Npt<- Numptcrv(PkL)
      Out1<- Partcrv(A,Npt,PkL)
      Out2<- Partcrv(1,B,PkL)
      Tmp<- Ptstart(PkL)-Ptend(PkL)
      if(Norm(Tmp)<Eps){
        Ans<- Joincrvs(Out1,Out2)
      }
      else{
        Ans<- list(Out1,Out2)
      }
      return(Ans)
    }
    Is<- ceiling(A)
    Ie<- floor(B)
    PL<- c()
    if(A<Is-Eps){
      P<- (Is-A)*PkL[Is-1,]+(1-Is+A)*PkL[Is,]
      PL<- c(P)
    }
    PL<- Appendrow(PL, PkL[Looprange(Is,Ie),])
    if(B>Ie+Eps){
      P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,]
      PL<- Appendrow(PL,P)
    }
    Ans<- PL
    return(Ans)
  }
  Tmp<- Nearestpt(A,PkL)
  Ta<- Op(2,Tmp)
  Tmp<- Nearestpt(B,PkL)
  Tb<- Op(2,Tmp)
  Ans<- Partcrv(Ta,Tb,PkL)
}

##########################################
#  13.05.03

Partframe<- function(Tb,St,Ed)
{
  G<- Dividetable(Tb)
  Gw<- G[[1]]
  Gt<- G[[2]]
  Gy<- G[[3]]
  Gwt<- Tb[[4]]
  Gwy<- Tb[[5]]
  Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]]))
  Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]]))
  Tmp1<- Ptstart(Gat[[St[1]]])
  Tmp2<- Ptstart(Gay[[St[2]]])
  Ps<- c(Tmp1[1],Tmp2[2])
  Tmp1<- Ptstart(Gat[[Ed[1]]])
  Tmp2<- Ptstart(Gay[[Ed[2]]])
  Pe<- c(Tmp1[1],Tmp2[2])
  Pars<- Paramoncurve(Ps,Gw)
  Pare<- Paramoncurve(Pe,Gw)
  if(Pars<Pare){
    Out<- Partcrv(Pars,Pare,Gw)
  }
  else{
    Tmp1<- Partcrv(Pars,Numptcrv(Gw),Gw)
    Tmp2<- Partcrv(1,Pare,Gw)
    Out<- Joincrvs(Tmp1,Tmp2)
  }
return(Out)
}


##########################################
# 10.12.04

Plotdata<- function(...)
{
  varargin<- list(...)
  Eps<- 10^(-5)
  Fnstr<- varargin[[1]]; Is<- 2
  Fnflg<- 0
  Rgstr<- varargin[[Is]]; Is<- Is+1
  Tmp<- strsplit(Rgstr,"=")
  K<-Tmp[[1]]
  if(length(K)>1){
    Vname<- K[1]
    Tmp1<- K[2]
    Rng<- eval(parse(text=Tmp1))
  }
  else{
    Vname<- Rgstr
    Rng<- c(XMIN,XMAX)
  }
  N<- 50      # Numpoints
  E<-c()       # Exclusions
  Exfun<- ""  # Exclusion function
  D<- Inf      # Discont
  for (I in Looprange(Is,length(varargin))){
    Tmp<- varargin[[I]]
    Lhs<- substring(Tmp,1,1)
    Tmp<- strsplit(Tmp,"=")
    K<- Tmp[[1]]
    Tmp1<- K[2]
    Tmp2<- grep(Vname,Tmp1,fixed=TRUE)   ## 10.12.04
    if(length(Tmp2)==0){
      Str<-paste(Lhs,"=",Tmp1,sep="")
      eval(parse(text=Str))
    }
    else{
      Exfun<-Tmp1
    }
  }
  X1<- Rng[1]; X2<- Rng[2]
  dx<- (X2-X1)/N # 17.09.22
  if(Fnflg==0){
    Str<-  gsub(Vname,"x",Fnstr,fixed=TRUE)
  }
  if(abs(dx)<Eps){  # Scilab 16.12.13
    x=X1
    P=c(X1,eval(parse(text=Str)))
    return(P)
  }
  Exfun<- gsub(Vname,"x",Exfun,fixed=TRUE)
  P<-c()
  if(length(E)>0){
    E<-sort(E)
    E<E[length(E):1]
  }
  E<- c(E, Inf)
  Tmp<- sort(E)
  E<- E[length(Tmp):1]
  Ke<- 1
  for (x in seq(X1,X2,by=dx)){
    if(nchar(Exfun)>0){
      Tmp<-eval(parse(text=Exfun))
      if(abs(Tmp)<Eps){
        P<- Appendrow(P,c(Inf,inf))
        next
      }
    }
    Pa<- c()
    if(x-E[Ke]< -Eps){     ## 10.12.04
      Tmp<-eval(parse(text=Str))
      Pa<- c(x,Tmp)
    }
    if(abs(x-E[Ke])<=Eps){
      if(Nrow(P)>0 && P[Nrow(P),]!=c(Inf,Inf)){
        Pa<- c(Inf,Inf)
      }
    }
    if(x-E[Ke]>Eps){
      Tmp<- eval(parse(text=Str))
       Pa<- c(x,Tmp)
       Ke<-Ke+1
    }
    if(length(Pa)>0){
      if(Pa[1]==Inf){
        Tmp<-Appendrow(P,Pa)
        P<-Tmp
      }
      else{
        if(Nrow(P)==0){
          Tmp<- Appendrow(P,Pa)
          P<-Tmp
        }          
        else{
          Tmp<- P[Nrow(P),]
          if(Tmp[1]==Inf){
            Tmp<- Appendrow(P,Pa)
            P<- Tmp
          }
          else{
            if(Norm(Tmp-Pa)<D){
              Tmp<-Appendrow(P,Pa)
              P<-Tmp
            }
            else{
              Tmp<- Appendrow(P,c(Inf,Inf),Pa)
              P<- Tmp
            }
          }
        }
      }
    }
  }
  Tmp<- Nrow(P)
  Tmp1<-P[Tmp,]
  if(Tmp1[1]==Inf)
  {
    P<- P[1:(Tmp-1),]
  }
  return(P)
}

######################################

Pointoncurve<-function(...)
{
  varargin<-list(...)
  Eps<-10^(-4)
  T<-varargin[[1]]
  Gdata<-varargin[[2]]
  if(Nrow(T)>1)
  {
    Tmp<-T; T<-Gdata; Gdata<-Tmp
  }
  PtL<-Gdata
  N<-trunc(T+Eps);
  S<-max(T-N,0);
  if(N==Nrow(PtL))
  {
    Out<-PtL[N,]
  }
  else
  {
    Pa<-PtL[N,]
    Pb<-PtL[N+1,]
    Out<-(1-S)*Pa+S*Pb
  }
  return(Out)
}

##############################################
#  10.11.20
#  13.05.03   Inf

Pointdata<-function(...)
{
  varargin<-list(...)
  Nargs<-length(varargin)
  PL<- list()
  for (I in Looprange(1,Nargs)){     # 10.11.20
    DL<-varargin[[I]]
	DL<- Flattenlist(DL)                    # 10.11.20  from here
	for (J in Looprange(1,length(DL))){
      Dt<- DL[[J]]
      if(is.matrix(Dt)|| is.data.frame(Dt)){
        for (K in 1:nrow(Dt)){
          Tmp<- as.numeric(Dt[K,])
          if(Tmp[1]<Inf){
            PL<- c(PL,list(Tmp))
          }
        }
      }
      else{
        PL<- c(PL,list(Dt))
      }
    }
  }                                                      # to here
  if(length(PL)==1)
  {
    PL<-PL[[1]]
  }
  return(PL)
}

##############################################

Prime<- function(...)
{
  varargin<- list(...)
  if(length(varargin)==0){
    Out="'"
  }
  else{
    Out<- paste(varargin[[1]],"'",sep="")
  }
  return(Out)
}

############################################
# 17.09.29

Ptcrv<-function(N,Fig)
{
  if(is.matrix(Fig)){
    return(Fig[N,])
  }
  else{
    return(Fig)
  }
}

#########################################

Ptend<-function(Fig)
{
  if(Length(Fig)>0){ #18.02.09
    return(Op(Length(Fig),Fig))
  }else{
    return(c())
  }
}

#########################################

Ptne<-function(...)
{
  varargin<- list(...)
  if(length(varargin)==0){
    Out<- c(XMAX,YMAX)
  }
  else{
    G<- varargin[[1]]
    XM<- max(G[,1])
    YM<- max(G[,2])
    Out<- c(XM,YM)
  }
  return(Out)
}

#########################################

Ptnw<-function(...)
{
  varargin<- list(...)
  if(length(varargin)==0){
    Out<- c(XMIN,YMAX)
  }
  else{
    G<- varargin[[1]]
    Xm<- min(G[,1])
    YM<- max(G[,2])
    Out<- c(Xm,YM)
  }
  return(Out)
}

#########################################

Ptse<-function(...)
{
  varargin<- list(...)
  if(length(varargin)==0){
    Out<- c(XMAX,YMIN)
  }
  else{
    G<- varargin[[1]]
    XM<- max(G[,1])
    Ym<- min(G[,2])
    Out<- c(XM,Ym)
  }
  return(Out)
}

#############################################

Ptstart<-function(Fig)
{
  if(Length(Fig)>0){ #18.02.09
    return(Op(1,Fig))
  }else{
    return(c())
  }
}

#########################################

Ptsw<-function(...)
{
  varargin<- list(...)
  if(length(varargin)==0){
    Out<- c(XMIN,YMAX)
  }
  else{
    G<- varargin[[1]]
    Xm<- min(G[,1])
    Ym<- min(G[,2])
    Out<- c(Xm,Ym)
  }
  return(Out)
}

##############################################

Putcell<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  TbL<- varargin[[1]]
  Str<- varargin[[Nargs]]
  if(mode(Str)=="numeric"){
    Str<- as.character(Str)
  }
  Pos<- varargin[[Nargs-1]]
  Nrg<- varargin[[2]]
  if(mode(Nrg)=="character"){
    if(Nargs==4){
      Cell<- Findcell(TbL,Nrg)
    }
    else{
      Mrg<- varargin[[3]]
      Cell<- Findcell(TbL,Nrg,Mrg)
    }
  }
  else{
    Mrg<- varargin[[3]]
    Cell<- Findcell(TbL,Nrg,Mrg)
  }
  Pt<- Cell[[1]]; Dr<- "c"
  Posh<- substr(Pos,1,1)
  Post<- substr(Pos,2,nchar(Pos))
  if(toupper(Posh)=="R"){
    Pt<- Pt+c(Cell[[2]],0)
    if(nchar(Post)==0){
      Dr<- "w1"
    }
    else{
      Dr<- paste("w",Post,sep="")
    }
  }
  if(toupper(Posh)=="L"){
    Pt=Pt-c(Cell[[2]],0)
    if(nchar(Post)==0){
      Dr<- "e1"
    }
    else{
      Dr<- paste("e",Post,sep="")
    }
  }
  if(toupper(Posh)=="U"){
    Pt<- Pt+c(0,Cell[[3]])
    if(nchar(Post)==0){
      Dr<- "s1"
    }
    else{
      Dr<- paste("s",Post,sep="")
    }
  }
  if(toupper(Posh)=="D"){
    Pt<- Pt-c(0,Cell[[3]])
    if(nchar(Post)==0){
      Dr<- "n1"
    }
    else{
      Dr<- paste("n",Post,sep="")
    }
  }
  if(toupper(Posh)=="B"){
    Pt<- Pt-c(0,Cell[[3]])
    if(nchar(Post)==0){
      Dr<- "n1"
    }
    else{
      Dr<- paste("n",Post,sep="")
    }
    Str<- paste("$\\mathstrut$",Str,sep="")
  }
  Letter(Pt,Dr,Str)
}

#############################################

PutcoL<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  TbL<- varargin[[1]]
  if(mode(TbL)!="list"){
    return("Tabledata missing")
  }
  Ag<- varargin[[2]]
  if(mode(Ag)=="numeric"){
    CoL<- Ag
  }
  else{    
    Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Clm<- c()
    for (I in Looprange(1,nchar(Ag))){
      C<- substr(Ag,I,I)
      C<- toupper(C) 
      Tmp<- strsplit(Alpha,C)
      Tmp<- Tmp[[1]]
      if(length(Tmp)>1){
        Tmp1<- nchar(Tmp[1])
        Clm<- c(Clm,Tmp1)
      }
    }
    Nrg<- 0
    for (I in seq(length(Clm),1,by=-1)){
      Tmp<- Clm[I]
      Tmp1<- length(Clm)-I
      Nrg<- Nrg+Tmp*26^Tmp1
    }
    CoL<- Nrg
  }
  Nc<- length(TbL[[3]])+1
  K<- 1
  Dpos<- varargin[[3]]
  for (I in Looprange(4,Nargs)){
    if(I-3>Nc){ 
      break
    }
    Dt<- varargin[[I]]
    if(mode(Dt)!="list"){
      Putcell(TbL,CoL,K,Dpos,Dt) #  2011.03.02
      K<- K+1
    }
    else{
      N<- length(Dt)
      Str<- Dt[[N]]
      Rrng<- c(K,K+1)
      Pos<- Dpos
      for (J in Looprange(1,N-1)){
        Tmp<- Dt[[J]]
        if(mode(Tmp)=="numeric"){
          Rrng<- c(K,K+Tmp)
        }
        if(mode(Tmp)=="character"){
          Pos<- Tmp
        }
      }
      Putcell(TbL,CoL,Rrng,Pos,Str)
      K<- Crng[2]
    }
  }
}

Putcol<- function(...)
{
 PutcoL(...)
}

PutcoLexpr<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  TbL<- varargin[[1]]
  if(mode(TbL)!="list"){
    return("Tabledata missing")
  }
  Ag<- varargin[[2]]
  if(mode(Ag)=="numeric"){
    CoL<- Ag
  }
  else{    
    Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Clm<- c()
    for (I in Looprange(1,nchar(Ag))){
      C<- substr(Ag,I,I)
      C<- toupper(C) 
      Tmp<- strsplit(Alpha,C)
      Tmp<- Tmp[[1]]
      if(length(Tmp)>1){
        Tmp1<- nchar(Tmp[1])
        Clm<- c(Clm,Tmp1)
      }
    }
    Nrg<- 0
    for (I in seq(length(Clm),1,by=-1)){
      Tmp<- Clm[I]
      Tmp1<- length(Clm)-I
      Nrg<- Nrg+Tmp*26^Tmp1
    }
    CoL<- Nrg
  }
  Nc<- length(TbL[[3]])+1
  K<- 1
  Dpos<- varargin[[3]]
  for (I in Looprange(4,Nargs)){
    if(I-3>Nc){ 
      break
    }
    Dt<- varargin[[I]]
    if(mode(Dt)!="list"){
      Dt<- paste("$",Dt,"$",sep="")
      Putcell(TbL,CoL,K,Dpos,Dt)  #  2011.03.02
      K<- K+1
    }
    else{
      N<- length(Dt)
      Str<- paste("$",Dt[[N]],"$",sep="")
      Rrng<- c(K,K+1)
      Pos<- Dpos
      for (J in Looprange(1,N-1)){
        Tmp<- Dt[[J]]
        if(mode(Tmp)=="numeric"){
          Rrng<- c(K,K+Tmp)
        }
        if(mode(Tmp)=="character"){
          Pos<- Tmp
        }
      }
      Putcell(TbL,CoL,Rrng,Pos,Str)
      K<- Crng[2]
    }
  }
}

Putcolexpr<- function(...)
{
 PutcoLexpr(...)
}

#####################################################

PutcoLstr<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Tb<- varargin[[1]]
  Nr<- varargin[[2]]
  Pos<- varargin[[3]]
  Str<- varargin[[4]]
  Sep<- ""
  if(Nargs>4){
    Sep<- varargin[[5]]
  }
  if(nchar(Sep)==0){
    for (I in Looprange(1,nchar(Str))){
      Tmp<- substr(Str,I,I)
      Putcell(Tb,Nr,I,Pos,Tmp)
    }
  }
  else{
    Ltr<- ""
    K<- 1
    for (I in Looprange(1,length(Str))){
      Tmp<- substr(Str,I,I)
      if(Tmp==Sep){
        Putcell(Tb,Nr,K,Pos,Ltr)
        K<- K+1
        Ltr<- ""
      }
      else{
        Ltr<- paste(Ltr,Tmp,sep="")
      }
    }
    if(nchar(Ltr)>0){
      Putcell(Tb,Nr,K,Pos,Ltr)
    }
  }
}

#############################################

Putrow<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  TbL<- varargin[[1]]
  if(mode(TbL)!="list"){
    return("Tabledata missing")
  }
  Row<- varargin[[2]]
  Nr<- length(TbL[[2]])+1
  K<- 1
  Dpos<- varargin[[3]]
  for (I in Looprange(4,Nargs)){
    if(I-3>Nr){ 
      break;
    }
    Dt<- varargin[[I]]
    if(mode(Dt)!="list"){
      Putcell(TbL,K,Row,Dpos,Dt)  # 110308
      K<- K+1
    }
    else{
      N<- length(Dt)
      Str<- Dt[[N]]
      Crng<- c(K,K+1)
      Pos<- Dpos
      for (J in Looprange(1,N-1)){
        Tmp<- Dt[[J]]
        if(mode(Tmp)=="numeric"){
          Crng<- c(K,K+Tmp)
        }
        if(mode(Tmp)=="character"){
          Pos<- Tmp
        }
      }
      Putcell(TbL,Crng,Row,Pos,Str)
      K<- Crng[2]
    }
  }
}

Putrowexpr<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  TbL<- varargin[[1]]
  if(mode(TbL)!="list"){
    return("Tabledata missing")
  }
  Row<- varargin[[2]]
  Nr<- length(TbL[[2]])+1
  K<- 1
  Dpos<- varargin[[3]]
  for (I in Looprange(4,Nargs)){
    if(I-3>Nr){ 
      break;
    }
    Dt<- varargin[[I]]
    if(mode(Dt)!="list"){
      Dt<- paste("$",Dt,"$",sep="")
      Putcell(TbL,K,Row,Dpos,Dt)  #110308
      K<- K+1
    }
    else{
      N<- length(Dt)
      Str<- paste("$",Dt[[N]],"$",sep="")
      Crng<- c(K,K+1)
      Pos<- Dpos
      for (J in Looprange(1,N-1)){
        Tmp<- Dt[[J]]
        if(mode(Tmp)=="numeric"){
          Crng<- c(K,K+Tmp)
        }
        if(mode(Tmp)=="character"){
          Pos<- Tmp
        }
      }
      Putcell(TbL,Crng,Row,Pos,Str)
      K<- Crng[2]
    }
  }
}

####################################################

Putrowstr<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Tb<- varargin[[1]]
  Nr<- varargin[[2]]
  Pos<- varargin[[3]]
  Str<- varargin[[4]]
  Sep<- ""
  if(Nargs>4){
    Sep<- varargin[[5]]
  }
  if(nchar(Sep)==0){
    for (I in Looprange(1,nchar(Str))){
      Tmp<- substr(Str,I,I)
      Putcell(Tb,I,Nr,Pos,Tmp)
    }
  }
  else{
    Ltr<- ""
    K<- 1
    for (I in Looprange(1,length(Str))){
      Tmp<- substr(Str,I,I)
      if(Tmp==Sep){
        Putcell(Tb,K,Nr,Pos,Ltr)
        K<- K+1
        Ltr<- ""
      }
      else{
        Ltr<- paste(Ltr,Tmp,sep="")
      }
    }
    if(nchar(Ltr)>0){
      Putcell(Tb,K,Nr,Pos,Ltr)
    }
  }
}

############################################
# 11.05.28

Ratiocmyk<- function(Color)
{
  if(is.numeric(Color)){
    return(Color)
  }
  R<- 
  switch(Color,
    greenyellow=c(0.15,0,0.69,0),
    yellow=c(0,0,1,0),
    goldenrod=c(0,0.1,0.84,0),
    dandelion=c(0,0.29,0.84,0),
    apricot=c(0,0.32,0.52,0),
    peach=c(0,0.5,0.7,0),
    melon=c(0,0.46,0.5,0),
    yelloworange=c(0,0.42,1,0),
    orange=c(0,0.61,0.87,0),
    burntorange=c(0,0.51,1,0),
    bittersweet=c(0,0.75,1,0.24),
    redorange=c(0,0.77,0.87,0),
    mahogany=c(0,0.85,0.87,0.35),
    maroon=c(0,0.87,0.68,0.32),
    brickred=c(0,0.89,0.94,0.28),
    red=c(0,1,1,0),
    orangered=c(0,1,0.5,0),
    rubinered=c(0,1,0.13,0),
    wildstrawberry=c(0,0.96,0.39,0),
    salmon=c(0,0.53,0.38,0),
    carnationpink=c(0,0.63,0,0),
    magenta=c(0,1,0,0),
    violetred=c(0,0.81,0,0),
    rhodamine=c(0,0.82,0,0),
    mulberry=c(0.34,0.9,0,0.02),
    redviolet=c(0.07,0.9,0,0.34),
    fuchsia=c(0.47,0.91,0,0.08),
    lavender=c(0,0.48,0,0),
    thistle=c(0.12,0.59,0,0),
    orchid=c(0.32,0.64,0,0),
    darkorchid=c(0.4,0.8,0.2,0),
    purple=c(0.45,0.86,0,0),
    plum=c(0.5,1,0,0),
    violet=c(0.79,0.88,0,0),
    royalpurple=c(0.75,0.9,0,0),
    blueviolet=c(0.86,0.91,0,0.04),
    periwinkle=c(0.57,0.55,0,0),
    cadetblue=c(0.62,0.57,0.23,0),
    cornflowerblue=c(0.65,0.13,0,0),
    midnightblue=c(0.98,0.13,0,0.43),
    navyblue=c(0.94,0.54,0,0),
    royalblue=c(1,0.5,0,0),
    blue=c(1,1,0,0),
    cerulean=c(0.94,0.11,0,0),
    cyan=c(1,0,0,0),
    processblue=c(0.96,0,0,0),
    skyblue=c(0.62,0,0.12,0),
    turquoise=c(0.85,0,0.2,0),
    tealblue=c(0.86,0,0.34,0.02),
    aquamarine=c(0.82,0,0.3,0),
    bluegreen=c(0.85,0,0.33,0),
    emerald=c(1,0,0.5,0),
    junglegreen=c(0.99,0,0.52,0),
    seagreen=c(0.69,0,0.5,0),
    green=c(1,0,1,0),
    forestgreen=c(0.91,0,0.88,0.12),
    pinegreen=c(0.92,0,0.59,0.25),
    limegreen=c(0.5,0,1,0),
    yellowgreen=c(0.44,0,0.74,0),
    springgreen=c(0.26,0,0.76,0),
    olivegreen=c(0.64,0,0.95,0.4),
    rawsienna=c(0,0.72,1,0.45),
    sepia=c(0,0.83,1,0.7),
    brown=c(0,0.81,1,0.6),
    tan=c(0.14,0.42,0.56,0),
    gray=c(0,0,0,0.5),
    black=c(0,0,0,1),
    white=c(0,0,0,0)
  )
  if(length(R)<4){
    print("No color")
    return(c())
  }
  return(R)
}

############################################
# 11.01.07

Readtextdata<- function(...)
{
  varargin<- list(...)
  OutL<- list()
  Nargs<- length(varargin)
  Fname<- varargin[[1]]
  Tmp<- readLines(Fname,n=1)
  if(length(grep("\t",Tmp))>0){
    Sep<- "\t"
  }
  else if(length(grep(",",Tmp))>0){
    Sep<- ","
  }
  else{
    Sep<- " "
  }
  Hajime<- c(1,1)
  Owari<- c(Inf,Inf)
  C<- Inf
  R<- Inf
  Rna<- FALSE
  Cna<- TRUE
  Mat<- FALSE
  Num<- TRUE
  D<- -Inf
  Flg<- 0
  for (I in Looprange(2,Nargs)){
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric"){
      if  (Flg==0){
        Hajime<- Tmp
        Flg<- 1
      }
      else{
        Owari<- Tmp
      }
    }
    else{
      eval(parse(text=Tmp))
    }
  }
  Tmp<- Hajime+c(R-1,C-1)
  Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2]))
  if(Cna){
    Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE)
  }
  else{
    Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE)
    Nv<- c(1:ncol(Df))
    colnames(Df)<- Nv
  }
  if(Rna){
    rownames(Df)<-Df[,1]
    Hajime<- Hajime+c(0,1)
  }
  if(Mat){
    M<- as.matrix(Df)
    Tmp1<- min(Owari[1],nrow(M))
    Tmp2<- min(Owari[2],ncol(M))
    Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2])
    if(Num){
      Tmp1<- as.numeric(Out)
      Out<- matrix(Tmp1,nrow=nrow(Out))
    }
  }
  else{
    Tmp1<- min(Owari[1],nrow(Df))
    Tmp2<- min(Owari[2],ncol(Df))
    Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2]
  }
  if(D!=-Inf){  # 11.01.20 v2
    Tmp<- ncol(Out) # 11.01.07
    Tmp1<- rep(Inf,Tmp) 
    Out[Out[,1]<=D,]<- Tmp1 # 11.01.07
  }
  return(Out)
}

##################################

Reflectdata<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)    
  Eps<- 10^(-8)
  ML<- varargin[[1]]
  if(Mixtype(ML)==1){
    ML<- list(ML)
  }
  if(Nargs==1){
    PtA<- c(0,0); PtB<- PtA
  }
  else{
    Pts<- varargin[[2]]
    if(length(Pts)==2){
      PtA<- Pts; PtB<- PtA
    }
    else{
      PtA<- Pts[1:2]; PtB<- Pts[3:4]
    }
  }  
  OutL<- list()
  for (N in Looprange(1,length(ML))){
    GL<- Op(N,ML)
    Out<- c()
    for (I in Looprange(1,Nrow(GL))){
      if(is.matrix(GL)){   # 10.12.07
        Tmp<- GL[I,]
      }
      else{
        Tmp<- GL
      }
      X1<- Tmp[1]
      Y1<- Tmp[2]
      if(X1==Inf){
        X2<- X1
        Y2<- Y1
      }
      else{
        if(Norm(PtA-PtB)<Eps){
          X2<- 2*PtA[1]-X1
          Y2<- 2*PtA[2]-Y1
        }
        else{  
          U<- PtB[1]-PtA[1]
          V<- PtB[2]-PtA[2]
          A<- PtA[1]
          B<- PtA[2]
          X2<- (U^2-V^2)/(U^2+V^2)*X1+2*U*V/(U^2+V^2)*Y1
          X2<- X2-2*V*(U*B-V*A)/(U^2+V^2)
          Y2<- 2*U*V/(U^2+V^2)*X1-(U^2-V^2)/(U^2+V^2)*Y1
          Y2<- Y2+2*U*(U*B-V*A)/(U^2+V^2)
        }
      }
      Out<- Appendrow(Out,c(X2,Y2))
    }
    OutL<- Mixjoin(OutL,list(Out))
  }
  if(length(OutL)==1){
    OutL<- Op(1,OutL)
  }
  return(OutL)
}

##########################################

Writetextdata<- function(...)
{
  varargin<- list(...)
  OutL<- list()
  Nargs<- length(varargin)
  Data<- varargin[[1]]
  Fname<- varargin[[2]]
  Sep=","
  for (I in Looprange(3,Nargs)){
    Tmp<- varargin[[I]]
    eval(parse(text=Tmp))
  }
  write.table(Data,Fname,sep=Sep,row.names=FALSE,na="")
}

##########################################
#  2014.12.17
#  2015.10.29

WriteOutData<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
#  if modulo(Nargs,2)==0 then
#    Fname=Fnameout;
#    Nst=1;
#  else
  Fname=varargin[[1]]
  Nst=2;
#  end;
  for(N in seq(Nst,Nargs,by=2)){
    Gname=varargin[[N]]
    Tmp=paste(Gname,"//",sep="")
    if(N==Nst){
      cat(Tmp,"\n",sep="",file=Fname)
    }
    else{
      cat(Tmp,"\n",sep="",file=Fname,append=TRUE)
    }
    Gdata=varargin[[N+1]]
    Gdata=Flattenlist(Gdata)
    if(!is.list(Gdata)){Gdata=list(Gdata)}
    for(K in Looprange(1,length(Gdata))){
      GL=Dividegraphics(Gdata[[K]])
#      for(J in seq(1,length(GL))){
      for(J in Looprange(1,length(GL))){
        cat("start//","\n",sep="",file=Fname,append=TRUE)
        Str=""
        Iend=Numptcrv(GL[[J]])
#        for(II in seq(1,Iend)){
        for(II in Looprange(1,Iend)){
          Pt=Ptcrv(II,GL[[J]])
          if(nchar(Str)>0){
            Str=paste(Str,",",sep="")
          }
          if(length(Pt)<3){
            Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="")
          }
          else{
            Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="")
          }
          if(nchar(Str)>80){
            cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE)
            Str=""
          }
        }
        if(nchar(Str)>0){
          cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE)
        }
        if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){
#          cat("end////","\n",sep="",file=Fname,append=TRUE)
          cat("end//","\n",sep="",file=Fname,append=TRUE)
        }
        else{
          cat("end//","\n",sep="",file=Fname,append=TRUE)
        }
      }
    }
  }
  cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05
}

######  Old  ####################################
#  2015.10.23
ReadOutData<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Fname=varargin[[1]]
  cmdall=readLines(Fname)
  cmdall=gsub("//","",cmdall,fixed=TRUE)
  varname=cmdall[1]
  outdt=list()
  varL=c()
  ptL=list()
  flg=0
  for(cmd in cmdall){
    if(nchar(cmd)>0){
      if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){
        if(cmd=="start"){
          pts=c()
        }
        if(cmd=="end"){
          ptL=c(ptL,list(pts))
        }
        if(substring(cmd,1,1)=="["){
          tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="")
          tmp1=strsplit(tmp1,"]",fixed=TRUE)
          tmp1=tmp1[[1]]
          tmp1=gsub(",[","c(",tmp1,fixed=TRUE)
		  for(st in tmp1){
            tmp=eval(parse(text=paste(st,")",sep="")))
            pts=rbind(pts,tmp)
          }
          row.names(pts)=1:nrow(pts)
        }
      }
      else{
        varname=cmd
        varL=c(varL,varname)
        if(flg==0){  # 17.10.07from
          flg=1
        }else{
          outdt=c(outdt,list(ptL))
        }  # 17.10.07upto
        ptL=c()
      }
    }
  }
  outdt=c(outdt,list(ptL))  # 17.10.07
  names(outdt)=varL
  for(var in varL){
    tmp=paste(var,"<<- outdt$",var,sep="")
    eval(parse(text=tmp))
  }
#  print(varL)
  outdt
}

####################################################

ReadOutData<- function(...){ #2017.10.23
  varargin<- list(...)
  Nargs<- length(varargin)
  Fname=varargin[[1]]
  cmdall=readLines(Fname)
  cmdall=gsub("//","",cmdall,fixed=TRUE)
  varname=""#17.12.13 cmdall[1]
  outdt=list()
  varL=c()
  ptL=list()
  flg=0
  for(cmd in cmdall){
    if(nchar(cmd)>0){
      if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){
        if(cmd=="start"){
          tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="")
          eval(parse(text=tmp))
          Ctr=Ctr+1
        }
        if(cmd=="end"){
        }
        if(substring(cmd,1,1)=="["){
          tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="")
          tmp1=strsplit(tmp1,"]",fixed=TRUE)
          tmp1=tmp1[[1]]
          tmp1=gsub(",[","c(",tmp1,fixed=TRUE)
		  for(st in tmp1){
            tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="")
            tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")#
            eval(parse(text=tmp))
          }
        }
      }
      else{
          # 17.12.13from
          if(nchar(varname)>0){
            tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="")
            eval(parse(text=tmp))
          }
          # 17.12.13upto
        varname=cmd
        tmp=paste(varname,"<<- list()",sep="")
        eval(parse(text=tmp))
        Ctr=0
        if(flg==0){  # 17.10.07from
          flg=1
        }else{
        }  # 17.10.07upto
      }
    }
  }
  # 17.12.13from
  tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="")
  eval(parse(text=tmp))
  # 17.12.13upto
}

####################################################

Rotatedata<- function(..., deg=FALSE)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Eps<- 10^(-8)
  ML<- varargin[[1]]
  if(Mixtype(ML)==1){
    ML<- list(ML)
  }
  Theta<- varargin[[2]]
  if(deg) Theta<- Theta*pi/180    # 10.12.07
  if(Nargs==2){
    Pt<- c(0,0)
  }
  else{ 
    Pt<- varargin[[3]]
  }
  Cx<- Pt[1]; Cy<- Pt[2]
  OutL<- c()
  for (N in Looprange(1,length(ML))){
    GL<- Op(N,ML)
    Out<- c()
    for (I in Looprange(1,Nrow(GL))){
      if(is.matrix(GL)){
        Tmp<- GL[I,]
      }
      else{
        Tmp<- GL
      }
      X1<- Tmp[1]         
      Y1<- Tmp[2]    
      if(X1==Inf){
        X2<- X1
        Y2<- Y1
      }
      else{
        X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta)
        Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta)
      }
      Out<- Appendrow(Out,c(X2,Y2))
    }
    if(nrow(Out)==1){
      Out<- Out[1,]
    }
    OutL<- Mixjoin(OutL,list(Out))
  }
  if(length(OutL)==1){
    OutL<- Op(1,OutL)
  }
  return(OutL)
}

###############################################

Scaledata<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)    
  Eps<- 10^(-8)
  ML<- varargin[[1]]
  if(Mixtype(ML)==1){
    ML<- list(ML)
  }
  A<- varargin[[2]]
  B<- varargin[[3]]
  if(Nargs==3){
    Pt<- c(0,0)
  }
  else{
    Pt<- varargin[[4]]
  }
  OutL<- list()
  for (N in Looprange(1,length(ML))){
    GL<- Op(N,ML)
    Out<- c()
    for (I in Looprange(1,Nrow(GL))){
      if(is.matrix(GL)){   # 10.12.07
        Tmp<- GL[I,]
      }
      else{
        Tmp<- GL
      }
      X1<- Tmp[1]         
      Y1<- Tmp[2]    
      if(X1==Inf){
        X2<- X1
        Y2<-Y1
      }
      else{
        X2<- Pt[1]+A*(X1-Pt[1])
        Y2<- Pt[2]+B*(Y1-Pt[2])
      }
      Out<- Appendrow(Out,c(X2,Y2))
    }
    OutL<- Mixjoin(OutL,list(Out))
  }
  if(length(OutL)==1){
    OutL<- Op(1,OutL)
  }
  return(OutL)
}

################################

Setarrow<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0){
    Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="")
    Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="")
    return(Str)
  }
  Flg<- 0
  for (I in 1:Nargs){
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric"){
      Flg<- Flg+1
      if(Flg==1) YaSize<<-Tmp
      if(Flg==2){
        if(Tmp<5){
          YaAngle<<- 18*Tmp
        }
        else{
          YaAngle<<- Tmp
        }
      }
      if(Flg==3) YaPosition<<- Tmp
      if(Flg==4) YaThick<<- Tmp
    }
    if(mode(Tmp)=="character"){
      YaStyle<<- Tmp
    }
  }
}

####################################

Setax<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0){
    if(ZIKU=="line"){
      Tmp<- ","
    }
    else{
      Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="")
    }
    Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="")
    Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="")
    return(Str)
  }
  ArgL<- c()
  Is<- 1
  Tmp<- varargin[[1]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1){
    Is<- varargin[[1]]
    ArgL<- c()
    for (I in Looprange(1,Is-1)){
      ArgL<- c(ArgL,"")
    }
    for (I in Looprange(2,Nargs)){
      ArgL<- c(ArgL,varargin[[I]])
    }
  }
  else{
    if(Nargs==1){ 
      ArgL<- c(varargin[[1]])
    }
    else{
      Tmp<- varargin[[2]]
      if(mode(Tmp)=="numeric" && length(Tmp)==1){
        ARROWSIZE<<-Tmp
        ArgL<- c(varargin[[1]])
        for (I in Looprange(3,Nargs)){
          ArgL<- c(ArgL,varargin[[I]])
        }
      }
      else{
        ArgL<- c()
        for (I in 1:Nargs){
          ArgL<- c(ArgL,varargin[[I]])
        }
      }
    }
  }
  for (I in Looprange(length(ArgL)+1,7)){
    ArgL<- c(ArgL,"")
  }
  Zk<- ArgL[1]
  if(nchar(Zk)>0){ 
    ZL<-substr(Zk,2,nchar(Zk))
    Zk<-substr(Zk,1,1)
    if(nchar(ZL)>0){
      ARROWSIZE<<- as.numeric(ZL)
    }
  }
  Xn<- ArgL[2]; Xp<- ArgL[3]
  Yn<- ArgL[4]; Yp<- ArgL[5]
  Genn<- ArgL[6]; Genp<- ArgL[7]
  if(nchar(Zk)>0){ 
    C<- Zk
    if(C=="a"){ 
      ZIKU<<- "arrow"
    }
    else{
      ZIKU<<- "line" 
    }
  }
  if(nchar(Xn)>0){
    XNAME<<- paste("$",Xn,"$",sep="")
  }
  if(nchar(Xp)>0){
    XPOS<<- Xp 
  }
  if(nchar(Yn)>0){
    YNAME<<- paste("$",Yn,"$",sep="")
  }
  if(nchar(Yp)>0){
    YPOS<<-Yp
  }
  if(nchar(Genn)>0){
    ONAME<<- Genn
  }
  if(nchar(Genp)>0){
    OPOS<<- Genp
  }
  Out<- "";
}

#################################
#  11.08.24

Setcolor<- function(...){
  varargin<- list(...)
  Color<- 'black'
  Kosa<- 1
  for(J in Looprange(1,length(varargin))){
    Tmp<- varargin[[J]]
    if(is.character(Tmp)) Color<- Tmp
    if(is.numeric(Tmp)){
      if(length(Tmp)==1){#  11.08.24
        Kosa<- Tmp
      }
      else{
        Color<- Tmp
      }
    }#  11.08.24
  }
  Iro<- Ratiocmyk(Color)
  if(length(Iro)==0) return(c())
  Str<- "\\color[cmyk]{" #17.09.22
  for(J in 1:4){
    Str<- paste(Str,as.character(Kosa*Iro[J]),sep="")
    if(J<4){
      Str<- paste(Str,",",sep="")
    }
  }
  Str<- paste(Str,"}",sep="")
  Texcom(Str)
}

##################################

Setmarklen<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0){
    Tmp<- MARKLENNow/MARKLENInit
    Tmp=round(Tmp*100)/100
    return(Tmp)
  }
  Size<- varargin[[1]]
  MARKLENNow<<- MARKLENInit*Size
  MARKLEN<<- MARKLENNow*1000/2.54/MilliIn
}

###############################

Setorigin<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0){
    return(GENTEN)
  }
  Pt<- varargin[[1]]
  GENTEN<<- Pt;
}

################################

Setscaling<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0)
  {
      return(c(SCALEY,LOGX,LOGY))
  }
  for (I in 1:Nargs)
  {
    Tmp<- varargin[[I]]
    if(mode(Tmp)=="numeric")
    {
      SCALEY<<- Tmp
    }
    if(mode(Tmp)=="character")
    {
      if(Tmp=="l")
      {
        LOGX<<- 0
        LOGY<<- 1
      }
      else if(Tmp=="ll")
      {
        LOGX<<- 1
        LOGY<<- 1
      }
      else
      {
        LOGX<<- 0
        LOGY<<- 0
      }
    }
  }
  Tmp<- c(SCALEY,LOGX,LOGY);
}

#########################################

Setpen<-function(Width)
{
  PenThick<<-round(PenThickInit*Width)
  Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="")
  cat(Str,file=Wfile,append=TRUE)
}

##############################################

Setpt<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0)
  {
    Tmp<- TenSize/TenSizeInit
    Tmp<- round(Tmp*100)/100
    return(Tmp)
  }
  Size<- varargin[[1]]
  TenSize<<- TenSizeInit*Size;
}

##############################################

Setunitlen<-function(...)
{
  varargin<-list(...)
  if(length(varargin)==0){
    return(ULEN)
  }
  Ul=varargin[[1]]
  Dx<-XMAX-XMIN
  Dy<-YMAX-YMIN
  Sym<-".0123456789 +-*/"
  SL<-Sym
  OL<-"+-*/"
  if(nchar(Ul)>0){
    ULEN<<-Ul
  }
  Is<-1
  VL<-""
  Ucode<-ULEN
  for (I in 1:nchar(Ucode)){
    C<-substring(Ucode,I,I)
    if(length(grep(C,SL))>0){
      if(length(grep(C,OL))>0){
        Tmp<-substring(Ucode,Is,I-1)
        Str<-paste(VL,Tmp,C,sep="")
        VL<-Str
        Is<-I+1
      }
    }
    else{
      Unit<-substring(Ucode,I,I+1)
      Str<-substring(Ucode,Is,I-1)
      VL<-paste(VL,Str,sep="")
      break;
    }
  }
  Valu<-eval(parse(text=VL))
  Str<-as.character(Valu)
  ULEN<<-paste(Str,Unit,sep="");
  if(Unit=="cm") MilliIn<<-1000/2.54*Valu
  if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10
  if(Unit=="in") MilliIn<<-1000*Valu
  if(Unit=="pt") MilliIn<<-1000/72.27*Valu
  if(Unit=="pc") MilliIn<<-1000/6.022*Valu 
  if(Unit=="bp") MilliIn<<-1000/72*Valu
  if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
  if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu
  if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
  MARKLEN<<-MARKLENNow*1000/2.54/MilliIn
  MEMORI<<-MEMORINow*1000/2.54/MilliIn  #17.12.17
}

#########################################
# 10.11.20

Setwindow<-function(...)
{
  varargin<-list(...)
  Nargs<-length(varargin)
  if(Nargs==0){
    Out<-c(XMIN,XMAX,YMIN,YMAX)
    return(Out)
  }
  if(Nargs==1){
    Dt<- varargin[[1]]
    if(is.list(Dt) && !is.data.frame(Dt)){
      Tmp<- as.data.frame(Dt)
      Dt<- t(Tmp)
    }
    Xm<- min(Dt[,1])
    XM<- max(Dt[,1])
    Ym<- min(Dt[,2])
    YM<- max(Dt[,2])
	Str<- "Setwindow("
	Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="")
    Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="")
	Str<- paste(Str,")",sep="")
    print(Str)
  }
  if(Nargs==2){
    RgX<-varargin[[1]]
    RgY<-varargin[[2]]
    XMIN<<-RgX[1]; XMAX<<-RgX[2]
    YMIN<<-RgY[1]; YMAX<<-RgY[2]
  }
  if(Nargs==4){
    XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]]
    YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]]
 }
 Out<- c(XMIN,XMAX,YMIN,YMAX);
}

#########################################

Shade<- function(...)
{           ##  Scaling is implemented
  varargin<- list(...)
  Nargs<- length(varargin)
  Iroflg=0
  Kosa=1
  if(Nargs>1){ 
    Iro=varargin[[Nargs]]
    if(is.character(Iro)){
      Iroflg=1
      if(length(grep("{",Iro))>0){
        Str=paste("{\\color",Iro,sep="")
      }
      else{
        Str=paste("{\\color{",Iro,"}",sep="")
      }
    }
    else{
      if(length(Iro)==1){
        Kosa=Iro
      }
      else{
        Iroflg=1
        if(length(Iro)==4){
          Str="{\\color[cmyk]{"
        }
        else{
          if(length(Iro)==3){
            Str="{\\color[rgb]{"
          }
        }
        for(J in 1:length(Iro)){
          Str=paste(Str,as.character(Iro[J]),sep="")
          if(J<length(Iro)){
            Str=paste(Str,",")
          }
        }
        Str=paste(Str,"}")
      }
    }
    if(Iroflg==1){
      Str=paste(Str,"%\n",sep="")
      cat(Str,file=Wfile,append=TRUE)
    }
  }
  Tmp=varargin[[1]]
  Data=Kyoukai(Tmp)
  for (I in Looprange(1, length(Data))){
    PL<- Op(I,Data)
    Mojisu<- 0
    for (J in  1:Nrow(PL)){
      P<- Doscaling(Op(J,PL))
      X<- as.character(round(MilliIn*P[1]))
      Y<- as.character(-round(MilliIn*P[2]))
      Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
      cat(Str,file=Wfile,append=TRUE)
      Mojisu<- Mojisu+nchar(Str)
      if(Mojisu>80){
        cat("%\n",file=Wfile,append=TRUE)
        Mojisu<- 0
      }
    }
    Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
    Str2<- paste("\\special{ip}%\n",sep="")
    cat(Str1,file=Wfile,append=TRUE)
    cat(Str2,file=Wfile,append=TRUE)
  }
  if(Iroflg==1){
    cat("}%\n",file=Wfile,append=TRUE)
  }
}

####### Shade new 17.09.24############

Shade<- function(...)
{           ##  Scaling is implemented
  varargin<- list(...)
  Nargs<- length(varargin)
  Iroflg<- 0
  Kosa<- 1
  if(Nargs>1){
    Iro<- varargin[[Nargs]]
    if(mode(Iro)=="character"){
      Iroflg<- 1
      if(length(grep(Iro,"{"))>0)
        Str<- paste("{\\color",Iro,sep="")
      else
        Str<- paste("{\\color{",Iro,"}",sep="")
    }
    else{
      if(length(Iro)==1)
        Kosa<- Iro
      else{
        Iroflg<- 1
        if(length(Iro)==4)
          Str<- paste("{\\color[cmyk]{",sep="")
        else
          if(length(Iro)==3)
            Str<- paste("{\\color[rgb]{",sep="")
        for (J in Looprange(1,length(Iro))){
          Str<- paste(Str,as.character(Iro[J]),sep="")
          if(J<length(Iro))
            Str<- paste(Str,",",sep="")
        }
        Str<- paste(Str,"}",sep="")
      }
    }
    if(Iroflg==1){
      if(Wfile=="default")
        cat(Str,"%\n",file="",append=TRUE,sep="")
      else
        cat(Str,"%\n",file=Wfile,append=TRUE,sep="")
    }
  }
  Tmp<- varargin[[1]]
  Data<- Kyoukai(Tmp)
  for (I in Looprange(1, length(Data))){
    PL<- Op(I,Data)
    Mojisu<- 0
    for (J in  1:Nrow(PL)){
      P<- Doscaling(Op(J,PL))
      X<- as.character(round(MilliIn*P[1]))
      Y<- as.character(-round(MilliIn*P[2]))
      Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
      if(Wfile=="default")
        cat(Str,file="",append=TRUE,sep="")
      else
        cat(Str,file=Wfile,append=TRUE,sep="")
      Mojisu<- Mojisu+nchar(Str)
      if(Mojisu>80){
        if(Wfile=="default")
          cat("%\n",file="",append=TRUE,sep="")
        else
          cat("%\n",file=Wfile,append=TRUE,sep="")
        Mojisu<- 0
      }
    }
    Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
    Str2<- paste("\\special{ip}%\n",sep="")
    if(Wfile=="default"){
       cat(Str1,file="",append=TRUE,sep="")
       cat(Str2,file="",append=TRUE,sep="")
    }
    else{
       cat(Str1,file=Wfile,append=TRUE,sep="")
       cat(Str2,file=Wfile,append=TRUE,sep="")
    }
  }
  if(Iroflg==1){
    if(Wfile=="default")
      cat("}%\n",file="",append=TRUE,sep="")
    else
      cat("}%\n",file=Wfile,append=TRUE,sep="")
  }
}

##############################################
# 11.01.07

Splinedata<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Eps<- 10^(-3)
  PL<- varargin[[1]]
  if(mode(PL)=="character"){
    Fname<- PL
    PL<- Readtextdata(Fname)
  }
  else{
    PL<- as.matrix(PL)
    if(Nrow(PL)==1){
      PL<- matrix(PL, nrow=length(PL)/2)
      PL<- t(PL)
    }
  }
  if(ncol(PL)==3){
    Flg3<- 1
  }
  else{
    Flg3<- 0
  }
  PLL<- Dividegraphics(PL)
  N<- 50
  C<- c()
  for (I in Looprange(2,Nargs)){
    Tmp<- varargin[[I]]
    if(mode(Tmp)!="character") next
    if(length(grep("=",Tmp,fixed=TRUE))>0){
      eval(parse(text=Tmp))
    }
    else{
      Tmp1<- substr(Tmp,1,1)
      if(toupper(Tmp1)=="C"){
        C<- 1:length(PLL)
      }
    }
  }
  Cflg<- rep(0,length(PLL))
  for(J in Looprange(1,length(C))){
  	K<- C[J]
  	Cflg[K]<- 1
  }
  if(length(N)>1){
    Nj<- as.numeric(N)
  }
  else{
    Tmp<- lapply(PLL,nrow)
    Tmp1<- as.numeric(Tmp)
    MxP<- max(Tmp1)
    Nj<- c()
    for (J in 1:length(PLL)){
      Tmp<- nrow(PLL[[J]])
      Tmp1<- round(N/MxP*(Tmp-1))
      Nj<- c(Nj,Tmp1)
    }
  }
  OutL<- list()
  for(J in 1:length(PLL)){
    PL<- PLL[[J]]
    if(Cflg[J]==1){
      if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){
        PL<-Appendrow(PL,PL[1,])
        Nj[J]=round(N/MxP*nrow(PL))
      }
      else{
        PL[Nrow(PL),]<- PL[1,]
      }
    }
    Tn<- 1:Nrow(PL)
    Xn<- PL[,1]
    Yn<- PL[,2]
    if(Flg3==1) Zn<- PL[,3]
    if(Cflg[J]==0){
      Dxn<- spline(Tn,Xn,n=Nj[J])
      Dyn<- spline(Tn,Yn,n=Nj[J])
      if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J])
    }
    else{
      Dxn<- spline(Tn,Xn,method="periodic")
      Dyn<- spline(Tn,Yn,method="periodic")
      if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic")
    }
    Tmp1<- Dxn$y
    Tmp2<- Dyn$y
    Tmp3<-c()
    if(Flg3==1) Tmp3<- Dzn$y
    Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1))
    OutL<- c(OutL,list(Out))
  }
  return(OutL)
}

############################################
#   2013.05.03  Domain is optional

Tabledata<- function(...){
  varargin<- list(...)
  Eps<- 0.001
  Tmp<- varargin[[1]]  # 130503 from
  if(is.numeric(Tmp)){
    Domain<- varargin[[1]]
    VL<- varargin[[2]]
    HL<- varargin[[3]]
  }
  else{
    Domain<- c(-1,-1)
    VL<- varargin[[1]]
    HL<- varargin[[2]]
  } # 130503 upto
  Hsize<- Domain[1]
  SvL<- list(0)
  S<- 0
  for (I in Looprange(1,length(VL))){
    Tmp<- VL[[I]]
    S<- S+Tmp[1]
    Tmp[1]<- S
    SvL<- c(SvL,list(Tmp))
  }
  if(Hsize>S){
    SvL<- c(SvL,list(Hsize))
  }
  Hsize<- Op(1,SvL[[length(SvL)]])
  Vsize<- Domain[2]
  ShL<- list(0)
  S<- 0
  for (I in Looprange(1,length(HL))){
    Tmp<- HL[[I]]
    S<- S+Tmp[1]
    Tmp[1]<- S
    ShL<- c(ShL,list(Tmp))
  }
  if(Vsize>S){
    ShL<- c(ShL,list(Vsize))
  }
  Vsize<- Op(1,ShL[[length(ShL)]])
  Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0
  if(length(Domain)>2){
    Marw<- Domain[3]
    Mare<- Domain[4]
  }
  if(length(Domain)>4){
    Marn<- Domain[5]
    Mars<- Domain[6]
  }
  Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn))
  Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps))
  Gdata<- list(Tmp)
  Tmp<- -Marw
  Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))))
  for (I in Looprange(1,length(SvL))){
    Data<- SvL[[I]]
    X<- Data[1]
    if(length(Data)==1){
      Y1<- 0
      Y2<- Vsize
      G<- Listplot(c(X,Y1),c(X,Y2))
    }
    else{
      G<- c()
      for (J in seq(2,length(Data),by=2)){
        Y1<- Vsize-Op(1,ShL[[Data[J]]])
        Y2<- Vsize-Op(1,ShL[[Data[J+1]]])
        Tmp<- Listplot(c(c(X,Y1),c(X,Y2)))
        Tmp1<- Appendrow(G,c(Inf,Inf))
        G<- Appendrow(Tmp1,Tmp)
      }
      G<- G[2:nrow(G),]
    }
    Hdata<- c(Hdata,list(G))
  }
  Tmp<- Hsize+Mare
  Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))
  Hdata<- c(Hdata,list(Tmp1))
  Tmp<- Vsize+Marn
  Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp))))
  for (I in Looprange(1,length(ShL))){
    Data<- ShL[[I]]
    Y<- Vsize-Data[1]
    if(length(Data)==1){
      X1<- 0
      X2<- Hsize
      G<- Listplot(c(X1,Y),c(X2,Y))
    }
    else{
      G<- c()
      for (J in seq(2,length(Data),by=2)){
        X1<- Op(1,SvL[[Data[J]]])
        X2<- Op(1,SvL[[Data[J+1]]])
        Tmp<- Listplot(c(X1,Y),c(X2,Y))
        G<- Appendrow(G,c(Inf,Inf))
        G<- Appendrow(G,Tmp)
      }
      G<-G[2:nrow(G),]
    }
    Vdata<- c(Vdata,list(G))
  }
#  Tmp<- Listplot(c(c(0,0),c(Hsize,0)))  # 2011.03.02
#  Vdata<- Mixjoin(Vdata,list(Tmp))
  Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars)))
  Vdata<- Mixjoin(Vdata,list(Tmp))
  Tmp1<- Hdata[Looprange(3,length(Hdata)-2)]
  Tmp2<- Vdata[Looprange(3,length(Vdata)-2)]
  Gdata<- Mixjoin(Gdata,Tmp1,Tmp2)
  Hind<- Looprange(2,1+length(Tmp1))
  Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2))
  G=Gdata[[1]]
  P1<- Ptsw(G); P2<- Ptnw(G)
  Q1<- Ptse(G); Q2<- Ptne(G)
  Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2)))
  P1<- Ptnw(G); P2<- Ptne(G)
  Q1<- Ptsw(G); Q2<- Ptse(G)
  Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) 
  Tmp3<- Framedata()
  Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3)
  return(Out)
}

################################

Texcom<- function(Meirei)
{
  if(Meirei=="\\thinlines"){
    Setpen(1);
    return();
  }
  if(Meirei=="\\thicklines"){
    Setpen(2);
    return()
  }
  if(Meirei=="\\Thicklines"){
    Setpen(3);
    return()
  }
  if(length(Meirei)==0){  # 09.12.07
    Tmp<- c()
  }
  else{
    Tmp<- grep("newline",Meirei) 
  }
  if(length(Tmp)>0){
    cat("\n",file=Wfile,append=TRUE);
  }
  else{
    Tmp<- paste(Meirei,"%\n",sep="")
	Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02
    cat(Tmp,file=Wfile,append=TRUE);
  }
}

###############################################

Texctr<- function(N){
  if(is.numeric(N)){
    Alpha<- "abcdefghijklmnopqrstuvwxyz"
    Out<- paste("ketpicctr",substr(Alpha,N,N),sep="")
  }
  else{
    if(grep("\\",N,fixed=TRUE)>0){
      Out<- substr(N,2,nchar(N))
    }
	else{
      Out<- N
    }
  }
  return(Out)
}

###############################################

Texelse<- function (){
  Texcom("");
  Texcom("\\else")
}

###############################################

Texend<- function()
{
  Texcom("%\n}")
}

###############################################

Texendfor<- function(I){
  Last<- TEXFORLAST[[TEXFORLEVEL]]
  Texcom("")
  Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="")
  Texcom(Tmp)
  Texcom("\\repeat")
  Texcom("}")
  TEXFORLEVEL<<- TEXFORLEVEL-1
  TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)]
}

###############################################

Texendif<- function(){
  Texcom("")
  Texcom("\\fi")
  Texcom("}")
}

###############################################

Texfor<- function(I,First,Last){
  TEXFORLEVEL<<- TEXFORLEVEL+1;
  Texsetctr(I,"0")
  Texsetctr(I,paste(as.character(First),"-1",sep=""))
  Texcom("")
  Texcom("{")
  Texcom("\\loop")
  Texsetctr(I,"+1")
  TEXFORLAST<<- c(TEXFORLAST,as.character(Last))
}

###############################################

Texforinit<- function(){
  TEXFORLEVEL<<- 0
  TEXFORLAST<<- list()
}

###############################################

Texif<- function(...){
  varargin<- list(...)
  Condstr<- varargin[[1]]
  Tp<- 0
  if(length(varargin)>1){
    Tp<- varargin[[2]]
  }
  Texcom("")
  Texcom("{")
  if(Tp==0){
    Texcom("\\ifnum")
  }
  else{
    Texcom("\\ifdim ")
  }
  Texcom(paste(Condstr," ",sep=""))
}

######################################

Texletter<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  for (I in seq(1,Nargs,by=3)){
    P<- varargin[[I]]
    X<- P[1]
    if(mode(X)=="numeric"){
      X<- as.character(X)
    }
    Y<- P[2]
    if(mode(Y)=="numeric"){
      Y<- as.character(Y)
    }
    Houkou<- varargin[[I+1]]
    Mojiretu<- varargin[[I+2]]
    Hset<- Houkou
    Vhoko<- "c"
    if(length(grep("n",Hset))>0){
      Vhoko<- "n"
    }
    if(length(grep("s",Hset))>0){
      Vhoko<- "s"
    }
    Hhoko<- "c";
    if(length(grep("e",Hset))>0){
      Hhoko<- "e"
    }
    if(length(grep("w",Hset))>0){
      Hhoko<- "w"
    }
    Hoko<- paste(Vhoko,Hhoko,sep="")
    CalcWidth(Hoko,Mojiretu)
    CalcHeight(Hoko,Mojiretu)
    Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="")
    Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") 
    cat(Str,file=Wfile,append=TRUE)
  }
}

##################################################

Texnewcmd<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Str<- varargin[[1]]    
  S<- paste("\\newcommand{",Str,"}",sep="")
  if(Nargs>1){
    Tmp<- as.character(varargin[[2]])
    S<- paste(S,"[",Tmp,"]",sep="")
  }
  if(Nargs>2){
    Tmp<- varargin[[3]]
    if(mode(Tmp)=="numeric"){
      Tmp<- as.character(Tmp)
    }
    S<- paste(S,"[",Tmp,"]",sep="")
  }
  S<- paste(S,"{",sep="")
  Texcom(S)
}

###############################################

Texnewctr<- function(N)
{
  if(mode(N)=="character"){
    Str<- paste("\\newcounter{",N,"}",sep="")
    Texcom(Str)
  }
  else{
    for (I in N){
      Str<- paste("\\newcounter{",Texctr(I),"}",sep="")
      Texcom(Str)
    }
  }
}
###############################################

Texrenewcmd<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Str<- varargin[[1]]    
  S<- paste("\\renewcommand{",Str,"}",sep="")
  if(Nargs>1){
    Tmp<- as.character(varargin[[2]])
    S<- paste(S,"[",Tmp,"]",sep="")
  }
  if(Nargs>2){
    Tmp<- varargin[[3]]
    if(mode(Tmp)=="numeric"){
      Tmp<- as.character(Tmp)
    }
    S<- paste(S,"[",Tmp,"]",sep="")
  }
  S<- paste(S,"{",sep="")
  Texcom(S)
}

###############################################

Texsetctr<- function(Nctr,Opstr)
{
  Ctr<- Texctr(Nctr)
  Opstr<- paste(Opstr,"%",sep="")
  OperL<- "+-*/%"
  Oper<- ""
  Va<- ""
  Evflg<- 0
  Paflg<- 0
  for (I in Looprange(1,nchar(Opstr))){
    Tmp<- substring(Opstr,I,I)
    if(Tmp=="("){
      Paflg<- 1
      if(nchar(Va)>0){
        Evflg<- 1
        Va<- paste(Va,Tmp,sep="")
      }
      next
    }
    if(Tmp==")"){
      Paflg<- 0
      if(Evflg>0){
        Va<- paste(Va,Tmp,sep="")
      }
      next
    }
    if(Paflg>0){
      Va<- paste(Va,Tmp,sep="")
      next
    }
    if(length(grep(Tmp,OperL))==0){
      Va<- paste(Va,Tmp,sep="")
    }
    else{
      if(Evflg>0){
        Tmp1<- eval(parse(text=Va))
        Va<- paste("\\value{",Tmp1,"}",sep="")
        Evflg<- 0
      }
      if(Oper==""){
        if(nchar(Va)>0){
          Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="")
          Texcom(Str)
        }
        Oper<- Tmp
        Va<-""      
      }
      else if(Oper=="+"){
        Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="")
        Texcom(Str)
        Oper<- Tmp
        Va<-""
      }
      else if(Oper=="-"){
        Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="")
        Texcom(Str)      
        Oper<- Tmp
        Va<-""
      }
      else if(Oper=="*"){
        Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="")
        Texcom(Str)      
        Oper<- Tmp
        Va<-""      
      }
      else if(Oper=="/"){
        Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="")
        Texcom(Str)      
        Oper<- Tmp
        Va<-"" 
      }
    }
  }
}

###############################################

Texthectr<- function(N)
{
  Out<- paste("\\the",Texctr(N),sep="")
  return(Out)
}

###############################################

Texvalctr<- function(N){
  Out<- paste("\\value{",Texctr(N),"}",sep="")
  return(Out)
}

###############################################

Texvctr<- function(N)
{
  Out<- paste("\\value{",Texctr(N),"}",sep="")
  return(Out)
}

###############################################

Tonumeric <- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)
  Data<- varargin[[1]]
  Sp<- c(1,1)
  Ep<- c(Inf,Inf)
  if(Nargs>1){
    Sp<- varargin[[2]]
  }
  if(Nargs>2){
    Ep<- varargin[[3]]
  }
  Nrs<- Sp[1]
  Nre<- min(nrow(Data),Ep[1])
  Ncs<- Sp[2]
  Nce<- min(ncol(Data),Ep[2])
  Tmp1<- Data[Nrs:Nre, Ncs:Nce]
  Tmp2 <- as.numeric(Tmp1)
  Out <- matrix(Tmp2,nrow=nrow(Tmp1))
  Sp<- c()
  for (I in 1:nrow(Out)){
    for (J in 1:ncol(Out)){
      Tmp<- Out[I,J]
      if(!is.na(Tmp)){
        Sp<- c(I,J)
        break;
      }
    }
    if(length(Sp)>0) break
  }
  if(length(Sp)==0){
    return("Numeric data not found")
  }
  Ep<- c(nrow(Out),ncol(Out))
  for (I in Sp[1]:nrow(Out)){
    Tmp<- Out[I,Sp[2]]
    if(is.na(Tmp)){
      Ep[1]<- I-1
      break
    }
  }
  for (J in Sp[2]:ncol(Out)){
    Tmp<- Out[Sp[1],J]
    if(is.na(Tmp)){
      Ep[2]<- J-1
      break
    }
  }
  Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]]
  return(Out)
}

##################################################

Translatedata<- function(...)
{
  varargin<- list(...)
  Nargs<- length(varargin)    
  Eps<- 10^(-8)
  ML<- varargin[[1]]
  if(Mixtype(ML)==1){
    ML<- list(ML)
  }
  Tmp=varargin[[2]]
  if(mode(Tmp)=="numeric" && length(Tmp)>1){
    A<- Tmp[1]; B<- Tmp[2]
  }
  else{
    A<- Tmp
    if(Nargs>=3){
      B<- varargin[[3]]
    }
    else{
      B<- 0
    }
  }
  OutL<- list()
  for (N in Looprange(1,length(ML))){
    GL<- Op(N,ML)
    Out<- c()
    for (I in Looprange(1,Nrow(GL))){
      if(is.matrix(GL)){   # 10.12.07
        Tmp<- GL[I,]
      }
      else{
        Tmp<- GL
      }
      X1<- Tmp[1]         
      Y1<- Tmp[2]    
      if(X1==Inf){
        X2<- X1
        Y2<-Y1
      }
      else{
        X2<- X1+A
        Y2<- Y1+B
      }
      Out<- Appendrow(Out,c(X2,Y2))
    }
    OutL<- Mixjoin(OutL,list(Out))
  }
  if(length(OutL)==1){
    OutL<- Op(1,OutL)
  }
  return(OutL)
}

#######################################

Unscaling<- function(G)
{
  GLg<- G
  if(class(GLg)=="numeric"){
    GLg<-c(G[1]/SCALEX, G[2]/SCALEY)
    Tmp<-GLg
    if(LOGX==1) Tmp[1]<- 10^(GLg[1])
    if(LOGY==1) Tmp[2]<- 10^(GLg[2])
    return(Tmp)
  }
  else{
    Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2)
    GLg<-G %*% Tmp1
    Tmp<-GLg
    if(LOGX==1) Tmp[,1]<- 10^(G[,1])
    if(LOGY==1) Tmp[,2]<- 10^(G[,2])
    return(Tmp)
  }
}

#############################################

Vtickmark<- function(...)
{  ## Scaling is implemented 
  varargin<- list(...)
  Nargs<- length(varargin)
  ArgsL<- varargin
  if(mode(ArgsL[[1]])=="character"){
    Str<- ArgsL[[1]]
    Tmp<- strsplit(Str,"m")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      I<- nchar(Tmp[1])+1
    }
    else{
      I<- 0
    }
    Tmp<- strsplit(Str,"n")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      J<- nchar(Tmp[1])+1
    }
    else{
      J<- 0
    }
    Tmp<- strsplit(Str,"r")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      K=nchar(Tmp[1])+1
    }
    else{
      K<- 0
    }
    if(K>0){
      S<- substr(Str,K+1,nchar(Str))
      R<-  as.numeric(S)
      if(is.na(R)){
        R<- 1
      }
    }
    else{
      R<- 1
      K<- nchar(Str)+1
    }
    if(J>0){
      S<- substr(Str,J+1,K-1)
      Dn<-  as.numeric(S)
      if(is.na(Dn)){
        Dn<- 1
      }
    }
    else{
      Dn<- 1000
      J<- nchar(Str)+1
    }
    S<- substr(Str,I+1,J-1)
    Dm<- as.numeric(S)
    if(is.na(Dm)){
      Dm<- 1
    }
    ArgsL<- list()
    for (I in 1:floor((YMAX-GENTEN[2])/Dm)){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
    for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
  }
  MemoriList<- list()
  Memori<- list()
  for (N in 1:length(ArgsL)){
    Dt<- ArgsL[[N]]
    if(mode(Dt)=="numeric" && length(Dt)>1){
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(Dt[1],Dt[2])
      next
    }
    if(mode(Dt)=="character"){
      Memori<- Mixjoin(Memori,Dt)
    }
    else{
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(GENTEN[1],Dt)
    }
  }
  MemoriList<- Mixjoin(MemoriList,list(Memori))
  for (N in 1:length(MemoriList)){
    Dt<- MemoriList[[N]]
    Ndt<- length(Dt)
    X=Op(1,Dt)
    Y=Op(2,Dt)
    Tmp<-Doscaling(c(X,Y))
    X<- Tmp[1]
    Y<- Tmp[2]
    Moji<- Op(Ndt,Dt)
    Tmp1<- Unscaling(c(X+MARKLEN,Y))
    Tmp2<- Unscaling(c(X-MARKLEN,Y))
    Fd<- Listplot(c(Tmp1,Tmp2))
    Drwline(Fd)
    if(Ndt==3){
      Tmp<-Unscaling(c(X-MARKLEN,Y))
      Expr(Tmp,"w",Moji)
    }
    if(Ndt==4){
      Houkou<- Op(3,Dt)
      Tmp<-grep("w",Houkou)
      if(length(Tmp)>0){
        Tmp<-Unscaling(c(X-MARKLEN,Y))
        Expr(Tmp,Houkou,Moji)
      }
      else{
        Tmp<- Unscaling(c(X+MARKLEN,Y))
        Expr(Tmp,Houkou,Moji)
      }
    }
      cat("%\n",file=Wfile,append=TRUE)
  }
}

############################################

Windisp<-function(...){
  varargin<-list(...)
  Nargs<-length(varargin)
  Tmp<- Doscaling(c(XMIN,YMIN))
  Xmn<- Tmp[1]; Ymn<- Tmp[2]
  Tmp<- Doscaling(c(XMAX,YMAX))
  Xmx<- Tmp[1]; Ymx<- Tmp[2]
  plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="")
  Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX)))
  axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2))
  Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0)))
  axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2))
  Tmp1<- c(XMIN,GENTEN[2])
  Tmp2<- c(XMAX,GENTEN[2])
  Tmp3<- Listplot(Tmp1,Tmp2)
  Tmp<- MakeCurves(Tmp3,0)
  if(Datalength(Tmp)>0){
    lines(Tmp[,1],Tmp[,2],col="green")
  }
  Tmp1<- c(GENTEN[1],YMAX)
  Tmp2<- c(GENTEN[1],YMIN)
  Tmp3<- Listplot(Tmp1,Tmp2)
  Tmp<- MakeCurves(Tmp3,0)
  if(Datalength(Tmp)>0){
    lines(Tmp[,1],Tmp[,2],col="green")
  }
  Tmp<-Doscaling(Framedata())
  lines(Tmp[,1],Tmp[,2])
  for (I in Looprange(1,Nargs)){
    Pdata<-varargin[[I]]
    if(mode(Pdata)=="numeric"){
      Pdata<-list(Pdata)
    }
    while(Mixtype(Pdata)==3){         # 10.02.23
      Tmp1<- list()
      for(II in Looprange(1,length(Pdata))){
        Tmp1<- Mixjoin(Tmp1,Pdata[[II]])
      }
      Pdata<- Tmp1
    }                                                  # 10.02.23
    for (II in Looprange(1,length(Pdata))){
      Tmp<-Pdata[[II]]
      P<-MakeCurves(Tmp,0)
      Ndm<-Dataindex(P)
      for (J in Looprange(1,Nrow(Ndm))){
        Q<-P[Ndm[J,1]:Ndm[J,2],]
        if(Nrow(Q)==1){
          Tmp<-seq(1,Ncol(Q),by=2)
          for (K in Tmp){
            Pt<-Q[K:(K+1)]
            points(Pt[1],Pt[2])
          }
        }
        else{
          lines(Q[,1],Q[,2])
        }
      }
    }
  }
}

############################################

WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04
  par(new=new)
  varargin<-list(...)
  Nargs<-length(varargin)
  if(!new)     # 10.12.04
  {
    Tmp<- Doscaling(c(XMIN,YMIN))
    Xmn<- Tmp[1]; Ymn<- Tmp[2]
    Tmp<- Doscaling(c(XMAX,YMAX))
    Xmx<- Tmp[1]; Ymx<- Tmp[2]
    plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="")
    Tick<- sort(c(YMIN,YMAX,vtick))                         #### 10.12.04  from here
    Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2)
    Tmp<- Doscaling(Tmp1)
    axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2))
    Tick<- sort(c(XMIN,XMAX,htick))
    Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2)
    Tmp<- Doscaling(Tmp1)
    axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2))  #### 10.12.04  to here
    Tmp1<- c(XMIN,GENTEN[2])
    Tmp2<- c(XMAX,GENTEN[2])
    Tmp3<- Listplot(Tmp1,Tmp2)
    Tmp<- MakeCurves(Tmp3,0)
    if(Datalength(Tmp)>0){
      lines(Tmp[,1],Tmp[,2],col="green")
    }
    Tmp1<- c(GENTEN[1],YMAX)
    Tmp2<- c(GENTEN[1],YMIN)
    Tmp3<- Listplot(Tmp1,Tmp2)
    Tmp<- MakeCurves(Tmp3,0)
    if(Datalength(Tmp)>0){
      lines(Tmp[,1],Tmp[,2],col="green")
    }
    Tmp<-Doscaling(Framedata())
    lines(Tmp[,1],Tmp[,2])
  }
  for (I in Looprange(1,Nargs)){
    Pdata<-Flattenlist(varargin[[I]])  # 101129  from here
	Cmd<- list()
	for (II in Looprange(1,length(Pdata))){
      Tmp<-Pdata[[II]]
	   if(length(Tmp)==1){
        Cmd<- c(Cmd,list(Tmp))
        next
      }
	  
      P<-MakeCurves(Tmp,0)
	  
      if(length(Cmd)>0){ 
        if(length(Cmd)>=3){
          polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]])
        }
        else{
          polygon(P,col=Cmd[[1]],border=Cmd[[2]])
        }
        next
      }                                               # 101129  to here
      Ndm<-Dataindex(P)
      for (J in Looprange(1,Nrow(Ndm))){
        Q<-P[Ndm[J,1]:Ndm[J,2],]
        if(Nrow(Q)==1){
          Tmp<-seq(1,Ncol(Q),by=2)
          for (K in Tmp){
            Pt<-Q[K:(K+1)]
            points(Pt[1],Pt[2],col=color)#taka101111
          }
        }
        else{
          lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111
        }
      }
    }
  }
  par(new=FALSE)
}

######################################

#  3D

#################################

# 10.08.16
CameracoordCurve<- function(Curve){
  Out<- c()
  for(J in Looprange(1,Nrow(Curve))){
    P<- Ptcrv(J,Curve) #P=Curve(J,:);
    Tmp<- P-FocusPoint
    X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3]
    Tmp<- EyePoint-FocusPoint
    E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3]
    Ca<- E1/sqrt(E1^2+F1^2)
    Sa<- F1/sqrt(E1^2+F1^2)
    X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1
    E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
    Cb<- E2/sqrt(E2^2+G2^2)
    Sb<- G2/sqrt(E2^2+G2^2)
    X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb
    E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb
    Xz<- X3
    Yz<- E3/(E3-X3)*Y3
    Zz<- E3/(E3-X3)*Z3
    Out<- rbind(Out,c(Yz,Zz,Xz))
  }
  rownames(Out)<- 1:Nrow(Out)
  return(Out)
}

#########################################

#100815
CameraCurve<- function(Curve){
  Eps<- 10^(-6)
  for (I in Looprange(1,Nrow(Curve))){
    P<- Curve[I,]
    x<- P[1]; y<- P[2]; z<- P[3]
    if(x!=Inf){
      Tmp<- Perspt(P)
      if(I==1){
         AnsL<- rbind(c(),Tmp)
      }else{
        Tmp1<- AnsL[Nrow(AnsL),]
        if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){
          AnsL<- rbind(AnsL,Tmp)
        }
      }
    }else{
      AnsL<- rbind(AnsL,c(Inf,Inf))
    }
  }
  rownames(AnsL)<- 1:Nrow(AnsL)
  return(AnsL)
}

######################################

Cancoordpara<- function(P){   # 18.02.15
  Xz<- P[1]
  Yz<- P[2] 
  Zz<- P[3]
  X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA)
  Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA)
  Z<- Yz*sin(THETA)+Zz*cos(THETA)
  Out<- c(X,Y,Z)
  return(Out)
}

######################################

Cancoordpers<- function(P){
  Tmp<- EyePoint-FocusPoint
  E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3]
  Ca<- E1/sqrt(E1^2+F1^2)
  Sa<- F1/sqrt(E1^2+F1^2)
  E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
  Cb<- E2/sqrt(E2^2+G2^2)
  Sb<- G2/sqrt(E2^2+G2^2)
  E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb
  Xz<- P[3]; Yz<- P[1]; Zz<- P[2]
  X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3
  X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3
  X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2
  X<- X1+FocusPoint[1]
  Y<- Y1+FocusPoint[2]
  Z<- Z1+FocusPoint[3]
  Out<- c(X,Y,Z)
  return(Out)
}

#######################################

Embed<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Pd3<- varargin[[1]]
  if(Mixtype(Pd3)==1){
    Pd3<- list(Pd3)
  }
  else if(Mixtype(Pd3)==3){
    Tmp<- list();
    for(I in Looprange(1,length(Pd3))){
      Tmp<- c(Tmp,Pd3[[I]])
    }
    Pd3<- Tmp
  }
  Tmpf=varargin[[2]]
  if(mode(Tmpf)=="character"){
    Tmp<- varargin[[3]]
    Tmp1<- gsub("c(","(",Tmp,fixed=TRUE)
    Vstr<- gsub(")",")",Tmp1,fixed=TRUE)
    Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="")
    eval(parse(text=Str))
  }
  else{
    Tmpfn<- Tmpf
  }
  Out<- list()
  for(I in Looprange(1,length(Pd3))){
     PD<- Pd3[[I]]
     Ans<- c()
     for(J in Looprange(1,Nrow(PD))){
       P<- PD[J,]
       Tmp<- Tmpfn(P[1],P[2])
       Ans<- rbind(Ans,Tmp)
     }
     Out<- c(Out, list(Ans))
  }
  if(length(Out)==1){
    Out<- Out[[1]]
  }
  return(Out)
}

#######################
# 10.08.17
# 14.03.30
Facesdata<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  FL<- varargin[[1]]
  PT<- varargin[[length(varargin)]]
  Tmp<-grep("para",PT,fixed=TRUE)
  if(length(Tmp)>0){
    Ptype<- 1
  }else{
    Ptype<- -1
  }
  if(Nargs==2){
    CLadd<- list()
  }else{
    CLadd<- varargin[[2]]
  }
  NohiddenL<- list()
  HiddenL<- list()
  Eps<- 10^(-4)
  if(length(CLadd)>0){
    if(mode(CLadd)=="numeric"){
      C<- list()
      if(Nrow(CLadd)>1){
        for (I in Looprange(1,Nrow(CLadd))){
           C<- c(C,list(CLadd[I,]))
        }
      }else{
        I<- 1
        while (I<=Ncol(CLadd)){
          C<- c(C,list(CLadd[1,I:(I+2)]))
          I<- I+3
        }
      }
      CrvL<- list(C)
    }else if(mode(CLadd[[1]])=="numeric"){
      CrvL<- list()
      for (J in Looprange(1,length(CL))){
        Ctmp<- CLadd[[J]]
        C<- list()
        if(Nrow(Ctmp)>1){
          for (I in Looprange(1,Nrow(Ctmp))){
            C<- c(C,list(Ctmp[I,]))
          }
        }else{
          I<- 1
          while(I<=Ncol(Ctmp)){
            C<- c(C,list(Ctmp[1,I:(I+2)]))
            I<- I+3
          }
        }
        CrvL<- c(CrvL,list(C))
      }
    }else{
      CrvL<- CLadd
    }
  }else{
    CrvL<- list()
  }
  Out<- MakeveLfaceL(FL)
  VELNO<<- Out[[1]]
  VELHI<<- list()
  for (I in Looprange(1,length(CrvL))){
    Tmp<- CrvL[[I]]
    for (J in Looprange(1,length(Tmp)-1)){
      Edge<- list(Tmp[J],Tmp[J+1])
      Ntmp<- length(VELNO)
      VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1)
    }
  }
  FaceL<- Out[[2]]
  Tmp<- grep("raw",PT,fixed=TRUE)
  if(length(Tmp)==0){
    for (Nf in Looprange(1,length(FaceL))){
      Face<- FaceL[[Nf]]
      Menkakusi2(Face,Nf,Ptype)
    }
  }
  for (I in Looprange(1,length(VELNO))){
    Edge<- Op(1,VELNO[[I]])
    if(Norm(Edge[[1]]-Edge[[2]])>Eps){
      NohiddenL<- c(NohiddenL,list(Spaceline(Edge)))
    }
  }
  EdgeL<- list()  # from 13.03.30
  for(K in Looprange(1,length(VELHI))){
    Edge<- Op(1,VELHI[[K]])
    P<- Edge[[1]]; Q<- Edge[[2]]
    if(Norm(P-Q)>Eps){
      EdgeL<- c(EdgeL,list(Edge))
    }
  }
  for(K in Looprange(1,length(EdgeL))){
    Edge<- EdgeL[[K]]
    P<- Edge[[1]]; Q<- Edge[[2]]
    Cflg<- 0
    for(J in Looprange(K+1,length(EdgeL))){
      Ej<- EdgeL[[J]]
      Pj<- Ej[[1]]; Qj<- Ej[[2]]
      if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){
        next
      }
      if(Norm(Q-Pj)<Eps){
         EdgeL[[J]]<- list(P,Qj)
         Cflg<- 1
         break
      }
      if(Norm(P-Qj)<Eps){
        EdgeL[[J]]=list(Q,Pj)
        Cflg<- 1
        break
      }
    }
    if(Cflg==0){
      HiddenL<- c(HiddenL,list(Spaceline(Edge)))
   }
  }  # upto 14.03.30
  PHHIDDENDATA<<- HiddenL
  return(NohiddenL)
}

##############################
# 2014.03.31

PhHiddenData<- function(){
  PHHIDDENDATA
}

########## Old Fullform ( Check the case of Polygon )####################

Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL)
  Out<- list(Op(1,FdL))
  N<- Mixlength(FdL)
  for (Jrg in Looprange(1,N)){
    Tmp<- Stripblanks(Op(Jrg,FdL))
    Tmp1<- grep("=c(",Tmp,fixed=TRUE)
    if(length(Tmp1)>0){
      break
    }
  }
  Urg<- Stripblanks(Op(Jrg,FdL))
  StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]]
  Uname<- StrV[1]
  Vrg<- Stripblanks(Op(Jrg+1,FdL))
  StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]]
  Vname<- StrV[1]
  if(Jrg==2){
    Tmp<- Stripblanks(Op(1,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
    Zf<- StrV[2]
    Tmp<- list(Uname,Vname,Zf,Urg,Vrg)
    Out<- c(Out,Tmp)
  }else if(Jrg==4){
    Tmp<- Stripblanks(Op(1,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
    Zf<- StrV[2]
    Tmp<- Stripblanks(Op(2,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
	Xname<- StrV[1]
    Xf<- StrV[2]
    Tmp<- Stripblanks(Op(3,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
    Yname<- StrV[1]
    Yf<- StrV[2]
    Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE)
    Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE)
    Tmp<- list(Xf,Yf,Zf,Urg,Vrg)
    Out<- c(Out,Tmp)
  }else{
    Tmp<- Stripblanks(Op(2,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
    Xf<- StrV[2]
    Tmp<- Stripblanks(Op(3,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
    Yf<- StrV[2]
    Tmp<- Stripblanks(Op(4,FdL))
    StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
    Zf<- StrV[2]
    Tmp<- list(Xf,Yf,Zf,Urg,Vrg)
    Out<- c(Out,Tmp)
  }
  DrwS<- "enws"
  BdyL<- c()
  for (I in Looprange(Jrg+2,Mixlength(FdL))){
    Tmp<- Op(I,FdL)
    if(mode(Tmp)=="character"){
      if(length(Tmp)==0){
        Tmp<- " "
      }
      DrwS<- Tmp
    }
    if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){
      BdyL<- Tmp
    }
  }
  Tmp<- list(DrwS,BdyL)
  Out<- c(Out,Tmp)
  return(Out)
}

####################################

Initangle<- function (){
  PHI<<- 30*pi/180
  THETA<<- 60*pi/180
}

##########################

Invparapt<- function(...){
  varargin<- list(...)
  Eps<- 10^(-4)
  Fk<- varargin[[length(varargin)]]
  NFk<- Numptcrv(Fk)    
  Tmp<- varargin[[1]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1){  # debug 
    Ph<- Tmp
    Fh<- varargin[[2]]
  }else{
    Fh<- Projpara(Fk)
    if(NFk>2){
      Tmp1<- Nearestpt(Tmp,Fh)
      Ph<- Tmp1[[2]]
    }else{
      Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh)
      V1<- Tmp-Ah; V2<- Bh-Ah
      Tmp1<- Crossprod(V1,V2)
      if(abs(Tmp1)>Eps){
        print("Not on the line")
        return(c())
      }else{
        Ph<- Dotprod(V1,V2)/Norm(V2)^2+1
      }
    }
  }
  if(NFk>2){
    N<- trunc(Ph)
    S0<- Ph-N
    if(Ph>Numptcrv(Fh)-Eps){
      Out<- list(Ptend(Fk),Numptcrv(Fh))
      return(Out)
    }
  }else{
    N<- 1
    S0<- Ph-1
  }
  Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk)
  Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh)
  Ph<- (1-S0)*Ah+S0*Bh
  T2<- S0
  Pk<- (1-T2)*Ak+T2*Bk
  Out<- list(Pk,N+T2)
  return(Out)
}

#################################

#100815
Invperspt<- function(...){
  varargin<-list(...)
  Eps<- 10^(-4)
  Fk<- varargin[[length(varargin)]]
  NFk<- Numptcrv(Fk)     
  Tmp<- varargin[[1]]
  if(mode(Tmp)=="numeric" && length(Tmp)==1){
    Ph<- varargin[[1]]
    Fh<- varargin[[2]]
  }else{
    Fh<- Projpers(Fk)
    if(NFk>2){
      Tmp1<- Nearestpt(Tmp,Fh)
      Ph<- Tmp1[[2]]
    }else{
      Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh)
      V1<- Tmp-Ah; V2<- Bh-Ah
      Tmp1<- Crossprod(V1,V2)
      if(abs(Tmp1)>Eps){
        print("Not on the line")
        Out<- c()
        return(Out)
      }else{
        Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12
      }
    }
  }
  if(NFk>2){
    N<- trunc(Ph)
    S0<- Ph-N
    if(Ph>Numptcrv(Fh)-Eps){
      Out<- list(Ptend(Fk),Numptcrv(Fh))
      return(Out)
    }
  }else{
    N<- 1
    S0<- Ph-1 # 09.11.12
  }
  Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk)
  Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh)
  Ph<- (1-S0)*Ah+S0*Bh
  Phc<- Cancoordpers(c(Ph,0))
  Ahc<- Cancoordpers(c(Ah,0))
  Bhc<- Cancoordpers(c(Bh,0))
  Vp<- Phc-EyePoint
  Va<- Ak-EyePoint
  AB<- Bk-Ak
  Cp<- Crossprod(Vp,AB)
  Nmr<- Crossprod(Va,Vp)
  Mx<- max(abs(Cp))
  if(abs(Cp[1])==Mx){
    T2<- Nmr[1]/Cp[1]
  }else if(abs(Cp[2])==Mx){
    T2<- Nmr[2]/Cp[2]
  }else{
    T2<- Nmr[3]/Cp[3]
  }
  Pk<- (1-T2)*Ak+T2*Bk
  Out<- list(Pk,N+T2)
  return(Out)
}

#########################

Kukannozoku<- function(Jokyo,KukanL){
  Eps<- 10^(-6)
  N<- Nrow(KukanL)
  T1<- Jokyo[1]; T2<- Jokyo[2]
  Tmp<- KukanL[1,]
  T1<- max(T1,Tmp[1])
  Tmp<- KukanL[N,]
  T2<- min(T2,Tmp[2])
  Res<- c()
  Flg<- 0
  for (I in Looprange(1,N)){
    Ku<- KukanL[I,]
    if(Flg==0){
      if(Ku[2]<T1){
        Res<- rbind(Res,Ku)
      }else{
        Flg<- 1
        if(Ku[1]<T1-Eps){
          Tmp<- c(Ku[1],T1)
          Res<- rbind(Res,Tmp)
        }
        if(Ku[2]>T2+Eps){
          Tmp<- c(T2,Ku[2])
          Res<- rbind(Res,Tmp)
        }
      }
    }else if(Flg==1){
      if(Ku[2]<T2){
        next
      }else{
        Flg<- 2
        if(Ku[1]<T2-Eps){
          Ku<- c(T2,Ku[2])
        }
        Res<- rbind(Res,Ku)
      }
    }else{
      Res<- rbind(Res,Ku)
    }
  }
  return(Res)
}

########################################

Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
  Eps<- 10.0^(-3)
  Dmat<- c()
  Dind<- c()
  for (I in Looprange(1,Mixlength(Plt2L))){
    Dt<- Op(I,Plt2L)
    N1<- Nrow(Dmat)+1
    if(Nrow(Dmat)==0){
      Dmat<- Dt
    }else{
      Dmat<- rbind(Dmat,Dt)
    }
    N2<- Nrow(Dmat)
    Dind<- c(Dind,N1,N2)
  }
  Dind<- matrix(Dind,ncol=2,byrow=TRUE)
  Nind<- Nrow(Dind)
  Allres<- list()
  for (Nobj in Looprange(1,Mixlength(Obj2L))){
    Plt2<- Op(Nobj,Obj2L)
    PhL<- Plt2[,1:2]
    ClipL<- c()
    for (Ns in Looprange(1,Nrow(PhL)-1)){
      P1<- PhL[Ns:(Ns+1),]
      for (I in Looprange(1,Nrow(Dind))){
        Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
        P2<- Tmp[,1:2]
        KC<- IntersectcrvsPp(P1,P2,Eps)
        if(Mixlength(KC)>0){
          for (J in 1:Mixlength(KC)){
            P<- Op(1,Op(J,KC))
            Tmp<- Op(2,Op(J,KC))
            if(Tmp<1+Eps && Ns==1){
              next
            }    
            if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
              next
            }
            N1<- Ns
            N2<- Op(3,Op(J,KC))
            Pa<- Plt2[N1,1:2]
            Za<- Plt2[N1,3]
            Pb<- Plt2[N1+1,1:2]
            Zb<- Plt2[N1+1,3]
            if(Norm(Pa-Pb)<Eps){
              next
            }
            T1<- Norm(Pa-P)/Norm(Pa-Pb)
            Z1<- (1-T1)*Za+T1*Zb
            Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
            Pa<- Tmp[N2,1:2]
            Za<- Tmp[N2,3]
            Pb<- Tmp[N2+1,1:2]
            Zb<- Tmp[N2+1,3]
            if((Norm(Pa-Pb)<Eps)){
              next
            }
            T2<- Norm(Pa-P)/Norm(Pa-Pb)
            Z2<- (1-T2)*Za+T2*Zb
            if(Z1<Z2-Eps2){
              if(Nrow(ClipL)==0){
                Tmp<- 1
              }else{
                Tmp1<- ClipL[,1]-P[1] 
                Tmp2<- ClipL[,2]-P[2]
                Tmp3<- Tmp1^2+Tmp2^2
                Tmp<- min(Tmp3)              
              }
              if(Tmp>Eps^2){
                Tmp1<- P1[2,]-P1[1,]
                Tmp2<- Pb-Pa
                Tmp3<- Dotprod(Tmp1,Tmp2)
                Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2)
                Tmp<- 1-0.5*Tmp3^2
                ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp))
              }
            }
          }
        }
      }
    }
    Te<- Nrow(Plt2)
    KukanL<- rbind(c(),c(1.0,Te))
    P1<- PhL
    if(Nrow(ClipL)>0){
      for (I in 1:Nrow(ClipL)){
        P<- ClipL[I,1:2]
        NN<- ClipL[I,3]
        T<- NN+ClipL[I,4]
        R<- ClipL[I,5]
        Flg<- 0
        for (J in NN:1){
          Q<- Pointoncurve(J,P1)
          if(Norm(P-Q)<R){
            next
          }
          Flg<- 1
          break
        }
        if(Flg==0){
          T1<- 1
        }else{
          T1<- J; T2<- T
          H<- T2-T1
          for (N in 1:10){
            H<- H*0.5
            Q<- Pointoncurve(T1+H,P1)
            if(Norm(P-Q)<R){
              T2<- T2-H
            }else{
              T1<- T1+H
            }
          }
        }
        Ku<- c(T1)
        Flg<- 0
        for (J in Looprange(NN+1,Te)){
          Q<- Pointoncurve(J,P1)
          if(Norm(P-Q)<R){
            next
          }
          Flg<- 1
          break
        }
        if(Flg==0){
          T2<- Te
        }else{
          T1<- T; T2<- J
          H<- T2-T1
          for (N in 1:10){
            H<- H*0.5
            Q<- Pointoncurve(T1+H,P1)
            if(Norm(P-Q)<R){
              T1<- T1+H
            }else{
              T2<- T2-H
            }
          }
        }
        Ku<- c(Ku,T2)
        KukanL<- Kukannozoku(Ku,KukanL)
      }
    }
    Res<- list()
    for (I in Looprange(1,Nrow(KukanL))){
      T1<- KukanL[I,1]; N1<- trunc(T1)
      T2<- KukanL[I,2]; N2<- trunc(T2)
      PtL<- list()
      if(T1-N1<1-Eps){
        Tmp<- Pointoncurve(T1,P1)
        PtL<- list(Tmp)
      }
      for (J in Looprange(N1+1,N2)){
        Tmp<- Pointoncurve(J,P1)
        PtL<- c(PtL,list(Tmp))
      }
      if(T2-N2>Eps){
        Tmp<- Pointoncurve(T2,P1)
        PtL<- c(PtL,list(Tmp))
      }
      Res<- c(Res,list(Listplot(PtL)))
    }
    Allres<- c(Allres,Res)
  }
  return(Allres)
}

#########################

#100815
Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
  Eps<- 10.0^(-3)
  Dmat<- c()
  Dind<- c()
  for (I in Looprange(1,Mixlength(Plt2L))){
    Dt<- Op(I,Plt2L)
    N1<- Nrow(Dmat)+1
    Dmat<- rbind(Dmat,Dt)
    N2<- Nrow(Dmat)
    Dind<- rbind(Dind,c(N1,N2))
  }
  Nind<- Nrow(Dind)
  Allres<- list()
  for (Nobj in Looprange(1,Mixlength(Obj2L))){
    Plt2<- Op(Nobj,Obj2L)
    PhL<- Plt2[,1:2]
    ClipL<- c()
    for (Ns in Looprange(1,Nrow(PhL)-1)){
      P1<- PhL[Ns:(Ns+1),]
      for (I in Looprange(1,Nrow(Dind))){
        Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
        P2<- Tmp[,1:2]
        KC<- IntersectcrvsPp(P1,P2,Eps)
        if(Mixlength(KC)>0){
		  for (J in Looprange(1,Mixlength(KC))){#
            P<- Op(1,Op(J,KC))
            Tmp<- Op(2,Op(J,KC))
            if(Tmp<(1+Eps) && Ns==1){
              next
            }   
            if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
              next
            }
            N1<- Ns
            N2<- Op(3,Op(J,KC))
            Pa<- Plt2[N1,1:2]
            Za<- Plt2[N1,3]
            Pb<- Plt2[N1+1,1:2]
            Zb<- Plt2[N1+1,3]
            if(Norm(Pa-Pb)<Eps){
              next
            }
            T1<- Norm(Pa-P)/Norm(Pa-Pb)#norm(Pa-P)/norm(Pa-Pb)
            Pka<- Cancoordpers(c(Pa[1],Pa[2],Za))
            Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb))
            if(T1>1-Eps){
              Pk<- Pkb
            }else{
              Tmp1<- Listplot(c(Pa,Pb))
              Tmp2<- Spaceline(c(Pka,Pkb))
              Tmp<- Invperspt(1+T1,Tmp1,Tmp2)
              Pk<- Op(1,Tmp)
            }
            Z1<- Zperspt(Pk)
            Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
            Pa<- Tmp[N2,1:2]
            Za<- Tmp[N2,3]
            Pb<- Tmp[N2+1,1:2]
            Zb<- Tmp[N2+1,3]
            if(Norm(Pa-Pb)<Eps){
              next
            }         
            T2<- Norm(Pa-P)/Norm(Pa-Pb)
            Pka<- Cancoordpers(c(Pa[1],Pa[2],Za))
            Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb))
            if(T2>(1-Eps)){
              Pk<- Pkb
            }else{
              Tmp1<- Listplot(c(Pa,Pb))
              Tmp2<- Spaceline(c(Pka,Pkb))
              Tmp<- Invperspt(1+T2,Tmp1,Tmp2)
              Pk<- Op(1,Tmp)
            }
            Z2<- Zperspt(Pk)
            if(Z1<(Z2-Eps2)){
              if(length(ClipL)==0){
                Tmp<- 1
              }else{
                Tmp1<- ClipL[,1]-P[1]
                Tmp2<- ClipL[,2]-P[2]
                Tmp3<- Tmp1^2+Tmp2^2
                Tmp<- min(Tmp3)              
              }
              if(Tmp>Eps^2){
                Tmp1<- P1[2,]-P1[1,]
                Tmp2<- Pb-Pa
                Tmp3<- Dotprod(Tmp1,Tmp2)
                Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2)
                Tmp<- 1-0.5*Tmp3^2
                ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp))
              }
            }
          }
        }
      }
    }
    Te<- Nrow(Plt2)
    KukanL<- rbind(c(),c(1.0,Te))
    P1<- PhL
    if(Nrow(ClipL)>0){
      for (I in Looprange(1,Nrow(ClipL))){
        P<- ClipL[I,1:2]
        NN<- ClipL[I,3]
        T<- NN+ClipL[I,4]
        R<- ClipL[I,5] #added 10.08.17
        Flg<- 0
        for (J in NN:1){
          Q<- Pointoncurve(J,P1)
          if(Norm(P-Q)<R){#(norm(P-Q)<R)
            next
          }
          Flg<- 1
          break
        }
        if(Flg==0){
          T1<- 1
        }else{
          T1<- J; T2<- T
          H<- T2-T1
          for (N in 1:10){
            H<- H*0.5
            Q<- Pointoncurve(T1+H,P1)
            if(Norm(P-Q)<R){ # norm(P-Q)<R
              T2<- T2-H
            }else{
              T1<- T1+H
            }
          }
        }
        Ku<- c(T1)#Ku<- [T1]
        Flg<- 0
        for (J in Looprange(NN+1,Te)){
          Q<- Pointoncurve(J,P1)
          if(Norm(P-Q)<R){
            next#continue
          }
          Flg<- 1
          break
        }
        if(Flg==0){
          T2<- Te
        }else{
          T1<- T; T2<- J
          H<- T2-T1
          for (N in 1:10){
            H<- H*0.5
            Q<- Pointoncurve(T1+H,P1)
            if(Norm(P-Q)<R){
              T1<- T1+H
            }else{
              T2<- T2-H
            }
          }
        }
        Ku<- c(Ku,T2)#[Ku,T2]
        KukanL<- Kukannozoku(Ku,KukanL)
      }
    }
    Res<- list()#[]
    for (I in Looprange(1,Nrow(KukanL))){#(I=1:size(KukanL,1))
      T1<- KukanL[I,1]; N1<- trunc(T1)
      T2<- KukanL[I,2]; N2<- trunc(T2)
      PtL<- list()#[]
      if(T1-N1<1-Eps){
        Tmp<- Pointoncurve(T1,P1)
        PtL<- list(Tmp)#100816c(PtL,list(Tmp)) PtL<- MixS(Tmp)
      }
      for (J in Looprange(N1+1,N2)){
        Tmp<- Pointoncurve(J,P1)
        PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp)
      }
      if(T2-N2>Eps){
        Tmp<- Pointoncurve(T2,P1)
        PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp)
      }
      Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL))
    }
    Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res)
  }
  return(Allres)
}

##############################3

MakeveLfaceL<- function(VfL){
#  // Out format
#  //   VeL   Edge, Face num(as numlist), VeL num
#  //   FL    Face (Vertexs)
  Eps<- 10^(-4)
  Tmp<- VfL[[length(VfL)]]
  Tmp1<- Tmp[[1]]
  if(mode(Tmp1)=="numeric"){
    FvL<- list(VfL)
  }else{
    FvL<- VfL
  }
  EL<- list(); FL<- list()
  for (Nn in Looprange(1,length(FvL))){
    Tmp<- FvL[[Nn]]
    VL<- Tmp[[1]]
    if(length(VL)>0){
      FnL<- Tmp[[2]]
      FaceL<- list()
      for (I in Looprange(1,length(FnL))){
        Tmp1<- FnL[[I]]
        PtL<- list()
        for (J in Looprange(1,length(Tmp1))){
          Tmp2<- Tmp1[[J]]
          PtL[[J]]<- VL[[Tmp2]]
        }
        FaceL[[I]]<- PtL
      }
    }else{
      FaceL<- list(Tmp[[2]])
    }
    for (I in Looprange(1,length(FaceL))){
      Face<- FaceL[[I]]
      Face<- c(Face,list(Face[[1]]))
      FL<- c(FL,list(Face))
      for (J in Looprange(1,length(Face)-1)){
        Edge<- list(Face[[J]],Face[[J+1]])
        Flg<- 0
        for (K in Looprange(1,length(EL))){
          Tmp<- EL[[K]]
          Tmp1<- Tmp[[1]]
          Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]])
          Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]])
          if(Tmp2<Eps || Tmp3<Eps){#(
            Tmp<- EL[[K]]
            Tmp1<- Tmp[[1]]
            Tmp2<- c(Tmp[[2]],length(FL))
            EL[[K]]<- list(Tmp1,Tmp2,K)
            Flg<- 1
            break
          }
        }
        if(Flg==0){
          Ntmp<- length(EL)
          EL[[Ntmp+1]]<- list(Edge,c(length(FL)),Ntmp+1)
        }
      }
    }
  }
  Out<- list(EL,FL)
  return(Out)
}

###########################
#// 09.10.29
#// 09.11.15

Menkakusi2<- function(Face,Nf,Ptype){
#  global THETA PHI EyePoint FocusPoint VELNO VELHI
  Eps0<- 10^(-6)
  Eps<- 10^(-4)
  Tmp1<- Face[[1]]-Face[[2]]
  Tmp2<- Face[[3]]-Face[[2]]
   if(Norm(Tmp1)<Eps || Norm(Tmp2)<Eps){
    return()
  }  
  Vec<- 1/Norm(Tmp1)/Norm(Tmp2)*Crossprod(Tmp1,Tmp2)
  if(Norm(Vec)<Eps){
    return()
  }
  if(Ptype== -1){
    W<- EyePoint
    Tmp<- Dotprod(Vec,W-Face[[1]])
  }else{
    W<- c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA))
    W<- 100*W
    Tmp<- Dotprod(Vec,W-Face[[1]])
  }
  if(abs(Tmp)<Eps){
    return()
  }
  if(Tmp<-Eps){
    Vec<- -Vec
  }
  if(Ptype==-1){
    G1<- Projpers(Spaceline(Face))
  }else{
    G1<- Projpara(Spaceline(Face))
  }
  VL<- list()
  for (I in Looprange(1,Numptcrv(G1))){
    VL[[I]]<- Ptcrv(I,G1)
  }
  Out1L<- list()
  Out2L<- VELHI
  for (N in Looprange(1,length(VELNO))){
    Out1<- list()
    Out2<- list()
    Tmp<- VELNO[[N]]
    Edge<- Tmp[[1]]
    Ne<- Tmp[[2]]
    NNe<- Tmp[[3]]
    if(Member(Nf,Ne)){
      Out1L<- c(Out1L, list(list(Edge,Ne,NNe)))
      next
    }
    if(Ptype==-1){
      PtA<- Perspt(Edge[[1]])
      PtB<- Perspt(Edge[[2]])
    }else{
      PtA<- Parapt(Edge[[1]])
      PtB<- Parapt(Edge[[2]])
    }
    if(Norm(PtA-PtB)<Eps){
      next
    }
    Bdy<- list(G1)
	V<- PtB-PtA
    TenL<- KoutenList(PtA,V,Bdy)
    Nten<- length(TenL)
    if(Nten==0){  # debug 10.08.17
      Out1L<- c(Out1L,list(list(Edge,Ne,NNe)))
      next
    }
	Te<- 0
    Pe3<- Edge[[1]]
    if(Ptype==-1){
      Tmp1<- Perspt(Pe3)
      Tmp<- Invperspt(Tmp1,Spaceline(Face))
    }else{
      Tmp1<- Parapt(Pe3)
      Tmp<- Invparapt(Tmp1,Spaceline(Face))
    }
    Qe3<- Tmp[[1]]
    Flg<- 0
    for (I in Looprange(1,Nten)){
      TenP<- TenL[[I]]
      Ts<- TenP[[1]]
      P<- TenP[[2]]
      if(Ts< -Eps){
        next
      }
      Eline<- Spaceline(Edge) 
      if(Ptype==-1){
        Tmp<- Invperspt(P,Eline)
        Tmp1<- Invperspt(P,Spaceline(Face))
      }else{
        Tmp<- Invparapt(P,Eline)
        Tmp1<- Invparapt(P,Spaceline(Face))
      }
      P3<- Tmp[[1]]; Q3<- Tmp1[[1]]
      if(Ts>1-Eps){#  // P3, Q3 are necessary
        Flg<- I
        break
      }
      if(abs(Te-Ts)>Eps0){
        if((I%%2)==1){
          Out1<- c(Out1,list(list(Pe3,P3)))
        }else{
          if(length(Qe3)==0){
            Tmp<- Op(2,TenL[[I-1]])
            if(Ptype==-1){
              Tmp1<- Invperspt(Tmp,Spaceline(Face))
            }else{
              Tmp1<- Invparapt(Tmp,Spaceline(Face))
            }
            Qe3<- Tmp1[[1]]
          }
          PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3)
          if(Ptype==-1){
            Z1<- Zperspt(PM); Z2<- Zperspt(QM)
          }else{
            Z1<- Zparapt(PM); Z2<- Zparapt(QM)
          }
          if(Z1>Z2){
            Out1<- c(Out1, list(list(Pe3,P3)))
          }else{
            Out2<- c(Out2, list(list(Pe3,P3)))
          }##
        }
      }
      Te<- Ts; Pe3<- P3; Qe3<- Q3
    }
    if(Flg==0){
      if(Norm(Pe3-Edge[[2]])>Eps0){
        Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
      }
    }else{
      if((Flg%%2)==1){ 
        Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
      }else{
        PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3)
        if(Ptype==-1){
          Z1<- Zperspt(PM); Z2<- Zperspt(QM)
        }else{
          Z1<- Zparapt(PM); Z2<- Zparapt(QM)
        }
        if(Z1>Z2){
          Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
        }else{
          Out2<- c(Out2, list(list(Pe3,Edge[[2]])))
        }       
      }
    }
    for (I in Looprange(1,length(Out1))){
      Tmp<- Out1[[I]]
      if(I==1){
        SeL<- Tmp
      }else{
        if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){
          SeL[[2]]<- Tmp[[2]]
        }else{
          Out1L<- c(Out1L, list(list(SeL,Ne,NNe)))
          SeL<- Tmp
        }
      }
    }
    if(length(Out1)>0){
      Out1L<- c(Out1L, list(list(SeL,Ne,NNe)))
    }
    for (I in Looprange(1,length(Out2))){
      Tmp<- Out2[[I]]
      if(I==1){
        SeL<- Tmp
      }else{
        if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){
          SeL[[2]]<- Tmp[[2]]
        }else{
          Out2L<- c(Out2L, list(list(SeL,Ne,NNe)))
          SeL<- Tmp
        }
      }
    }
    if(length(Out2)>0){
      Out2L<- c(Out2L, list(list(SeL,Ne,NNe)))
    }
  }
  VELNO<<- Out1L
  VELHI<<- Out2L
}

###################################

Parapt<- function(Plist){  # 18.02.19 changed (for point list)
  if(!is.list(Plist)){Plist=list(Plist)}
  Out=list()
  for(jj in 1:length(Plist)){
    P=Op(jj,Plist)
    x<- P[1]
    y<- P[2]
    z<- P[3]
    Xz<- -x*sin(PHI)+y*cos(PHI)
    Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA)
    Out<- c(Out,list(c(Xz,Yz)))
  }
  if(length(Out)==1){Out=Op(1,Out)}
  return(Out)
}

###################################

Partcrv3<- function(T1,T2,Fk){
  Eps0=10^(-4)
#// Tmp=Mixop(1,Fk)
#// new part from
  if(T1>(T2+Eps0)){
    Npt<- Nrow(Fk)
    Out1<- Partcrv3(T1,Npt,Fk)
    Out2<- Partcrv3(1,T2,Fk)
    Tmp<- Fk[1,]-Fk[Npt,]
    if(Norm(Tmp)<Eps0){
      PL<- Joincrvs(Out1,Out2) 
    }else{
      PL<- list(Out1,Out2)
    }
    rownames(PL)<- 1:Nrow(PL)
    return(PL)
  }
  if(floor(T1)==floor(T2)){ #18.02.26from
    Tmp=floor(T1)
    p1=Op(Tmp,Fk); p2=Op(Tmp+1,Fk)
    PL=c(p1+(T1-Tmp)*(p2-p1)) 
    PL=Appendrow(PL, p1+(T2-Tmp)*(p2-p1)) #18.02.26upto
  }else{
    Is<- ceiling(T1)
    Ie<- floor(T2)
    PL<- c()
    if(T1<Is-Eps0){
      P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,]  
      PL<- Appendrow(PL, P)  #18.02.10(bug)
    }
    PL<- Appendrow(PL,Fk[Is:Ie,])
    if(T2>(Ie+Eps0)){
      P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] 
      PL<- Appendrow(PL,P)
    }
  }
  return(PL)
}

###################################

#100815
Perspt<- function(P){
  Tmp<- P-FocusPoint
  X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3]
  Tmp<- EyePoint-FocusPoint
  E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3]
  Ca<- E1/sqrt(E1^2+F1^2)
  Sa<- F1/sqrt(E1^2+F1^2)
  X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1
  E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
  Cb<- E2/sqrt(E2^2+G2^2)
  Sb<- G2/sqrt(E2^2+G2^2)
  X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb
  E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb
  Yz<- E3/(E3-X3)*Y3
  Zz<- E3/(E3-X3)*Z3
  Out<- c(Yz,Zz)
  return(Out)
}


#################################

Phcutdata<- function(VL,FaceL,PlaneD){
  Out<- list()
  EL<- list()
  Eps<- 10^(-4)
  for (I in Looprange(1,Mixlength(FaceL))){
    Face<- Op(I,FaceL)
    for (J in Looprange(1,length(Face))){
      Nj<- J+1
      if(J==length(Face)){
        Nj<- 1
      }
      N1<- Face[J]; N2<- Face[Nj]
      Tmp<- c(N1,N2)
      Flg<- 0
      for (K in Looprange(1,Mixlength(EL))){
        Tmp1<- Op(K,EL)
        Tmp2<- Tmp1[2:1]
        if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){
          Flg<- 1
          break
        }
      }
      if(Flg==0){
        EL<- c(EL,list(Tmp))
      }
    }
  }
  Out0<- list()
  for (I in Looprange(1,Mixlength(EL))){
    Tmp<- Op(I,EL)
    Tmp1<- Op(Tmp[1],VL)
    Tmp2<- Op(Tmp[2],VL)
    Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2)))
  }
  if(Mixtype(PlaneD)!=1){
    V1<- Op(1,PlaneD)
    Tmp<- Op(2,PlaneD)
    if(length(Tmp)>1){
      d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3]
    }else{
      d<- Tmp
    }
  }else if(mode(PlaneD)=="numeric"){
    V1<- PlaneD[1:3]
    d<- PlaneD[4]
  }else{
    StrV<- strsplit(PlaneD,"=",fixed=TRUE)
	StrV<- StrV[[1]]
	if(length(StrV)>1){
	  Tmp1<- StrV[1] 
	  Tmp2<- StrV[2]
      PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="")
    }
    x<- 0; y<- 0; z<- 0
    d<- -eval(parse(text=PlaneD))
    x<- 1; y<- 0; z<- 0;
    Tmp1<- eval(parse(text=PlaneD))+d
    x<- 0; y<- 1; z<- 0
    Tmp2<- eval(parse(text=PlaneD))+d
    x<- 0; y<- 0; z<- 1
    Tmp3<- eval(parse(text=PlaneD))+d
    V1<- c(Tmp1,Tmp2,Tmp3)
  }
  if(all(V1==c(0,0,0))){
    return(Out0)
  }
  V3<- c(1,0,0)
  Out1<- Rotate3data(Out0,V1,V3)
  Tmp2<- Rotate3pt(c(1,0,0),V3,V1)
  Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3]
  x0<- d/Tmp
  PtL<- list()
  for (I in Looprange(1,Mixlength(Out1))){
    Tmp<- Op(I,Out1)
    Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,]
    P<- list(Tmp1,Tmp2-Tmp1)
    Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1])
    if(abs(Tmp[[2]]) < Eps){
      Tmp<- c()
    }else{
      Tmp1<- Tmp[[2]]
      Tmp2<- x0-Tmp[[1]]
      Tmp<- c(Tmp2/Tmp1)
    }
    if(length(Tmp)>0){
      Tmp<- Tmp[1]
      if(Tmp>-Eps && Tmp<(1+Eps)){
        Tmp3<- P[[1]]+Tmp*P[[2]]
        Tmp3<- Rotate3pt(Tmp3,V3,V1)
        if(Tmp<Eps){
          Tmp1<- Op(I,EL)
          Tmp1<- Tmp1[1]
          Tmp4<- list(c(Tmp1,Tmp1),Tmp3)
        }else{
          if(Tmp>1-Eps){
            Tmp1<- Op(I,EL)
            Tmp1<- Tmp1[2]
            Tmp4<- list(c(Tmp1,Tmp1),Tmp3)
          }else{
            Tmp4<- list(Op(I,EL),Tmp3)
          }
        }
        Flg<- 0
        for (J in Looprange(1,Mixlength(PtL))){
          Tmp<- Op(J,PtL)
          Tmp<- Op(2,Tmp)
          if(Norm(Tmp3-Tmp)<Eps){
            Flg<- 1
            break
          }
        }
        if(Flg==0){
          PtL<- c(PtL,list(Tmp4))
        }
      }
    }
  }
  if(Mixlength(PtL)==0){
    return(Out0)
  }
  PL<- list(Op(1,PtL))
  QL<- PtL[2:Mixlength(PtL)]
  N<- Mixlength(QL)
  for (I in Looprange(2,N+1)){
    Tmp1<- Op(Mixlength(PL),PL)
    Tmp1<- Op(1,Tmp1)
    for (J in Looprange(1,Mixlength(QL))){
      Tmp2<- Op(J,QL)
      Tmp2<- Op(1,Tmp2)
      Flg<- 0
      for (K in Looprange(1,Mixlength(FaceL))){
        Tmp3<- Op(K,FaceL);
        if(Member(Tmp1[1],Tmp3) &&
             Member(Tmp1[2],Tmp3) && 
             Member(Tmp2[1],Tmp3) && 
             Member(Tmp2[2],Tmp3)){
          Flg<- 1
          break
        }
      }
      if(Flg==1){
        break
      }
    }
    J<- min(J, Mixlength(QL))
    PL<- c(PL,list(Op(J,QL)))
    Tmp1<- QL[Looprange(1,J-1)]
    Tmp2<- QL[Looprange(J+1,Mixlength(QL))]
    QL<- c(Tmp1,Tmp2)
    if(Mixlength(QL)==0){
      break
    }
  }
  PHCUTPOINTL<<- PL
  Tmp<- list()
  for (J in Looprange(1,Mixlength(PL))){
    Tmp1<- Op(J,PL)
    Tmp1<- Op(2,Tmp1)
    Tmp<- c(Tmp,list(Tmp1))
  }
  Tmp1<- Op(1,PL)
  Tmp1<- Op(2,Tmp1)
  Tmp<- c(Tmp,list(Tmp1))
  Out2<- Spaceline(Tmp)
  Out<- c(Out0,list(Out2))
}

#########################################

Phcutoffdata<- function(...){
  varargin<-list(...)
  Eps<- 10^(-4)
  Out2<- list()
  VL<- varargin[[1]]
  FaceL<- varargin[[2]]
  PlaneD<- varargin[[3]]
  Sgnstr<- varargin[[4]]
  Fugou<- 1
  if(Sgnstr=="-" || Sgnstr=="n"){
    Fugou<- -1
  }
  Out0<- Phcutdata(VL,FaceL,PlaneD)
  PtL<- PHCUTPOINTL
  PHVERTEXL<<- VL
  PHFACEL<<- FaceL
  if(length(PtL)==0){
	Out2<- Out0
    return(Out2)
  }
  N1<- Mixlength(VL)
  Face<- c()
  for (I in Looprange(1,Mixlength(PtL))){
    Tmp<- Op(I,PtL)
    Tmp3<- Op(1,Tmp) 
    Tmp1<- Tmp3[[1]]; Tmp2<- Tmp3[[2]] # debugged 10.08.14
	if(Tmp1!=Tmp2){ 	
      VL<- c(VL,list(Op(2,Tmp)))
      N1<- N1+1
      Tmp1<- N1
    }
    Face<- c(Face,Tmp1)
    PtL[[I]]<- list(Op(1,Tmp),Tmp1)
  }
  OutfL<- list(Face)
  if(Mixtype(PlaneD)!=1){
    V1<- Op(1,PlaneD)
    Tmp<- Op(2,PlaneD)
    if(length(Tmp)>1){
      d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3]
    }else{
      d<- Tmp
    }
  }else if(mode(PlaneD)=="numeric"){
    V1<- PlaneD[1:3]
    d<- PlaneD[4]
  }else{
    StrV<- strsplit(PlaneD,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Tmp1<- StrV[1]
	  Tmp2<- StrV[2]
      PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="")
    }
    x<- 0; y<- 0; z<- 0
    d<- -eval(parse(text=PlaneD))
    x<- 1; y<- 0; z<- 0
    Tmp1<- eval(parse(text=PlaneD))+d
    x<- 0; y<- 1; z<- 0
    Tmp2<- eval(parse(text=PlaneD))+d
    x<- 0; y<- 0; z<- 1
    Tmp3<- eval(parse(text=PlaneD))+d
    V1<- c(Tmp1,Tmp2,Tmp3)
  }
  for (I in Looprange(1,Mixlength(FaceL))){
    Face<- Op(I,FaceL)
    TmpL<- list()
    for (J in Looprange(1,length(Face))){
      N1<- Face[J]
      if(J==length(Face)){
        N2<- Face[1]
      }else{
        N2<- Face[J+1]
      }
      for (K in Looprange(1,Mixlength(PtL))){
        Pd<- Op(K,PtL)
        Tmp<- Op(1,Pd)
        if(Tmp[1]==Tmp[2]){
          if(Tmp[1]==N1){
            TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) 
          }
        }else{
          if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){
            TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd))))
          }
        }
      }
    }
    if(Mixlength(TmpL)<2){
	  Flg<- 0
      for (J in Looprange(1,length(Face))){
        Tmp<- Op(Face[J],VL)
       Tmp1<- Fugou*(Dotprod(V1,Tmp)-d)
        if(Tmp1< -Eps){
          Flg<- 1
          break
        }
      }
	  if(Flg==0){
        OutfL<- c(OutfL,list(Face))
	  }
      next
    }
	Pd<- Op(1,TmpL)
    Qd<- Op(2,TmpL)
    Outf1<- c(Op(3,Pd))
    Nf<- Op(1,Pd)+1
    Tmp<- Op(2,Pd)
    JJ<- 0
    while (!all(Tmp==Op(2,Qd))){
      JJ<- JJ+1
      if(JJ>20){
        print("bug")
        return()
      }
      Tmp1<- Tmp[2]
      if(Outf1[length(Outf1)]!=Tmp1){
        Outf1<- c(Outf1,Tmp1)
      }
      Tmp<- c(Face[Nf])
      Nf<- Nf+1
      if(Nf>length(Face)){
		Nf<- 1
      }
      Tmp<- c(Tmp,Face[Nf])
    }
    Tmp1<- Op(3,Qd)
    if(Outf1[length(Outf1)]!=Tmp1){
      Outf1<- c(Outf1,Tmp1)
    }
    Outf2<- c(Op(3,Pd))
    Nf<- Op(1,Pd)
    Tmp<- Op(2,Pd)
    JJ<- 0
    while (!all(Tmp==Op(2,Qd))){
      JJ<- JJ+1
      if(JJ>20){
        print("bug")
        return()
      }
      Tmp1<- Tmp[1]
      if(Outf2[length(Outf2)]!=Tmp1){
        Outf2<- c(Outf2,Tmp1)
      }
      Tmp<- c(Face[Nf])
      Nf<- Nf-1
      if(Nf<1){
        Nf<- length(Face)
      }
      Tmp<- c(Face[Nf],Tmp)
    }
    Tmp1<- Op(3,Qd)
    if(Outf2[length(Outf2)]!=Tmp1){
      Outf2<- c(Outf2,Tmp1)
    }
    if(length(Outf1)<3 || length(Outf2)<3){
      Face<- Outf1
      if(length(Outf1)<length(Outf2)){ 
        Face<- Outf2
      }
      Flg<- 0
      for (J in Looprange(1,length(Face))){
        Tmp<- Op(Face(J),VL)
        Tmp1<- Fugou*(Dotprod(V1,Tmp)-d)
        if(Tmp1<-Eps){
          Flg<- 1
          break
        }
      }
      if(Flg==0){
        OutfL<- c(OutfL,list(Face))
      }
    }else{
      Tmp<- Op(Outf1[2],VL)
      Tmp1<- Outf1
      Tmp2<- Fugou*(Dotprod(V1,Tmp)-d)   
      if(Tmp2<0){
        Tmp1<- Outf2
      }
      OutfL<- c(OutfL,list(Tmp1))
    }
  }
  PHVERTEXL<<- VL
  PHFACEL<<- OutfL
  Out2<- Phcutdata(VL,OutfL,c(0,0,0,0))
  return(Out2)
}

#######################

Phparadata<- function(VL,FaceL){
 Out<- Facesdata(list(VL,FaceL),"para")
 return(Out)
}

####################################

Phpersdata<- function(VL,FaceL){
 Out<- Facesdata(list(VL,FaceL),"pers")
 return(Out)
}

####################################

Phspersdata<- function(Fdata){ 
 Out<- Facesdata(Fdata,"pers")
 return(Out)
}

####################################

Phsparadata<- function(Fdata){
 Out<- Facesdata(Fdata,"para")
 return(Out)
}

#########################

#100816
Projpers<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Flg<- 0
  if(Nargs==1 && Mixtype(varargin[[1]])==1){
    Flg<- 1
  }
  CL<- list()
  for (N in Looprange(1,Nargs)){
    Crv<- varargin[[N]]
    if(Mixtype(Crv)==1){
      Tmp<- CameraCurve(Crv)
      CL<- c(CL,list(Tmp))
    }else{
      if(Mixtype(Crv)==3){
        ObjL<- list()
        for (I in Looprange(1,Mixlength(Crv))){
          Tmp1<- Op(I,Crv)
          if(Mixtype(Tmp1)==1){
            ObjL<- c(ObjL,list(Tmp1))
          }else{
            ObjL<- c(ObjL,Tmp1)
          }
        }
        Crv<- ObjL
      }
      for (J in Looprange(1,Mixlength(Crv))){
        Tmp<- CameraCurve(Op(J,Crv))
        CL<- c(CL,list(Tmp))
      }
    }
  }
  if(Mixlength(CL)==1 && Flg==1){
    CL<- Op(1,CL)
  }  
  return(CL)      
}

###################################

ProjcoordCurve<- function(Curve){
  SP<- sin(PHI); CP<- cos(PHI)
  ST<- sin(THETA); CT<- cos(THETA)
  Out<- c()
  for (J in Looprange(1,Nrow(Curve))){
    P<- Ptcrv(J,Curve)
    x<- P[1]; y<- P[2]; z<- P[3]
    Xz<- -x*SP+y*CP
    Yz<- -x*CP*CT-y*SP*CT+z*ST
    Zz<- x*CP*ST+y*SP*ST+z*CT
    Out<- c(Out,Xz,Yz,Zz)
  }
  Out<- matrix(Out,ncol=3,byrow=TRUE)
  return(Out) 
}

#################################

ProjCurve<- function(Curve){  # 2018.02.26 rewritten
  AnsL= c()
  SP=sin(PHI); CP=cos(PHI)
  ST=sin(THETA); CT=cos(THETA)
  for(I in Looprange(1,Length(Curve)) ){
    P=Op(I,Curve)
    x=P[1]; y=P[2]; z=P[3]
    if(x!=Inf){
      Xz=-x*SP+y*CP
      Yz= -x*CP*CT-y*SP*CT+z*ST
      AnsL=Appendrow(AnsL,c(Xz,Yz))
      Tmp= c(Xz,Yz) 
    }else{
      AnsL=Appendrow(AnsL,c(Inf,Inf)) 
    }
  }
  return(AnsL)                      
}

####################################

Projpara<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  Flg<- 0
  if((Nargs==1)&&(is.numeric(varargin[[1]]))){
    Flg<- 1
  }
  CL<- list()
  for (N in Looprange(1,Nargs)){
    Crv<- varargin[[N]]
    if(is.numeric(Crv)){
      Tmp<- ProjCurve(Crv)
      CL<- c(CL,list(Tmp))
    }
    else{
      if(is.list(Crv)){
        ObjL<- list()
        for (I in Looprange(1,Mixlength(Crv))){
          Tmp1<- Op(I,Crv)
          if(is.numeric(Tmp1)){
            ObjL<- c(ObjL,list(Tmp1))
          }
          else{
            ObjL<-  c(ObjL,Tmp1)
          }
        }
        Crv<- ObjL
      }
      for (J in Looprange(1,length(Crv))){
        Tmp<- ProjCurve(Op(J,Crv))
        CL<- c(CL,list(Tmp))
      }
    }
  }
  if((length(CL)==1)&&(Flg==1)){
    CL<- Op(1,CL)
  }
  return(CL)
}

#########################

#100816
Projpers<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Flg<- 0
  if(Nargs==1 && Mixtype(varargin[[1]])==1){
    Flg<- 1
  }
  CL<- list()
  for (N in Looprange(1,Nargs)){
    Crv<- varargin[[N]]
    if(Mixtype(Crv)==1){
      Tmp<- CameraCurve(Crv)
      CL<- c(CL,list(Tmp))
    }else{
      if(Mixtype(Crv)==3){
        ObjL<- list()
        for (I in Looprange(1,Mixlength(Crv))){
          Tmp1<- Op(I,Crv)
          if(Mixtype(Tmp1)==1){
            ObjL<- c(ObjL,list(Tmp1))
          }else{
            ObjL<- c(ObjL,Tmp1)
          }
        }
        Crv<- ObjL
      }
      for (J in Looprange(1,Mixlength(Crv))){
        Tmp<- CameraCurve(Op(J,Crv))
        CL<- c(CL,list(Tmp))
      }
    }
  }
  if(Mixlength(CL)==1 && Flg==1){
    CL<- Op(1,CL)
  }  
  return(CL)      
}

#########################################
# 11.08.27
# 14.03.23   Debugged "center"

Rotate3data<- function(...){
#Eps=10^(-4)
  varargin<-list(...)
  Nargs<- length(varargin)
  Pd3<- varargin[[1]]
  W1<- varargin[[2]]
  W2<- varargin[[3]]
  C<- c(0,0,0)
  if(Nargs>=4){
    C<- varargin[[4]]
  }
  if(Mixtype(Pd3)==1){
    Pd3<- list(Pd3)
  } else if(Mixtype(Pd3)==3){
    Tmp<- list()
    for (I in Looprange(1,Mixlength(Pd3))){
      Tmp<- c(Tmp,Op(I,Pd3))
    }
    Pd3<- Tmp
  }
  Out<- list() 
  for (I in Looprange(1,Mixlength(Pd3))){
     PD<- Op(I,Pd3)
     Ans<- c() 
     for (J in Looprange(1,Nrow(PD))){
      if(is.matrix(PD)){ # 11.08.27
        P<- PD[J,]
      }
      else{
        P<- PD
      } 
       Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23
       Ans<- rbind(Ans,Tmp)
     } # 11.08.27
    rownames(Ans)<- 1:Nrow(Ans) #10.08.16
     Out<- c(Out,list(Ans))
   }
   if(Mixlength(Out)==1){
     Out<- Op(1,Out)
  }
  return(Out)
}

#######################################

Rotate3pt<- function(...){
  varargin<-list(...)
  Eps<-10^(-4)
  Nargs<-length(varargin)
  P<- varargin[[1]]
  W1<- varargin[[2]]
  W2<- varargin[[3]]
  C<- c(0,0,0)
  if(Nargs>=4){
    C<- varargin[[4]]
  }
  if(mode(W2)=="numeric" && length(W2)==1){
    Ct<- cos(W2)
    St<- sin(W2)
    V3<- 1/Norm(W1)*W1
    if(V3[1]==0){
      Tmp<- c(1,0,0) 
    }else{
      Tmp<- c(0,1,0)
    }
    W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2],
         Tmp[3]*V3[1]-Tmp[1]*V3[3],
         Tmp[1]*V3[2]-Tmp[2]*V3[1])
    V1<- 1/Norm(W1)*W1
    V2<- c(V3[2]*V1[3]-V3[3]*V1[2],
         V3[3]*V1[1]-V3[1]*V1[3],
         V3[1]*V1[2]-V3[2]*V1[1])
  }else{
    Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2],
          W1[3]*W2[1]-W1[1]*W2[3],
          W1[1]*W2[2]-W1[2]*W2[1])
    if(Norm(Tmp)<Eps){ 
      Ans<- P
      return(Ans)
    }
    V1<- 1/Norm(W1)*W1 
    Ns<- V1[1]*W2[1]+V1[2]*W2[2]+V1[3]*W2[3]
    Tmp<- W2-Ns*V1
    V2<- 1/Norm(Tmp)*Tmp 
    Tmp<- c(V1[2]*V2[3]-V1[3]*V2[2],
         V1[3]*V2[1]-V1[1]*V2[3],
         V1[1]*V2[2]-V1[2]*V2[1])
    V3<- 1/Norm(Tmp)*Tmp 
    Ct<- Ns/Norm(W2)
    St<- sqrt(1-Ct^2)
  }
  if(Norm(Tmp)<Eps){
    Ans<- P
    return(Ans)
  }
  V1x<- V1[1]; V1y<- V1[2]; V1z<- V1[3]
  V2x<- V2[1]; V2y<- V2[2]; V2z<- V2[3]
  V3x<- V3[1]; V3y<- V3[2]; V3z<- V3[3]
  if(Mixtype(P)!=1){
    PtL<- P
  }else{
    PtL<- list(P)
  }
  Ans<- list() 
  for (N in Looprange(1,Mixlength(PtL))){
    P<- Op(N,PtL)
    if(P[1]==Inf){
      Ans<- c(Ans,list(c(Inf,Inf,Inf)))
      next
    }
    x<- P[1]-C[1]; y=P[2]-C[2]; z=P[3]-C[3] 
	Tmp1<-  ((V1x*Ct+V2x*St)*V1x+(-V1x*St+V2x*Ct)*V2x+V3x^2)*x
	Tmp2<- ((V1x*Ct+V2x*St)*V1y+(-V1x*St+V2x*Ct)*V2y+V3x*V3y)*y
	Tmp3<- ((V1x*Ct+V2x*St)*V1z+(-V1x*St+V2x*Ct)*V2z+V3x*V3z)*z
	X<- Tmp1+Tmp2+Tmp3
    Tmp1<-  ((V1y*Ct+V2y*St)*V1x+(-V1y*St+V2y*Ct)*V2x+V3x*V3y)*x
    Tmp2<- ((V1y*Ct+V2y*St)*V1y+(-V1y*St+V2y*Ct)*V2y+V3y^2)*y
    Tmp3<- ((V1y*Ct+V2y*St)*V1z+(-V1y*St+V2y*Ct)*V2z+V3y*V3z)*z
	Y<- Tmp1+Tmp2+Tmp3
    Tmp1<-  ((V1z*Ct+V2z*St)*V1x+(-V1z*St+V2z*Ct)*V2x+V3x*V3z)*x
    Tmp2<- ((V1z*Ct+V2z*St)*V1y+(-V1z*St+V2z*Ct)*V2y+V3y*V3z)*y
    Tmp3<- ((V1z*Ct+V2z*St)*V1z+(-V1z*St+V2z*Ct)*V2z+V3z^2)*z
	Z<- Tmp1+Tmp2+Tmp3
     Ans<- c(Ans,list(C+c(X,Y,Z))) 
  }
  if(Mixlength(Ans)==1){
    Ans<- Op(1,Ans)
  }
 return(Ans)
}

######################################

Setangle<- function(...){
  Eps<- 10^(-6)
  varargin<-list(...)
  Nargs<-length(varargin)
  if(Nargs==0) {   
  }
  else if(Nargs==1){
    V<- varargin[[1]]
    V<- V/Norm(V)
    THETA<<- acos(V[3])
    if(abs(sin(THETA))<Eps){
      PHI<<- 0
    }
    else{
      PHI<<- acos(V[1]/sin(THETA))
      if(V[2]< -Eps) PHI<<- -PHI
    }	
  }
  else{
    PHI<<- varargin[[2]]*pi/180
    THETA<<- varargin[[1]]*pi/180
  }
  Out<- paste("theta=",as.character(THETA*180/pi)," phi=",
      as.character(PHI*180/pi),sep="")
  return (Out)  
}

#################################

Setpers<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  if(Nargs==0){
  }
  else{
    FocusPoint<<- varargin[[1]]
    EyePoint<<- varargin[[2]]
  }
  F<- as.character(FocusPoint)
  E<- as.character(EyePoint)
  Out<- paste("Focus = c(",F[1],",",F[2],",",F[3],") , ",
     " Eye = c(", E[1],",",E[2],",",E[3],") ",sep="")
  return (Out)  
}

#################################

SetstereoL<- function(R,T,P,H){
  X<- R*sin(T*pi/180)*cos(P*pi/180)
  Y<- R*sin(T*pi/180)*sin(P*pi/180)
  Z<- R*cos(T*pi/180)
  Eye<- c(X+H/2*Y/(X^2+Y^2),Y-H/2*X/(X^2+Y^2),Z)
  Out<- Setpers(c(0,0,0),Eye)
  return(Out)
}

#################################

SetstereoR<- function(R,T,P,H){
  X<- R*sin(T*pi/180)*cos(P*pi/180)
  Y<- R*sin(T*pi/180)*sin(P*pi/180)
  Z<- R*cos(T*pi/180)
  Eye<- c(X-H/2*Y/(X^2+Y^2),Y+H/2*X/(X^2+Y^2),Z)
  Out<- Setpers(c(0,0,0),Eye)
  return(Out)
}

###############################

Sf3data<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  FdL<- Fullformfunc(varargin[[1]])
  F<- Op(1,FdL)
  Xf<- Op(2,FdL)
  Yf<- Op(3,FdL)
  Zf<- Op(4,FdL)
  Urg<- Op(5,FdL)
  Vrg<- Op(6,FdL)
  Str<- strsplit(Urg,"=",fixed=TRUE)[[1]]
  U<- Str[1]
  Tmp<- Str[2]
  Tmp<- eval(parse(text=Tmp))
  Umin<- Tmp[1]; Umax<- Tmp[2]
  Str<- strsplit(Vrg,"=",fixed=TRUE)[[1]]
  V<- Str[1]
  Tmp<- Str[2]
  Tmp<- eval(parse(text=Tmp))
  Vmin<- Tmp[1]; Vmax<- Tmp[2]
  Ndu<- 25 ; Ndv<- 25; Np<- c(50,50)
  if(Nargs>=3){
    Ndu<- varargin[[2]]
    Ndv<- varargin[[3]]
  }
  if(Nargs>=4){
    Np<- varargin[[4]]
    if(mode(Np)=="numeric" && length(Np)==1){
      Np<- c(Np,Np)
    }
  }
  Du<- (Umax-Umin)/Ndu
  Dv<- (Vmax-Vmin)/Ndv
  PL <-  c()#PL <-  []
  Assign("Vmin",Vmin,"Vmax",Vmax)
  Trgstr<- Assign("t=c(Vmin,Vmax)") 
  PL <-  list()
  for (I in Looprange(0,Ndu)){
    U0 <- paste("(",as.character(Umin+I*Du),")",sep="")
    Tmp<- gsub(U,U0,Xf,fixed=TRUE)
    Tmp1<- gsub(V,"t",Tmp,fixed=TRUE)
    Tmp<- gsub(U,U0,Yf,fixed=TRUE)
    Tmp2<- gsub(V,"t",Tmp,fixed=TRUE)
    Tmp<- gsub(U,U0,Zf,fixed=TRUE)
    Tmp3<- gsub(V,"t",Tmp,fixed=TRUE)
    Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="")
    PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2])))
    PL<- c(PL,list(PD))
  }
  Assign("Umin",Umin,"Umax",Umax)
  Trgstr<- Assign("t=c(Umin,Umax)")
  for (J in Looprange(0,Ndv)){
    V0<- paste("(",as.character(Vmin+J*Dv),")",sep="")
    Tmp<- gsub(V,V0,Xf,fixed=TRUE)
    Tmp1<- gsub(U,"t",Tmp,fixed=TRUE)
    Tmp<- gsub(V,V0,Yf,fixed=TRUE)
    Tmp2<- gsub(U,"t",Tmp,fixed=TRUE)
    Tmp<- gsub(V,V0,Zf,fixed=TRUE)
    Tmp3<- gsub(U,"t",Tmp,fixed=TRUE)
    Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")")
    PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1])))
    PL<- c(PL,list(PD))
  }
  return(PL)
}

###################################

Skeletonparadata<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  Out<- list()
  ObjL<- Flattenlist(varargin[[1]])
  Plt3L<- Flattenlist(varargin[[2]])
  R<- 0.075*1000/2.54/MilliIn
  if(Nargs>2){
    R<- R*varargin[[3]]
  }
  Eps2<- 0.05
  if(Nargs>3){
    Eps2<- varargin[[4]]
  }
  Obj2L<- list()
  for (I in Looprange(1,Mixlength(ObjL))){
    Tmp<- ProjcoordCurve(Op(I,ObjL))
    Obj2L<- c(Obj2L,list(Tmp))
  }
  Plt2L<- list()
  for (I in  Looprange(1,Mixlength(Plt3L))){
    Tmp<- ProjcoordCurve(Op(I,Plt3L))
    Plt2L<- c(Plt2L,list(Tmp))
  }
  Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2)
  return(Out)
}

################################

Skeletonpara3data<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  ObjL<- Flattenlist(varargin[[1]])
  Plt3L<- Flattenlist(varargin[[2]])
  R<- 0.075*1000/2.54/MilliIn
  if(Nargs>2){
    R=R*varargin[[3]]
  }
  Eps2<- 0.05
  if(Nargs>3){
    Eps2<- varargin[[4]]
  }
  Plt2L<- list()
  for (I in Looprange(1,Mixlength(Plt3L))){
    Tmp<- ProjcoordCurve(Op(I,Plt3L))
    Plt2L<- c(Plt2L,list(Tmp))
  }
  Out<- list()
  for (I in Looprange(1,Mixlength(ObjL))){
    Obj3<- Op(I,ObjL)
    Tmp<- ProjcoordCurve(Obj3)
    Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2)
    for (J in Looprange(1,Mixlength(Data))){
      Gd<- Op(J,Data)
      PtD<- c()
      for (J in Looprange(1,Nrow(Gd))){
        Tmp<- Ptcrv(J,Gd)
        Tmp1<- Invparapt(Tmp,Obj3)
        Tmp1<- Op(1,Tmp1)
        PtD<- c(PtD,Tmp1)
      }
      PtD<- matrix(PtD,ncol=3,byrow=TRUE)
      Out<- c(Out,list(PtD))
    }
  }
  return(Out)
}

#################################

#100815
Skeletonpersdata<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  Out<- list() 
  ObjL<- Flattenlist(varargin[[1]])
  Plt3L<- Flattenlist(varargin[[2]])
  R<- 0.075*1000/2.54/MilliIn
  if(Nargs>2){
    R<- R*varargin[[3]]
  }
  Eps2<- 0.05
  if(Nargs>3){
    Eps2<- varargin[[4]]
  }
  Obj2L<- list() 
  for (I in Looprange(1,Mixlength(ObjL))){
    Tmp<- CameracoordCurve(Op(I,ObjL))
    Obj2L<- c(Obj2L,list(Tmp))
  }
  Plt2L<- list()
  for (I in Looprange(1,Mixlength(Plt3L))){
    Tmp<- CameracoordCurve(Op(I,Plt3L))
    Plt2L<- c(Plt2L,list(Tmp))
  }
  Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2)
  return(Out)
}

#####################
#100815
Skeletonpers3data<- function(...){
  varargin<-list(...)
  Nargs<- length(varargin)
  Out<- list()
  ObjL<- Flattenlist(varargin[[1]])
  Plt3L<- Flattenlist(varargin[[2]])
  R<- 0.075*1000/2.54/MilliIn
  if(Nargs>2){
    R<- R*varargin[[3]]
  }
  Eps2<- 0.05
  if(Nargs>3){
    Eps2<- varargin[[4]]
  }
  Plt2L<- list()
  for (I in Looprange(1,Mixlength(Plt3L))){
    Tmp<- CameracoordCurve(Op(I,Plt3L))
    Plt2L<- c(Plt2L,list(Tmp))
  }
  Out<- list()
  for (I in Looprange(1,Mixlength(ObjL))){
    Obj3<- Op(I,ObjL)
    Tmp<- CameracoordCurve(Obj3)
    Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2)
    for (J in Looprange(1,Mixlength(Data))){
      Gd<- Op(J,Data)
      PtD<- c()
      for (J in Looprange(1,Nrow(Gd))){
        Tmp<- Gd[J,]
        Tmp1<- Invperspt(Tmp,Obj3)
        Tmp1<- Op(1,Tmp1)
        PtD<- rbind(PtD,Tmp1)
      }
      Out<- c(Out,list(PtD))
    }
  }
  return(Out)
}

#################################

Spacecurve<- function(...){
  Eps<- 10^(-5)
  varargin<-list(...)
  Nargs<- length(varargin)
  Fnstr<- varargin[[1]]
  Rgstr<- varargin[[2]]
  Range<- c(0,2*pi)
  N<- 50                 #Numpoints
  E<- c()                #Exclusions
  D<- Inf                #Discont  (Changed)
  for(I in Looprange(3,Nargs)){
    Tmp<- varargin[[I]]
    StrV<-  strsplit(Tmp,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    Tmp1<- toupper(StrV[1])
    Lhs<- substr(Tmp1,1,1) 
    Str<- paste(Lhs,"=",StrV[2],sep="") 
    eval(parse(text=Str)) 
  }
  StrV<-  strsplit(Rgstr,"=",fixed=TRUE)
  StrV<- StrV[[1]]
  if(length(StrV)>1){
    Vname<- StrV[1]
    Rng<- eval(parse(text=StrV[2]))
  }
  else{
    Vname<- Rgstr
    Rng<- c(XMIN,XMAX)
  }
  T1<- Rng[1]; T2<- Rng[2]
  Dt<- (T2-T1)/N #17.09.22
  Str<- gsub(Vname,"t",Fnstr)
  Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines)
  Str=gsub("]",")",Str,fixed=TRUE)
  if(abs(Dt)<Eps){ # 16.12.13
    t=T1
    P=eval(parse(text=Str))
    return(P)
  }
  P<- c()
#  E<- sort(E,decreasing=FALSE)
  E<- c(E,Inf)
  E<- sort(E,decreasing=FALSE)
  Ke<- 1
  for(jj in 1:(N+1)){
    t=T1+(jj-1)*Dt
    Pa<- c()
    if(t-E[Ke]< Eps){
	  Pa<-  eval(parse(text=Str))
    }
    if(abs(t-E[Ke])<=Eps){
      if(length(P)>0 && P[Nrow(P),1]!=Inf){ 
        Pa<- c(Inf,Inf,Inf)
      }
    }
    if(t-E[Ke]>Eps){
      Pa<- eval(parse(text=Str))
      Ke<- Ke+1
    }
    if(length(Pa)>0){
      if(Pa[1]==Inf){
        P<- rbind(P,Pa)
      }else if(length(P)==0){
        P<- rbind(c(),c(Pa))
      }
      else{
        Tmp<- P[Nrow(P),]
        if(Tmp[1]==Inf){
          P<- rbind(P,Pa)
        }
        else if( Norm(Tmp-Pa)<D){
          P<- rbind(P,Pa)
        }
        else{
          P<- rbind(P,c(Inf,Inf,Inf))
		  P<- rbind(P,Pa)
        }
      }
    }
  }
  rownames(P)<- 1:Nrow(P) # 10.08.16
  return(P)
}

########################################

Spaceline<- function(...){
  varargin<- list(...)
  Z<- c()                 
  for(I in 1:length(varargin)){  
    Data<- varargin[[I]]   
    if(Mixtype(Data)==1){
      J<- 1
      while (J<=Ncol(Data)){ 
        Tmp<- Data[J:(J+2)] 
        Z<-c(Z,Tmp)
        J<- J+3
      }
      next
    }
    if(Mixtype(Data)==3){  
      Tmp<- list() 
      for(I in 1:Mixlength(Data)){
        Tmp<- c(Tmp,Op(I,Data))
      }
      Data<- Tmp
    }
    for(J in 1:Mixlength(Data)){
      Tmp<- Op(J,Data)  
      Z<- c(Z,Tmp)
    }
  }
  Z<- matrix(Z,ncol=3,byrow=TRUE)                
  return(Z)
}

#################################

Translate3data<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Pd3<- varargin[[1]]
  Mv<- varargin[[2]]
  if(mode(Mv)=="numerice" && length(Mv)==1){
    Mv<- c(varargin[[2]],varargin[[3]],varargin[[4]])
  }
  if(Mixtype(Pd3)==1){
    Pd3<- list(Pd3)
  }
  else if(Mixtype(Pd3)==3){
    Tmp<-list()
    for(I in Looprange(1,Mixlength(Pd3))){
      Tmp<- c(Tmp, Op(I,Pd3))
    }
    Pd3<- Tmp
  }
  Out<- list()
  for(I in Looprange(1,Mixlength(Pd3))){
    PD<- Op(I,Pd3)
    PD<- rbind(c(),PD)
    Ans<- c()
    for(J in Looprange(1,Nrow(PD))){
      P<- PD[J,]
      Tmp<- P+Mv
      Ans<- rbind(Ans,Tmp)
    }
    rownames(Ans)<- 1:Nrow(Ans)
    Out<- c(Out,list(Ans))
  }
  if(Mixlength(Out)==1){
    Out<- Op(1,Out)
  }
  return(Out)
}

###############################################

Xyzax3data<- function(Xrange,Yrange,Zrange){
  StrV<-strsplit(Xrange,"=",fixed=TRUE)
  StrV<- StrV[[1]]
  if(length(StrV)>1) StrV<- StrV[2]
  Tmp<- eval(parse(text=StrV)) 
  Px<- c(Tmp[1],0,0) 
  Qx<- c(Tmp[2],0,0)
  StrV<-strsplit(Yrange,"=",fixed=TRUE)
  StrV<- StrV[[1]]
  if(length(StrV)>1) StrV<- StrV[2]
  Tmp<- eval(parse(text=StrV)) 
  Py<- c(0,Tmp[1],0) 
  Qy<- c(0,Tmp[2],0)
  StrV<-strsplit(Zrange,"=",fixed=TRUE)
  StrV<- StrV[[1]]
  if(length(StrV)>1) StrV<- StrV[2]
  Tmp<- eval(parse(text=StrV)) 
  Pz<- c(0,0,Tmp[1])
  Qz<- c(0,0,Tmp[2])
  Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz))
  return(Out)
}

###################################

Xyzaxparaname<- function(...){
  varargin<- list(...)
  Nargs<- length(varargin)
  Eps<- 10.0^(-6)
  Dr<- 0.19*1000/2.54/MilliIn
  Tmp<- varargin[[Nargs]]
  if(Nargs>1 && is.numeric(Tmp)){
    Dr<- Dr*Tmp
    Nargs<- Nargs-1
  }
  if(mode(varargin[[1]])=="character"){
    Xname<- "x"
	Yname<- "y"
	Zname<- "z"
    Xrange<- varargin[[1]]
    Yrange<- varargin[[2]]
    Zrange<- varargin[[3]]
    StrV<-strsplit(Xrange,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Xname<- StrV[1]
	  StrV<- StrV[2]
	}
    Tmp<- eval(parse(text=StrV)) 
    Px<- c(Tmp[1],0,0) 
    Qx<- c(Tmp[2],0,0)
    StrV<-strsplit(Yrange,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Yname<- StrV[1]
	  StrV<- StrV[2]
	}
    Tmp<- eval(parse(text=StrV)) 
    Py<- c(0,Tmp[1],0) 
    Qy<- c(0,Tmp[2],0)
    StrV<-strsplit(Zrange,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Zname<- StrV[1]
	  StrV<- StrV[2]
	}
    Tmp<- eval(parse(text=StrV)) 
    Pz<- c(0,0,Tmp[1])         
    Qz<- c(0,0,Tmp[2])
  }else{
    Data<- varargin[[1]]
    Xname<- "x"; Yname<- "y"; Zname<- "z"   
    if(Nargs>1){
      if(varargin[[2]]!=""){
        Xname<- varargin[[2]]
      }
      if(varargin[[3]]!=""){
        Yname<- varargin[[3]]
      }
      if(varargin[[4]]!=""){
        Zname<- varargin[[4]]
      }
    }
    Tmp<- Op(1,Data)
    Px<- Tmp[1,]; Qx<- Tmp[2,]
    Tmp<- Op(2,Data)
    Py<- Tmp[1,]
    Qy<- Tmp[2,]
    Tmp<- Op(3,Data)
    Pz<- Tmp[1,]
    Qz<- Tmp[2,]
  }
  Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh)
  Kekka<- list()                  
  if(R>Eps){
    Ch<- Qh+Dr/R*(Qh-Ph)
    Kekka<- c(Kekka,list(Pointdata(Ch)))
    Expr(Ch,"c",Xname)           
  }
  Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh)
  if(R>Eps){
    Ch<- Qh+Dr/R*(Qh-Ph)
    Kekka<- c(Kekka,list(Pointdata(Ch)))
    Expr(Ch,"c",Yname)
  }
  Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh)
  if(R>Eps){
    Ch<- Qh+Dr/R*(Qh-Ph)
    Kekka<- c(Kekka,list(Pointdata(Ch)))
    Expr(Ch,"c",Zname)
  }
#  return(Kekka)
}

###################################

Xyzaxpersname<- function(...){
  varargin<- list(...)
  Eps<- 10.0^(-6)
  Nargs<- length(varargin)
  Dr<- 0.19*1000/2.54/MilliIn
  Tmp<- varargin[[Nargs]]
  if(Nargs>1 && mode(Tmp)=="numeric"){
    Dr<- Dr*Tmp
    Nargs<- Nargs-1
  }
  if(mode(varargin[[1]])=="character"){
    Xname<- "x"
	Yname<- "y"
	Zname<- "z"
    Xrange<- varargin[[1]]
    Yrange<- varargin[[2]]
    Zrange<- varargin[[3]]
    StrV<-strsplit(Xrange,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Xname<- StrV[1]
	  StrV<- StrV[2]
	}
    Tmp<- eval(parse(text=StrV)) 
    Px<- c(Tmp[1],0,0)
    Qx<- c(Tmp[2],0,0)
    StrV<-strsplit(Yrange,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Yname<- StrV[1]
	  StrV<- StrV[2]
	}
    Tmp<- eval(parse(text=StrV)) 
    Py<- c(0,Tmp[1],0)
    Qy<- c(0,Tmp[2],0)
    StrV<-strsplit(Zrange,"=",fixed=TRUE)
    StrV<- StrV[[1]]
    if(length(StrV)>1){
	  Zname<- StrV[1]
	  StrV<- StrV[2]
	}
    Tmp<- eval(parse(text=StrV))
    Pz<- c(0,0,Tmp[1]) 
    Qz<- c(0,0,Tmp[2])
  }else{
    Data<- varargin[[1]]
    Xname<- "x"; Yname<- "y"; Zname<- "z"
    if(Nargs>1){
      if(varargin[[2]]!=""){
        Xname<- varargin[[2]]
      }
      if(varargin[[3]]!=""){
        Yname<- varargin[[3]]
      }
      if(varargin[[4]]!=""){
        Zname<- varargin[[4]]
      }
    }
    Tmp<- Op(1,Data)
    Px<- Tmp[1,]; Qx<- Tmp[2,]
    Tmp<- Op(2,Data)
    Py<- Tmp[1,]
    Qy<- Tmp[2,]
    Tmp<- Op(3,Data)
    Pz<- Tmp[1,]
    Qz<- Tmp[2,]
  }
  Ph<- Perspt(Px)
  Qh<- Perspt(Qx)
  R<- Norm(Ph-Qh)
  Kekka<- list()
  if(R>Eps){
    Ch<- Qh+Dr/R*(Qh-Ph)
    Kekka<- c(Kekka,list(Pointdata(Ch)))
    Expr(Ch,"c",Xname)
  }
  Ph<- Perspt(Py)
  Qh<- Perspt(Qy)
  R<- Norm(Ph-Qh) 
  if(R>Eps){
    Ch<- Qh+Dr/R*(Qh-Ph)
    Kekka<- c(Kekka,list(Pointdata(Ch)))
    Expr(Ch,"c",Yname)
  }
  Ph<- Perspt(Pz)
  Qh<- Perspt(Qz)
  R<- Norm(Ph-Qh) 
  if(R>Eps){
    Ch<- Qh+Dr/R*(Qh-Ph)
    Kekka<- c(Kekka,list(Pointdata(Ch)))
    Expr(Ch,"c",Zname)
  }
#  return(Kekka)
}

#########################
#100815
Zparapt<- function(P){#function Out=Zparapt(P)
  x<- P[1]; y<- P[2]; z<- P[3]
  Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA)
  return(Out)
}

#########################
#100815
Zperspt<- function(P){
  Tmp<- P-FocusPoint
  X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3]
  Tmp<- EyePoint-FocusPoint
  E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3]
  Ca<- E1/sqrt(E1^2+F1^2)
  Sa<- F1/sqrt(E1^2+F1^2)
  X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1
  E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
  Cb<- E2/sqrt(E2^2+G2^2)
  Sb<- G2/sqrt(E2^2+G2^2)
  X3<- X2*Cb+Z2*Sb
  return(X3)
}

##########################################



##########################################

# Stat Package

##########################################

# 2010.04.12

# new

# Htickmarklower, Vtickmarkleft, HtickmarklowerV
# VtickmarkleftV, Insertcom, Replacecom
# Maketexfile, Formatting
# Drwhistframe, Histplotdata, Drwhistplot

Htickmarklower<- function(...)
{  ## Scaling is implemented 
  varargin<- list(...)
  Nargs<- length(varargin)
  ArgsL<- varargin
  if(mode(ArgsL[[1]])=="character"){
    Str<- ArgsL[[1]]
    Tmp<- strsplit(Str,"m")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      I<- nchar(Tmp[1])+1
    }
    else{
      I<- 0
    }
    Tmp<- strsplit(Str,"n")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      J<- nchar(Tmp[1])+1
    }
    else{
      J<- 0
    }
    Tmp<- strsplit(Str,"r")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      K=nchar(Tmp[1])+1
    }
    else{
      K<- 0
    }
    if(K>0){
      S<- substr(Str,K+1,nchar(Str))
      R<-  as.numeric(S)
      if(is.na(R)){
        R<- 1
      }
    }
    else{
      R<- 1
      K<- nchar(Str)+1
    }
    if(J>0){
      S<- substr(Str,J+1,K-1)
      Dn<-  as.numeric(S)
      if(is.na(Dn)){
        Dn<- 1
      }
    }
    else{
      Dn<- 1000
      J<- nchar(Str)+1
    }
    S<- substr(Str,I+1,J-1)
    Dm<- as.numeric(S)
    if(is.na(Dm)){
      Dm<- 1
    }
    ArgsL<- list()
    for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
    for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
  }
  MemoriList<- list()
  Memori<- list()
  for (N in 1:length(ArgsL)){
    Dt<- ArgsL[[N]]
    if(mode(Dt)=="numeric" && length(Dt)>1){
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(Dt)
      next
    }
    if(mode(Dt)=="character"){
      Memori<- Mixjoin(Memori,Dt)
    }
    else{
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(Dt,GENTEN[2])
    }
  }
  MemoriList<- Mixjoin(MemoriList,list(Memori))
  for (N in 1:length(MemoriList)){
    Dt<- MemoriList[[N]]
    Ndt<- length(Dt)
    X=Op(1,Dt)
    Y=Op(2,Dt)
    Tmp<-Doscaling(c(X,Y))
    X<- Tmp[1]
    Y<- Tmp[2]
    Moji<- Op(Ndt,Dt)
    Tmp1<- Unscaling(c(X,Y))
    Tmp2<- Unscaling(c(X,Y-2*MARKLEN))
    Fd<- Listplot(c(Tmp1,Tmp2))
    Drwline(Fd)
    if(Ndt==3){
      Tmp<-Unscaling(c(X,Y-2*MARKLEN))
      Expr(Tmp,"s",Moji)
    }
    if(Ndt==4){
      Houkou<- Op(3,Dt)
      Tmp<-grep("s",Houkou)
      if(length(Tmp)>0){
        Tmp<-Unscaling(c(X,Y-2*MARKLEN))
        Expr(Tmp,Houkou,Moji)
      }
      else{
        Tmp<- Unscaling(c(X,Y))
        Expr(Tmp,Houkou,Moji)
      }
    }
      cat("%\n",file=Wfile,append=TRUE)
  }
}

Vtickmarkleft<- function(...)
{  ## Scaling is implemented 
  varargin<- list(...)
  Nargs<- length(varargin)
  ArgsL<- varargin
  if(mode(ArgsL[[1]])=="character"){
    Str<- ArgsL[[1]]
    Tmp<- strsplit(Str,"m")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      I<- nchar(Tmp[1])+1
    }
    else{
      I<- 0
    }
    Tmp<- strsplit(Str,"n")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      J<- nchar(Tmp[1])+1
    }
    else{
      J<- 0
    }
    Tmp<- strsplit(Str,"r")
    Tmp<- Tmp[[1]]
    if(length(Tmp)>1){
      K=nchar(Tmp[1])+1
    }
    else{
      K<- 0
    }
    if(K>0){
      S<- substr(Str,K+1,nchar(Str))
      R<-  as.numeric(S)
      if(is.na(R)){
        R<- 1
      }
    }
    else{
      R<- 1
      K<- nchar(Str)+1
    }
    if(J>0){
      S<- substr(Str,J+1,K-1)
      Dn<-  as.numeric(S)
      if(is.na(Dn)){
        Dn<- 1
      }
    }
    else{
      Dn<- 1000
      J<- nchar(Str)+1
    }
    S<- substr(Str,I+1,J-1)
    Dm<- as.numeric(S)
    if(is.na(Dm)){
      Dm<- 1
    }
    ArgsL<- list()
    for (I in 1:floor((YMAX-GENTEN[2])/Dm)){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
    for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){
      ArgsL<- Mixjoin(ArgsL,I*Dm)
      if(I-floor(I/Dn)*Dn==0){
        Str<- as.character(I*Dm*R)
        ArgsL<- Mixjoin(ArgsL,Str)
      }
    }
  }
  MemoriList<- list()
  Memori<- list()
  for (N in 1:length(ArgsL)){
    Dt<- ArgsL[[N]]
    if(mode(Dt)=="numeric" && length(Dt)>1){
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(Dt)
      next
    }
    if(mode(Dt)=="character"){
      Memori<- Mixjoin(Memori,Dt)
    }
    else{
      if(length(Memori)>0){
        MemoriList<- Mixjoin(MemoriList,list(Memori))
      }
      Memori<- list(GENTEN[1],Dt)
    }
  }
  MemoriList<- Mixjoin(MemoriList,list(Memori))
  for (N in 1:length(MemoriList)){
    Dt<- MemoriList[[N]]
    Ndt<- length(Dt)
    X=Op(1,Dt)
    Y=Op(2,Dt)
    Tmp<-Doscaling(c(X,Y))
    X<- Tmp[1]
    Y<- Tmp[2]
    Moji<- Op(Ndt,Dt)
    Tmp1<- Unscaling(c(X,Y))
    Tmp2<- Unscaling(c(X-2*MARKLEN,Y))
    Fd<- Listplot(c(Tmp1,Tmp2))
    Drwline(Fd)
    if(Ndt==3){
      Tmp<-Unscaling(c(X-2*MARKLEN,Y))
      Expr(Tmp,"w",Moji)
    }
    if(Ndt==4){
      Houkou<- Op(3,Dt)
      Tmp<-grep("w",Houkou)
      if(length(Tmp)>0){
        Tmp<-Unscaling(c(X-2*MARKLEN,Y))
        Expr(Tmp,Houkou,Moji)
      }
      else{
        Tmp<- Unscaling(c(X,Y))
        Expr(Tmp,Houkou,Moji)
      }
    }
      cat("%\n",file=Wfile,append=TRUE)
  }
}

HtickmarklowerV<- function(Vec,digits=2,nsmall=2)
{
  for (I in 1:length(Vec)){
    Tmp<- Vec[I]
    Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall))
  }
}

HtickLV<- function(...)
{
  HtickmarklowerV(...)
}

VtickmarkleftV<- function(Vec,digits=2,nsmall=2)
{
  for (I in 1:length(Vec)){
    Tmp<- Vec[I]
    Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall))
  }
}

VtickLV<- function(...)
{
  VtickmarkleftV(...)
}

Insertcom<- function(CmdM,Npos,Str)
{
  if(is.matrix(CmdM)){
    Cmd<- CmdM
  }
  else{
    C<- paste("Cmd<- ",CmdM)
    eval(parse(text=C))
  }
  Out<- Cmd[Looprange(1,Npos-1),]
  Out<- c(Out,Str)
  Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),]
  Out<- c(Out,Tmp)
  Out<- matrix(Out)
  if(!is.matrix(CmdM)){
    C<- paste(CmdM,"<<- Out")
    eval(parse(text=C))
  }
  return(Out)
}

Replacecom<- function(CmdM,Npos,Str)
{
  if(is.matrix(CmdM)){
    Cmd<- CmdM
  }
  else{
    C<- paste("Cmd<- ",CmdM)
    eval(parse(text=C))
  }
  Out<- Cmd[Looprange(1,Npos-1),]
  Out<- c(Out,Str)
  Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),]
  Out<- c(Out,Tmp)
  Out<- matrix(Out)
  if(!is.matrix(CmdM)){
    C<- paste(CmdM,"<<- Out")
    eval(parse(text=C))
  }
  return(Out)
}

Deletecom<- function(CmdM,Npos)
{
  if(is.matrix(CmdM)){
    Cmd<- CmdM
  }
  else{
    C<- paste("Cmd<- ",CmdM)
    eval(parse(text=C))
  }
  Out<- Cmd[Looprange(1,Npos-1),]
  Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),]
  Out<- c(Out,Tmp)
  Out<- matrix(Out)
  if(!is.matrix(CmdM)){
    C<- paste(CmdM,"<<- Out")
    eval(parse(text=C))
  }
  return(Out)
}

Maketexfile<- function(commands="",texfile="")
{
  Openfile(texfile)
  Execmd(commands)
  Closefile()
}

Formatting<- function(X,D=2,N=2)
{
  if(D>0){
    Xs <- format(X,digits=D,nsmall=N)
  }
  else{
    Xs<- as.character(X)
  }
  return(Xs)
}

################################

Boxplotdata1 <-function(DataF1,CenterX,Width,...)
{
  Xr <- Width
  Temp <- boxplot(DataF1[1],plot=FALSE)
  Stats <- Temp$stats     
  rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige")
  Out <- Temp$out
  Lhige <- Stats["Lhige",1]
  Uhige <- Stats["Uhige",1]
  Q1 <- Stats["Q1",1]
  Q2 <- Stats["Q2",1]
  Q3 <- Stats["Q3",1]
  CenterY <- (Q1+Q3)/2
  C <- c(CenterX,CenterY)
  V <- c(0,(Q3-Q1)/2)
  G1 <- Framedata(C,Xr/2,V[2]) # box
  Temp1 <- c(0,Q1-Lhige)
  Temp2 <- c(0,Uhige-Q3)
  G2 <- Listplot(C-V,C-V-Temp1) #
  G3 <- Listplot(C+V,C+V+Temp2) #
  Temp3 <- c(Xr/4,0)
  G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) #
  G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) #
  Temp4 <- c(0,Q3-Q2)
  Temp5 <- c(Xr/2,0)
  G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) #
  G7 <- list()
  for(j in Looprange(1,length(Out))){
    G7 <- c(G7,list(c(CenterX, Out[j])))
  }
  G7 <- G7[order(Out,decreasing=TRUE)]
  list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7)
}

Boxplotdata2 <- function(Data,Ratio, ...)
{
  DataF<- Flattenlist(Data)  # 11.07.21(from)
  ymin<- Inf
  ymax<- -Inf
  for(J in 1:length(DataF)){
    Tmp<- DataF[[J]]
    ymin<- min(ymin, min(Tmp))
    ymax<- max(ymax,max(Tmp))
  }                                           # 11.07.21(upto)
  dy <- ymax-ymin
  Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy))
  R1<- (YMAX-YMIN)/(XMAX-XMIN)
  R<- Ratio/R1
  Setscaling(R)
  Delta <- XMAX/length(DataF)
  W <- 0.6*Delta
  PdL <- list()
  for(i in 1:length(DataF)){  # 11.07.21
    X <- (0.5+i-1)*Delta
    G <- Boxplotdata1(DataF[i],X,W,...)
    PdL <- c(PdL,list(G))
  }
  G <- Framedata()
  Tmp<- list(frame=G)  
  PdL <-c(PdL,list(Tmp))  
  Epsi <-0
  Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi))
  return(PdL)
}

Drwboxframe<-function(BoxDataL)
{
  Setorigin(c(XMIN,YMIN))
  Tmp<- Unscaling(c(0.2,0.2))
  Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX))
  Hako<- BoxDataL$plotdata
  title<- BoxDataL$title
  cap<- BoxDataL$cap
  ylab<- BoxDataL$ylab
  if(mode(title)!="list") title<- list(title)
  if(mode(cap)!="list") cap<- list(cap)
  if(mode(ylab)!="list") ylab<- list(ylab)
  if(length(title)==0) title<- list("")
  if(length(title)==1) title<- c(title, list("n"))
  if(length(title)==2) title<- c(title, list(""))
  if(length(cap)==0) cap<- list("")
  if(length(cap)==1) cap<- c(cap, list("n"),0)  # 11.11.27
  if(length(cap)==2) cap<- c(cap, 0)  # 11.11.27
  if(length(ylab)==0) ylab<- list("")
  if(length(ylab)==1) ylab <- c(ylab, list("n"))
  if(length(ylab)==2) ylab<- c(ylab, list(""))
  Temp <- Hako[[length(Hako)]]
  Drwline(Temp$frame)       
  Fontsize(cap[[2]])
  for(i in Looprange(1,length(Hako)-1)){
    Temp <- Hako[[i]]
    attach(Temp)   
      Dashline(uwhisker,lwhisker)   
      Drwline(median,2)    
      Drwline(box,lwp,uwp)    
      Drwpt(outliers,0)         
      X <- uwhisker[1,1]
    detach(Temp)   
    Htickmarklower(X)
    if(nchar(cap[[1]])<1) next  # 2011.03.08
    if(length(cap)==2 || cap[[3]]==0){
      pos<- 1
      if(length(cap)>=4) pos<- cap[[4]]
      Tmp<- paste("s",as.character(pos),sep="")
      Letter(c(X,YMIN),Tmp, Op(i,cap[[1]]))
    }
    else{
      rotate<- cap[[3]] 
      if(length(cap)==3){
        pos<- 0
      }
      else{
        pos<- cap[[4]]
      }
      Temp1 <- rotate*pi/180
      Temp <- c(cos(Temp1),sin(Temp1))
      Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]]))
    }
  }
  if(nchar(ylab[[1]])>0){
    Fontsize(ylab[[2]])
	Tmp1<- ylab[[1]]
	Tmp3<- ylab[[3]]
	if(nchar(Tmp3)>0){
      Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
    }
    Letter(c(XMIN, YMAX),"n2",Tmp1)
    Fontsize("n")
  }
  if(nchar(title[[1]])>0){
    Fontsize(title[[2]])
	Tmp1<- title[[1]]
	Tmp3<- title[[3]]
	if(nchar(Tmp3)>0){
      Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
    }
    Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1)
  }
  Fontsize("n")
}

Drwboxplot<- function(dataf,var,size,
           title=list(""), cap=list(colnames(dataf)),
           ylab=list(""), ptsize=5,plot=TRUE,...)
           #Return : title,cap,ylab,commands,plotdata,info
{
  Tmp <- boxplot(dataf, plot=FALSE, ...)
  Stats <- Tmp$stats 
  DataF<- Flattenlist(dataf)  # 11.07.21(from)
  ymin<- Inf
  ymax<- -Inf
  for(J in 1:length(DataF)){
    Tmp<- DataF[[J]]
    ymin<- min(ymin, min(Tmp))
    ymax<- max(ymax,max(Tmp))
  }                                           # 11.07.21(upto)
  Hako<- Boxplotdata2(dataf, size[2]/size[1], ...)
  if(plot){
    Windisp(Hako)
  }
  Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5)
  unit<- paste(Tmp,"cm",sep="")
  Setunitlen(unit)
  Exstr<- c(
    "","",
    paste("Beginpicture(","'",unit,"')",sep=""),
    paste("Setpt(",as.character(ptsize),")",sep=""),
    "","",     
    paste("Drwboxframe(",var,")",sep=""),
    paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""),
    "","","","",
    "Setpt(1)",    
    "Endpicture(0)"
  )
  Exstr<- matrix(Exstr)
  Xpos<- c()
  for(i in Looprange(1,length(Hako)-1)){
    Temp <- Hako[[i]]
    Temp1 <- Temp[[5]]
    Xpos <- c(Xpos,Temp1[1,1])
  }
  Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos)
  Tmp<- paste(var,"<<- ",
                 "list(title=title,cap=cap,ylab=ylab,",
                 "commands=Exstr,plotdata=Hako,info=Info)",sep="")
  eval(parse(text=Tmp)) 
}


###########################################

Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...)
# 10.12.07  freq
{
  Temp <- hist(DataV,plot=FALSE,...)
  Breaks <- Temp$breaks
  Counts <- Temp$counts
  Density <- Temp$density
  Mids  <- Temp$mids
  if(!freq){
     Data<- Density
  }
  else{
    Data<- Counts
  }  
  Ghist <- list()
  for(i in Looprange(1,length(Breaks)-1)){
    Tmp1 <- c(Breaks[i],Breaks[i+1])
    Tmp2 <- c(0,Data[i])
    G1 <- Framedata(Tmp1,Tmp2) #bar
    Ghist <- c(Ghist,list(G1))
  }
  Bin <- Breaks[2]-Breaks[1]
  Eps <- 0.7*Bin # 0.7 times Bin
  Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps)  # Put Eps at both sides
  Temp2 <- c(0,max(Data)*1.02)
  Setwindow(Temp1,Temp2)
  Setorigin(c(Temp1[1],0))
  R1<- (YMAX-YMIN)/(XMAX-XMIN)
  R<- Ratio/R1
  Setscaling(R)
  VEps <- 0.05*(XMAX-XMIN)/5
  Temp1<- Temp1-c(VEps,0)
  Temp2<-  Temp2-1/R*c(VEps,0)
  Setwindow(Temp1,Temp2)
  Fpt <- c(Mids[1]-Bin,0)
  Lpt <- c(Mids[length(Mids)]+Bin,0)
  Fp <- matrix(Fpt,nrow=1)
  for(i in Looprange(1,length(Mids))){
    Tmp <- c(Mids[i],Data[i])
    Fp <- rbind(Fp,Tmp)
  }
  Fp <- rbind(Fp,Lpt)
  rownames(Fp)<- c(1:nrow(Fp))
  if(densplot){
    Temp <- density(DataV)
    X <- matrix(Temp$x)     
    Y <- matrix(Temp$y)     
    Gdens <- cbind(X,Y)
  }
  else{
    Gdens <- list()
  } 
  list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)),
       breaks=Breaks,counts=Counts,density=Density,mids=Mids)
}

Drwhistframe<-function(HistDataL)
{
  title<- HistDataL$title
  xlab<- HistDataL$xlab
  ylab<- HistDataL$ylab
  if(mode(title)!="list") title<- list(title)
  if(mode(xlab)!="list") cap<- list(xlab)
  if(mode(ylab)!="list") cap<- list(ylab)
  if(length(title)==0) title<- list("")
  if(length(title)==1) title<- c(title, list("n"))
  if(length(title)==2) title<- c(title, list(""))
  if(length(xlab)==0) xlab<- list("")
  if(length(xlab)==1) xlab<- c(xlab, list("n"))
  if(length(xlab)==2) xlab<- c(xlab, list(""))
  if(length(xlab)==3) xlab<- c(xlab, list(8))
  if(length(ylab)==0) ylab<- list("")
  if(length(ylab)==1) ylab<- c(ylab, list("n"))
  if(length(ylab)==2) ylab<- c(ylab, list(""))
  if(nchar(title[[1]])>0){
    Fontsize(title[[2]])
	Tmp1<- title[[1]]
	Tmp3<- title[[3]]
	if(nchar(Tmp3)>0){
      Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
    }
    Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1)
    Fontsize("n")
  }
  if(nchar(xlab[[1]])>0){
    Fontsize(xlab[[2]])
	Tmp1<- xlab[[1]]
	Tmp3<- xlab[[3]]
	if(nchar(Tmp3)>0){
      Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
    }
	Tmp4<- paste("s",as.character(xlab[[4]]),sep="")
    Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1)
    Fontsize("n")
  }
  if(nchar(ylab[[1]])>0){
    Fontsize(ylab[[2]])
	Tmp1<- ylab[[1]]
	Tmp3<- ylab[[3]]
	if(nchar(Tmp3)>0){
      Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
    }
	Tmp<- Setorigin()
    Letter(c(Tmp[1], YMAX),"n2",Tmp1)
    Fontsize("n")
  }
  
  Setax(2," ")
  Setax(4," ")
  Setax(6," ")
}

Drwhistplot<- function(datav,var,size,freq=TRUE,
           title=list(""), xlab=list(""), ylab=list(""),
           plot=TRUE,densplot=FALSE,fpplot=TRUE,...)
           #Output : title,xlab,ylab,commands,plotdata,info
{
  H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...)
  Pd<- H$plotdata
  Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot)  # 10.12.07
  if(fpplot){
    Ghist<- c(Ghist,list(fpplot=Pd$fpplot))
  }
  if(plot){  
    Windisp(Ghist)
  }
  Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5)
  unit<- paste(Tmp,"cm",sep="")
  Setunitlen(unit)
  Infostr<- paste(var,"$info",sep="")
  Brkstr<- paste(Infostr,"$breaks",sep="")
  Midstr<- paste(Infostr,"$mids",sep="")
  if(!freq){
    Digits<- ",2,2"
    Denstr<- paste(Infostr,"$density",sep="")
  }
  else{
    Digits<- ",0,0"
    Denstr<- paste(Infostr,"$counts",sep="")
  }
  
  if(fpplot) Prefp<- "" else Prefp<- "#"
  Exstr<- c(
    "","",
    paste("Beginpicture(","'",unit,"')",sep=""),
    "","",     
    paste("Drwhistframe(",var,")",sep=""),
	paste("HtickLV(",Midstr,",1,1)",sep=""),
	paste("VtickLV(max(",Denstr,")",Digits,")",sep=""),
    paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""),
    paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""),
    paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""),
    "","","","",
    "Endpicture(1)"
  )
  Exstr<- matrix(Exstr)
  Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids,
              window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2))
  Tmp<- paste(var,"<<- ",
              "list(title=title,xlab=xlab,ylab=ylab,",
              "commands=Exstr,plotdata=Ghist,info=Info)",sep="")
  eval(parse(text=Tmp)) 
}

##########################
#17.09.30

Bezierpt<- function(t,Ptlist,Ctrlist){
  if(length(Ptlist)==6){
    P0=Ptlist[1:3]
    P3=Ptlist[4:6]
    P1=Ctrlist[1:3]
    if(length(Ctrlist)==3){
      P2=P3
      flg3=0
    }else{
      P2=Ctrlist[4:6]
      flg3=1
    }
  }else{
    P0=Ptlist[1:2]
    P3=Ptlist[3:4]
    P1=Ctrlist[1:2]
    if(length(Ctrlist)==2){
      P2=P3
      flg3=0
    }else{
      P2=Ctrlist[3:4]
      flg3=1
    }
  }
  P4=(1-t)*P0+t*P1
  P5=(1-t)*P1+t*P2
  P6=(1-t)*P2+t*P3
  P7=(1-t)*P4+t*P5
  P8=(1-t)*P5+t*P6
  P9=(1-t)*P7+t*P8
  if(flg3==0){
    Out=P7
  }else{
    Out=P9
  }
  return(Out)
}

Bezier<- function(...){
  varargin<- list(...)
  Nargs=length(varargin)
  Ptlist=varargin[[1]]
  Ctrlist=varargin[[2]]
  Num=10
  for(J in Looprange(3,Nargs)){
    Tmp=varargin[[J]]
    K=strsplit(Tmp,'=',fixe=TRUE)
    K=K[[1]]
    Tmp1=substring(K[1],1,1)
    Lhs=toupper(Tmp1)
    if(Lhs=="N"){
       Num=eval(parse(text=K[2]))
    }
  }
  if(length(Num)==1){
    Num=rep(Num,length(Ctrlist)) #17.10.08
  }
  Out=c()
  for(ii in Looprange(1,length(Ctrlist))){
    Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]])
    Tmp2=Ctrlist[[ii]]
    if(ii==1){
      St=0
    }else{
      St=1
    }
    for(J in Looprange(St,Num[ii])){
      Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2)
      Out=Appendrow(Out,Tmp)
    }
  }
  return(Out)
}

#######################
#  17.10.02

Connectseg<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Pdata=varargin[[1]]
  Eps=10^(-4)
  if(Nargs>=2){
    Eps=varargin[[2]]
  }
  if(is.matrix(Pdata)){
    Din=Dataindex(Pdata)
    tmp1=list()
    for(J in 1:nrow(Din)){
      tmp=Pdata[Din[J,1]:Din[J,2],]
      tmp1=c(tmp1,list(tmp))
    }
    Pdata=tmp1
  }
  PlotL=list(Op(1,Pdata))
  VI=Looprange(2,length(Pdata))
  while(length(VI)>0){
	Qd=Op(Length(PlotL),PlotL)
    Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd)
    Flg=0
    for(J in 1:length(VI)){
      Tmp1=Op(VI[J],Pdata)
      P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1)
      if(Norm(P-Ao)<Eps){
		Tmp=Tmp1[Looprange(2,Length(Tmp1)),]
         if(Length(Tmp)>0){
          Qd=Appendrow(Qd,Tmp)
        }
        PlotL[[length(PlotL)]]=Qd
        VI=VI[-J]
        Flg=1
        break
      }
      if(Norm(Q-Ao)<Eps){
        Tmp=Tmp1[(nrow(Tmp1)-1):1,]
        Qd=Appendrow(Qd,Tmp)
        PlotL[[length(PlotL)]]=Qd
        VI=VI[-J]
        Flg=1
        break
      }
      if(Norm(P-Ah)<Eps){
        Tmp=Tmp1[2:nrow(Tmp1),]
        Qd=Appendrow(Tmp,Qd)
        PlotL[[length(PlotL)]]=Qd
        VI=VI[-J]
        Flg=1
        break
      }
      if(Norm(Q-Ah)<Eps){
        Tmp=Tmp1[(nrow(Tmp1)-1):1,]
        Qd=Appendrow(Tmp,Qd)
        PlotL[[length(PlotL)]]=Qd
        VI=VI[-J]
        Flg=1
        break
      }
    }
    if(Flg==0){
      PlotL=c(PlotL,Pdata[VI[1]])
      VI=VI[-1]
    }
  }
  return(PlotL)
}

Makevaltable<- function(MS){
  Eps=10^(-6)
  Nargs=length(MS)
  Fstr=Op(1,MS)
  Tmp=Op(2,MS)
  Tmp1=strsplit(Tmp,"=",fixed=TRUE)
  Tmp1=Tmp1[[1]]
  Xname=Tmp1[1]
  Xrange=eval(parse(text=Tmp1[2]))
  Tmp=Op(3,MS)
  Tmp1=strsplit(Tmp,"=",fixed=TRUE)
  Tmp1=Tmp1[[1]]
  Yname=Tmp1[1]
  Yrange=eval(parse(text=Tmp1[2]))
  Tmp=gsub(Xname,"x",Fstr)
  Fstr=gsub(Yname,"y",Tmp)
  Tmp=grep(Xname,Fstr)
  if(length(Tmp)==0){
    Fstr=paste(Fstr,'+0*x',sep="")
  }
  Mdv=50
  Ndv=50
  if(Nargs>=4){
    Tmp=Op(4,MS)
    if(Length(Tmp)>1){ #18.02.09
      Mdv=Op(1,Tmp)
      Ndv=Op(2,Tmp)
    }else{
      Mdv=Tmp
      if(Nargs==4){
        Ndv=Mdv
      }else{
        Tmp1=Op(5,MS)
        if((is.numeric(Tmp1))&&(length(Tmp1)==1)){
          Ndv=Tmp1
        }else{
          Ndv=Mdv
        }
      }
    }
  }
  X1=Xrange[1]; X2=Xrange[2]
  Y1=Yrange[1]; Y2=Yrange[2]
  Dx=(X2-X1)/Mdv
  Dy=(Y2-Y1)/Ndv
  Xval=c()
  Tmp=X1
  for(ii in 1:(Mdv+1)){
    Tmp=X1+(ii-1)*Dx
    Xval=c(Xval,Tmp)
   }
  Yval=c()
  Tmp=Y1
  for(jj in 1:(Ndv+1)){
    Tmp=Y1+(jj-1)*Dy
    Yval=c(Yval,Tmp)
  }
  Zval=matrix(nrow=Ndv+1,ncol=Mdv+1)
  I=1
  for(y in Yval){
    J=1
    for(x in Xval){
      Zval[I,J]=eval(parse(text=Fstr))
      J=J+1
    }
    I=I+1
  }
  return(list(Zval,Xval,Yval))
}

Implicitplot<- function(...){
  varargin=list(...)
  Eps0=10^(-4)
  Nargs=length(varargin)
  Fstr=varargin[[1]]
  if(is.list(Fstr)){
    MS=Fstr
    Tmp=Makevaltable(MS)
    Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]]
  }else if(is.character(Fstr)){
#    MS=list()
#    for(I in 1:Nargs){
#      MS=c(MS,varargin[I])
#    }
#    Tmp=Makevaltable(MS)
    Tmp=Makevaltable(varargin) #18.02.24
    Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]]
  }else{
    Zval=varargin[[1]]
    Xval=varargin[[2]]
    Yval=varargin[[3]]
  }
  Out=c()
  for(J in Looprange(1,length(Yval)-1)){
    for(I in Looprange(1,length(Xval)-1)){
      a1=Xval[I]; b1=Yval[J]; c1=Zval[J,I]
      a2=Xval[I+1]; b2=Yval[J]; c2=Zval[J,I+1]
      a3=Xval[I+1]; b3=Yval[J+1]; c3=Zval[J+1,I+1]
      a4=Xval[I];b4=Yval[J+1];c4=Zval[J+1,I]
      PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
      VL=c(c1,c2,c3,c4,c1)
      QL=c()
      for(K in 1:4){
        if(abs(VL[K])<=Eps0){
          QL=Appendrow(QL,PL[K,])
        }else if(VL[K]>Eps0){
          if(VL[K+1]< -Eps0){
            Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,])
            QL=Appendrow(QL,Tmp)
          }
        }else{
          if(VL[K+1]>Eps0){
            Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,])
            QL=Appendrow(QL,Tmp)
          }
        }
      }
	  if(Length(QL)==2){
        Out=Appendrow(Out,c(Inf,Inf))
        Out=Appendrow(Out,QL)
      }
    }
  }
  Out=Out[2:nrow(Out),]
  if(Length(Out)>0){
    Out=Connectseg(Out)
  }else{
    Out=c()
  }
  return(Out)
}

#########################
# 17.10.06

Deqdata=function(deq,rng,initt,initf,Num){
  Eps=10^(-3)
  inf=10^3
  tmp=strsplit(deq,"=")[[1]]
  tmp1=gsub("`","",tmp[1],fixed=TRUE)
  tmp1=substring(tmp1,3,nchar(tmp1)-1)
  Xname=strsplit(tmp1,",")[[1]]
  func=tmp[2]
  for(J in 1:(length(Xname))){
    tmp1=paste("X[",as.character(J),"]",sep="")
    func=gsub(Xname[J],tmp1,func,fixed=TRUE)
  }
  tmp=strsplit(rng,"=")[[1]]
  tname=tmp[1]
  tmp=eval(parse(text=tmp[2]))
  t1=tmp[1]
  t2=tmp[2]
  tmp=paste("function(",tname,",X){",func,"}",sep="")
  funP=eval(parse(text=tmp))
  tmp=paste("function(",tname,",X){-",func,"}",sep="")
  funN=eval(parse(text=tmp))
  dt=(t2-t1)/Num
  tt=initt
  X0=initf
  pdL=c(tt,X0)
  for(J in Looprange(1,floor((t2-initt)/dt))){
    kl1=dt*funP(tt,X0)
    kl2=dt*funP(tt+dt/2,X0+kl1/2)
    kl3=dt*funP(tt+dt/2,X0+kl2/2)
    kl4=dt*funP(tt+dt,X0+kl3)
    X0=X0+(kl1+2*kl2+2*kl3+kl4)/6
    tt=initt+J*dt
    tmp=c(tt,X0)
    if(Norm(tmp)>inf){break}
    pdL=Appendrow(pdL,tmp)
  }
  tt=initt
  X0=initf
  for(J in Looprange(1,floor((initt-t1)/dt))){
    kl1=dt*funN(tt,X0)
    kl2=dt*funN(tt+dt/2,X0+kl1/2)
    kl3=dt*funN(tt+dt/2,X0+kl2/2)
    kl4=dt*funN(tt+dt,X0+kl3)
    X0=X0+(kl1+2*kl2+2*kl3+kl4)/6
    tt=initt-J*dt
    tmp=c(tt,X0)
    if(Norm(tmp)>inf){break}
    pdL=Appendrow(tmp,pdL)
  }
  pdL
}

Deqplot=function(...){
  varargin=list(...)
  deq=varargin[[1]]
  rng=varargin[[2]]
  initt=varargin[[3]]
  initf=varargin[[4]]
  Num=50
  Sel=c(1,2)
  for(J in Looprange(5,length(varargin))){
    tmp1=varargin[[J]]
    if(is.character(tmp1)){
      tmp=strsplit(tmp1,"=")[[1]]
      Num=eval(parse(text=tmp[2]))
    }else{
      SeL=tmp1
    }
  }
  pdL=Deqdata(deq,rng,initt,initf,Num)
  pdL=pdL[,SeL]
}


############## obj ###############

Openobj<- function(Fnm){
  OBJFMT<<- "%7.4f"
  NPOINT<<- 0
  NNORM<<- 0
  OBJSCALE<<- 1
  OBJFIGNO<<- 0
  OBJJOIN<<- 0
  Wfile<<- Fnm
  Tmp=grep(".obj",Fnm,fixed=TRUE)
  if(length(Tmp)==0){
    if(nchar(Fnm)>0){
      Wfile<<- paste(Fnm,".obj",sep="")
    }
  }
  cat("",file=Wfile,sep="")
  Wfile
}

Closeobj<- function(){
  Wfile=""
}

Writeobjpoint<- function(P){
  X=sprintf(OBJFMT,P[1]*OBJSCALE)
  Y=sprintf(OBJFMT,P[2]*OBJSCALE)
  Z=sprintf(OBJFMT,P[3]*OBJSCALE)
  Str=paste("v",X,Y,Z,sep=" ")
  Printobjstr(Str)
  NPOINT<<- NPOINT+1
  return(NPOINT)
}

Printobjstr<- function(Str){
  cat(Str,"\n",sep="",file=Wfile,append=TRUE)
}

Objname<- function(){
  if(OBJJOIN==0){
    OBJFIGNO<<- OBJFIGNO+1
    Gname=paste("ketfig",as.character(OBJFIGNO),sep="")
    Printobjstr(paste("# ",Gname,sep=""))
    Printobjstr(paste("g ",Gname,sep=""))
  }
}

Objjoin<- function(...){
  varargin=list()
  if(length(varargin)>0){
    OBJJOIN<<- abs(sign(varargin[[1]]))
  }
  OBJJOIN
}

Objsurf<- function(...){ #17.12.18
  Args<- list(...)
  Nargs<- length(Args)
  Sel=Args[[Nargs]]; Nargs=Nargs-1
  Rf=Args[[1]]
  N=2
  Mg=0; Ng=0
  if(is.numeric(Args[[N]])){
    if(length(Args[[N]])>2){
      U=Args[[N]]
      Mg=length(U)-1
      N=N+1
    }else if(length(Args[[N]])==2){
      Intab=Args[[N]]
      Ag=Intab[1]; Bg=Intab[2]
      N=N+1
    }else{
      Ag=Args[N]; Bg=Args[N+1]
      N=N+2
   }
  }else{
    Tmp0=Args[[N]]
    Tmp=grep("=",Tmp0,fixed=TRUE)
    if(length(Tmp)>0){
      Tmp1=strsplit(Tmp0,"=")
      Tmp0=Tmp1[[1]][2]
    }
    Intab=eval(parse(text=Tmp0))
    Ag=Intab[1]; Bg=Intab[2]
    N=N+1
  }
  if(is.numeric(Args[[N]])){
    if(length(Args[[N]])>2){
      V=Args[[N]]
      Ng=length(V)-1
      N=N+1
    }else if(length(Args[[N]])==2){
      Intab=Args[[N]]
      Cg=Intab[1]; Dg=Intab[2]
      N=N+1
    }else{
      Cg=Args[[N]]; Dg=Args[[N+1]]
      N=N+2
    }
  }else{ # the case of is.character(Args[[N]])
    Tmp0=Args[[N]]
    Tmp=grep("=",Tmp0,fixed=TRUE)
    if(length(Tmp)>0){
      Tmp2=strsplit(Tmp0,"=")
      Tmp0=Tmp2[[1]][2]
    }
    Intab=eval(parse(text=Tmp0))
    Cg=Intab[1]; Dg=Intab[2]
    N=N+1
  }  
  if(Mg==0){
    Mg=Args[[N]]
    N=N+1
	U=c()
    for(J in Looprange(1,Mg+1)){
      U=c(U,Ag+(J-1)/Mg*(Bg-Ag))
    }
  }
  if(Ng==0){
    Ng=Args[[N]]
    V=c()
    for(K in Looprange(1,Ng+1)){
      V=c(V,Cg+(K-1)/Ng*(Dg-Cg))
    }
  }
  Objname()
  PL=list()
  for(J in Looprange(1,Mg+1)){
    for(K in Looprange(1,Ng+1)){
      P=Rf(U[J],V[K])
      Np=Writeobjpoint(P)
      PL=c(PL,list(c(P,Np)))
    }
  }
  Idx=1+(Ng+1)*(0:Mg)
  Pus=PL[Idx]
  Idx=(Ng+1)*(1:(Mg+1))
  Pue=PL[Idx]
  Idx=1:(Ng+1)
  Pvs=PL[Idx]
  Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1))
  Pve=PL[Idx]
  Printobjstr("vt 0 0")
  Printobjstr("vt 1 0")
  Printobjstr("vt 1 1")
  Printobjstr("vt 0 1")
  for(J in Looprange(1,Mg)){
    for(K in Looprange(1,Ng)){
      P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]]))
      P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]]))
      P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]]))
      P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]]))
      N1=""; N2=""; N3=""; N4=""
      if(Sel=="+"){
        Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="")
        Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="")
      }else{
        Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="")
        Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="")
      }
      Printobjstr(Str)
    }
  }
  list(U,V,Pus,Pue,Pvs,Pve)
}

Objthicksurf<- function(...){
  Args=list(...)
  Nargs=length(Args)
  Sel=Args[[Nargs]]; Nargs=Nargs-1
  Selsurf=substring(Sel,1,1)
  Selside=c("0","0","0","0")
  Tmp=grep("w",Sel,fixed=TRUE)
  if(length(Tmp)>0){
    Selside[1]="w"
  }
  Tmp=grep("e",Sel,fixed=TRUE)
  if(length(Tmp)>0){
    Selside[2]="e"
  }
  Tmp=grep("s",Sel,fixed=TRUE)
  if(length(Tmp)>0){
    Selside[3]="s"
  }
  Tmp=grep("n",Sel,fixed=TRUE)
  if(length(Tmp)>0){
    Selside[4]="n"
  }
  Nfth=Args[[Nargs-2]]
  Thick1=Args[[Nargs-1]]
  Thick2=Args[[Nargs]]
  Nargs=Nargs-3
  Rfth=Args[[1]]
  N=2
  Mg=0; Ng=0
  if(is.numeric(Args[[N]])){
    if(length(Args[[N]])>2){
      U=Args[[N]]
      Mg=length(U)-1
      N=N+1
    }else if(length(Args[[N]])==2){
      Intab=Args[[N]]
      Ag=Intab[1]; Bg=Intab[2]
      N=N+1
    }else{
      Ag=Args[[N]]; Bg=Args[[N+1]]
      N=N+2
    }
  }else{
    Tmp0=Args[[N]]
    Tmp=strsplit(Tmp0,"=",fixe=TRUE)
    if(length(Tmp)>0){
      Tmp0=Tmp[[1]][2]
    }
    Intab=eval(parse(text=Tmp0))
    Ag=Intab[1]; Bg=Intab[2]
    N=N+1
  }
  if(is.numeric(Args[[N]])){
    if(length(Args[[N]])>2){
      V=Args[[N]]
      Ng=length(V)-1
      N=N+1
    }else if(length(Args[[N]])==2){
      Intab=Args[[N]]
      Cg=Intab[1]; Dg=Intab[2]
      N=N+1
    }else{
      Cg=Args[[N]]; Dg=Args[[N+1]]
      N=N+2
    }
  }else{
    Tmp0=Args[[N]]
    Tmp=strsplit(Tmp0,"=",fixed=TRUE)
    if(length(Tmp)>0){
      Tmp0=Tmp[[1]][2]
    }
    Intab=eval(parse(text=Tmp0))
    Cg=Intab[1]; Dg=Intab[2]
    N=N+1
  }
  if(Mg==0){
    Mg=Args[[N]]
    N=N+1
	U=c()
    for(J in Looprange(1,Mg+1)){
      U=c(U,Ag+(J-1)/Mg*(Bg-Ag))
    }
  }
  if(Ng==0){
    Ng=Args[[N]]
    V=c()
    for(K in Looprange(1,Ng+1)){
      V=c(V,Cg+(K-1)/Ng*(Dg-Cg))
    }
  }
  Objname()
  Join=OBJJOIN
  OBJJOIN<<- 1
  F1=function(u,v){
    Rfth(u,v)+Thick1*Nfth(u,v)
  }
  F2=function(u,v){
    Rfth(u,v)+Thick2*Nfth(u,v)
  }
  Dt1=Objsurf(F1,U,V,Selsurf)
  if(Selsurf=="+"){
    Tmp="-"
  }else{
    Tmp="+"
  }
  Dt2=Objsurf(F2,U,V,Tmp);
  Out=list(Dt1,Dt2);

  if(Selside[1]!="0"){
    Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1])
    Out=c(Out,list(Dt))
  }
  if(Selside[2]!="0"){
    Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2])
    Out=c(Out,list(Dt))
  }
  if(Selside[3]!="0"){
    Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3])
    Out=c(Out,list(Dt))
  }
  if(Selside[4]!="0"){
    Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4])
    Out=c(Out,list(Dt))
  }
  OBJJOIN<<- Join
}

Objrecs<- function(...){
  Eps=10^(-6)
  Args=list(...)
  Nargs=length(Args)
  Tmp=Args[[1]]
  PtL=Flattenlist(Tmp)
  for(J in Looprange(1,length(PtL))){ #17.12.23from
    Tmp=PtL[[J]]
    if(!is.matrix(Tmp)){ 
      PtL[[J]]=matrix(Tmp,nrow=1)
    }
  }  #17.12.23upto
  PL1=list()
  for(J in Looprange(1,length(PtL))){
    Tmp=PtL[[J]]
    for(K in Looprange(1,nrow(Tmp))){
      PL1=c(PL1,list(Tmp[K,]))
    }
  }
  Sel=Args[[Nargs]]; Nargs=Nargs-1
  Objname()
  for(J in Looprange(1,length(PL1))){
    P=PL1[[J]]
    if((length(P)<4) || (P[4]==0)){
      Np=Writeobjpoint(P)
      PL1[[J]]=c(P[1:3],Np)
    }
  }
  Tmp=Args[[2]]
  if((is.numeric(Tmp)) && (length(Tmp)==1)){
    Drv=Tmp
    Len=Norm(Drv)
    PL2=list()
    for(J in Looprange(1,length(PL1))){
      Tmp=PL1[[J]]
      P=Tmp[1:3]+Drv
      Np=Writeobjpoint(P)
      PL2=c(PL2,list(c(P[1:3],Np)))
      if(J<length(PL1)){
        Vec=PL1[[J+1]]-PL1[[J]]
        if(Norm(Vec)>Eps){
          Tmp1=Crossprod(Drv,Vec)
          Tmp2=Crossprod(Tmp1,Vec)
          Tmp3=Dotprod(Tmp2,Drv)
          if(Tmp3<-Eps){
            Tmp2=-Tmp2
          }
          Drv=Len/Norm(Tmp2)*Tmp2
        }
      }
    }
  }else{
    PtL=Flattenlist(Tmp)
    for(J in Looprange(1,length(PtL))){ #17.12.23from
      Tmp=PtL[[J]]
      if(!is.matrix(Tmp)){ 
        PtL[[J]]=matrix(Tmp,nrow=1)
      }
    }  #17.12.23upto
    PL2=list()
    for(J in Looprange(1,length(PtL))){
      Tmp=PtL[[J]]
      for(K in Looprange(1,nrow(Tmp))){
          PL2=c(PL2,list(Tmp[K,]))
      }
    }
    for(J in Looprange(1,length(PL2))){
      P=PL2[[J]]
      if((length(P)<4) || (P[4]==0)){
         Np=Writeobjpoint(P)
         PL2[[J]]=c(P[1:3],Np)
      }
    }
  }
  Printobjstr("vt 0 0")
  Printobjstr("vt 1 0")
  Printobjstr("vt 1 1")
  Printobjstr("vt 0 1")
  for(J in Looprange(2,length(PL1))){
    P1=sprintf("%1d",Op(4,PL1[[J-1]]))
    P2=sprintf("%1d",Op(4,PL2[[J-1]]))
    P3=sprintf("%1d",Op(4,PL2[[J]]))
    P4=sprintf("%1d",Op(4,PL1[[J]]))
    N1=""; N2=""; N3=""; N4=""
	if(Sel=="+"){
      Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="")
      Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="")
    }else{
      Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="")
      Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="")
    }
    Printobjstr(Str)
  }
  list(PL1,PL2)
}

Objpolygon<- function(...){
  Eps=10^(-6)
  Args=list(...)
  Nargs=length(Args)
  Tmp=Args[[1]]
  PtL=Flattenlist(Tmp)
  for(J in Looprange(1,length(PtL))){ #17.12.23from
    Tmp=PtL[[J]]
    if(!is.matrix(Tmp)){ 
      PtL[[J]]=matrix(Tmp,nrow=1)
    }
  }  #17.12.23upto
  PL=list()
  for(J in Looprange(1,length(PtL))){
    Tmp=PtL[[J]]
    for(K in Looprange(1,nrow(Tmp))){
       PL=c(PL,list(Tmp[K,]))
    }
  }
  Sel=Args[[Nargs]]; Nargs=Nargs-1
  Objname()
  for(J in Looprange(1,length(PL))){
    P=PL[[J]]
    if((length(P)<4) || (P(4)==0)){
       Np=Writeobjpoint(P)
       PL[[J]]=c(P[1:3],Np)
    }
  }
  if(Nargs==1){
    Tmp=PL[[1]]
    Cen=Tmp[1:3]
	Nc=Tmp[4]
  }else{
    Tmp=Args[[2]]
    if(length(Tmp)==1){
      Tmp1=PL[[Tmp]]
      Cen=Tmp1[1:3]
      Nc=Tmp[4]
    }else{
      Cen=Tmp
      Nc=Writeobjpoint(Cen)
    }
  }
  for(J in Looprange(1,length(PL))){
    if(J<length(PL)){
     Je=J+1
    }else{
      Je=1
    }
    Pt1=Cen
    PLj=PL[[J]]; PLje=PL[[Je]]
    Pt2=PLj[1:3]; Pt3=PLje[1:3]
    if(Norm(Crossprod(Pt2-Pt1,Pt3-Pt1))<Eps){
     next
    }
    P1=sprintf("%1d",Nc)
    P2=sprintf("%1d",PLj[4])
    P3=sprintf("%1d",PLje[4])
	if(Sel=="+"){
      Str=paste("f",P1,P2,P3,"",sep=" ")
    }else{
      Str=paste("f",P1,P3,P2,"",sep=" ")
    }
    Printobjstr(Str)
  }
  PL
}

Objpolyhedron<- function(Vertex,Face){
  OBJFIGNO<<- OBJFIGNO+1
  Ninit=NPOINT
  Objname()
  for(N in Looprange(1,length(Vertex))){
    P=Vertex[[N]]
    Np=Writeobjpoint(P)
    Vertex[[N]]=c(P[1:3],Np)
  }
  for(N in Looprange(1,length(Face))){
    F=Face[[N]]+Ninit
    Face[[N]]=F
    Str="f"
    for(J in Looprange(1,length(F))){
      P=sprintf("%1d",F[J])
      Str=paste(Str,P,sep=" ")
    }
    Printobjstr(Str)
  }
  list(Vertex,Face)
}

Objcurve<- function(...){
  Eps=10^(-6)
  Args=list(...)
  Nargs=length(Args)
  Tmp=Args[[1]]
  PtL=Flattenlist(Tmp)
  for(J in Looprange(1,length(PtL))){ #17.12.23from
    Tmp=PtL[[J]]
    if(!is.matrix(Tmp)){ 
      PtL[[J]]=matrix(Tmp,nrow=1)
    }
  }  #17.12.23upto
  PL=list()
  for(J in Looprange(1,length(PtL))){
    Tmp=PtL[[J]]
    for(K in Looprange(1,nrow(Tmp))){
       PL=c(PL,list(Tmp[K,]))
    }
  }
  Closed=Norm(PL[[length(PL)]]-PL[[1]])<Eps
  Pstr="xy"
  Tmp=Args[[Nargs]]
  if(is.character(Tmp)){
    Pstr=Tmp
    Nargs=Nargs-1
  }
  Sz=0.1
  Np=4
  if(Nargs>=2){
    Sz=Args[[2]]
  }
  if(Nargs>=3){
    Np=Args[[3]]
  }
  Assign("Sz",Sz)
  if(Pstr=="xy"){
    Vz=c(0,0,1)
    Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)")
  }
  if(Pstr=="yz"){
    Vz=c(1,0,0)
    Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))")
  }
  if(Pstr=="zx"){
    Vz=c(0,1,0)
    Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))")
  }
  Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep=""))
  P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]]
  PQ1=Q-P
  if(!Closed){
    PQ2=PQ1
  }else{ 
    PQ2=P-R
  }
  Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2)
  Vp1=Vp/Norm(Vp)
  Theta=acos(min(Dotprod(Vz,Vp1),1));
  Vj=Crossprod(Vz,Vp1)
  if(Norm(Vj)<Eps){
    Vj=Vz
  }
  Gc1=Rotate3data(Gc0,Vj,Theta)
  CL=list(Translate3data(Gc1,P))
  for(J in Looprange(2,length(PL)-1)){
    P=PL[[J]]; Q=PL[[J+1]]
    PQ2=Q-P
    if(Norm(PQ2)<Eps){
      next
    }
    Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2)
    Vp2=Vp/Norm(Vp)
    Theta=acos(min(Dotprod(Vp1,Vp2),1))
    Vj=Crossprod(Vp1,Vp2)
    if(Norm(Vj)<Eps){
      Vj=Vp1
    }
    Gc2=Rotate3data(Gc1,Vj,Theta)
    CL=c(CL,list(Translate3data(Gc2,P)))
    PQ1=PQ2
    Vp1=Vp2
    Gc1=Gc2
  }
  if(!Closed){
    Vp2=(Q-P)/Norm(Q-P)
    Theta=acos(min(Dotprod(Vp1,Vp2),1))
    Vj=Crossprod(Vp1,Vp2)
    if(Norm(Vj)<Eps){
      Vj=Vp1
    }
    Gc3=Rotate3data(Gc1,Vj,Theta)
    CL=c(CL,list(Translate3data(Gc3,Q)))
  }
  Objname()
  Join=Objjoin();
  Objjoin(1)
  GL1=CL[[1]]
  for(J in Looprange(2,length(CL))){
    GL2=CL[[J]]
    Dt=Objrecs(GL1,GL2,"-")
    GL1=Dt[[2]]
    if(J==2){
      GL0=Dt[[1]]
    }
  }
  if(!Closed){
    Objpolygon(CL[[1]],"-")
    N=length(CL)
    Objpolygon(CL[[N]],"+")
  }else{
     Objrecs(GL1,GL0,"-")
  }
  Out=CL
  OBJJOIN<<- Join
}

Objsymb<- function(Symb,Thick,Face,Dir){
  for(J in Looprange(1,length(Symb))){
    Objcurve(Op(J,Symb),Thick,Face,Dir)
  }
}

Symb3data<- function(Moji,Size,Kaiten,NV,Pos){
  if(is.character(Moji)){
    #Tmp=Symbdata(Moji)
    #    GY1=Tmp(2)
  }else{
      GY1=Moji
  }
  GY1=Scaledata(GY1,Size,Size)
  GY1=Rotatedata(GY1,Kaiten*pi/180)
  A=NV[1]; B=NV[2]; C=NV[3]
  if(A^2+B^2==0){
    E1=c(1,0,0)
    E2=c(0,1,0)
  }else{
    E1=c(B,-A,0)
    E2=c(-A*C,-B*C,A^2+B^2)
    Tmp=matrix(c(E1,E2,NV),3,3)
    D=det(Tmp)
    if(D<0){
      E1=-E1
    }
    E1=E1/Norm(E1)
    E2=E2/Norm(E2)
  }
  Em<- function(X,Y){
    c(E1[1]*X+E2[1]*Y,E1[2]*X+E2[2]*Y,E1[3]*X+E2[3]*Y)
  }
  GY1=Embed(GY1,Em)
  GY1=Translate3data(GY1,Pos)
  Flattenlist(GY1)
}

############## New Intersect 18.02.01 #############

Intersectline<- function(p1,v1,p2,v2){
  Eps0=10^(-5)
  tmp=Dotprod(v1,v2)
  tmp1=c(tmp,Norm(v1)^2)
  tmp2=c(-Norm(v2)^2,-tmp)
  tmp3=c(Dotprod(p2-p1,v2),Dotprod(p2-p1,v1))
  d=Crossprod(tmp1,tmp2)
  tmp=abs(Crossprod(v1,v2))
  if(tmp>Eps0){
    dt=Crossprod(tmp3,tmp2)
    ds=Crossprod(tmp1,tmp3)
    t=dt/d
    s=ds/d
    pt=p1+v1*t
    out=list(pt,t,s)
  }else{
    tmp1=Crossprod(p2-p1,v1)/Norm(v1)
    out=list(abs(tmp1))
  }
  return(out)
}

Intersectseg<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Eps0=10^(-4)
  Eps1=0.01
  seg1=varargin[[1]]
  seg2=varargin[[2]]
  if(Nargs>2){Eps1=varargin[[3]]}
  p1=Op(1,seg1); q1=Op(2,seg1)
  p2=Op(1,seg2); q2=Op(2,seg2)
  if((Norm(q1-p1)<Eps0)||(Norm(q2-p2)<Eps0)){
    out=list(-1)
  }else{
    tmp=Intersectline(p1,q1-p1,p2,q2-p2)
    if(length(Op(1,tmp))>1){
      pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp)
      if((t*(t-1)<Eps0)&&(s*(s-1)<Eps0)){
        out=list(0,pt,t,s)
      }else{
        t=min(max(t,0),1)
        s=min(max(s,0),1)
        tmp3=c(Norm(p1-p2),Norm(p1-q2),Norm(p2-p1),Norm(p2-q1))
        tmp1=c(Op(2,q2-p2),-Op(1,q2-p2))
        tmp=Intersectline(p1,tmp1,p2,q2-p2)
        if(length(Op(1,tmp))>1){
          if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
            tmp3=c(tmp3,Norm(Op(1,tmp)-p1))
          }
        }
        tmp=Intersectline(q1,tmp1,p2,q2-p2)
        if(length(Op(1,tmp))>1){
          if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
            tmp3=c(tmp3,Norm(Op(1,tmp)-q1))
          }
        }
        tmp1=c(Op(2,q1-p1),-Op(1,q1-p1))
        tmp=Intersectline(p2,tmp1,p1,q1-p1);
        if(length(Op(1,tmp))>1){
          if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
            tmp3=c(tmp3,Norm(Op(1,tmp)-p2))
          }
        }
        if(length(Op(1,tmp))>1){
          if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
            tmp3=c(tmp3,Norm(Op(1,tmp)-q2))
          }
        }
        out=list(min(tmp3),pt,t,s)
      }
    }else{
      dist=tmp[[1]]
      tmp1=q1-p1
      n=c(tmp1[2],-tmp1[1])/Norm(tmp1)
      pts=list()
      tmp=Intersectline(p1,n,p2,q2-p2)
      if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
        tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2
        pts=c(pts,list(list(tmp1,0,tmp[[3]])))
      }
      tmp=Intersectline(q1,n,p2,q2-p2)
      if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
        tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2
        pts=c(pts,list(list(tmp1,1,tmp[[3]])))
      }
      tmp=Intersectline(p2,n,p1,q1-p1)
      if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
        tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1
        pts=c(pts,list(list(tmp1,tmp[[3]],0)))
      }
      if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
        tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1
        pts=c(pts,list(list(tmp1,tmp[[3]],2)))
      }
      if(length(pts)==0){
        tmp1=min(Norm(p2-p1),Norm(q2-p1),Norm(p2-q1),Norm(q2-q1))
        out=list(tmp1)
      }else{
        if(dist>Eps1){
          out=list(dist)
        }else{
          tmp=c();
          for(j in 1:length(pts)){
            tmp=Appendrow(tmp,Op(1,pts[[j]]))
          }
          tmp1=sum(tmp[,1])/(length(pts))
          tmp2=sum(tmp[,2])/(length(pts))
          tmp3=c(tmp1,tmp2)
          tmp=Nearestpt(tmp3,seg1)
          tmp1=tmp[[2]]
          tmp=Nearestpt(tmp3,seg2)
          tmp2=tmp[[2]]
          out=list(dist,tmp3,tmp1,tmp2)
        }
      }
    }
  }
  return(out)
}

Osplineseg<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Eps=10^(-2)
  Eps0=10^(-6)
  Ptlist=varargin[[1]]
  Numstr="Num=20"
  if(Nargs>1){
    Numstr=varargin[[2]]
  }
  p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist)
  tmp=Norm(p2-p0)*Norm(p3-p1)
  tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2)
  cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp
  pQ=p1+cc*(p2-p0)
  pR=p2+cc*(p1-p3)
  ctrL=list(c(pQ,pR))
  out=Bezier(list(p1,p2),ctrL,Numstr)
  return(out)
}

Intersectpartseg<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  crv1=varargin[[1]]
  crv2=varargin[[2]]
  ii=varargin[[3]]
  jj=varargin[[4]]
  Eps1=varargin[[5]]
  Eps2=varargin[[6]]
  Dist=10*Eps2
  if(Nargs>6){Dist=varargin[[7]]}
  Eps0=10^(-4)
  out=list()
  seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1))
  seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2))
  tmp1=Op(2,seg1)-Op(1,seg1)
  tmp2=Op(2,seg2)-Op(1,seg2)
  snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2))
  tmp=Intersectseg(seg1,seg2,Eps1)
  dst=Op(1,tmp)
  if(dst<Eps0){
    out=list(Op(2,tmp),ii+Op(3,tmp),jj+Op(4,tmp),dst,snang)
  }else{
    if(dst<Eps2){
      if((Length(crv1)==2)||(Norm(Op(2,seg1)-Op(1,seg1))>Dist-Eps0)){
        os1=seg1
      }else{
        p1=Op(1,seg1); p2=Op(2,seg1)
        if(ii==1){
          p3=Op(3,crv1)
          tmp=p2-p1
          tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
          p0=Reflectdata(p3,c((p1+p2)/2,tmp))
        }else{
          if(ii==Length(crv1)-1){
            p0=Op(ii-1,crv1)
            tmp=p2-p1
            tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
            p3=Reflectdata(p0,c((p1+p2)/2,tmp))
          }else{
            p0=Op(ii-1,crv1); p3=Op(ii+2,crv1)
          }
        }
        os1=Osplineseg(list(p0,p1,p2,p3))
      }
	  if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){
        os2=seg2
      }else{
        p1=Op(1,seg2); p2=Op(2,seg2)
        if(jj==1){
          p3=Op(3,crv2)
          tmp=p2-p1
          tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
          p0=Reflectdata(p3,c((p1+p2)/2,tmp))
        }else{
          if(jj==Length(crv2)-1){
            p0=Op(jj-1,crv2)
            tmp=p2-p1
            tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
            p3=Reflectdata(p0,c((p1+p2)/2,tmp))
          }else{
            p0=Op(jj-1,crv2); p3=Op(jj+2,crv2)
          }
        }
        os2=Osplineseg(list(p0,p1,p2,p3))
      }
      tmp2=list()
      for(kk in Looprange(1,Length(os1)-1)){
        for(ll in Looprange(1,Length(os2)-1)){
          seg1=Listplot(Op(kk,os1),Op(kk+1,os1))
          seg2=Listplot(Op(ll,os2),Op(ll+1,os2))
          tmp=Intersectseg(seg1,seg2,Eps1)
          if((Op(1,tmp)<Eps1)&&(length(tmp)>1)){ #18.02.05
            if(Op(1,tmp)<dst+Eps0){
              dst=Op(1,tmp)
              tmp3=list()
              for( nn in Looprange(1,length(tmp2))){
                if(Op(1,tmp2[[nn]])<dst){
                  tmp3=c(tmp3,list(tmp2[[nn]]))
                }
              }
              tmp2=c(tmp3,list(list(dst,Op(2,tmp))))
            }
          }
        }
      }
      if(length(tmp2)>0){
        tmp1=c()
        for(nn in Looprange(1,length(tmp2))){
          tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]]))
        }
        tmp=sum(tmp1[,1])/length(tmp2)
        tmp=c(tmp,sum(tmp1[,2])/length(tmp2))
        out=list(tmp)
        p1=Op(ii,crv1); p2=Op(ii+1,crv1)
        tmp=c(Op(2,p2-p1),-Op(1,p2-p1))
        tmp=Intersectline(Op(1,out),tmp,p1,p2-p1)
        tmp=min(max(Op(3,tmp),0),1)
        out=c(out,list(ii+tmp))
        p1=Op(jj,crv2); p2=Op(jj+1,crv2)
        tmp=c(Op(2,p2-p1),-Op(1,p2-p1))
        tmp=Intersectline(Op(1,out),tmp,p1,p2-p1)
        tmp=min(max(Op(3,tmp),0),1)
        out=c(out,list(jj+tmp,dst,snang))
      }
    }
  }
  return(out)
}

Collectnear<- function(ptdL,Eps2){
  gL=list(Op(1,ptdL))
  rL=ptdL[Looprange(2,length(ptdL))] #18.02.07
  for( ii in Looprange(1,length(ptdL)-1)){
    numL=c()
    for(jj in Looprange(1,length(rL))){
      tmp1=100
      for(kk in Looprange(1,length(gL))){
        tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]]))
        if(tmp<tmp1){tmp1=tmp}
      }
      if(tmp1<Eps2){numL=c(numL,jj)}
    }
    if(length(numL)==0){
      break
    }else{
      gL=c(gL,rL[numL]) #18.02.05
      tmp=setdiff(1:(length(rL)),numL)
      rL=rL[tmp]
    }
  }
  return(list(gL,rL))
}

Groupnearpt<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Eps=varargin[[Nargs]]
  plist=varargin[[1]]
  qlist=varargin[[2]]
  if(!is.list(qlist)){
    qlist=plist
    plist=list()
  }
  if(length(qlist)==0){
    return(plist)
  }
  pt=qlist[[1]]
  qlist=qlist[Looprange(2,length(qlist))]
  if(length(plist)==0){
    plist=list(matrix(pt,nrow=1))
  }else{
    flg=0
    for(ii in Looprange(1,length(plist))){
      gL=plist[[ii]]
      for(jj in Looprange(1,Length(gL))){
        if(Norm(Op(jj,gL)-pt)<Eps){
          flg=1
          break
        }
      }
      if(flg==1){
        plist[[ii]]=Appendrow(gL,pt)
        break
      }
    }
    if(flg==0){
      plist=c(plist,list(matrix(pt,nrow=1)))
    }
  }
  out=Groupnearpt(plist,qlist,Eps)
  return(out)
}

IntersectcurvesPp<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Eps0=10^(-4)
  Eps1=0.01
  Eps2=0.05
  Dist=10*Eps2
  if(Nargs>2){Eps1=varargin[[3]]}
  if(Nargs>3){Eps2=varargin[[4]]}
  if(Nargs>4){Dist=varargin[[5]]}  
  tmp1=varargin[[1]]
  crv1=matrix(Op(1,tmp1),nrow=1)
  for(ii in Looprange(2,Length(tmp1))){
    tmp=Op(Length(crv1),crv1)
    if(Norm(tmp-Op(ii,tmp1))>Eps0){
      crv1=Appendrow(crv1,Op(ii,tmp1))
    }
  }
  tmp2=varargin[[2]]
  crv2=matrix(Op(1,tmp2),nrow=1)
  for(ii in Looprange(2,Length(tmp2))){
    tmp=Op(Length(crv2),crv2)
    if(Norm(tmp-Op(ii,tmp2))>Eps0){
      crv2=Appendrow(crv2,Op(ii,tmp2))
    }
  }
  if(Length(crv1)!=Length(crv2)){
    self=0
  }else{
    self=1
    for(ii in Looprange(1,Length(crv1))){
      if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){
        self=0
        break
      }
    }
  }
  out=list()
  for(ii in Looprange(1,Length(crv1)-1)){
    if(self==0){
      loopL=Looprange(1,Length(crv2)-1)
    }else{
      loopL=Looprange(ii+2,Length(crv2)-1)
    }
    for(jj in loopL){
      tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist)
      if(length(tmp)>1){ #18.02.05
        if(length(out)==0){
          out=list(tmp)
        }else{
          tmp1=Op(length(out),out)
          if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){
            out=c(out,list(tmp))
          }
        }
        if(self==1){
          tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp))
          out=c(out,list(tmp))
        }
      }
    }
  }
  tmp2=out
  out=list()
  tmp1=tmp2
  for(ii in Looprange(1,length(tmp2))){
    tmp=Collectnear(tmp1,Eps2)
    out=c(out,list(Op(1,tmp)))
   if(length(Op(2,tmp))==0){
      break
    }else{
      tmp1=Op(2,tmp)
    }
  }
  for(ii in Looprange(1,length(out))){
    tmp1=Op(ii,out)
    if(length(tmp1)==1){
      out[[ii]]=Op(1,tmp1)
    }else{
      tmp=c()
      for(jj in Looprange(1,length(tmp1))){
        tmp=c(tmp,Op(4,tmp1[[jj]]))
      }
      dst=min(tmp)
      tmp=c()
      for(jj in Looprange(1,length(tmp1))){
        if(Op(4,tmp1[[jj]])<dst+Eps0){
          tmp=c(tmp,Op(1,tmp1[[jj]]))
        }
      }
      tmp=matrix(tmp,ncol=2,byrow=TRUE)
      tmp=c(sum(tmp[,1]),sum(tmp[,2]))/Length(tmp)
      tmp2=list(tmp)
      tmp=Nearestpt(Op(1,tmp2),crv1)
      tmp2=c(tmp2,list(Op(2,tmp)))
      tmp=Nearestpt(Op(1,tmp2),crv2)
      tmp2=c(tmp2,list(Op(2,tmp)))
      tmp2=c(tmp2,list(list(dst,Op(5,tmp1[[1]]))))
      out[[ii]]=tmp2
    }
  }
  return(out)
}

Intersectcurves<- function(...){
  dtL=IntersectcurvesPp(...)
  out=list()
  for(jj in Looprange(1,length(dtL))){
    out=c(out,list(Op(1,dtL[[jj]])))
  }
  return(out)
}

############## end of New Intersect  #############

############## New Enclosing2 #############

Enclosing2<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  plist=varargin[[1]]
  Eps0=10^(-5)
  Eps1=0.01
  Eps2=0.1
  Start=c()
  flg=0
  for(ii in Looprange(2,Nargs)){
    tmp=varargin[[ii]]
    if(length(tmp)>1){
#      Start=tmp
    }else{
     if(flg==0){Eps1=tmp}
     if(flg==1){Eps2=tmp}
     flg=flg+1
    }
  }
  flg=0
  AnsL=c()
  if(length(plist)==1){
    Fdata=plist[[1]]
    tmp1=Op(1,Fdata)
    tmp2=Op(Length(Fdata),Fdata)
    if(Norm(tmp1-tmp2)<Eps0){
      AnsL=Fdata
    }else{
      AnsL=Appendrow(Fdata,tmp1)
    }
    flg=1
  }
  if(flg==0){
    Fdata=Op(1,plist)
    Gdata=Op(length(plist),plist)
    KL=IntersectcurvesPp(Fdata,Gdata)
    if(length(KL)==0){
      tmp1=Op(Length(Gdata),Gdata)
      tmp2=Op(1,Fdata)
      tmp=Listplot(tmp1,tmp2)
      plist=c(plist,list(tmp))
      Start=tmp2
      tst=1
#      flg=1
    }else{
      if(length(KL)==1){
        tmp=Op(1,KL)
        tst=Op(2,tmp)
        Start=crv(tst,Fdata)
      }
      if(length(KL)>1){
        KL=Quicksort(KL,2)
        if(length(Start)==0){
          tmp=Op(1,KL)
          tst=Op(2,tmp)
          Start=Pointoncurve(tst,Fdata)
        }else{
          tmp=c()
          for(ii in Looprange(1,length(KL))){
            tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start)))
          }
          tmp=min(tmp)
          tmp1=list()
          for(ii in Looprange(1,length(KL))){
            tmp2=Op(1,KL[[ii]])
            if(Norm(tmp2-Start)==tmp){
              tmp1=c(tmp1,list(tmp2))
            }
          }
          tmp=Op(1,tmp1)
          tst=Op(2,tmp)
          Start=Pointoncurve(tst,Fdata)
        }
      }
    }
  }
  if(flg==0){
    t1=tst
    for(nn in Looprange(1,length(plist))){
      Fdata=Op(nn,plist)
      if(nn==length(plist)){
        nxtno=1
      }else{
        nxtno=nn+1
      }
      Gdata=Op(nxtno,plist)
      KL=IntersectcurvesPp(Fdata,Gdata)
      if(length(KL)==0){
        tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from
        Gdata=Appendrow(tmp,Gdata)
        plist[[nxtno]]=Gdata
        t2=Length(Fdata)
        ss=1 #18.02.02upto
      }else{
        tmp=Op(1,KL)
        t2=Op(2,tmp)
        ss=Op(3,tmp)
        if(abs(t2-t1)<Eps0){
          if(length(KL)>1){
            tmp=Op(2,KL)
            t2=Op(2,tmp)
            ss=Op(3,tmp)
          }else{
#            println(text(nn)+" and "+text(nn+1)+" not intersect");
#            flg=1
          }
        }
      }
      if(flg==0){
        tmp=Partcrv(t1,t2,Fdata)
        if(nn==1){
          AnsL=tmp
        }else{
          tmp=tmp[2:Length(tmp),]
          AnsL=Appendrow(AnsL,tmp)
        }
        t1=ss
      }
    }
  }
  return(AnsL)
}

############## end of Enclosing2 #############

############## start of surface drawing #############

Fullformfunc<- function(FdL){
  ADDPOINT<<- list() #18.02.19
  Out=list(Op(1,FdL))
  N=length(FdL)
  for(Jrg in Looprange(1,N)){
    Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE)
    if(length(Tmp)>0){
      break
    }
  }
  Urg=Stripblanks(Op(Jrg,FdL))
  Tmp=strsplit(Urg,"=",fixed=TRUE)
  UNAME<<- Tmp[[1]][1]
  URNG<<- eval(parse(text=Tmp[[1]][2]))
  Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",",
               sprintf("%6.7f",URNG[2]),")",sep="")
  Vrg=Stripblanks(Op(Jrg+1,FdL))
  Tmp=strsplit(Vrg,"=",fixed=TRUE)
  VNAME<<- Tmp[[1]][1]
  VRNG<<- eval(parse(text=Tmp[[1]][2]))
  Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",",
               sprintf("%6.7f",VRNG[2]),")",sep="")
  if(Jrg==2){
    Xf=UNAME
    Yf=VNAME
    Tmp=Stripblanks(Op(1,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Zf=Tmp[[1]][2]
    Tmp=list(UNAME,VNAME,Zf,Urg,Vrg)
    Out=c(Out,Tmp)
  }else if(Jrg==4){
    Tmp=Stripblanks(Op(1,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Zf=Tmp[[1]][2]
    Tmp=Stripblanks(Op(2,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Xname=Tmp[[1]][1]
    Xf=Tmp[[1]][2]
    Tmp=Stripblanks(Op(3,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Yname=Tmp[[1]][1]
    Yf=Tmp[[1]][2]
    Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE)
    Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE)
    Tmp=list(Xf,Yf,Zf,Urg,Vrg)
    Out=c(Out,Tmp)
  }else{
    Tmp=Stripblanks(Op(2,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Xf=Tmp[[1]][2]
    Tmp=Stripblanks(Op(3,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Yf=Tmp[[1]][2]
    Tmp=Stripblanks(Op(4,FdL))
    Tmp=strsplit(Tmp,"=",fixed=TRUE)
    Zf=Tmp[[1]][2]
    Tmp=list(Xf,Yf,Zf,Urg,Vrg)
    Out=c(Out,Tmp)
  }
  tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='')
  eval(parse(text=tmp))
  tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='')
  eval(parse(text=tmp))
  tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='')
  eval(parse(text=tmp)) 
  tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='')
  tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='')
  eval(parse(text=tmp)) 
  XYZstr<<- c(Xf,Yf,Zf)
  DRWS<<- "enws"
  BdyL=list()
  for(I in Looprange(Jrg+2,length(FdL))){
    Tmp=Op(I,FdL)
    if(is.character(Tmp)){
      if(nchar(Tmp)==0){
        Tmp=" "
      }
      DRWS<<- list(Tmp)
    }
    if((is.numeric(Tmp))&&(Length(Tmp)>1)){
      BdyL=list(Tmp)
    }
  }
  BDYL<<- BdyL
  Tmp=c(DRWS,BDYL)
  Out=c(Out,Tmp)
  return(Out)
}

Addpoints<- function(ptlist){
  ADDPOINT<<- ptlist
}

Makexybdy<- function(Np){
  Eps0=10^(-4)
  Xystr=XYZstr[1:2]
  Umin=URNG[1]; Umax=URNG[2]
  Vmin=VRNG[1]; Vmax=VRNG[2]
  Cflg=0
  EhL=list()
  Tmp=grep("e",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:2){
      Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",VRNG)
    Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[2]))
    Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
    if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
      Cflg=1
      Tmp[Length(Tmp),]=Tmp[1,]
    }
    EhL=c(EhL,list(Tmp))
  }
  Tmp=grep("n",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:2){
      Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",URNG)
    Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[1]))
    Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
    if(Cflg>0){ 
      Tmp1=Op(length(EhL),EhL)
      Tmp=Joincrvs(Tmp1,Tmp)
      if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
        Cflg=1
        Tmp[Length(Tmp),]=Tmp[1,]
      }
      Tmp1=EhL[Looprange(1,length(EhL)-1)]
      EhL=c(Tmp1,Tmp)
    }else{
      Cflg=0
      if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
        Cflg=1
        Tmp[Length(Tmp),]=Tmp[1,]
      }
      EhL=c(EhL,list(Tmp))
    }
  }
  Tmp=grep("w",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:2){
      Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",VRNG)
    Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[2]))
    Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
    if(Cflg>0){
      Tmp1=Op(length(EhL),EhL)
	  Tmp=Joincrvs(Tmp1,Tmp)
      if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
        Cflg=1
        Tmp[Length(Tmp),]=Tmp[1,]
      }
      Tmp1=EhL[Looprange(1,length(EhL)-1)]
      EhL=c(Tmp1,list(Tmp))
    }else{
      Cflg=0
      if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
        Cflg=1
        Tmp[Length(Tmp),]=Tmp[1,]
      }
      EhL=c(EhL,list(Tmp))
    }
  }
  Tmp=grep("s",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:2){
      Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",URNG)
    Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[1]))
    Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
    if(Cflg>0){
      Tmp1=Op(length(EhL),EhL)
      Tmp=Joincrvs(Tmp1,Tmp)
      if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
        Cflg=1
        Tmp1=EhL[Looprange(1,length(EhL)-1)]
      }
      Tmp1=EhL[Looprange(1,length(EhL)-1)]
      EhL=c(Tmp1,list(Tmp))
    }else{
      Cflg=0
      if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
        Cflg=1
        Tmp[Length(Tmp),]=Tmp[1,]
      }
      EhL=c(EhL,list(Tmp))
    }
  }
  return(EhL)
}

Partitionseg<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Fig=varargin[[1]]
  GL=varargin[[2]]; N=3
  if(!is.list(GL)){GL=list(GL)} #18.02.21
  Eps0=10^(-4)
  Eps=0.01
  if(Nargs>2){
    Eps=varargin[[3]]
  }
  Eps2=0.1
  if(Nargs>3){
    Eps2=varargin[[4]]
  }
  if(Nargs>4){
    Ns=varargin[[5]]
    if(Ns>0){#18.02.21from
      Other=Op(Ns,OTHERPARTITION)
    }else{
      Other=c()
    }#18.02.21upto
  }else{
    Ns=1
    Other=c()
  }
  Npt=Length(Fig)
  ParL=c(1,Npt,Other)
  for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21
	G=Op(N,GL)
    KouL=IntersectcurvesPp(Fig,G,Eps,Eps2)
    Tmp1=c(); Tmp2=c()
    for(jj in Looprange(1,length(KouL))){
      tmp=Op(2,KouL[[jj]])
      if((tmp>1+Eps0)&&(tmp<Npt-Eps0)){
        Tmp1=c(Tmp1,tmp)
      }
      tmp=Op(3,KouL[[jj]])
      if((tmp>1+Eps0)&&(tmp<Length(G)-Eps0)){
        Tmp2=c(Tmp2,tmp)
      }
    }
    ParL=c(ParL,Tmp1)
    if((Ns>0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21
      tmp=OTHERPARTITION[[N]]
      OTHERPARTITION[[N]]<<- c(tmp,Tmp2)
    }
  }
  tmp1=sort(ParL)
  ParL=c()
  tmp2=-1
  for(jj in Looprange(1,length(tmp1))){
    tmp=Op(jj,tmp1)
    if(abs(tmp-tmp2)>Eps){
      ParL=c(ParL,tmp)
      tmp2=tmp
    }
  }
  return(ParL)
}

Evlptablepara<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Tmp=varargin[[1]]
  Mdv=50
  Ndv=50
  if(Nargs>=2){
    Tmp=varargin[[2]]
    if(is.list(Tmp)){Tmp=Op(1,Tmp)}
    if(length(Tmp)>1){
      Mdv=Tmp[1]
      Ndv=Tmp[2]
    }else{
      Mdv=Tmp
      if(Nargs==2){
        Ndv=Mdv
      }else{
        Tmp1=varargin[[3]]
        if((is.numeric(Tmp1)) && (length(Tmp1)==1)){
          Ndv=Tmp1
        }else{
          Ndv=Mdv
        }
      }
    }
  }
  U1=URNG[1]; U2=URNG[2]
  V1=VRNG[1]; V2=VRNG[2]
  Du=(U2-U1)/(Mdv)
  Dv=(V2-V1)/(Ndv)
  sph=sprintf("%7.7f",sin(PHI))
  cph=sprintf("%7.7f",cos(PHI))
  sth=sprintf("%7.7f",sin(THETA))
  cth=sprintf("%7.7f",cos(THETA))
  xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="")
  tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="")
  ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="")
  dxu=Diff(xstr,UNAME)
  dxv=Diff(xstr,VNAME)
  dyu=Diff(ystr,UNAME)
  dyv=Diff(ystr,VNAME)
  I=1
  Zval=c()
  for(jj in 1:(Ndv+1)){
    v=V1+(jj-1)*Dv
    ZuL=c()
    for(ii in 1:(Mdv+1)){
      u=U1+(ii-1)*Du
      tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="")
      tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="")
      Dxu=Funvalue(dxu,tmp1,tmp2)
      Dxv=Funvalue(dxv,tmp1,tmp2)
      Dyu=Funvalue(dyu,tmp1,tmp2)
      Dyv=Funvalue(dyv,tmp1,tmp2)
      Tmp=Dxu*Dyv-Dxv*Dyu
      ZuL=c(ZuL,Tmp)
    }
    Zval=Appendrow(Zval,ZuL)
  }
  Yval=c()
  for(jj in 1:(Ndv+1)){
    v=V1+(jj-1)*Dv
    Yval=c(Yval,v)
  }
  Xval=c()
  for(ii in 1:(Mdv+1)){
    u=U1+(ii-1)*Du
    Xval=c(Xval,u)
  }
  return(list(Zval,Xval,Yval))
}

Dropnumlistcrv<- function(QdL,Eps){
  Eps0=10^(-4)
  if(!is.list(QdL)){
    PdL=list(QdL)
  }else{
    PdL=QdL
  }
  OutL=list()
  for(I in Looprange(1,length(PdL))){
    Pd=Op(I,PdL)
    PtL=c(1)
    P=Op(1,Pd)
    for(K in Looprange(2,Length(Pd)-1)){
      if(Norm(P-Op(K,Pd))>Eps){
        PtL=c(PtL,K)
        P=Op(K,Pd)
      }
    }
    K=Length(Pd)
    if(Norm(P-Op(K,Pd))>Eps){ #18.02.12 eps
      PtL=c(PtL,K)
    }
    if(length(PtL)==1){
      PtL=c()
    }
    OutL=c(OutL,list(PtL))
  }
  return(OutL)
}

Cuspsplitpara<- function(...){
  varargin=list(...)
  Nargs=length(varargin);
  Gdxy=varargin[[1]]
  if(!is.list(Gdxy)){
    Gdxy=list(Gdxy)
  }
  Eps0=10^(-4)
  Eps=0.01
  if(Nargs>2){Eps=varargin[[2]]}
  N=2
  CUSPSPLITPT<<- list()
  OutkL=list()
  for(Ng in Looprange(1,length(Gdxy))){
    PtxyL=Op(Ng,Gdxy)
    PtkL=c()
    PthL=c()
    for(I in Looprange(1,Length(PtxyL))){
      Tmp=Op(I,PtxyL)
      Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="")
      eval(parse(text=Tmp1))
      Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="")
      eval(parse(text=Tmp1))
      Tmp2=c(eval(parse(text=XYZstr[1])))
      Tmp2=c(Tmp2,eval(parse(text=XYZstr[2])))
      Tmp2=c(Tmp2,eval(parse(text=XYZstr[3])))
      Tmp3=Parapt(Tmp2)
      if(I==1){
        PtkL=matrix(Tmp2,nrow=1)
        PthL=matrix(Tmp3,nrow=1)
      }else{
        Tmp4=Op(Length(PthL),PthL)
        if(Norm(Tmp3-Tmp4)>Eps0){
          PtkL=Appendrow(PtkL,Tmp2)
          PthL=Appendrow(PthL,Tmp3)
        }
      }
    }
    if(Length(PthL)==0){
      return(list())
    }
    Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL)
    Cflg=0
    if(Norm(Ps-Pe)<Eps){Cflg=1}
    CuspL=c()
    Cva=cos(10*pi/180)
    for(I in Looprange(1,Length(PthL)-1)){
      if(Length(PthL)==2){break}
      Tmp=Op(I,PthL)
      if(I==1){
        if(Cflg==0){next}
        Tmp1=Op(Length(PthL)-1,PthL)
      }else{
        Tmp1=Op(I-1,PthL)
      }
      Tmp2=Op(I+1,PthL)
      V1=Tmp-Tmp1
      V2=Tmp2-Tmp
      Tmp3=Dotprod(V1,V2)/(Norm(V1)*Norm(V2))
      Cuspflg=0
      if(Tmp3<Cva){
        P=Op(I,PthL)
        Kaku=acos(Tmp3)*180/pi
        if(Crossprod(V1,V2)<0){
          Kaku=-Kaku 
        }
		Cuspflg=0
        for(J in Looprange(I+1,Length(PthL)-1)){
          if(abs(Kaku)>90){
            Cuspflg=1
            break
          }
          Q=Op(J,PthL)
          if(Norm(P-Q)>Eps){
            break
          }
          V1=Q-Op(J-1,PthL)
          V2=Op(J+1,PthL)-Q
          Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2))
          Tmp=acos(Tmp3)*180/pi
          if(Crossprod(V1,V2)<0){
            Tmp=-Tmp 
          }
          Kaku=Kaku+Tmp
        }
        if(Cuspflg==1){
          Tmp=trunc((I+J)*0.5)
          I=J
          if(length(CuspL)==0){
            CuspL=c(Tmp)
          }else{
            CuspL=c(CuspL,Tmp)
          }
        }
      }
    }
    if(Cflg==0){
      CuspL=c(1,CuspL,Length(PthL))
    }else if(length(CuspL)==0){
      CuspL=c(1,Length(PthL))
    }else if(Op(1,CuspL)==1){
      CuspL=c(CuspL,Length(PthL))
    }else{
      Tmp=Op(1,CuspL)
      Tmp1=PthL[Tmp:Length(PthL),]
      Tmp2=PthL[2:Tmp,]
      PthL=Appendrow(Tmp1,Tmp2)
      Tmp1=PtkL[Tmp:Length(PthL),]
      Tmp2=PtkL[2:Tmp,]
      PtkL=Appendrow(Tmp1,Tmp2)
      CuspL=CuspL-Tmp+1
      CuspL=c(CuspL,Length(PthL))
    }
    if(length(CuspL)==2){
      Tmp4=PthL[Length(PthL),]
      if(Length(PtkL)>=2){
        CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4))
        OutkL=c(OutkL,list(PtkL))
      }
      next
    }
    Outk=list()
    Is=1
    for(I in Looprange(1,length(CuspL)-1)){
      Tmp1=CuspL[Is]; Tmp2=CuspL[I+1]
      Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL)
      if(Norm(Tmp3-Tmp4)>Eps){
        Tmpk=PtkL[Tmp1:Tmp2,]
        Outk=c(Outk,list(Tmpk))
        CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4))
        Is=I+1
      }
    }
    OutkL=c(OutkL,Outk)
  }
  Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps*0.5)
  Tmp=list()
  for(I in Looprange(1,length(OutkL))){
    Tmp2=Op(I,OutkL)
    Tmp3=Op(I,Tmp1)
    Tmp4=c()
    for(J in Looprange(1,Length(Tmp3))){
      Tmp5=Op(Tmp3[J],Tmp2)
      Tmp4=Appendrow(Tmp4,Tmp5)
    }
    if(Length(Tmp4)>0){
      Tmp=c(Tmp,list(Tmp4))
    }
  }
  return(Tmp)
}

PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps,Eps2){
  Eps0=10^(-4)
  Out=c()
  Vec=1/Norm(Vec)*Vec
  if(length(Np)==1){
    Np=c(Np,Np)
  }
  Tmp=paste("Eqfun<- function(U,V){",sep='')
  if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){
    Vstr=sprintf("%6.6f",Vec)
    Pstr=sprintf("%6.6f",PtA)
    Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='')
    Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='')
  }else{
    Tmp=paste(Tmp,"Xfunc(U,V)}",sep='')
  }
  eval(parse(text=Tmp))
  Dx=(URNG[2]-URNG[1])/Np[1]
  Dy=(VRNG[2]-VRNG[1])/Np[2]
  for(J in Looprange(1,Np[2])){ #####
    Vval1=VRNG[1]+(J-1)*Dy
    Vval2=VRNG[1]+J*Dy
    for(I in Looprange(1,Np[1])){ #####
      Uval1=URNG[1]+(I-1)*Dx
      Uval2=URNG[1]+I*Dx
      Eval11=Eqfun(Uval1,Vval1)
      Eval12=Eqfun(Uval1,Vval2)
      Eval21=Eqfun(Uval2,Vval1)
      Eval22=Eqfun(Uval2,Vval2)
      a1=Uval1;b1=Vval1;c1=Eval11
      a2=Uval2;b2=Vval1;c2=Eval21
      a3=Uval2;b3=Vval2;c3=Eval22
      a4=Uval1;b4=Vval2;c4=Eval12
      PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
      VL=c(c1,c2,c3,c4,c1)
      QL=c()
      for(K in 1:4){
        P1=Op(K,PL); P2=Op(K+1,PL)
        M1=Op(K,VL); M2=Op(K+1,VL)
        if(abs(M1)<Eps0){
          QL=Appendrow(QL,P1)
          next
        }
        if(abs(M2)<Eps0){
#          QL=Appendrow(QL,P2)
          next
        }
        if((M1> 0) && (M2> 0)){
          next
        }
        if((M1< 0) && (M2< 0)){
          next
        }
        Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
        QL=Appendrow(QL,Tmp)
      }
      if(Length(QL)==2){
        Puv1=Op(1,QL); Puv2=Op(2,QL)
        Tmp1=Op(1,Puv1)
        Tmp2=Op(2,Puv1)
        Xv=Xfunc(Tmp1,Tmp2)
        Yv=Yfunc(Tmp1,Tmp2)
        Zv=Zfunc(Tmp1,Tmp2)
        P1=c(Xv,Yv,Zv)
        Tmp1=Op(1,Puv2)
        Tmp2=Op(2,Puv2)
        Xv=Xfunc(Tmp1,Tmp2)
        Yv=Yfunc(Tmp1,Tmp2)
        Zv=Zfunc(Tmp1,Tmp2)
        P2=c(Xv,Yv,Zv)
        V1=Vec[1]; V2=Vec[2]; V3=Vec[3]
        if(abs(V1)>Eps0){
          M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3]
          M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3]
        }else if(abs(V2)>Eps0){
          M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3]
          M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3]
        }else{
          M1=PtA[2]-P1[2]
          M2=PtA[2]-P2[2]
        }
        if(M1*M2>= 0){
          if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
            next
          }
          if(M1==0){
            Pt=P1; Ptuv=Puv1
          }else{
            Pt=P2; Ptuv=Puv2
          }
        }else{  
          Pt=1/(M1-M2)*(-M2*P1+M1*P2)
          Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2)
        }
        if(is.character(Uveq)){		
          Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='')
          Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='')
          Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE)
          Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE)
          Tmp=eval(parse(text=Tmp))
          if(Tmp< -Eps0){
            next
          }
        }
        Tmp1=Crossprod(Pt-PtA,Vec)
        if(Norm(Tmp1)<Eps){ #18.02.19
          if(Zparapt(Pt)>Zparapt(PtA)+Eps2){
            return(list(1,Pt,Zparapt(Pt),Zparapt(PtA)))
          }else{
            Out=Appendrow(Out,Pt)
          }
        }
      }
    }
  }
  if(Length(Out)==0){
    return(list(0,c()))
  }
  return(c(list(0,Out)))
}

Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps,Eps2){
  Eps0=10^(-4)
  Fh=Projpara(Fk)
  P1=Ptstart(Fh)
  P2=Ptend(Fh)
  Csp=CUSPPT
  if(!is.list(Csp)){Csp=list(Csp)}
  Cspflg=1
  for(I in Looprange(1,length(Csp))){
    Tmp=Op(I,Csp)
    if(Norm(Tmp-P1)<Eps0){
      if(Cspflg==1){Cspflg=2}
      if(Cspflg==3){Cspflg=6}
      next
    }
    if(Norm(Tmp-P2)<Eps0){
      if(Cspflg==1){Cspflg=3}
      if(Cspflg==2){Cspflg=6}
      next
    }
  }
  PaL=c()
  tmp2=-1
  for(jj in Looprange(1,length(Par)-1)){
    tmp1=Op(jj,Par)
    if(abs(tmp1-tmp2)>Eps2){
      PaL=c(PaL,tmp1)
      tmp2=tmp1
    }
  }
  tmp1=PaL[length(PaL)] #18.02.26from
  tmp2=Par[length(Par)]
  if(abs(tmp1-tmp2)<Eps2){
    PaL[length(PaL)]=tmp2
  }else{
    PaL=c(PaL,tmp2)
  } #18.02.26upto
  SeL=c()
  for(N in Looprange(1,length(PaL)-1)){
    S=(PaL[N]+PaL[N+1])/2
    Tmp=Invparapt(S,Fh,Fk)
	PtA=Op(1,Tmp)
    PtAp=Parapt(PtA)
	Vec=c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA))
    Flg=PthiddenQ(PtA,Vec,Uveq,Np,Eps,Eps2)
    if(Flg[[1]]==0){
      SeL=c(SeL,N)
    }
  }
  FigL=list()
  FigkL=list()
  for(I in Looprange(1,length(SeL))){
    Tmp1=Pointoncurve(PaL[SeL[I]],Fh)
    Tmp2=Pointoncurve(PaL[SeL[I]+1],Fh)
    if(I==1){
      P=Tmp1; SP=PaL[SeL[I]]
      Q=Tmp2; SQ=PaL[SeL[I]+1]
    }else{
      if(Member(SeL[I]-1,SeL)){
        Q=Tmp2; SQ=PaL[SeL[I]+1]
      }else{
        FigL=c(FigL,list(Partcrv(SP,SQ,Fh)))
        Tmp3=Invparapt(SP,Fh,Fk)
        TP=Op(2,Tmp3)
        Tmp3=Invparapt(SQ,Fh,Fk)
        TQ=Op(2,Tmp3)
        Tmp4=Partcrv3(TP,TQ,Fk)
        FigkL=c(FigkL,list(Tmp4))
        P=Tmp1; SP=PaL[SeL[I]]
        Q=Tmp2; SQ=PaL[SeL[I]+1]
      }
    }
  }
  if(length(SeL)>0){
    if(Norm(P-Q)>Eps0){ #18.02.14
      FigL=c(FigL,list(Partcrv(P,Q,Fh)))
      Tmp3=Invparapt(SP,Fh,Fk)
      TP=Op(2,Tmp3)
      Tmp3=Invparapt(SQ,Fh,Fk)
      TQ=Op(2,Tmp3)
      FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk)))
    }else{
      FigL=c(FigL,list(Fh))
      FigkL=c(FigkL,list(Fk))
    }
  }
  Tmp=c()
  for(I in Looprange(1,length(PaL)-1)){
    if(!Member(I,SeL)){
      Tmp=c(Tmp,I)
    }
  }
  SeL=Tmp
  HIDDENDATA<<- list()
  for(I in Looprange(1,length(SeL))){
    Tmp=PaL[SeL[I]]
    Tmp1=Pointoncurve(Tmp,Fh)
    Tmp=PaL[SeL[I]+1]
    Tmp2=Pointoncurve(Tmp,Fh)
    if(I==1){
      P=Tmp1; SP=PaL[SeL[I]]
      Q=Tmp2; SQ=PaL[SeL[I]+1]
    }else{
      if(Member(SeL[I]-1,SeL)){
        Q=Tmp2; SQ=PaL[SeL[I]+1]
      }else{
        Tmp=Invparapt(SP,Fh,Fk)
        TP=Op(2,Tmp)
        Tmp=Invparapt(SQ,Fh,Fk)
        TQ=Op(2,Tmp)
        HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk)))
        P=Tmp1; SP=PaL[SeL[I]]
        Q=Tmp2; SQ=PaL[SeL[I]+1]
      }
    }
  }
  if(length(SeL)>0){
    if(Norm(P-Q)>Eps0){ #18.02.14
      Tmp=Invparapt(SP,Fh,Fk)
      TP=Op(2,Tmp)
      Tmp=Invparapt(SQ,Fh,Fk)
      TQ=Op(2,Tmp)
      HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk)))
    }else{
      HIDDENDATA<<- c(HIDDENDATA,list(Fk))
    }
  }
  return(FigkL)
}

Borderparadata<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  FkL=varargin[[1]]
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(2,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  Umin=URNG[1]; Umax=URNG[2]
  Vmin=VRNG[1]; Vmax=VRNG[2]
  EkL=list()
  Tmp=grep("e",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:3){
      Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",VRNG)
    Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[2]),sep="")
    Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
    EkL=c(EkL,list(Tmp))
  }
  Tmp=grep("n",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:3){
      Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",URNG)
    Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[1]),sep="")
    Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
    EkL=c(EkL,list(Tmp))
  }
  Tmp=grep("w",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:3){
      Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",VRNG)
    Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[2]))
    Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
    EkL=c(EkL,list(Tmp))
  }
  Tmp=grep("s",DRWS,fixed=TRUE)
  if(length(Tmp)>0){
    Tmp1="c("
    for(jj in 1:3){
      Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj])
      Tmp1=paste(Tmp1,Tmp,",",sep="")
    }
    Tmp=substring(Tmp1,1,Length(Tmp1)-1)
    Tmp1=paste(Tmp,")",sep="")
    Tmp=sprintf("%6.6f",URNG)
    Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
    Tmp3=paste('N=',as.character(Np[1]))
    Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
    EkL=c(EkL,list(Tmp))
  }
  if(length(EkL)>0){
    FkL=c(FkL,EkL)
  }
  Fall=Projpara(FkL)
  if(is.numeric(Fall)){
    Fall=list(Fall)
  }
  Fbdxy=Makexybdy(Np)
  BORDERPT<<- list()
  Tmp1=list()
  for(I in Looprange(1,length(Fall))){
    Tmp1=c(Tmp1,list(c()))
  }
  OTHERPARTITION<<- Tmp1
  FsL=list()
  BORDERHIDDENDATA<<- list()
  starttime=proc.time()
  for(I in Looprange(1,length(FkL))){
    Tmp=Op(I,FkL)
    Tmp=Projpara(Tmp)
    Par=Partitionseg(Tmp,Fall,Eps,Eps2,I)
    Tmp1=Op(I,FkL)
    Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps,Eps2)
	if(length(HIDDENDATA)>0){
      BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA)
    }
    if(length(Tmp)>0){
      FsL=c(FsL,Tmp)
    }
    Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='')
    Tmp=paste(Tmp,as.character(length(FkL)),' obtained  : Time =',sep='')
    Tmp1=proc.time()-starttime
    print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
  }
  return(FsL)
}

Sfbdparadata<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  Fd=varargin[[1]]
  FdL=Fullformfunc(Fd)
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(2,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  starttime=proc.time()
  tmp=Evlptablepara(Np)
  Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]]
  Out3=Implicitplot(Zval,Xval,Yval)
  tmp3=list()
  for(jj in Looprange(1,length(Out3))){
    tmp1=Op(jj,Out3)
    tmp2=c()
    for(kk in Looprange(1,Length(tmp1))){
      tmp=Op(kk,tmp1)
      tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
    }
    Nlist=Dropnumlistcrv(tmp2,Eps)
    Nlist=Nlist[[1]]
    tmp=c()
    for(kk in Looprange(1,length(Nlist))){
      tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18
    }
    if(Length(tmp)>0){
      tmp3=c(tmp3,list(tmp))
    }
  }
  Out3=tmp3
  IMPLICITDATA<<- Out3
  Tmp=proc.time()-starttime
  print(paste('ImplicitData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep=''))
  starttime=proc.time()
  Out4=Cuspsplitpara(Out3,Eps)
  CUSPDATA<<- Out4
  CUSPPT<<- CUSPSPLITPT
  Tmp=proc.time()-starttime
  print(paste('CuspData obtained     : Time =',sprintf("%6.3f",Tmp[1]),sep=''))
  Out5=Borderparadata(Out4,Np,Eps,Eps2)
  return(Out5)
}

Meetpoints<- function(PtA,PtB,Uveq,Np,Eps){
  Eps0=10^(-4)
  Vec=PtB-PtA
  if(Norm(Vec)<Eps0){return(list())} #18.02.24
  Out=list()
  Vec=1/Norm(Vec)*Vec
  if(length(Np)==1){
    Np=c(Np,Np)
  }
  Tmp=paste("Eqfun<- function(U,V){",sep='')
  if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){
    Vstr=sprintf("%6.6f",Vec)
    Pstr=sprintf("%6.6f",PtA)
    Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='')
    Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='')
  }else{
    Tmp=paste(Tmp,"Xfunc(U,V)}",sep='')
  }
  eval(parse(text=Tmp))
  Dx=(URNG[2]-URNG[1])/Np[1]
  Dy=(VRNG[2]-VRNG[1])/Np[2]
  for(J in Looprange(1,Np[2])){ #####
    Vval1=VRNG[1]+(J-1)*Dy
    Vval2=VRNG[1]+J*Dy
    for(I in Looprange(1,Np[1])){ #####
      Uval1=URNG[1]+(I-1)*Dx
      Uval2=URNG[1]+I*Dx
      Eval11=Eqfun(Uval1,Vval1)
      Eval12=Eqfun(Uval1,Vval2)
      Eval21=Eqfun(Uval2,Vval1)
      Eval22=Eqfun(Uval2,Vval2)
      a1=Uval1;b1=Vval1;c1=Eval11
      a2=Uval2;b2=Vval1;c2=Eval21
      a3=Uval2;b3=Vval2;c3=Eval22
      a4=Uval1;b4=Vval2;c4=Eval12
      PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
      VL=c(c1,c2,c3,c4,c1)
      QL=c()
      for(K in 1:4){
        P1=Op(K,PL); P2=Op(K+1,PL)
        M1=Op(K,VL); M2=Op(K+1,VL)
        if(abs(M1)<Eps0){
          QL=Appendrow(QL,P1)
          next
        }
        if(abs(M2)<Eps0){
#          QL=Appendrow(QL,P2)
          next
        }
        if((M1> 0) && (M2> 0)){
          next
        }
        if((M1< 0) && (M2< 0)){
          next
        }
        Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
        QL=Appendrow(QL,Tmp)
      }
      if(Length(QL)==2){
        Puv1=Op(1,QL); Puv2=Op(2,QL)
        Tmp1=Op(1,Puv1)
        Tmp2=Op(2,Puv1)
        Xv=Xfunc(Tmp1,Tmp2)
        Yv=Yfunc(Tmp1,Tmp2)
        Zv=Zfunc(Tmp1,Tmp2)
        P1=c(Xv,Yv,Zv)
        Tmp1=Op(1,Puv2)
        Tmp2=Op(2,Puv2)
        Xv=Xfunc(Tmp1,Tmp2)
        Yv=Yfunc(Tmp1,Tmp2)
        Zv=Zfunc(Tmp1,Tmp2)
        P2=c(Xv,Yv,Zv)
        V1=Vec[1]; V2=Vec[2]; V3=Vec[3]
        if(abs(V1)>Eps0){
          M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3]
          M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3]
        }else if(abs(V2)>Eps0){
          M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3]
          M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3]
        }else{
          M1=PtA[2]-P1[2]
          M2=PtA[2]-P2[2]
        }
        if(M1*M2>= 0){ #18.02.21
          if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
            next
          }
          if(M1==0){
            Pt=P1; Ptuv=Puv1
          }else{
            Pt=P2; Ptuv=Puv2
          }
        }else{  
          Pt=1/(M1-M2)*(-M2*P1+M1*P2)
          Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2)
        }
        if(is.character(Uveq)){
          Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='')
          Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='')
          Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE)
          Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE)
          Tmp=eval(parse(text=Tmp))
          if(Tmp< -Eps0){
            next
          }
        }
        Tmp1=Crossprod(Pt-PtA,Vec)
        if(Norm(Tmp1)<Eps){ #18.02.19
          Tmp1=Dotprod(Pt-PtA,Vec) #18.02.21
          if((Tmp1>-Eps0)&&(Tmp1<Norm(PtB-PtA)+Eps0)){
            Out=c(Out,list(Pt))
          }
        }
      }
    }
  }
  tmp1=Groupnearpt(Out,Eps)
  Out=list()
  for(jj in Looprange(1,length(tmp1))){
    tmp=Op(jj,tmp1)
    tmp=c(sum(tmp[,1]),sum(tmp[,2]),sum(tmp[,3]))/Length(tmp)
    Out=c(Out,list(tmp))
  }
  return(Out)
}

Clipindomain<- function(ObjL,FigL){
  Eps0=10^(-4)
  Eps1=0.01
  Eps2=0.05
  Bdy=Kyoukai(FigL)
  if(length(Bdy)>=2){
     Fbdy=Joincrvs(FigL)
  }else{
     Fbdy=Op(1,FigL)
  }
  if(!is.list(ObjL)){
    ObjL=list(ObjL)
  }
  if(!is.list(FigL)){
    FigL=list(FigL)
  }
  OutL=list()
  for(Nobj in Looprange(1,length(ObjL))){
    Obj=Op(Nobj,ObjL)
    ParL=c(1,Length(Obj))
    Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2)
    for(J in Looprange(1,length(Tmp))){
      Tmp1=Op(J,Tmp)
      ParL=c(ParL,Op(2,Tmp1))
    }
    ParL=sort(ParL)
    Tmp=c(1)
    for(I in Looprange(1,length(ParL))){
      Tmp1=Op(length(Tmp),Tmp)
      Tmp2=ParL[I]
      if(Tmp2-Tmp1>Eps0){
        Tmp=c(Tmp,Tmp2)
      }
    }
    ParL=Tmp
    Tmp1=Op(length(ParL),ParL)
    Tmp2=Length(Obj)
    if(abs(Tmp1-Tmp2)<Eps){
      ParL=c(ParL[Looprange(1,length(ParL)-1)],Tmp2)
    }
    Fig=list()
    for(N in Looprange(1,length(ParL)-1)){
      Tmp=(ParL[N]+ParL[N+1])*0.5
      Tmp=Pointoncurve(Tmp,Obj)
      Tmp=Naigai(Tmp,Bdy)
      Tmp1=sum(Tmp)%%2
      if(Tmp1==0){
        next
      }
      Fig=c(Fig,list(Partcrv(ParL[N],ParL[N+1],Obj)))
    }
    OutL=c(OutL,Fig)
  }
  return(OutL)
}

Crvsfparadata<- function(...){
  starttime=proc.time()
  varargin=list(...)
  Nargs=length(varargin)
  Sepflg=0
  Tmp=varargin[[Nargs]]
  if((is.numeric(Tmp))&&(Tmp<=0)){
    Sepflg=1
    Nargs=Nargs-1
  }
  Fk=varargin[[1]]
  if(!is.list(Fk)){
    FkL=list(Fk)
  }else{
    FkL=Fk
  }
  Fbdy=Projpara(varargin[[2]])
  Fd=varargin[[3]]; 
  Fullformfunc(Fd) #18.02.17
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(4,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  Out=list()
  CRVSFHIDDENDATA<<- list()
  for(Nn in Looprange(1,length(FkL))){
    Fk=Op(Nn,FkL)
    Tmp=Projpara(Fk)
    Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0)
    if(Sepflg==0){
      for(I in Looprange(1,Length(Fk)-1)){
        Pa=Op(I,Fk)
        Pb=Op(I+1,Fk)
        PtL=Meetpoints(Pa,Pb,1,Np,Eps)
        for(J in Looprange(1,Length(PtL))){
          Tmp=Op(J,PtL)
          Tmp=Parapt(Tmp)
          Tmp1=Paramoncurve(Tmp,I,Projpara(Fk))
          Tmp2=min(abs(Par-Tmp1))
          if(Tmp2*Norm(Parapt(Pb-Pa))>Eps) {
            Par=c(Par,Tmp1)
          }
        }
        Par=sort(Par)
      }
    }
    for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from
      tmp=Parapt(Op(jj,ADDPOINT))
      tmp=Nearestpt(tmp,Projpara(Fk))
      if(tmp[[3]]<Eps){
        Par=c(Par,tmp[[2]])
      }
    } #18.02.19upto
    tmp1=sort(Par)
    Par=c()
    tmp2=-1
    for(jj in Looprange(1,length(tmp1))){
      tmp=Op(jj,tmp1)
      if(abs(tmp-tmp2)>Eps){
        Par=c(Par,tmp)
        tmp2=tmp
      }
    }
    Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2)
    Out=c(Out,Tmp1)
    CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA)
    Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='')
    Tmp=paste(Tmp,as.character(length(FkL)),' obtained  : Time =',sep='')
    Tmp1=proc.time()-starttime
    print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
  }
  return(Out)
}

Crv3onsfparadata<- function(...){
  starttime=proc.time()
  varargin=list(...)
  Nargs=length(varargin)
  Fk=varargin[[1]]
  if(!is.list(Fk)){
    FkL=list(Fk)
  }else{
    FkL=Fk
  }
  Fbdy=Projpara(varargin[[2]])
  Fd=varargin[[3]]
  Fullformfunc(Fd) #18.02.17
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(4,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  Out=list()
  CRVONSFHIDDENDATA<<- list()
  for(Nn in Looprange(1,length(FkL))){
    Fk=Op(Nn,FkL)
    Tmp=Projpara(Fk)
    Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0)
    for(jj in Looprange(1,length(ADDPOINT))){
      tmp=Parapt(Op(jj,ADDPOINT))
      tmp=Nearestpt(tmp,Projpara(Fk))
      if(tmp[[3]]<Eps){
        Par=c(Par,tmp[[2]])
      }
    }
    Par=sort(Par)
    Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2)
    Out=c(Out,Tmp1)
    CRVONSFHIDDENDATA<<- c(CRVONSFHIDDENDATA,HIDDENDATA)
    Tmp=paste('Crvonsfdata',formatC(Nn,width=2,flag="0"),'/',sep='')
    Tmp=paste(Tmp,as.character(length(FkL)),' obtained  : Time =',sep='')
    Tmp1=proc.time()-starttime
    print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
  }
  return(Out)
}

Crvonsfparadata<- function(...){
  starttime=proc.time()
  varargin=list(...)
  Nargs=length(varargin)
  Fuv=varargin[[1]]
  Fbdy3=varargin[[2]]
  Fd=varargin[[3]]
  Fullformfunc(Fd) 
  if(!is.list(Fuv)){
    Fuv=list(Fuv)
  }
  FkL=list()
  for(jj in Looprange(1,length(Fuv))){
    tmp1=Op(jj,Fuv)
    tmp2=c()
    for(kk in Looprange(1,Length(tmp1))){
      tmp=Op(kk,tmp1)
      tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
    }
    FkL=c(FkL,list(tmp2))
  }
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(4,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2)
  return(Out)
}

Wireparadata<- function(...){
  starttime=proc.time()
  varargin=list(...)
  Nargs=length(varargin)
  Fbdy3=varargin[[1]]
  Fd=varargin[[2]]
  FdL=Fullformfunc(Fd) 
  DuL=varargin[[3]]
  DvL=varargin[[4]]
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(5,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  if(is.numeric(DuL)){
    tmp1=DuL
    DuL=list()
    for(jj in Looprange(1,tmp1)){
      tmp=jj*(URNG[2]-URNG[1])/(tmp1+1)
      DuL=c(DuL,list(tmp))
    }
  }
  if(is.numeric(DvL)){
    tmp1=DvL
    DvL=list()
    for(jj in Looprange(1,tmp1)){
      tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1)
      DvL=c(DvL,list(tmp))
    }
  }
  Fuv=list()
  for(jj in Looprange(1,length(DuL))){
    tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="")
    tmp2=paste("N=",as.character(Np[2]),sep="")
    tmp1=Paramplot(tmp1,Op(6,FdL),tmp2)
    tmp2=c()
    for(kk in Looprange(1,Length(tmp1))){
      tmp=Op(kk,tmp1)
      tmp2=Appendrow(tmp2,tmp)
    }
    Fuv=c(Fuv,list(tmp2))
  }
  FkL=list()
  for(jj in Looprange(1,length(Fuv))){
    tmp1=Op(jj,Fuv)
    tmp2=c()
    for(kk in Looprange(1,Length(tmp1))){
      tmp=Op(kk,tmp1)
      tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
    }
    FkL=c(FkL,list(tmp2))
  }
  Tmp1=proc.time()-starttime
  cat(UNAME,"direction started","\n")
  Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2)
  WIREHIDDENDATA<<- CRVONSFHIDDENDATA
  Fuv=list()
  for(jj in Looprange(1,length(DvL))){
    tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="")
    tmp2=paste("N=",as.character(Np[2]),sep="")
    tmp1=Paramplot(tmp1,Op(5,FdL),tmp2)
    tmp2=c()
    for(kk in Looprange(1,Length(tmp1))){
      tmp=Op(kk,tmp1)
      tmp2=Appendrow(tmp2,tmp)
    }
    Fuv=c(Fuv,list(tmp2))
  }
  FkL=list()
  for(jj in Looprange(1,length(Fuv))){
    tmp1=Op(jj,Fuv)
    tmp2=c()
    for(kk in Looprange(1,Length(tmp1))){
      tmp=Op(kk,tmp1)
      tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
    }
    FkL=c(FkL,list(tmp2))
  }
  cat(VNAME,"direction started","\n")
  Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2)
  WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA)
  Out=c(Out1,Out2)
  return(Out)
}

Intersectcrvsf<- function(...){
  # bdyeq is the equation of boundary f(x,y,z) =0
  starttime=proc.time()
  varargin=list(...)
  Nargs=length(varargin)
  crv=varargin[[1]]
  Fd=varargin[[2]]
  Fullformfunc(Fd) 
  bdyflg=0
  bdyeq=varargin[[Nargs]]
  if(is.character(bdyeq)){
    Nargs=Nargs-1
    bdyflg=1
    tmp=strsplit(bdyeq,"=",fixed=TRUE)
    tmp=tmp[[1]]
    if(length(tmp)>1){
      bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="")
    }
    tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="")
    eval(parse(text=tmp))
  }
  Eps0=10^(-4)
  Np=c(50,50)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(3,Nargs)){
    tmp=varargin[[jj]]
    if((length(tmp)>1)||(tmp>1)){
      Np=tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=tmp}
      if(ctr==2){Eps2=tmp}
    }
  }
  PtL=list()
  for(I in Looprange(1,Length(crv)-1)){
    Pa=Op(I,crv)
    Pb=Op(I+1,crv)
    if(bdyflg==0){
      tmp=Meetpoints(Pa,Pb,1,Np,Eps)
    }else{
      M1=bdyeq(Pa); M2=bdyeq(Pb)
      if(M1*M2>= 0){ #18.02.21
        if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
          next
        }
        if(M1==0){
          tmp=list(Pa)
        }else{
          tmp=list(Pb)
        }
      }else{
        while(Norm(Pb-Pa)>Eps0){
          if(bdyeq(Pa)==0){
            tmp=list(Pa)
            break
          }
          if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){
            Pa=(Pa+Pb)/2
          }else{
            Pb=(Pa+Pb)/2
          }
        }
        tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb))
      }
    }
    PtL=c(PtL,tmp)
  }
  Tmp=paste('Intersectcrvsf obtained  : Time =',sep='')
  Tmp1=proc.time()-starttime
  print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
  return(PtL)
}

Sfcutparadata<- function(...){
  varargin=list(...)
  Nargs=length(varargin)
  CutD=varargin[[1]]
  Fbdy3=varargin[[2]]
  Fd=varargin[[3]]
  FdL=Fullformfunc(Fd)
  Np=c(50,50)
  Eps0=10^(-4)
  Eps=0.01
  Eps2=0.05
  ctr=0
  for(jj in Looprange(4,Nargs)){
    Tmp=varargin[[jj]]
    if((length(Tmp)>1)||(Tmp>1)){
      Np=Tmp
      if(length(Np)==1){
        Np=c(Np,Np)
      }
    }else{
      ctr=ctr+1
      if(ctr==1){Eps=Tmp}
      if(ctr==2){Eps2=Tmp}
    }
  }
  starttime=proc.time()
  Tmp=strsplit(CutD,'=')
  Tmp=Tmp[[1]]
  if(length(Tmp)==1){
    Eq=CutD
  }else{
    Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="")
  }
  Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE)
  Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE)
  Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE)
  Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="")  ########
  eval(parse(text=Tmp))
  Du=(URNG[2]-URNG[1])/Np[1]
  Dv=(VRNG[2]-VRNG[1])/Np[2]
  Out=list();Out2=list()
  for(J in Looprange(1,Np[2])){ #####
    Vval1=VRNG[1]+(J-1)*Dv
    Vval2=VRNG[1]+J*Dv
    for(I in Looprange(1,Np[1])){ #####
      Uval1=URNG[1]+(I-1)*Du
      Uval2=URNG[1]+I*Du
      Eval11=Eqfun(Uval1,Vval1)
      Eval12=Eqfun(Uval1,Vval2)
      Eval21=Eqfun(Uval2,Vval1)
      Eval22=Eqfun(Uval2,Vval2)
      a1=Uval1;b1=Vval1;c1=Eval11
      a2=Uval2;b2=Vval1;c2=Eval21
      a3=Uval2;b3=Vval2;c3=Eval22
      a4=Uval1;b4=Vval2;c4=Eval12
      PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
      VL=c(c1,c2,c3,c4,c1)
      QL=c()
      for(K in 1:4){
        P1=Op(K,PL); P2=Op(K+1,PL)
        M1=Op(K,VL); M2=Op(K+1,VL)
        if(abs(M1)<Eps0){
          QL=Appendrow(QL,P1)
          next
        }
        if(abs(M2)<Eps0){
#          QL=Appendrow(QL,P2)
          next
        }
        if((M1> 0) && (M2> 0)){
          next
        }
        if((M1< 0) && (M2< 0)){
          next
        }
        Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
        QL=Appendrow(QL,Tmp)
      }
      if(Length(QL)==2){
        q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2]
        if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){
          if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){
            Out2=c(Out2,list(QL))
          }else{
            Out=c(Out,list(QL))
          }
          next
        }
        if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){
          if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){
            Out2=c(Out2,list(QL))
          }else{
            Out=c(Out,list(QL))
          }
          next
        }
        Out=c(Out,list(QL))
      }
    }
  }
  while(length(Out2)>0){
    tmp1=Out2[[1]]
    Out=c(Out,list(tmp1))
    Out2=Out2[-1]
    rmv=c()
    for(jj in Looprange(1,length(Out2))){
      tmp2=Out2[[jj]]
      diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,])
      diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,])
      if((diff1<Eps0)||(diff2<Eps0)){
        rmv=c(rmv,jj)
        next
      }
    }
    Out2=Out2[-rmv]
  }
  Out=Connectseg(Out,Eps)
  Tmp1=Out
  Out=list()
  for(ii in Looprange(1,length(Tmp1))){
    Tmp2=Op(ii,Tmp1)
    Tmp3=c()
    for(jj in Looprange(1,Length(Tmp2))){
      Tmp=Op(jj,Tmp2)
      Tmp=XYZfunc(Tmp[1],Tmp[2])
      if(Length(Tmp3)>0){
        if(Norm(Op(Length(Tmp3),Tmp3)-Tmp)<Eps){next}
      }
      Tmp3=Appendrow(Tmp3,Tmp)
    }
    Out=c(Out,list(Tmp3))
  }
  Out=Crv3onsfparadata(Out,Fbdy3,Fd,Np,Eps,Eps2)
  return(Out)
}
