'===========================================================================
' Subject: SOUNDEX REPRESENTATION FOR PBCC   Date: 12-25-99 (19:12)       
' Author:  Don Schullian                     Code: PBCC                   
' Origin:  d83@DASoftVSS.com               Packet: PBCC.ABC
'===========================================================================
#IF 0
    ----------------------------                      PowerBASIC/cc v2.0
 ---|          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 -> 656565656
 -------------------------------------------------------------------------
#ENDIF

DECLARE FUNCTION fSoundex (BYVAL TheWord AS STRING) AS LONG

FUNCTION fSoundex ( BYVAL TheWord AS STRING ) EXPORT 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 incoming data pointer
                                                  '
  TheWord = UCASE$(TheWord)                       ' upper case for consistancy
  W_ptr   = STRPTR(TheWord)                       ' set ptr to incoming string
  T_ptr   = VARPTR(Temp)                          ' set ptr to temp buffer
                                                  '
  FOR Widx = 0 TO LEN(TheWord) -1                 ' process each char in incoming string
    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 new char in temp buffer
    IF Tidx = 8 THEN EXIT FOR                     ' if buffer is full then we're done
    INCR Tidx                                     ' next character position
    Last = Char                                   ' save this char's value for test
  NEXT                                            '
                                                  '
  FUNCTION = VAL(Temp)                            'RETURN LONG INTEGER VALUE

END FUNCTION