Category : BASIC Source Code
Archive   : METAFONE.ZIP
Filename : METAFONE.BAS

 
Output of file : METAFONE.BAS contained in archive : METAFONE.ZIP

SUBROUTINE METAPHONE(NAME,METAPH)
***********************************************************************
*
* Lawrence B.F. Philips 25 July 1990
*
***********************************************************************
*
* this listing is in Pick BASIC. It is a fairly standard BASIC,
* and rather convenient for the purposes of string manipulation
* The two most non-standard features are ':', a string concatenator,
* and the convention for addressing substrings:
*
* STRING[ start, length ]
*
************************************************************************
*
EQU VOWELS TO "AEIOU"
EQU FRONTV TO "EIY"
EQU VARSON TO "CSPTG"
* as in 'variable sound', i.e. those modified by the addition of an 'h'
*
*
NAME = ICONV(NAME,'MCU')
ENAME = ICONV(NAME,'MCA')
* delete non-alphanumeric characters and make all caps
*
IF ENAME = "" THEN RETURN
*
*
TWO = ENAME[1,2]
IF TWO = "PN" OR TWO = "AE" OR TWO = "KN" OR TWO = "GN" OR TWO = "WR" THEN ENAME = ENAME[2,9999]
IF ENAME[1,1] = "X" THEN ENAME = "S":ENAME[2,99999]
IF TWO = "WH" THEN ENAME = "W":ENAME[3,99999]
*
*
* Convert to metaph
*
L = LEN(ENAME)
METAPH = '' ; NEW = 1 ; HARD = 0
FOR N = 1 TO L WHILE LEN(METAPH) < 4
SYMB = ENAME[N,1]
IF SYMB # "C" AND N > 1 AND ENAME[N - 1,1] = SYMB THEN NEW = 0 ELSE NEW = 1
IF NEW = 1 THEN
BEGIN CASE
CASE INDEX(VOWELS,SYMB,1) > 0 AND N = 1
METAPH = SYMB
CASE SYMB = "B"
IF N = L AND ENAME[N - 1,1] = "M" THEN SILENT = 1 ELSE SILENT = 0
IF NOT(SILENT) THEN METAPH = METAPH:SYMB
CASE SYMB = "C"
IF NOT(N > 1 AND ENAME[N - 1,1] = "S" AND (N + 1) <= L AND INDEX(FRONTV,ENAME[N + 1,1],1) > 0) THEN
IF (N + 2) <= L AND ENAME[N + 1,1] = "I" AND ENAME[N + 2,1] = "A" THEN
METAPH = METAPH:"X"
END ELSE
IF N < L AND INDEX(FRONTV,ENAME[N + 1,1],1) > 0 THEN
METAPH = METAPH:"S"
END ELSE
IF N > 1 AND N < L AND ENAME[N + 1,1] = "H" AND ENAME[N - 1,1] = "S" THEN
METAPH = METAPH:"K"
END ELSE
IF N < L AND ENAME[N + 1,1] = "H" THEN
IF N = 1 AND (N + 2) <= L AND INDEX(VOWELS,ENAME[N + 2,1],1) = 0 THEN
METAPH = METAPH:"K"
END ELSE
METAPH = METAPH:"X"
END
END ELSE
METAPH = METAPH:"K"
END
END
END
END
END
CASE SYMB = "D"
IF (N + 2) <= L AND ENAME[N + 1,1] = "G" AND INDEX(FRONTV,ENAME[N + 2,1],1) > 0 THEN
METAPH = METAPH:"J"
END ELSE
METAPH = METAPH:"T"
END
CASE SYMB = "G"
IF N < L AND ENAME[N + 1,1] = "H" AND INDEX(VOWELS,ENAME[N + 2,1],1) = 0 THEN SILENT = 1 ELSE SILENT = 0
IF N > 1 AND ((N + 1) = L OR (ENAME[N + 1,1] = "N" AND ENAME[N + 2,1] = "E" AND ENAME[N + 3,1] = "D" AND (N + 3) = L)) AND ENAM
IF N > 1 AND (N + 1) <= L AND ENAME[N - 1,1] = "D" AND INDEX(FRONTV,ENAME[N + 1,1],1) > 0 THEN SILENT = 1
IF N > 1 AND ENAME[N - 1,1] = "G" THEN HARD = 1 ELSE HARD = 0
IF NOT(SILENT) THEN
IF N < L AND INDEX(FRONTV,ENAME[N + 1,1],1) > 0 AND NOT(HARD) THEN
METAPH = METAPH:"J"
END ELSE
METAPH = METAPH:"K"
END
END
CASE SYMB = "H"
IF NOT(N = L OR (N > 1 AND INDEX(VARSON,ENAME[N - 1,1],1) > 0)) THEN
IF INDEX(VOWELS,ENAME[N + 1,1],1) > 0 THEN
METAPH = METAPH:"H"
END
END
CASE SYMB = "F" OR SYMB = "J" OR SYMB = "L" OR SYMB = "M" OR SYMB = "N" OR SYMB = "R"
METAPH = METAPH:SYMB
CASE SYMB = "K"
IF N > 1 AND ENAME[N - 1,1] # "C" THEN
METAPH = METAPH:"K"
END ELSE
IF N = 1 THEN
METAPH = "K"
END
END
CASE SYMB = "P"
IF N < L AND ENAME[N + 1,1] = "H" THEN
METAPH = METAPH:"F"
END ELSE
METAPH = METAPH:"P"
END
CASE SYMB = "Q"
METAPH = METAPH:"K"
CASE SYMB = "S"
IF N > 1 AND (N + 2) <= L AND ENAME[N + 1,1] = "I" AND (ENAME[N + 2,1] = "O" OR ENAME[N + 2,1] = "A") THEN
METAPH = METAPH:"X"
END ELSE
IF N < L AND ENAME[N + 1,1] = "H" THEN
METAPH = METAPH:"X"
END ELSE
METAPH = METAPH:"S"
END
END
CASE SYMB = "T"
IF N > 1 AND (N + 2) <= L AND ENAME[N + 1,1] = "I" AND (ENAME[N + 2,1] = "O" OR ENAME[N + 2,1] = "A") THEN
METAPH = METAPH:"X"
END ELSE
IF N < L AND ENAME[N + 1,1] = "H" THEN
IF NOT(N > 1 AND ENAME[N - 1,1] = "T") THEN
METAPH = METAPH:"0"
END
END ELSE
IF NOT(ENAME[N + 1,1] = "C" AND ENAME[N + 2,1] = "H") THEN
METAPH = METAPH:"T"
END
END
END
CASE SYMB = "V"
METAPH = METAPH:"F"

CASE SYMB = "W" OR SYMB = "Y"
IF N < L AND INDEX(VOWELS,ENAME[N + 1,1],1) > 0 THEN METAPH = METAPH:SYMB
CASE SYMB = "X"
METAPH = METAPH:"KS"
CASE SYMB = "Z"
METAPH = METAPH:"S"
END CASE
END
NEXT N
*
RETURN
*
END