MODULE Attributes;
CONST
Invalid = -1;
InitialAttributeArraySize = 16;
TYPE
Attribute* = RECORD
object : ANY;
flags- : SET;
data- : ANY;
END;
AttributeArray = POINTER TO ARRAY OF Attribute;
TYPE
Attributes* = OBJECT
VAR
attributes : AttributeArray;
nofAttributes : LONGINT;
PROCEDURE &Init*;
BEGIN
attributes := NIL;
nofAttributes := 0;
END Init;
PROCEDURE ResizeArrayIfNecessary;
VAR newAttributes : AttributeArray; i : LONGINT;
BEGIN
IF (attributes = NIL) THEN
ASSERT(nofAttributes = 0);
NEW(attributes, InitialAttributeArraySize);
ELSIF (nofAttributes >= LEN(attributes)) THEN
NEW(newAttributes, 2 * LEN(attributes));
FOR i := 0 TO nofAttributes - 1 DO newAttributes[i] := attributes[i]; END;
END;
END ResizeArrayIfNecessary;
PROCEDURE AddObject(object : ANY; flags : SET; data : ANY);
BEGIN
ASSERT((object # NIL) & ((flags # {}) OR (data # NIL)));
ResizeArrayIfNecessary;
attributes[nofAttributes].object := object;
attributes[nofAttributes].flags := flags;
attributes[nofAttributes].data := data;
INC(nofAttributes);
END AddObject;
PROCEDURE RemoveObject(object : ANY; hint : LONGINT);
VAR index, i : LONGINT;
BEGIN
ASSERT((object # NIL) & ((hint = Invalid) OR (attributes[hint].object = object)));
index := hint;
IF (index = Invalid) THEN index := GetIndexOf(object); END;
ASSERT(index # Invalid);
IF (index = nofAttributes - 1) THEN
attributes[index].object := NIL;
attributes[index].flags := {};
attributes[index].data := NIL;
ELSE
ASSERT(attributes[nofAttributes-1].object = NIL);
FOR i := index TO nofAttributes-2 DO
attributes[i] := attributes[i + 1];
END;
END;
DEC(nofAttributes);
END RemoveObject;
PROCEDURE GetIndexOf(object : ANY) : LONGINT;
VAR index : LONGINT;
BEGIN
ASSERT(object # NIL);
index := 0;
WHILE (index < nofAttributes) & (attributes[index].object # object) DO INC(index); END;
IF (index = nofAttributes) THEN index := Invalid; END;
ASSERT((index = Invalid) OR ((0 <= index) & (index < nofAttributes) & (attributes[index].object = object)));
RETURN index;
END GetIndexOf;
PROCEDURE Get*(object : ANY) : Attribute;
VAR attribute : Attribute; index : LONGINT;
BEGIN
ASSERT(object # NIL);
index := GetIndexOf(object);
IF (index # Invalid) THEN
attribute := attributes[index];
ELSE
attribute.flags := {};
attribute.data := NIL;
END;
RETURN attribute;
END Get;
PROCEDURE Set*(object : ANY; flags : SET; data : ANY);
VAR index : LONGINT;
BEGIN
ASSERT(object # NIL);
index := GetIndexOf(object);
IF (index # Invalid) THEN
IF (flags # {}) OR (data # NIL) THEN
attributes[index].flags := flags;
attributes[index].data := data;
ELSE
RemoveObject(object, index);
END;
ELSIF (flags # {}) OR (data # NIL) THEN
AddObject(object, flags, data);
END;
END Set;
PROCEDURE GetFlags*(object : ANY) : SET;
VAR flags : SET; index : LONGINT;
BEGIN
ASSERT(object # NIL);
flags := {};
index := GetIndexOf(object);
IF (index # Invalid) THEN flags := attributes[index].flags; END;
RETURN flags;
END GetFlags;
PROCEDURE SetFlags*(object : ANY; flags : SET);
VAR index : LONGINT;
BEGIN
ASSERT(object # NIL);
index := GetIndexOf(object);
IF (index # Invalid) THEN
IF (flags # {}) THEN
attributes[index].flags := flags;
ELSIF (attributes[index].data = NIL) THEN
RemoveObject(object, index);
END;
ELSIF (flags # {}) THEN
AddObject(object, flags, NIL);
END;
END SetFlags;
PROCEDURE Include*(object : ANY; flag : LONGINT);
VAR index : LONGINT;
BEGIN
ASSERT((object # NIL) & (0 <= flag) & (flag <= MAX(SET)));
index := GetIndexOf(object);
IF (index # Invalid) THEN
INCL(attributes[index].flags, flag);
ELSE
AddObject(object, {flag}, NIL);
END;
END Include;
PROCEDURE Exclude*(object : ANY; flag : LONGINT);
VAR index : LONGINT;
BEGIN
ASSERT((object # NIL) & (0 <= flag) & (flag <= MAX(SET)));
index := GetIndexOf(object);
IF (index # Invalid) THEN
EXCL(attributes[index].flags, flag);
IF (attributes[index].flags = {}) THEN RemoveObject(object, index); END;
END;
END Exclude;
PROCEDURE GetData*(object : ANY) : ANY;
VAR data : ANY; index : LONGINT;
BEGIN
ASSERT(object # NIL);
data := NIL;
index := GetIndexOf(object);
IF (index # Invalid) THEN data := attributes[index].data; END;
RETURN data;
END GetData;
PROCEDURE SetData*(object, data : ANY);
VAR index : LONGINT;
BEGIN
ASSERT(object # NIL);
index := GetIndexOf(object);
IF (index # Invalid) THEN
IF (data # NIL) THEN
attributes[index].data := data;
ELSIF (attributes[index].flags = {}) THEN
RemoveObject(object, index);
END;
ELSE
AddObject(object, {}, data);
END;
END SetData;
PROCEDURE Clear*;
BEGIN
attributes := NIL;
nofAttributes := 0;
END Clear;
END Attributes;
END Attributes.