
<<AlgebraStructuresMain.mesa>>
<<Last Edited by: Arnon, June 20, 1985 4:46:23 pm PDT>>
<<>>
DIRECTORY
<<Commander,>>
<<Process,>>
ViewerClasses,
Rope,
Menus,
    IO,
    Convert,
    ViewerIO,
    ViewerTools,
    TypeScript,
AlgebraClasses,
Ints,
BigRats,
RatIntervals,
Reals,
Complexes,
Variables,
Polynomials,
AlgebraicNumbers,
ExtensionFields,
Matrices;

AlgebraStructuresMain: CEDAR PROGRAM
    IMPORTS Menus, ViewerIO, IO, Convert, Rope, ViewerTools, TypeScript, Ints, AlgebraClasses, BigRats, RatIntervals, Reals, 
Complexes, Variables,  Polynomials, AlgebraicNumbers, ExtensionFields, Matrices
= BEGIN OPEN AC: AlgebraClasses, INTS: Ints, BR: BigRats, RI: RatIntervals, VARS: Variables, AN: AlgebraicNumbers, EF: 
ExtensionFields, POL: Polynomials, MAT: Matrices;

    <<windowCount: INT _ 0; -- a count of the number of calculators created>>
<<MakeCalculator: ENTRY Commander.CommandProc = BEGIN    >>
<<Puts up a calculator window.>>
<<title: Rope.ROPE;>>
<<windowCount _ windowCount+1;>>
<<title _ IO.PutFR["Algebra machine number %g", IO.int[windowCount]];>>
<<TRUSTED {Process.Detach[FORK Calculate[title]];}>>
<<END;>>

<<Calculate: PROC[title: Rope.ROPE] = {>>
    ts: TypeScript.TS; -- the primary typescript
in, out: IO.STREAM; -- global variables for log writing
globalVariableSequence: VARS.VariableSeq;
globalMatrixSize: NAT;
structureElement1, structureElement2: REF;
ratInt: RI.RatInterval _ NIL;
algNum, realAlgNum: AN.AlgebraicNumber _ NIL;
scalar: REF _ NIL;
globalStructure: AC.Structure;

    PrintGlobalStructure: PROC [] ~ {
    out.PutRope[  Rope.Cat["Global Structure is (", AC.FlavorToRope[globalStructure.class.flavor], ") ", 
    globalStructure.class.printName[globalStructure], "\n"] ];
        };

SetIntegers: Menus.MenuProc = {
globalStructure _ INTS.Ints;
PrintGlobalStructure[];
};

SetRationals: Menus.MenuProc = {
globalStructure _ BR.BigRats;
PrintGlobalStructure[];
};

SetReals: Menus.MenuProc = {
globalStructure _ Reals.Reals;
PrintGlobalStructure[];
};

SetComplexes: Menus.MenuProc = {
globalStructure _ Complexes.Complexes;
PrintGlobalStructure[];
};

SetVarSeq: Menus.MenuProc = {
globalVariableSequence _ VARS.VariableSeqFromRope[ViewerTools.GetSelectionContents[] ];
out.PutRope[  Rope.Cat["Variables = ", VARS.VariableSeqToRope[globalVariableSequence], "\n"] ];
};

SetMatrixSize: Menus.MenuProc = {
globalMatrixSize _ Convert.CardFromRope[ViewerTools.GetSelectionContents[] ];
out.PutF["Matrix Size = %g\n", IO.card[globalMatrixSize] ];
};

MakePolyRing: Menus.MenuProc = {
    IF globalStructure.class.flavor = ring OR globalStructure.class.flavor = algebra THEN
    globalStructure _ POL.PolynomialsOverRing[globalStructure, globalVariableSequence]
ELSE IF globalStructure.class.flavor = field OR globalStructure.class.flavor = divisionAlgebra THEN
globalStructure _ POL.PolynomialsOverField[globalStructure, globalVariableSequence]
ELSE ERROR;
PrintGlobalStructure[];
};

MakeMatrixRing: Menus.MenuProc = {
    IF globalStructure.class.flavor = ring OR globalStructure.class.flavor = algebra THEN
    globalStructure _ MAT.MakeMatrixRing[globalStructure, globalMatrixSize]
ELSE IF globalStructure.class.flavor = field THEN
globalStructure _ MAT.MakeMatrixAlgebra[globalStructure, globalMatrixSize]
ELSE ERROR;
PrintGlobalStructure[];
};

SetStructureElement1: Menus.MenuProc = {
structureElement1 _ globalStructure.class.fromRope[ViewerTools.GetSelectionContents[], globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};

SetStructureElement2: Menus.MenuProc = {
structureElement2 _ globalStructure.class.fromRope[ViewerTools.GetSelectionContents[], globalStructure];
globalStructure.class.write[out, structureElement2, globalStructure];
out.PutRope["\n\n"];
};

AddStructureElements: Menus.MenuProc = {
structureElement1 _ globalStructure.class.add[structureElement1, structureElement2, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};

NegateStructureElement: Menus.MenuProc = {
structureElement1 _ globalStructure.class.negate[structureElement1, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};

SubtractStructureElements: Menus.MenuProc = {
structureElement1 _ globalStructure.class.subtract[structureElement1, structureElement2, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};

MultiplyStructureElements: Menus.MenuProc = {
structureElement1 _ globalStructure.class.multiply[structureElement1, structureElement2, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};
<<>>
DivideStructureElements: Menus.MenuProc = {
IF globalStructure.class.divide = NIL THEN {
out.PutRope["No divide op in this structure\n\n" ];
RETURN;
};
structureElement1 _ globalStructure.class.divide[structureElement1, structureElement2, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};
<<>>
RemainderStructureElements: Menus.MenuProc = {
IF globalStructure.class.remainder = NIL THEN {
out.PutRope["No remainder op in this structure\n\n" ];
RETURN;
};
structureElement1 _ globalStructure.class.remainder[structureElement1, structureElement2, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};
<<>>
SetScalar: Menus.MenuProc = {
groundStructure: AC.Structure;
dataMatrix: Matrices.MatrixStructureData;
dataGenExtField: EF.ExtensionFieldData;
dataRealExtField: EF.ExtensionFieldData;
<<dataVectorSpace:>>
    IF globalStructure.class.flavor # vectorSpace AND globalStructure.class.flavor # algebra AND globalStructure.class.flavor # 
    divisionAlgebra THEN ERROR;
IF Matrices.IsMatrixRing[globalStructure] THEN{
dataMatrix _ NARROW[globalStructure.instanceData];
groundStructure _ dataMatrix.elementStructure;
}
ELSE IF EF.IsGeneralExtensionField[globalStructure] THEN {
dataPolynomial: POL.PolynomialRingData;
dataGenExtField _ NARROW[globalStructure.instanceData];
dataPolynomial _ NARROW[dataGenExtField.primitiveElement.minPolyRing.instanceData];
groundStructure _ dataPolynomial.coeffRing;
}
ELSE IF EF.IsRealExtensionField[globalStructure] THEN {
dataPolynomial: POL.PolynomialRingData;
dataRealExtField _ NARROW[globalStructure.instanceData];
dataPolynomial _ NARROW[dataRealExtField.primitiveElement.minPolyRing.instanceData];
groundStructure _ dataPolynomial.coeffRing;
}
ELSE ERROR;
scalar _ groundStructure.class.fromRope[ViewerTools.GetSelectionContents[], groundStructure];
groundStructure.class.write[out, scalar, groundStructure];
out.PutRope["\n\n"];
};
<<>>
ScalarMultiply: Menus.MenuProc = {
IF globalStructure.class.scalarMultiply = NIL THEN {
out.PutRope["No scalarMultiply op in this structure\n\n" ];
RETURN;
};
IF scalar = NIL THEN ERROR;
structureElement1 _ globalStructure.class.scalarMultiply[scalar, structureElement1, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};
<<>>
MatrixTranspose: Menus.MenuProc = {
IF NOT Matrices.IsMatrixRing[globalStructure] THEN {
out.PutRope["Structure is not a matrix ring\n\n" ];
RETURN;
};
structureElement1 _ Matrices.Transpose[globalStructure][structureElement1, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};
<<>>
MatrixDeterminant: Menus.MenuProc = {
groundElt: REF;
data: Matrices.MatrixStructureData;
IF NOT Matrices.IsMatrixRing[globalStructure] THEN {
out.PutRope["Structure is not a matrix ring\n\n" ];
RETURN;
};
data _ NARROW[globalStructure.instanceData];
groundElt _ Matrices.Determinant[globalStructure][structureElement1, globalStructure];
data.elementStructure.class.write[out, groundElt, data.elementStructure];
out.PutRope["\n\n"];
};
<<>>
MatrixInvert: Menus.MenuProc = {
IF NOT Matrices.IsMatrixRing[globalStructure] THEN {
out.PutRope["Structure is not a matrix ring\n\n" ];
RETURN;
};
IF globalStructure.class.invert = NIL THEN {
out.PutRope["No invert op in this structure\n\n" ];
RETURN;
};
structureElement1 _ globalStructure.class.invert[structureElement1, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};
<<>>
PolynomialDiff: Menus.MenuProc = {
IF NOT Polynomials.IsPolynomialRing[globalStructure] THEN {
out.PutRope["Structure is not a polynomial ring\n\n" ];
RETURN;
};
structureElement1 _ Polynomials.Differentiate[globalStructure][structureElement1, globalStructure];
globalStructure.class.write[out, structureElement1, globalStructure];
out.PutRope["\n\n"];
};

SetGenAlgebraicNum: Menus.MenuProc = {
data: POL.PolynomialRingData _ NARROW[globalStructure.instanceData];
groundStructure: AC.Structure _ data.coeffRing;
    IF groundStructure.class.flavor # field AND groundStructure.class.flavor # divisionAlgebra THEN ERROR;
    IF groundStructure.class.algebraicallyClosedField THEN ERROR;
algNum _ AN.MakeAlgebraicNumber[globalStructure, NARROW[structureElement1, POL.Polynomial]];
AN.WriteAlgebraicNumber[algNum, out];  out.PutF["\n"];
};

MakeGenExtField: Menus.MenuProc = {
IF algNum = NIL THEN ERROR;
globalStructure _ EF.MakeExtensionField[algNum];
PrintGlobalStructure[];
};

SetRatInt: Menus.MenuProc = {
ratInt _ RI.RatIntervalFromRope[ViewerTools.GetSelectionContents[] ];
RI.WriteRatInterval[ratInt, out];  out.PutF["\n"];
};

SetRealAlgebraicNum: Menus.MenuProc = {
IF ratInt = NIL THEN ERROR;
realAlgNum _ AN.MakeAlgebraicNumber[globalStructure, NARROW[structureElement1, POL.Polynomial], TRUE, ratInt ];
AN.WriteAlgebraicNumber[realAlgNum, out];  out.PutF["\n"];
};

MakeRealExtField: Menus.MenuProc = {
IF realAlgNum = NIL THEN ERROR;
globalStructure _ EF.MakeExtensionField[realAlgNum];
PrintGlobalStructure[];
};

<<>>
    ts _ TypeScript.Create[info: [name: "AlgebraStructures" ] ];
Menus.ChangeNumberOfLines[menu: ts.menu, newLines: 4];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Ints", proc: SetIntegers]];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"BigRats", proc: SetRationals]];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Reals", proc: SetReals]];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Complexes", proc: SetComplexes]];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"    VarSeq", proc: SetVarSeq], line: 0];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"PolyRing", proc: MakePolyRing], line: 0];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"PolynomialDiff ", proc: PolynomialDiff], line: 0];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"MatrixSize", proc: SetMatrixSize], line: 1];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"MatrixRing", proc: MakeMatrixRing], line: 1];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"MatrixTranspose ", proc: MatrixTranspose], line: 1];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"MatrixDeterminant ", proc: MatrixDeterminant], line: 1];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"MatrixInvert ", proc: MatrixInvert], line: 1];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"GenAlgNum", proc: SetGenAlgebraicNum], line: 2];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"GenExtField", proc: MakeGenExtField], line: 2];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"RatInterval", proc: SetRatInt], line: 2];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"RealAlgNum", proc: SetRealAlgebraicNum], line:2];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"RealExtField", proc: MakeRealExtField], line: 2];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"XXX", proc: SetStructureElement1], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"YYY", proc: SetStructureElement2], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Add ", proc: AddStructureElements], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Neg ", proc: NegateStructureElement], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Sub ", proc: SubtractStructureElements], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Mult", proc: MultiplyStructureElements], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Divide", proc: DivideStructureElements], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"Rem", proc: RemainderStructureElements], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"SetScalar", proc: SetScalar], line: 3];
Menus.AppendMenuEntry[menu: ts.menu, entry:Menus.CreateEntry [name:"ScalarMult", proc: ScalarMultiply], line: 3];

    [in: in, out: out] _ ViewerIO.CreateViewerStreams[name: "AlgebraStructures",viewer: ts];

<<DO>>
<<out.PutChar[in.GetChar[] ];>>
<<ENDLOOP;>>
<<};>>

<<Commander.Register[>>
<<key: "Algebra", proc: MakeCalculator, doc: "Simple algebra system"];>>
<<>>

END.

<<>>