MODULE MatrixModels;
IMPORT
Streams, Strings, XML, Types, Models;
CONST
EmptyMatrix = "[ ]";
TYPE
Datatype* = REAL;
Matrix* = ARRAY [*,*] OF Datatype;
MatrixValue* = RECORD(Types.Generic)
value* : Matrix;
END;
TYPE
MatrixModel* = OBJECT (Models.Model)
VAR
matrix* : Matrix;
PROCEDURE &Init*;
BEGIN
Init^;
SetNameAsString(StrMatrix);
END Init;
PROCEDURE Set*(matrix : Matrix);
BEGIN
AcquireWrite;
SELF.matrix := matrix;
Changed;
ReleaseWrite;
END Set;
PROCEDURE Get*() : Matrix;
BEGIN
RETURN matrix;
END Get;
PROCEDURE SetGeneric*(CONST value : Types.Any; VAR res : LONGINT);
VAR matrix : Matrix;
BEGIN
GetMatrix(value, matrix, res);
IF (res = Types.Ok) THEN Set(matrix); END;
END SetGeneric;
PROCEDURE GetGeneric*(VAR value : Types.Any; VAR res : LONGINT);
BEGIN
AcquireRead;
SetMatrix(value, matrix, res);
ReleaseRead;
END GetGeneric;
PROCEDURE WriteValue*(w : Streams.Writer; level : LONGINT);
VAR column, row, nofColumns, nofRows : LONGINT;
BEGIN
WriteValue^(w, level);
nofColumns := LEN(matrix, 0);
nofRows := LEN(matrix, 1);
IF (nofColumns = 0) & (nofRows = 0) THEN
w.String(EmptyMatrix);
ELSIF (nofRows = 1) THEN
w.String("[");
FOR column := 0 TO nofColumns - 1 DO
w.Float(matrix[column, 0], 0);
IF (column # nofColumns - 1) THEN w.String(", "); END;
END;
w.String("]");
ELSE
Models.NewLine(w, level + 1);
w.String("[");
FOR row := 0 TO nofRows - 1 DO
Models.NewLine(w, level + 2);
w.String("[");
FOR column := 0 TO nofColumns - 1 DO
w.Float(matrix[column, row], 0);
IF (column # nofColumns - 1) THEN w.String(", "); END;
END;
w.String("]");
END;
Models.NewLine(w, level + 1);
w.String("]");
Models.NewLine(w, level);
END;
END WriteValue;
END MatrixModel;
VAR
StrMatrix : Strings.String;
PROCEDURE GetStringLength(CONST matrix : Matrix) : LONGINT;
VAR length, nofColumns, nofRows : LONGINT;
BEGIN
length := 0;
nofColumns := LEN(matrix, 0);
nofRows := LEN(matrix, 1);
IF (nofColumns = 0) & (nofRows = 0) THEN
length := Strings.Length(EmptyMatrix);
ELSE
length := 1024;
END;
RETURN length;
END GetStringLength;
PROCEDURE MatrixToString(CONST matrix : Matrix; VAR string : ARRAY OF CHAR; VAR res : LONGINT);
VAR length, nofColumns, nofRows, column, row, i : LONGINT; error : BOOLEAN;
PROCEDURE Append(VAR string : ARRAY OF CHAR; VAR index : LONGINT; CONST suffix : ARRAY OF CHAR) : BOOLEAN;
VAR result : BOOLEAN; length, i : LONGINT;
BEGIN
length := Strings.Length(suffix);
ASSERT(length > 0);
result := (index + length < LEN(string));
IF result THEN
FOR i := 0 TO length - 1 DO
string[index] := suffix[i];
INC(index);
END;
ASSERT(index < LEN(string));
string[index] := 0X;
END;
RETURN result;
END Append;
PROCEDURE AppendFloat(VAR string : ARRAY OF CHAR; VAR index : LONGINT; float : LONGREAL) : BOOLEAN;
VAR floatStr : ARRAY 128 OF CHAR;
BEGIN
Strings.FloatToStr(float, 0, 10, 4, floatStr);
RETURN Append(string, index, floatStr);
END AppendFloat;
BEGIN
res := Types.TruncatedError;
length := LEN(string) - 1;
nofColumns := LEN(matrix, 0);
nofRows := LEN(matrix, 1);
IF (nofColumns = 0) & (nofRows = 0) THEN
IF (length >= Strings.Length(EmptyMatrix)) THEN
COPY(EmptyMatrix, string);
res := Types.Ok;
END;
ELSE
i := 0;
IF Append(string, i, "[") THEN
error := FALSE;
row := 0;
WHILE (row < nofRows) & ~error DO
IF (nofRows > 1) THEN error := error OR ~Append(string, i, "["); END;
column := 0;
WHILE (column < nofColumns) & ~error DO
error := error OR ~AppendFloat(string, i, matrix[column, row]);
INC(column);
IF (column # nofColumns) THEN error := error OR ~Append(string, i, ", "); END;
END;
IF (nofRows > 1) THEN error := error OR ~Append(string, i, "]"); END;
INC(row);
END;
IF ~error & Append(string, i, "]") THEN
res := Types.Ok;
END;
END;
END;
END MatrixToString;
PROCEDURE StringToMatrix(CONST string : ARRAY OF CHAR; VAR matrix : Matrix; VAR res : LONGINT);
VAR
nofColumns, nofRows, column, row, length, index : LONGINT;
PROCEDURE IsWhitespace(character : CHAR) : BOOLEAN;
BEGIN
RETURN (character <= " ") & (character # 0X);
END IsWhitespace;
PROCEDURE SkipWhitespace(CONST string : ARRAY OF CHAR; length : LONGINT; VAR index : LONGINT);
BEGIN
ASSERT(length < LEN(string));
WHILE (index < length) & (string[index] # 0X) & IsWhitespace(string[index]) DO INC(index); END;
ASSERT(index <= length);
END SkipWhitespace;
PROCEDURE CountFloats(CONST string : ARRAY OF CHAR; length : LONGINT; VAR index : LONGINT) : LONGINT;
VAR nofFloats : LONGINT;
BEGIN
nofFloats := 1;
WHILE (index < length) & (string[index] # "]") DO
IF (string[index] = ",") THEN INC(nofFloats); END;
INC(index);
END;
IF (string[index] # "]") THEN nofFloats := -1; END;
ASSERT(index < length);
RETURN nofFloats;
END CountFloats;
PROCEDURE Consume(CONST string : ARRAY OF CHAR; character : CHAR; VAR index : LONGINT) : BOOLEAN;
VAR result : BOOLEAN;
BEGIN
result := (index < LEN(string)) & (string[index] = character);
IF result THEN INC(index); END;
RETURN result;
END Consume;
PROCEDURE GetDimensions(CONST string : ARRAY OF CHAR; length : LONGINT; VAR nofColumns, nofRows : LONGINT; VAR res : LONGINT);
CONST Start = 0; ExpectRow = 1; ReadingRow = 2; Error = 9; Done = 10;
VAR oldIndex, index : LONGINT; state, nofFloats : LONGINT;
BEGIN
res := Types.CannotConvert;
index := 0;
SkipWhitespace(string, length, index);
IF Consume(string, "[", index) THEN
state := Start;
oldIndex := index - 1;
WHILE (index < length) & (state # Done) & (state # Error) DO
ASSERT(index > oldIndex);
oldIndex := index;
SkipWhitespace(string, length, index);
ASSERT((state = Start) OR (state = ExpectRow) OR (state = ReadingRow));
CASE string[index] OF
|"[":
IF (state = Start) OR (state = ExpectRow) THEN
state := ReadingRow;
INC(nofRows);
INC(index);
ELSE
state := Error;
END;
|"]":
IF (state = Start) OR (state = ExpectRow) THEN
state := Done;
ELSE
state := ExpectRow;
END;
INC(index);
|"0".."9", "-", "+":
IF (state = Start) THEN
nofRows := 1;
nofFloats := CountFloats(string, length, index);
IF (nofFloats > 0) & Consume(string, "]", index) THEN
nofColumns := nofFloats;
state := Done;
ELSE
state := Error;
END;
ELSIF (state = ReadingRow) THEN
nofFloats := CountFloats(string, length, index);
IF (nofFloats > 0) & ((nofColumns = 0) OR (nofColumns = nofFloats)) & Consume(string, "]", index) THEN
state := ExpectRow;
nofColumns := nofFloats;
ELSE
state := Error;
END;
ELSE
state := Error;
END;
ELSE
state := Error;
END;
END;
IF (state = Done) THEN
SkipWhitespace(string, length, index);
IF (string[index] = 0X) THEN
res := Types.Ok;
END;
END;
END;
END GetDimensions;
PROCEDURE ReadFloat(CONST string : ARRAY OF CHAR; VAR index : LONGINT) : LONGREAL;
VAR floatStr : ARRAY 128 OF CHAR; float : LONGREAL; i : LONGINT;
BEGIN
i := 0;
WHILE (string[index] # ",") & (string[index] # "]") DO
floatStr[i] := string[index];
INC(index);
END;
Strings.StrToFloat(floatStr, float);
RETURN float;
END ReadFloat;
BEGIN
length := Strings.Length(string);
GetDimensions(string, length, nofColumns, nofRows, res);
IF (res = Types.Ok) THEN
IF (nofColumns = 0) & (nofRows = 0) THEN
NEW(matrix, 0, 0);
ELSE
index := 0;
SkipWhitespace(string, length, index);
ASSERT(string[index] = "[");
INC(index);
NEW(matrix, nofColumns, nofRows);
IF (nofRows = 1) THEN
FOR column := 0 TO nofColumns - 1 DO
SkipWhitespace(string, length, index);
matrix[column, 0] := SHORT(ReadFloat(string, index));
IF (column < nofColumns - 1) THEN
ASSERT(string[index] = ",");
INC(index);
END;
END;
SkipWhitespace(string, length, index);
ASSERT(string[index] = "]");
ELSE
FOR row := 0 TO nofRows - 1 DO
SkipWhitespace(string, length, index);
ASSERT(string[index] = "[");
INC(index);
FOR column := 0 TO nofColumns - 1 DO
SkipWhitespace(string, length, index);
matrix[column, row] := SHORT(ReadFloat(string, index));
IF (column < nofColumns - 1) THEN
ASSERT(string[index] = ",");
INC(index);
END;
END;
SkipWhitespace(string, length, index);
ASSERT(string[index] = "]");
INC(index);
END;
END;
END;
END;
END StringToMatrix;
PROCEDURE GetMatrix(CONST source : Types.Any; VAR value : Matrix; VAR res : LONGINT);
VAR matrixValue : MatrixValue;
BEGIN
res := Types.Ok;
IF (source IS MatrixValue) THEN
value := source(MatrixValue).value;
ELSIF (source IS Types.String32) THEN
StringToMatrix(source(Types.String32).value, value, res);
ELSIF (source IS Types.String256) THEN
StringToMatrix(source(Types.String256).value, value, res);
ELSIF (source IS Types.String) THEN
IF (source(Types.String).value # NIL) THEN
StringToMatrix(source(Types.String).value^, value, res);
ELSE
res := Types.ConversionError;
END;
ELSIF (source IS Types.DynamicString) THEN
StringToMatrix(source(Types.DynamicString).value^, value, res);
ELSIF (source IS Types.Generic) THEN
IF (source(Types.Generic).Get # NIL) THEN
source(Types.Generic).Get(source(Types.Generic), matrixValue, res);
IF (res = Types.Ok) THEN value := matrixValue.value; END;
ELSE
res := Types.CannotRead;
END;
ELSE
res := Types.CannotConvert;
END;
END GetMatrix;
PROCEDURE SetMatrix(VAR target : Types.Any; CONST value : Matrix; VAR res : LONGINT);
VAR matrixValue : MatrixValue;
BEGIN
res := Types.Ok;
IF (target IS MatrixValue) THEN
target(MatrixValue).value := value;
ELSIF (target IS Types.String32) THEN
MatrixToString(value, target(Types.String32).value, res);
ELSIF (target IS Types.String256) THEN
MatrixToString(value, target(Types.String256).value, res);
ELSIF (target IS Types.String) THEN
IF (target(Types.String).value # NIL) THEN
MatrixToString(value, target(Types.String).value^, res);
ELSE
res := Types.ConversionError;
END;
ELSIF (target IS Types.DynamicString) THEN
Types.EnsureLength(target(Types.DynamicString), GetStringLength(value));
MatrixToString(value, target(Types.DynamicString).value^, res);
ELSIF (target IS Types.Generic) THEN
IF (target(Types.Generic).Set # NIL) THEN
matrixValue.value := value;
target(Types.Generic).Set(target(Types.Generic), matrixValue, res);
ELSE
res := Types.CannotWrite;
END;
ELSE
res := Types.CannotConvert;
END;
END SetMatrix;
PROCEDURE MatrixValueGetter(CONST self : Types.Generic; VAR target : Types.Any; VAR res : LONGINT);
BEGIN
ASSERT(self IS MatrixValue);
SetMatrix(target, self(MatrixValue).value, res);
END MatrixValueGetter;
PROCEDURE MatrixValueSetter(CONST self : Types.Generic; CONST source : Types.Any; VAR res : LONGINT);
BEGIN
ASSERT(self IS MatrixValue);
GetMatrix(source, self(MatrixValue).value, res);
END MatrixValueSetter;
PROCEDURE GetMatrixValue*() : MatrixValue;
VAR matrixValue : MatrixValue;
BEGIN
matrixValue.Get := MatrixValueGetter;
matrixValue.Set := MatrixValueSetter;
RETURN matrixValue;
END GetMatrixValue;
PROCEDURE GenMatrixModel*() : XML.Element;
VAR matrix : MatrixModel;
BEGIN
NEW(matrix); RETURN matrix;
END GenMatrixModel;
PROCEDURE InitStrings;
BEGIN
StrMatrix := Strings.NewString("Matrix");
END InitStrings;
BEGIN
InitStrings;
END MatrixModels.