include "ConsoleWindow"

def tab 12
_soundexNil$ = "0000"

local mode
local fn Soundex( codeWord as Str255 ) as Str255
dim as long          i,u
dim as unsigned char charCode,lastCode
dim as Str31         outputStr

outputStr = _soundexNil$

if codeWord[0] = _nil then exit fn

UppercaseStripDiacritics( @codeWord[1], codeWord[0], _smCurrentScript )

outputStr[1] = codeWord[1]
charCode     = outputStr[1] : gosub "getSoundexCode"
lastCode     = charCode
i = 1 : u = 1

while i <= codeWord[0]
   i++ : charCode = codeWord[i] : gosub "getSoundexCode"
   if charCode > 0 and lastCode <> charCode
      u++ : outputStr[u] = charCode
      if u = 4 then exit while
   end if
lastCode = charCode
wend

exit fn

"getSoundexCode"

select charCode
case _"B", _"F", _"P", _"V"
charCode = _"1"
case _"C", _"G", _"J", _"K", _"Q", _"S", _"X", _"Z"
charCode = _"2"
case _"D", _"T"
charCode = _"3"
case _"L"
charCode = _"4"
case _"M", _"N"
charCode = _"5"
case _"R"
charCode = _"6"
case else
charCode = 0
end select
return
end fn = outputStr

dim as Str255 nameStr, testName(100)
dim as long i

testName(0) = "Smith "
testName(1) = "Johnson "
testName(2) = "Williams "
testName(3) = "Jones "
testName(4) = "Brown "
testName(5) = "Davis "
testName(6) = "Miller "
testName(7) = "Wilson "
testName(8) = "Moore "
testName(9) = "Taylor "
testName(10) = "Anderson "
testName(11) = "Thomas "
testName(12) = "Jackson "
testName(13) = "White "
testName(14) = "Harris "
testName(15) = "Martin "
testName(16) = "Thompson "
testName(17) = "Garcia "
testName(18) = "Martinez "
testName(19) = "Robinson "
testName(20) = "Clark "
testName(21) = "Rodriguez "
testName(22) = "Lewis "
testName(23) = "Lee "
testName(24) = "Walker "
testName(25) = "Hall "
testName(26) = "Allen "
testName(27) = "Young "
testName(28) = "Hernandez "
testName(29) = "King "
testName(30) = "Wright "
testName(31) = "Lopez "
testName(32) = "Hill "
testName(33) = "Scott "
testName(34) = "Green "
testName(35) = "Adams "
testName(36) = "Baker "
testName(37) = "Gonzalez "
testName(38) = "Nelson "
testName(39) = "Carter "
testName(40) = "Mitchell "
testName(41) = "Perez "
testName(42) = "Roberts "
testName(43) = "Turner "
testName(44) = "Phillips "
testName(45) = "Campbell "
testName(46) = "Parker "
testName(47) = "Evans "
testName(48) = "Edwards "
testName(49) = "Collins "
testName(50) = "Stewart "
testName(51) = "Sanchez "
testName(52) = "Morris "
testName(53) = "Rogers "
testName(54) = "Reed "
testName(55) = "Cook "
testName(56) = "Morgan "
testName(57) = "Bell "
testName(58) = "Murphy "
testName(59) = "Bailey "
testName(60) = "Rivera "
testName(61) = "Cooper "
testName(62) = "Richardson "
testName(63) = "Cox "
testName(64) = "Howard "
testName(65) = "Ward "
testName(66) = "Torres "
testName(67) = "Peterson "
testName(68) = "Gray "
testName(69) = "Ramirez "
testName(70) = "James "
testName(71) = "Watson "
testName(72) = "Brooks "
testName(73) = "Kelly "
testName(74) = "Sanders "
testName(75) = "Price "
testName(76) = "Bennett "
testName(77) = "Wood "
testName(78) = "Barnes "
testName(79) = "Ross "
testName(80) = "Henderson "
testName(81) = "Coleman "
testName(82) = "Jenkins "
testName(83) = "Perry "
testName(84) = "Powell "
testName(85) = "Long "
testName(86) = "Patterson "
testName(87) = "Hughes "
testName(88) = "Flores "
testName(89) = "Washington "
testName(90) = "Butler "
testName(91) = "Simmons "
testName(92) = "Foster "
testName(93) = "Gonzales "
testName(94) = "Bryant "
testName(95) = "Alexander "
testName(96) = "Russell "
testName(97) = "Griffin "
testName(98) = "Diaz "
testName(99) = "Hayes "

print "Soundex codes for 100 popular American surnames:"
for i = 0 to 99
   nameStr = testName(i)
   print nameStr, "= "; fn Soundex( nameStr )
next

print
print "Soundex codes for similar sounding names:"

print " Stuart = "; fn Soundex( "Stuart"  )
print "Stewart = "; fn Soundex( "Stewart" )
print "Steward = "; fn Soundex( "Steward" )
print " Seward = "; fn Soundex( "Seward"  )