184 lines
7.7 KiB
Fortran
184 lines
7.7 KiB
Fortran
!
|
|
! Abbreviations, simple
|
|
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.10
|
|
! GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0 on Kubuntu 25.10
|
|
! VSI Fortran does not/not yet compile this code.
|
|
! U.B., December 2025
|
|
!==============================================================================
|
|
program AbbrSimple
|
|
|
|
implicit none
|
|
|
|
integer, parameter :: lenCmd = 10
|
|
character (len=*), parameter :: cmdTable = &
|
|
'add 1 alter 3 backup 2 bottom 1 Cappend 2 change 1 Schange Cinsert 2 Clast 3 '&
|
|
'compress 4 copy 2 count 3 Coverlay 3 cursor 3 delete 3 Cdelete 2 down 1 duplicate '&
|
|
'3 xEdit 1 expand 3 extract 3 find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2 '&
|
|
'forward 2 get help 1 hexType 4 input 1 powerInput 3 join 1 split 2 spltJOIN load '&
|
|
'locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2 macro merge 2 modify 3 move 2 '&
|
|
'msg next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit read recover 3 '&
|
|
'refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left '&
|
|
'2 save set shift 2 si sort sos stack 3 status 4 top transfer 3 type 1 up 1 '
|
|
|
|
|
|
character (len=*), parameter :: userCmds = &
|
|
' riG rePEAT copies put mo rest types fup. 6 poweRin'
|
|
|
|
character (len=*), parameter :: invalid = '*error*'
|
|
|
|
character (len=len(cmdTable)) :: upcaseCmdTable
|
|
character (len=len(userCmds)) :: upcaseUserCmds
|
|
character (len=lenCmd) :: parsedCmd
|
|
character (len=lenCmd), allocatable :: allCmd (:), allUpcaseCmd(:)
|
|
integer, allocatable :: minLength (:)
|
|
|
|
character (len=lenCmd) inputCmd(10), upcaseInputCmd(10) ! 10 counted manually.
|
|
|
|
integer :: ip1, ip2
|
|
integer :: ii, l, la, nSpaces
|
|
|
|
! Prepare command table to UPPER CASE for case-blind compare
|
|
! count spaces so we get an idea how many commands there are in total.
|
|
|
|
nSpaces = 0
|
|
do ii=1, len(cmdTable)
|
|
upcaseCmdTable (ii:ii) = toupper (cmdTable (ii:ii))
|
|
if (upcaseCmdTable (ii:ii) .eq. ' ') nSpaces = nSpaces + 1
|
|
end do
|
|
|
|
! Also, have all user commands in UPCASE
|
|
do ii=1, len(userCmds)
|
|
upcaseUserCmds (ii:ii) = toupper (userCmds (ii:ii))
|
|
end do
|
|
|
|
! make space for the array with all commands bioth upper and lower case.
|
|
allocate (character(len=lenCmd) :: allCmd (nSpaces+1)) ! might be more than needed bc superfluous spaces
|
|
allocate (character(len=lenCmd) :: allUpcaseCmd(nSpaces+1))
|
|
allocate (integer :: minLength (nSpaces+1))
|
|
|
|
! Prepare lists of allowed commands and input commands
|
|
call tokenize (cmdTable, upcaseCmdTable, allCmd,allUpcaseCmd, minLength)
|
|
call tokenize (userCmds, upcaseUserCmds, inputCmd, upcaseInputCmd) ! 5th arg is optional
|
|
|
|
! As first output line, print user input
|
|
write (*, '("Input: ", 10(A10,x))') (inputCmd(ip1), ip1=1, size(inputCmd))
|
|
write (*, '("Parsed: ")', advance='no')
|
|
! Parse all user input commands
|
|
do ip1 = 1, size(inputCmd)
|
|
l = len_trim (inputCmd(ip1))
|
|
parsedCmd = invalid
|
|
do ip2 = 1, size(allCmd)
|
|
la =len_trim(allCmd(ip2))
|
|
if (la .ge. l) then ! input is possible abbreviation of this command
|
|
! Case blind comparison
|
|
if (allUpcaseCmd(ip2)(:l) .eq. upcaseInputCmd (ip1) (:l)) then
|
|
! at least this input cmd is a short form of this full command.
|
|
! But is it valid?
|
|
if (minLength(ip2) .gt. l) then
|
|
cycle ! input is shorter than required minimum length, try next command
|
|
endif
|
|
else
|
|
cycle ! input does not match command
|
|
endif
|
|
! Here we know that input an abbreviation of command,
|
|
! and that it is not too short
|
|
parsedCmd = allUpcaseCmd (ip2) ! We have a result
|
|
exit ! no need to check input against following commands
|
|
else
|
|
! input is longer than this command, nothing to do.
|
|
end if
|
|
end do
|
|
! here we found the valid command, or the parsed value is still
|
|
write (*, '(A10,X)', advance='no') parsedCmd
|
|
end do
|
|
write (*,*) ! Terminate output line.
|
|
|
|
contains
|
|
|
|
! ======================================================================================
|
|
! Divide a string of words separated by blanks into an array of the words without blanks
|
|
! ======================================================================================
|
|
subroutine tokenize (tokenString, upCaseString, retList, upcaseRetList, minLength )
|
|
|
|
character (len=*), intent(in) :: tokenString, upcaseString ! input "as is" and "upcase"
|
|
character (len=lencmd), intent(out) :: retList(*), upcaseRetList(*) ! Result "as is" and "Upcase"
|
|
integer, intent(out), optional :: minLength(*) ! Minimum lengths of commands
|
|
integer :: ip1, ip2 ! pointers into tokenString
|
|
integer :: nTokens ! Counter forisolated words
|
|
integer :: lstr ! Length of the tokenString
|
|
|
|
ip1 = 1
|
|
nTokens = 0
|
|
lstr = len_trim (tokenString)
|
|
! Expect keyword first, then an optional number.
|
|
do while (ip1 .le. lstr)
|
|
! First scan for a command
|
|
do while (ip1 .le. lstr .and. tokenString (ip1:ip1) .eq. ' ') ! Skip space(s)
|
|
ip1 = ip1 + 1
|
|
end do
|
|
|
|
if (ip1 .le. lstr) then ! still inside Line?
|
|
ip2 = ip1
|
|
! First expect keyword
|
|
do while (ip2 .le. lstr .and. tokenString (ip2:ip2) .ne. ' ') ! Find end of current word
|
|
ip2 = ip2 + 1
|
|
end do
|
|
ip2 = ip2 - 1 ! set to the true end of the new command, not one behind the next keyword
|
|
nTokens = nTokens + 1
|
|
|
|
retList (nTokens) = tokenString (ip1:ip2)
|
|
upcaseRetList (nTokens) = upcaseString (ip1:ip2)
|
|
|
|
! Now go look for the number
|
|
ip1 = ip2 + 1 ! prepare to find start of next text (numeric or not)
|
|
if (ip1 .le. lstr) then ! Still not past the end of tokenString?
|
|
do while (ip1 .le. lstr .and. tokenString (ip1:ip1) .eq. ' ') ! Skip space(s)
|
|
ip1 = ip1 + 1
|
|
end do
|
|
if (isDigit (tokenString (ip1:ip1))) then
|
|
if (present (minLength)) then
|
|
ip2 = ip1
|
|
read (tokenString (ip1:), *) minLength (nTokens)
|
|
do while (ip2 .le. lstr .and. isDigit (tokenString(ip2:ip2)) ) ! Find end of current Number
|
|
ip2 = ip2 + 1
|
|
end do
|
|
ip1 = ip2 ! prepare for next text search. ip2 is already behind the number.
|
|
endif
|
|
endif
|
|
endif
|
|
endif
|
|
end do
|
|
|
|
end subroutine tokenize
|
|
|
|
! =========================================================
|
|
! Convert a character c to UPPER CASE, if its in lower case.
|
|
! =========================================================
|
|
|
|
function toupper (c) result (U)
|
|
character, intent(in) :: c ! input
|
|
character :: U ! output
|
|
integer :: ix ! Helper: index of c in alphabet
|
|
|
|
Character(26), Parameter :: cap = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
|
Character(26), Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
|
|
|
|
ix = index (low, c) ! find c in lower case alphabet
|
|
if (ix .gt. 0) then ! c found: it is in lower case
|
|
U = cap (ix:ix) ! ...and needs conversion
|
|
else ! c not found, so is already in upper case,
|
|
U = c ! ...or it is not a letter. Just copy to result.
|
|
endif
|
|
end function toupper
|
|
|
|
|
|
! ==========================================================
|
|
! Returns .true. if input character c is in interval [0...9]
|
|
! ==========================================================
|
|
function isDigit (c) result (YN)
|
|
character, intent(in) :: c
|
|
logical :: YN
|
|
YN = (index ('0123456789', c) .ne. 0)
|
|
end function isDigit
|
|
|
|
end program AbbrSimple
|