* BASIC CODE from Computer Language, Dec 1990
*
* Author: Lawrence Philips
*
SUBROUTINE METAPHONE(NAME, METAPH)
EQU VOWELS TO "AEIOU"
EQU FRONTV TO "EIY"
EQU VARSON TO "CSPTG"
* As in variable sound--those modified by adding an "h"
NAME = ICONV(NAME, 'MCU')
ENAME = ICONV(NAME, 'MCA')
* Delete nonalphanumeric 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,9999]
IF TWO = "WH" THEN ENAME = "W":ENAME[3,9999]
* 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) > 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