'===========================================================================
' Subject: SOUNDEX REPRESENTATION             Date: 12-25-99 (19:12)       
'  Author: Don Schullian                      Code: PB                     
'  Origin: d83@DASoftVSS.com                Packet: PB.ABC
'===========================================================================
$IF 0
    ----------------------------                         PowerBASIC v3.5
 ---|          DASoft          |------------------------------------------
    ----------------------------         code           DATE: 1999-12-25
    | FILE NAME   SoundEX .bas |          by
    | DIRECTORY                |  Don Schullian, Jr.
    ----------------------------

             This code released into the public domain.

 -------------------------------------------------------------------------
  PURPOSE: CREATE a SoundEX representation of a given string
   PARMAS: TheWord$ - the string to be processed
  RETURNS: a LONG INTEGER in the range of 0 -> 656,565,656
 -------------------------------------------------------------------------
$ENDIF

DECLARE FUNCTION fSoundEX (BYVAL TheWord AS STRING) AS LONG

FUNCTION fSoundEX ( BYVAL TheWord AS STRING ) PUBLIC AS LONG

  DIM Char  AS LOCAL LONG                         ' character being processed
  DIM Last  AS LOCAL LONG                         ' last character processed
  DIM Temp  AS LOCAL ASCIIZ * 10                  ' buffer for outgoing value
  DIM T_ptr AS LOCAL BYTE PTR                     ' pointer to temp buffer
  DIM Tidx  AS LOCAL LONG                         ' index to temp pointer
  DIM W_ptr AS LOCAL BYTE PTR                     ' pointer to incoming data
  DIM Widx  AS LOCAL LONG                         ' index to data pointer
                                                  '
  TheWord = UCASE$  (TheWord)                     ' ucase for consistancy
  W_ptr   = STRPTR32(TheWord)                     ' set ptr to data string
  T_ptr   = VARPTR32(Temp)                        ' set ptr to temp buffer
                                                  '
  FOR Widx = 0 TO LEN(TheWord) -1                 ' process each char
    SELECT CASE @W_ptr[Widx]                      '  by character value
      CASE 66, 70, 80, 86             : Char = 49 '
      CASE 67, 71, 74, 81, 83, 88, 90 : Char = 50 '
      CASE 68, 84                     : Char = 51 '
      CASE 76                         : Char = 52 '
      CASE 77, 78                     : Char = 53 '
      CASE 82                         : Char = 54 '
      CASE ELSE                       : ITERATE   '  skip everything else
    END SELECT                                    '
    IF Char = Last THEN ITERATE                   ' no doubles allowed
    @T_ptr[Tidx] = Char                           ' set char in temp buffer
    IF Tidx = 8 THEN EXIT FOR                     ' if buffer full we're done
    INCR Tidx                                     ' next character position
    Last = Char                                   ' save cvhar's value
  NEXT                                            '
                                                  '
  FUNCTION = VAL(Temp)                            'RETURN LONG INTEGER VALUE

END FUNCTION