Source module last modified on Wed, 13 Jul 2005, 16:20;
HTML image of Fortran source automatically generated by
for2html on Mon, 29 May 2006, 15:06.
#///////////////////////////////////////////////////////////////////////////
#//// ////
#//// LINP - v.1.2, (c) J.Saroun, 1999-2001 ////
#//// ////
#//// Universal command line interpreter ////
#//// ////
#//// ////
#///////////////////////////////////////////////////////////////////////////
#////
#////
#//// Usage:
#////
#//// CALL LINPSET(NLINES,' PROMPT',COMMANDS,HINTS)
#//// ..... to set the prompt, commands and hints
#////
#//// LINE=LINPEXEC(ICOM,NPAR)
#//// ..... reads the input and returns command number(ICOM),
#///// number of following parameters (NPAR)
#//// and the rest of the input string after the command (LINE)
#////
#//// LINE=FUNCTION LINPEXECSTR(SCOMM,ICOM,NPAR)
#//// ..... as LINPEXEC, but treats the string SCOMM instead of std. input
#////
#//// CALL LINPGETIO(IN,OUT,ERR), LINPSETIO(IN,OUT,ERR)
#//// .... get or set the inout, output and error unit numbers
#////
#////
#///////////////////////////////////////////////////////////////////////////
# ---------------------------------------------------
integer*4 FUNCTION ORDCOM(what,commands,ncmd)
# returns ordinal number of command
# copy of GETICOM from "linp", but with var 'commands' argument
# ---------------------------------------------------
implicit none
character*(*) what
integer*4 i,l,ipos,nc,ncmd
character*(*) commands(ncmd)
ipos=1
nc=0
ORDCOM=0
call FINDPAR(what,1,ipos,l)
if (l.le.0) return
call MKUPCASE(what(ipos:ipos+l-1))
do i=1,ncmd
if (index(commands(i),what(ipos:ipos+l-1)).eq.1) then
ORDCOM=i
nc=nc+1
endif
if (nc.gt.1) then
ORDCOM=-3 ! ambiguous command
return
endif
enddo
end
#---------------------------------------------------
integer*4 FUNCTION GETICOM(what)
# returns ordinal number of command
# command not found ... return 0
# ambiguous command ... return -3
#---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
character*(*) what
integer*4 i,l,ipos,nc,i1,i2
character*5 cm
ipos=1
nc=0
GETICOM=0
call FINDPAR(what,1,ipos,l)
if (l.gt.5) l=5
if (l.le.0) return
call MKUPCASE(what(ipos:ipos+l-1))
do i=1,linp_nc
cm=linp_c(i)
call MKUPCASE(cm)
if (index(cm,what(ipos:ipos+l-1)).eq.1) then
GETICOM=i
nc=nc+1
i1=1
call FINDPAR(cm,1,i1,i2)
if (cm(i1:i1+i2-1).eq.what(ipos:ipos+l-1)) return
endif
enddo
if (nc.gt.1) then
GETICOM=-3 ! ambiguous command
return
endif
end
# ---------------------------------------------------
SUBROUTINE LINPGETIO(in,out,err)
# ---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
integer*4 in,out,err
in=linp_in
out=linp_out
err=linp_err
end
# ---------------------------------------------------
SUBROUTINE LINPSETIO(in,out,err)
# ---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
integer*4 in,out,err
linp_in=in
linp_out=out
linp_err=err
linp_eof=0
end
# ---------------------------------------------------
SUBROUTINE LINPSET(nc,prompt,commands,hints)
# ---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
integer*4 nc,i,dimc,dimh
character*(*) commands(nc)
character*(*) hints(nc),prompt
call BOUNDS(prompt,i,linp_np)
if (i+linp_np-1.gt.20) linp_np=21-i
linp_p=prompt(1:i+linp_np-1)
# if nc=0, only prompt can be set up
if (nc.le.0) return
dimc=len(commands(1))
dimh=len(hints(1))
linp_nc=nc
if (dimc.gt.5) dimc=5
if (dimh.gt.60) dimh=60
if (linp_nc.gt.linp_dim) linp_nc=linp_dim
do i=1,linp_nc
linp_c(i)=commands(i)(1:dimc)
linp_h(i)=hints(i)(1:dimh)
# write(*,*) i,' ',linp_c(i),' ',linp_h(I)
enddo
end
#---------------------------------------------------
character*(*) FUNCTION LINPEXECSTR(scomm,icom,npar)
# Treat command string
# input:
# SCOMM ... command string
# output:
# ICOM: command ID
# NPAR: number of command arguments
# return: command with arguments
# NOTE:
# - ICOM=-5 ... command is an integer => return this integer as NPAR
# - ICOM=-4 ... end of input file
# - ICOM=-3 ... ambiguous command
# - ? gives a list of commands with hints
# -
#---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
integer*4 icom,i,j,k,l,ip,ll,GETICOM,npar
character*128 line
character*(*) scomm
logical*4 IsInteger
data linp_in,linp_out,linp_err /5,6,7/
data linp_np,linp_p /4, 'LINP'/
1 format(a)
l=len(scomm)
line=scomm(1:l)
#// if the input is integer, return it as string, and in NPAR as value
if (IsInteger(line(1:l))) then
read(line(1:l),*,err=20) i
LINPEXECSTR=scomm(1:l)
#c WRITE(LINPEXECSTR,*) I
icom=-5
npar=i
return
endif
20 icom=GETICOM(line) ! find command number
ll=len(line)
if (icom.eq.-3) write(linp_err,1) 'Ambiguous command !'
if (icom.lt.0) return
k=1
call FINDPAR(line,1,k,l)
if (l.eq.0) return ! line was empty
if (icom.gt.0) then
call BOUNDS(line(k+l:ll),ip,i)
ip=ip+k+l-1
LINPEXECSTR=line(ip:ip+i-1) ! return string with parameters
npar=0
do while (l.gt.0)
k=k+l
call FINDPAR(line,1,k,l)
if (l.gt.0) npar=npar+1
enddo
return
else if (icom.eq.0) then
if (line(1:k).eq. '?') then
k=k+l
call FINDPAR(line,1,k,l)
i=GETICOM(line(k:k+l-1))
if (i.gt.0) then
if (linp_h(i) .ne. ' ') then
write(linp_out,*) linp_c(i)// ' '//linp_h(i)
endif
else
do j=1,linp_nc
if (linp_h(j).ne. ' ') then
write(linp_out,*) linp_c(j)// ' '//linp_h(j)
endif
enddo
write(linp_out,*) 'LIST list values'
write(linp_out,*) 'QUIT quit this menu'
endif
else
call MKUPCASE(line(1:k))
if (index( 'QUIT',line(1:k)).eq.1) then
LINPEXECSTR= 'QUIT'
npar=0
return
else if (index( 'LIST',line(1:k)).eq.1) then
LINPEXECSTR= 'LIST'
npar=0
return
else
write(linp_out,*) 'type ? for help'
endif
endif
endif
LINPEXECSTR= ' '
npar=0
end
# ---------------------------------------------------
character*(*) FUNCTION GETCOM(icom)
# returns ICOM-th command name
# ---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
integer*4 icom
if (icom.gt.0.and.icom.le.linp_nc) then
GETCOM=linp_c(icom)
else if (icom.eq.-1) then
GETCOM= 'QUIT'
else if (icom.eq.-2) then
GETCOM= '?'
else
GETCOM= ' '
endif
end
# ---------------------------------------------------
character*(*) FUNCTION GETHINT(icom)
# ---------------------------------------------------
implicit none
INCLUDE 'linp.inc'
integer*4 icom
if (icom.gt.0.and.icom.le.linp_nc) then
GETHINT=linp_h(icom)
else if (icom.eq.-1) then
GETHINT= 'Quit interpreter'
else if (icom.eq.-2) then
GETHINT= 'Show hints'
else if (icom.eq.-3) then
GETHINT= 'Ambiguous command'
else
GETHINT= ' '
endif
end