Action routines are a very powerful way of reusing code. As a real-world example, let's consider how to deal with a mildly complex data structure, the Macintosh "STR#" (string list) resource.
An STR# resource is a list of strings. It begins with a word count of the number of strings in the list, followed by the concatenated strings in Pascal format (each beginning with a length byte). Here's a generic routine for parsing this structure, parsing information about each string found to a caller-specified action routine:
TYPE
StringListActions =
PROCEDURE
(
(*ThisString :*) StringPtr,
(*StringIndex :*) CARDINAL,
VAR (*KeepGoing :*) BOOLEAN,
(*Arg :*) ADDRESS
);
PROCEDURE TraverseStringList
(
TheStringList : Handle;
Action : StringListActions;
ActionArg : ADDRESS
);
(* traverses a 'STR#' structure, calling the specified
action routine for each string found. *)
VAR
StringListState : HandleState;
StringCount, StringIndex : CARDINAL;
ThisString : StringPtr;
KeepGoing : BOOLEAN;
BEGIN
LockHandle(TheStringList, StringListState);
StringCount := CAST(ShortCard, GetWord(TheStringList^));
ThisString := TheStringList^ + SIZE(ShortCard);
StringIndex := 0;
KeepGoing := TRUE; (* to begin with *)
LOOP
IF StringIndex = StringCount THEN
EXIT
END (*IF*);
INC(StringIndex);
Action(ThisString, StringIndex, KeepGoing, ActionArg);
IF NOT KeepGoing THEN
EXIT
END (*IF*);
ThisString :=
CAST
(
StringPtr,
CAST(LONGCARD, ThisString)
+
VAL(LONGCARD, ThisString^[0])
+
1
)
END (*LOOP*);
HSetState(TheStringList, StringListState)
END TraverseStringList;
Believe it or not, this TraverseStringList routine encapsulates basically everything you need to know about the structure of an STR# resource. For example, here's how you could implement the standard Toolbox GetIndString routine:
PROCEDURE GetIndString
(
VAR theString : ARRAY OF CHAR;
strListID : ResID;
index : CARDINAL
);
(* returns a string from the specified 'STR#' resource. *)
VAR
TheStringList : Handle;
PROCEDURE ReturnNthString
(
ThisString : StringPtr;
StringIndex : CARDINAL;
VAR KeepGoing : BOOLEAN
);
(* returns the string with the desired index. *)
BEGIN
IF StringIndex = index THEN
CopyCounted(ThisString, theString);
KeepGoing := FALSE
END (*IF*)
END ReturnNthString;
BEGIN (*GetIndString*)
theString[0] := 0C; (* default to empty string if not found *)
TheStringList := GetResource(StringListResType, strListID);
IF TheStringList <> NIL THEN
TraverseStringList
(
(*TheStringList :=*) TheStringList,
(*Action :=*) CAST(StringListActions, ADR(ReturnNthString)),
(*ActionArg :=*) CurrentFrame()
)
END (*IF*);
END GetIndString;
Note the way in which the ActionArg argument is used to pass the environment for the action routine, so that it can make up-level references to entities declared in the outer routine. Unfortunately, Modula-2 doesn't provide direct support for this, hence the need for a CAST as well as the implementation-dependent CurrentFrame routine.
I admit this is the one ugly feature of my technique. However, I believe the technique as a whole is too useful for this to stop me using it.
Here's another example of the reuse of TraverseStringList: this time, to replace a particular string in a string list with a new one.
PROCEDURE ReplaceString
(
TheStringList : Handle;
VAR TheNewString : ARRAY OF CHAR;
Index : CARDINAL;
VAR Err : OSErr
);
(* replaces a string in an STR# at the specified index. *)
VAR
ReplaceOffset : LONGCARD;
FoundOffset : BOOLEAN;
PROCEDURE FindLocation
(
ThisString : StringPtr;
StringIndex : CARDINAL;
VAR KeepGoing : BOOLEAN
);
(* finds the existing string to replace. *)
BEGIN
IF StringIndex = Index THEN
ReplaceOffset :=
CAST(LONGCARD, ThisString)
-
CAST(LONGCARD, TheStringList^);
FoundOffset := TRUE;
KeepGoing := FALSE
END (*IF*)
END FindLocation;
PROCEDURE DoTheReplacement;
(* replaces the old string with the new one. *)
VAR
OldSize, NewSize : Size;
ExistingString : StringPtr;
RestOffset : LONGCARD;
BEGIN
LOOP (*once*)
OldSize := GetHandleSize(TheStringList);
NewSize := OldSize + ORD(TheNewString[0]) - ORD(ThisString^[0]);
IF NewSize > OldSize THEN
(* resize before move *)
SetHandleSize(TheStringList, NewSize);
Err := MemError();
IF Err <> noErr THEN
EXIT
END (*IF*)
END (*IF*);
IF NewSize <> OldSize THEN
ExistingString := CAST
(
StringPtr,
TheStringList^ + ReplaceOffset
);
RestOffset := ReplaceOffset + ORD(ExistingString^[0]) + 1;
(* offset to first string after the one being replaced *)
BlockMoveData (* adjust positions of following strings *)
(
(*sourcePtr :=*) TheStringList^ + RestOffset,
(*destPtr :=*)
TheStringList^ + RestOffset
+
NewSize - OldSize,
(*byteCount :=*) OldSize - RestOffset
)
END (*IF*);
BlockMoveData (* insert replacement string *)
(
(*sourcePtr :=*) ADR(TheNewString),
(*destPtr :=*) TheStringList^ + ReplaceOffset,
(*byteCount :=*) ORD(TheNewString[0]) + 1
);
IF NewSize < OldSize THEN
(* resize after move *)
SetHandleSize(TheStringList, NewSize)
END (*IF*);
(* all done *)
EXIT
END (*LOOP*)
END DoTheReplacement;
BEGIN (*ReplaceString*)
FoundOffset := FALSE;
TraverseStringList
(
(*TheStringList :=*) TheStringList,
(*Action :=*) CAST(StringListActions, ADR(FindLocation)),
(*ActionArg :=*) CurrentFrame()
);
IF FoundOffset THEN
DoTheReplacement
ELSE
Err := (* something to indicate that existing
entry wasn't found *)
END (*IF*)
END ReplaceString;
Yes, it's complex (I said this was a real-world example). But think how much more complex it would be if I had to reimplement the parsing code.
This action-routine technique is one I use heavily in my custom libraries.