# Category : BASIC Source Code

Archive : METAFONE.ZIP

Filename : METAFONE.BAS

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