NetNews Usenet Archive 1992 #30/NN_1992_30.iso/spool/comp/sys/mac/programm/19871

Text File | 1992-12-15 | 8.3 KB | 256 lines

Newsgroups: comp.sys.mac.programmer
Path: sparky!uunet!usc!rpi!batcomputer!cornell!rochester!udel!news.udel.edu!chopin.udel.edu!kurisuto
From: [e-mail] (Sean J. Crist)
Subject: Free code:  Packing up strings into a STR#
Message-ID: <[e-mail]>
Sender: [e-mail]
Nntp-Posting-Host: chopin.udel.edu
Organization: University of Delaware
Date: Wed, 16 Dec 1992 00:27:40 GMT
Lines: 244

I wrote the following code as a part of a parser, where I had to store a
lot of strings in a table.  Since storing strings as an array of Str255
(255 bytes per string) was very wasteful of memory, I wrote this code to
pack strings up into a handle with almost no memory overhead.

I believe that the structure I use is identical to that of STR# resources,
but I haven't actually tried saving one of the resulting handles as a STR#
and using GetIndString to see if it is completely identical or not.
There's really no need to do this, since I've provided a routine for
extracting the strings back out of the handle.

I've tested the code pretty throroughly, but I'd appreciate hearing any
bug reports.  Comments are welcome.  The code is in THINK Pascal 4.0.

--Kurisuto
[e-mail]

unit STRpackaging;

{By Sean Crist}

{This code is for packing and unpacking strings in a compressed format
like that of an STR#}
{resource.  The strings are kept in a handle.  The first two bytes of this
handle are the total }
{number of strings.  Following are the strings themselves.  A Pascal
string has the string length}
{in the first byte followed by the characters themselves; if the length
byte plus number of characters}
{is an odd integer, we add an extra byte into the structure as packing.}

interface

{This function creates a new empty STR.  You should pass it an unallocated
handle; this routine}
{will allocate the handle and will return it in the same argument that you
passed.  This function}
{returns TRUE if the allocation was successful, FALSE if it couldn't
allocate the memory (in which}
{case you must gracefully deal with this failure).}
 function CreateNewSTR (var TheSTR: Handle): Boolean;

{This function adds a new string to the end of a STR and returns its
index.  TheSTR is a string}
{handle you created with CreateNewSTR; TheString is the Pascal string
which you want to add}
{to this handle.  This function returns the index for the string in the
list.  If memory cannot be}
{allocated to expand the handle, -1 is returned.}
 function AddToSTR (TheSTR: Handle; TheString: string): Integer;

{This function searches for a given string and returns its index.  It
returns the index of the string;}
{if it can't find a match for the string, it returns 0.}
 function FindInSTR (TheSTR: Handle; TheString: string): Integer;

{This function, given an index, returns a string (much like GetIndString).
 If TheIndex is not a valid}
{index, then the empty string '' is returned.}
 function ExtractSTR (TheSTR: Handle; TheIndex: Integer): Str255;

implementation

 procedure doOSErr (WhichError: Integer);
 begin
{You'd have to put whatever code you use to report an error here.}
{My program puts up an alert with the error number as a ParamText argument.}
{I've just included this here so that the unit will compile; this example
is about}
{packing up strings, not about reporting errors :-)  }
 end;

{About the following four routines:  these routines are for compressing
strings into}
{an array with the same structure as a STR# resource.  This is a way to
save a lot}
{of memory which would go wasted if we stored lists of strings as arrays
of Str255.}

 function CreateNewSTR (var TheSTR: Handle): Boolean;
  var
   TheNewSTR: Handle;
 begin
  TheNewSTR := NewHandle(2);   {Make a new handle the size of an integer.}
  if MemError <> 0 then   {Check for MemError like good boys and girls}
   begin
    doOSErr(MemError);
    CreateNewStr := false;   {Tell whoever called us that we've failed.}
   end
  else   {The memory was successfully allocated, so go ahead.}
   begin
    CreateNewStr := true;  {Tell whoever called us that we've succeeded.}
    TheSTR := TheNewSTR;
    StuffHex(TheNewSTR^, '0000');  {Initialize the number of strings to 0.}
   end;
 end;

{The following routine makes odd numbers into even numbers by adding one
if necessary.}
 function MakeEven (OddInteger: Integer): Integer;
 begin
{If this is an even integer...}
  if OddInteger = ((OddInteger div 2) * 2) then
{...then just return the number we were given...}
   MakeEven := OddInteger
  else
{...but if this is an odd integer, add 1 to make it even.}
   MakeEven := OddInteger + 1;
 end;

{This function adds a new string to the end of a STR and returns its
index.  If memory is}
{insufficient, we return -1.}
 function AddToSTR; {(TheSTR: Handle, TheString: string): Integer;}
  var
   OldNumberOfStrings, NewNumberOfStrings: Integer;
   NewStringEvenLength, StringLength: Byte;
   counter, CurrentOffset: Integer;
   ScratchPtr: Ptr;
   OldSize: LongInt;
   OkSoFar: Boolean;
 begin
  OkSoFar := true;  {Let's assume everything's going to be all right.}
{Figure out how big the old handle and the new string are.}
  NewStringEvenLength := MakeEven(Length(TheString) + 1);  {+1 for size byte}
  OldSize := GetHandleSize(TheSTR);
{Set the size of the handle and check for errors.}
  SetHandleSize(TheSTR, OldSize + NewStringEvenLength);
  if MemError <> 0 then
   begin
    OkSoFar := false;
    doOSErr(MemError);
   end;
{If everything is OK, then copy the new string into the handle.}
  if OkSoFar then
   begin
    HLock(TheSTR);

{Figure out where the current end of the block is.}
    BlockMove(TheSTR^, @OldNumberOfStrings, 2);
    CurrentOffset := 2;
    if OldNumberOfStrings > 0 then
     for counter := 1 to OldNumberOfStrings do
      begin
       ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
       StringLength := ScratchPtr^;
       StringLength := MakeEven(StringLength + 1);
       CurrentOffset := CurrentOffset + StringLength;
      end;

{Copy the string into there.}
    ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
    BlockMove(@TheString, ScratchPtr, NewStringEvenLength);

{Update the count of strings.}
    NewNumberOfStrings := OldNumberOfStrings + 1;
    BlockMove(@NewNumberOfStrings, TheSTR^, 2);

    HUnlock(TheSTR);
   end;

  AddToSTR := NewNumberOfStrings;
  if not OkSoFar then
   AddToSTR := -1;
 end;

{This function searches for a given string and returns its index.  If we
can't find it,}
{we return 0.}
 function FindInSTR; {(TheSTR:  Handle , TheString: string): Integer;}
  var
   Index, CurrentOffset, TopStrings: Integer;
   StringLength: Byte;
   CheckString: Str255;
   done, foundIt: Boolean;
   ScratchPtr: Ptr;
 begin
  Index := 0;
  BlockMove(TheSTR^, @TopStrings, 2);  {Get the number of strings.}
  CurrentOffset := 2;
  done := false;
  foundIt := false;
  if TopStrings > 0 then
{Loop through the strings until we find a match or until we've gone
through them all.}
   while not done do
    begin
     Index := Index + 1;
     ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
     StringLength := ScratchPtr^;
     StringLength := MakeEven(StringLength + 1);
     BlockMove(ScratchPtr, @CheckString, StringLength);
     if EqualString(CheckString, TheString, false, true) then
      begin
       done := true;
       foundIt := true;
      end
     else
      begin
       CurrentOffset := CurrentOffset + StringLength;
      end;
     if Index = TopStrings then
      done := true;
    end;
  if FoundIt then
   FindInSTR := Index
  else
   FindInStr := 0;
 end;

{This function, given an index, returns a string.  If the index is out of
range, we}
{return an empty string.}
 function ExtractSTR; {(TheSTR: Handle, TheIndex: Integer): Str255;}
  var
   CurrentOffset, TopStrings, counter: Integer;
   StringLength: Byte;
   TheString: Str255;
   ScratchPtr: Ptr;
 begin
  BlockMove(TheSTR^, @TopStrings, 2);
  CurrentOffset := 2;
  TheString := '';
  if (TopStrings > 0) and (TheIndex <= TopStrings) then
   begin
    for counter := 1 to TheIndex - 1 do
     begin
      ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
      StringLength := ScratchPtr^;
      StringLength := MakeEven(StringLength + 1);
      CurrentOffset := CurrentOffset + StringLength;
     end;
    ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
    StringLength := ScratchPtr^;
    StringLength := MakeEven(StringLength + 1);
    BlockMove(ScratchPtr, @TheString, StringLength);
   end;
  ExtractSTR := TheString;
 end;


end.