subroutine mat_comand(id)
character(len=*),intent(in) :: id
integer :: chr
integer :: i, k
integer :: l
! a list of names this procedure matches to use for some preliminary tests
character(len=10),parameter :: cmd(*)=[ character(len=10) :: &
& 'clear', 'else', 'end', 'exit', 'for', &
& 'help', 'if', 'long', 'quit', 'semi', &
& 'short', 'what', 'while', 'who', 'sh', &
& 'lala', 'shell', 'continue', 'return', 'fhelp' &
& ]
FINISHED: block
G_FUN = 0
do k = size(cmd),0,-1
if(k.eq.0)then ! did not match anything
G_FIN = 0
return
elseif (id.eq.cmd(k))then ! found match to command
select case(G_CHRA) ! check next character
case(comma,semi,GG_EOL) ! next character is end of a command so good to go
exit
case(iachar('0'):iachar('9'),iachar('a'):iachar('z'),iachar('A'):iachar('Z'),score) ! alphanumeric or a HELP command so good to go
exit
end select
if (id.eq.'help')then ! special case where anything after the help could be a topic
exit
elseif(id.eq.'fhelp')then
exit
else
call mat_err(16) ! improper command
return
endif
endif
enddo
G_FIN = 1 ! found a match and next character passed tests
!===================================================================================================================================
COMAND : select case(id)
!===================================================================================================================================
case('clear')
! alphameric character
if(verify(achar(G_CHRA),big//little//digit)==0)then ! is alphanumeric so good to go by name
call mat_getsym()
G_ARGUMENT_POINTER = G_ARGUMENT_POINTER+1
G_VAR_ROWS(G_ARGUMENT_POINTER) = 0
G_VAR_COLS(G_ARGUMENT_POINTER) = 0
G_RHS = 0
call mat_stack_put(G_SYN)
if (G_ERR .gt. 0) return
G_FIN = 1
else
G_TOP_OF_SAVED = GG_MAX_NUMBER_OF_NAMES-3
endif
!===================================================================================================================================
case('for')
G_FIN = -11
exit FINISHED
case('while')
G_FIN = -12
exit FINISHED
case('if')
G_FIN = -13
exit FINISHED
case('else')
G_FIN = -14
exit FINISHED
case('end')
G_FIN = -15
exit FINISHED
!===================================================================================================================================
case('exit')
IF (G_PT .GT. G_PTZ)then
G_FIN = -16
exit COMAND
endif
K = int(GM_REALS(GM_BIGMEM-2))
call journal('sc',' total flops ',k)
select case( int(mat_urand(G_CURRENT_RANDOM_SEED)*9) ) ! for serendipity's sake randomly pick a sign-off
case(1); call journal(' adios')
case(2); call journal(' adieu')
case(3); call journal(' arrivederci')
case(4); call journal(' au revior')
case(5); call journal(' so long')
case(6); call journal(' sayonara')
case(7); call journal(' auf wiedersehen')
case default
call journal(' cheerio')
end select
G_FUN = 99
!===================================================================================================================================
case('quit','return')
K = G_LINE_POINTER(1) - 7
IF (K .LE. 0)then
G_FUN = 99
exit COMAND
endif
call mat_files(-G_RIO,G_BUF)
G_LINE_POINTER(1) = G_LIN(K+1)
G_LINE_POINTER(4) = G_LIN(K+2)
G_LINE_POINTER(6) = G_LIN(K+3)
G_PTZ = G_LIN(K+4)
G_RIO = G_LIN(K+5)
G_LINECOUNT(4) = G_LIN(K+6)
G_CHRA = BLANK
G_SYM = COMMA
exit FINISHED
!===================================================================================================================================
case('continue')
G_FUN = 99
exit FINISHED
!===================================================================================================================================
case('lala')
call journal('QUIT SINGING AND GET BACK TO WORK.')
!===================================================================================================================================
case('shell')
call journal(' Your place or mine?')
!===================================================================================================================================
case('short','long')
if(k.eq.11)then
G_FMT = 1
else
G_FMT = 2
endif
if (G_CHRA.eq.e_low .or. G_CHRA.eq.d_low .or. G_CHRA.eq.e_up .or. chr.eq.d_up ) G_FMT = G_FMT+2
if (G_CHRA .eq. z_low) G_FMT = 5
if (G_CHRA.eq.e_low .or. G_CHRA.eq.d_low .or. G_CHRA.eq.z_low) call mat_getsym()
if (G_CHRA.eq.e_UP .or. G_CHRA.eq.d_up .or. G_CHRA.eq.z_up ) call mat_getsym()
!===================================================================================================================================
case('semi')
G_LINECOUNT(3) = 1 - G_LINECOUNT(3) ! toggle "semi" mode
!===================================================================================================================================
case('who')
call journal(' Your current variables are...')
call mat_print_id(G_VAR_IDS(1,G_TOP_OF_SAVED),GG_MAX_NUMBER_OF_NAMES-G_TOP_OF_SAVED+1)
!x!do i=1,size(keywords)
!x! write(*,*)keywords(i),rows(i),cols(i),locs(i)
!x!enddo
l = GM_BIGMEM-G_VAR_DATALOC(G_TOP_OF_SAVED)+1
call journal('sc','using',l,'out of',GM_BIGMEM,'elements')
!===================================================================================================================================
case('what')
!===================================================================================================================================
case('sh')
call sh_command()
!===================================================================================================================================
case('help','fhelp')
HELP_ : block
character(len=GG_LINELEN) :: topic_name
G_BUF=blank
if (G_CHRA .eq. GG_EOL) then ! if no topic
topic_name= ' '
else
call mat_getsym() ! get next symbol or name
if (G_SYM .eq. isname)then ! use next word on line as topic
G_BUF(:GG_MAX_NAME_LENGTH) = G_SYN
else ! use next non-blank character as topic
if (G_SYM .eq. 0) G_SYM = dot
G_BUF(1) = G_SYM
G_BUF(2:) = blank
endif
call mat_buf2str(topic_name,G_BUF,len(topic_name)) ! convert ADE array to string
endif
if(topic_name.eq.'search')then
topic_name=ade2str(pack(G_LIN,G_LIN.gt.0.and.G_LIN.lt.255))
i=index(topic_name,'search') ! assuming help command on line by itself to some extent
if(i.ne.0)topic_name=topic_name(i:)
endif
if(id.eq.'help')then
call help_command(G_HELP_TEXT,trim(topic_name),&
& merge(G_LINECOUNT(:2),[0,huge(0)],& ! page length
& G_PROMPT))
else
call help_command(G_FORTRAN_TEXT,trim(topic_name),&
& merge(G_LINECOUNT(:2),[0,huge(0)],& ! page length
& G_PROMPT))
endif
endblock HELP_
!===================================================================================================================================
case default ! did not find a match
G_FIN = 0
return
!===================================================================================================================================
end select COMAND
!===================================================================================================================================
call mat_getsym()
endblock FINISHED
end subroutine mat_comand