'===========================================================================
' Subject: PACK/UNPACK STRING TO/FROM QUAD   Date: 01-14-00 (03:11)       
' Author:  Don Schullian                     Code: PBCC                   
' Origin:  d83@DASoftVSS.com               Packet: PBCC.ABC
'===========================================================================
$IF 0
    ----------------------------                      PowerBASIC/cc v2.0
 ---|          DASoft          |------------------------------------------
    ----------------------------         Code           DATE: 2000-01-14
    | FILE NAME   STR2QUAD.bas |          by
    | DIRECTORY                |  Don Schullian, Jr.
    ----------------------------
             This code is placed into the Public Domain
 -------------------------------------------------------------------------
  PURPOSE: pack and unpack strings into/from a QUAD integer
   PARMAS: TheString - A STRING of no more than 12 characters
           TheQuad   - A QUAD integer that carries a packed string
     NOTE: The incoming string will be UCASEd and all characters other
           than the 26 letters of the alphabet and the SPACE will be
           discarded
 -------------------------------------------------------------------------
  Similar routines to these were developed while I was building an anagram
game. The speed difference in locating a word in list of 80,000 strings
was prohibitive hence the use of QUAD integers. QUADs proved to be about 10
times faster than STRINGS.

  These QUADs are packed to hold up to 12 characters with 4 bits left over
and sort alphabetically. One COULD use 3 of the left over bits as a flag and
still maintain alphabetical order by shifting the QUAD left 3 bits and ORing
the flag(s) onto the end then, when unpacking, remove the flag(s) first.

  These routines could come in handy to create index keys.

  PB/DOS users should make the following changes to the code:
    Change: LONGs  to INTEGERs in all cases
            STRPTR to STRPTR32 in fString2Quad
            VARPTR to VARPTR32 in fQuad2String

    Remove: the following lines
            FUNCTION PBmain ()
            FORMAT$
            WAITKEY$
            END FUNCTION

N'joy,

   ____    _    ____      ____  _____
  |  _ \  / \  / ___) __ | ___)(_   _) Don Schullian
  | |_)  / _ \ \____\/  \|  _)   | |    d83@DASoftVSS.com
  |____//_/ \_\(____/\__/|_|     |_|    www.DASoftVSS.com
  ___________________________________   www.basicguru.com
      Vertical Software Solutions


$ENDIF
'
'-------------------------------------------------------------------------------
'
FUNCTION fString2Quad(BYVAL TheString AS STRING) AS QUAD

  DIM C       AS LOCAL LONG
  DIM Offset  AS LOCAL LONG
  DIM S_ptr   AS LOCAL BYTE PTR
  DIM Slen    AS LOCAL LONG
  DIM TheQuad AS LOCAL QUAD

  Slen  = MIN(12,LEN(TheString)) -1    ' length of string -1
  IF Slen < 0 THEN EXIT FUNCTION       ' nothing to do here
  S_ptr = STRPTR(TheString)            ' set string pointer
                                       '
  FOR Offset = 0 TO Slen               ' once for each character
    C = @S_ptr[Offset]                 '  glean ASCii value from string
    SELECT CASE C                      '  convert ASCii value
      CASE 65 TO  90 : C = C - 64      '   already UPPER CASE
      CASE 97 TO 122 : C = C - 96      '   UCASE the value
      CASE = 32      : GOTO NoORing    '   this is a space
      CASE ELSE      : ITERATE         '   not a valid character
    END SELECT                         '
    TheQuad = (TheQuad OR C)           '  OR the new value to the buffer
    NoORing:                           '
    IF Offset = Slen THEN EXIT FOR     '
    SHIFT LEFT TheQuad, 5              '
  NEXT                                 '
                                       '
  IF Slen < 11 THEN                    '
    C = 5 * ( 11 - Slen )              '
    SHIFT LEFT TheQuad, C              '
  END IF                               '
                                       '
  FUNCTION = TheQuad                   ' RETURN PACKED STRING

END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fQuad2String(BYVAL TheQuad AS QUAD) AS STRING

  DIM C         AS LOCAL LONG
  DIM Offset    AS LOCAL LONG
  DIM S_ptr     AS LOCAL BYTE PTR
  DIM TheString AS LOCAL STRING * 12

  IF TheQuad = 0 THEN EXIT FUNCTION    ' nothing to do here
  S_ptr = VARPTR(TheString)            ' set string pointer
                                       '
  FOR Offset = 11 TO 0 STEP -1         ' unpack 12 characters
    C = (TheQuad AND 31)               '  read value from 5 bits
    SHIFT RIGHT TheQuad, 5             '  move next 5 bits into line
    IF C > 0 THEN                      '   convert value into ASCii value
      @S_ptr[Offset] = C + 64          '
    END IF                             '
  NEXT                                 '
                                       '
  FUNCTION = RTRIM$(TheString)         ' RETURN THE UNPACKED STRING

END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION PBmain ()                                 ' remove this line for
PB/DOS

  DIM L     AS LOCAL LONG
  DIM Q(20) AS LOCAL QUAD
  DIM S(20) AS LOCAL STRING
  DIM X     AS LOCAL LONG

  RANDOMIZE TIMER
  S(0) = "hello world"
  Q(0) = fString2Quad(S(0))
  FOR X = 1 TO 20
    L = RND(1,12)
    WHILE L > 0
      S(X) = S(X) & CHR$(RND(65,90))
      DECR L
    WEND
    Q(X) = fString2Quad(S(X))
  NEXT

  ARRAY SORT S(0), COLLATE UCASE
  ARRAY SORT Q(0)
  FOR X = 0 TO 20
    PRINT S(X); TAB(14);
    PRINT fQuad2String(Q(X)); TAB(28);
    PRINT FORMAT$(Q(X),"###,###,###,###,###,###,###") ' remove this line
  NEXT

  WAITKEY$                                            ' remove this line

END FUNCTION                                          ' remove this line