MathConstructorsImpl.mesa
Carl Waldspurger, August 18, 1986 8:31:53 pm PDT
DIRECTORY
MathExpr,
MathRules,
MathDB,
MathTypes,
MathBox,
ImagerFont,
ImagerTransformation,
Imager,
Rope USING [ROPE, Fetch, Length],
Vector USING [VEC],
Convert USING [RopeFromChar, RopeFromReal],
MathConstructors;
MathConstructorsImpl: CEDAR PROGRAM
IMPORTS MathBox, MathRules, ImagerFont, Imager, ImagerTransformation, MathExpr,
MathDB, Convert, Rope
EXPORTS MathConstructors ~
BEGIN
Type Abbreviations
EXPR: TYPE ~ MathExpr.EXPR;
BOX: TYPE ~ MathBox.BOX;
ROPE: TYPE ~ Rope.ROPE;
VEC: TYPE ~ Vector.VEC;
AtomBoxProc: TYPE ~ MathRules.AtomBoxProc;
AtomPaintProc: TYPE ~ MathRules.AtomPaintProc;
CompoundBoxProc: TYPE ~ MathRules.CompoundBoxProc;
CompositionProc: TYPE ~ MathRules.CompositionProc;
AtomToRopeProc: TYPE ~ MathRules.AtomToRopeProc;
Alignment2D: TYPE ~ MathRules.Alignment2D;
Offset: TYPE ~ MathRules.Offset;
Size: TYPE ~ MathRules.Size;
AtomValue: TYPE ~ MathTypes.AtomValue;
AtomRopeValue: TYPE ~ MathTypes.AtomRopeValue;
AtomCharValue: TYPE ~ MathTypes.AtomCharValue;
AtomBoxValue: TYPE ~ MathTypes.AtomBoxValue;
Argument: TYPE ~ MathExpr.Argument;
Symbol: TYPE ~ MathExpr.Symbol;
AtomClass: TYPE ~ MathExpr.AtomClass;
AtomFlavor: TYPE ~ MathExpr.AtomFlavor;
CompoundClass: TYPE ~ MathExpr.CompoundClass;
FormatClass: TYPE ~ MathTypes.FormatClass;
Style: TYPE ~ MathTypes.Style;
Procedure Abbreviations
MakeArgument: PROC[name: ATOM, aliases: LIST OF ATOM, size: Size] RETURNS[Argument] ~ MathExpr.MakeArgument;
MakeSymbol: PROC[name: ATOM, aliases: LIST OF ATOM, size: Size, value: EXPR] RETURNS[Symbol] ~ MathExpr.MakeSymbol;
MakeAtomClass: PROC[name: ATOM, formatClass: FormatClass, flavor: AtomFlavor, style: Style, boxRule: AtomBoxProc, paintRule: AtomPaintProc, cvtRope: AtomToRopeProc] RETURNS[AtomClass] ~ MathExpr.MakeAtomClass;
MakeCompoundClass: PROC[name: ATOM, formatClass: FormatClass, description: ROPE, args: LIST OF Argument, syms: LIST OF Symbol, boxRule: CompoundBoxProc, compBox: CompositionProc, cvtAS: ROPENIL] RETURNS[CompoundClass] ~ MathExpr.MakeCompoundClass;
Constants
smallGap: REAL = 0.05;
medGap: REAL = 0.10;
bigGap: REAL = 0.25;
thinSpace: ImagerFont.Extents = [leftExtent: 0.0, rightExtent: 0.05, ascent: 0.05, descent: 0.0];
medSpace: ImagerFont.Extents = [leftExtent: 0.0, rightExtent: 0.12, ascent: 0.12, descent: 0.0];
Common Rule Procs
Common Paint Procs
PaintChar: AtomPaintProc ~ {
effects: Paints value.char onto context in absBox
local declarations
xFactor, yFactor: REAL; -- scaling factors
font: ImagerFont.Font;
extents: ImagerFont.Extents;
check types
IF (absBox.Type # absolute) THEN ERROR wrongBoxType;
WITH value SELECT FROM
c: AtomCharValue => {
font ← ImagerFont.Find[style.font];
extents ← ImagerFont.BoundingBox[font, c.char];
Imager.SetXY[context, [absBox.Offset.x, absBox.Offset.y]];
xFactor ← absBox.Width / (extents.leftExtent + extents.rightExtent);
yFactor ← absBox.Height / (extents.descent + extents.ascent);
Imager.SetFont[context,
ImagerFont.Modify[font, ImagerTransformation.Scale2[[xFactor, yFactor]]]];
Imager.ShowXChar[context, c.char];
};
anything but char is a type error
ENDCASE => ERROR wrongAtomValueType;
};
PaintRope: AtomPaintProc ~ {
effects: Paints value.rope onto context in absBox
local declarations
xFactor, yFactor: REAL; -- scaling factors
font: ImagerFont.Font;
extents: ImagerFont.Extents;
check types
IF (absBox.Type # absolute) THEN ERROR wrongBoxType;
WITH value SELECT FROM
r: AtomRopeValue => {
font ← ImagerFont.Find[style.font];
extents ← ImagerFont.RopeBoundingBox[font, r.rope];
Imager.SetXY[context, [absBox.Offset.x, absBox.Offset.y]];
xFactor ← absBox.Width / (extents.rightExtent + extents.leftExtent);
yFactor ← absBox.Height / (extents.ascent + extents.descent);
Imager.SetFont[context,
ImagerFont.Modify[font, ImagerTransformation.Scale2[[xFactor, yFactor]]]];
Imager.ShowRope[context, r.rope];
};
anything but rope is a type error
ENDCASE => ERROR wrongAtomValueType;
};
PaintLine: AtomPaintProc ~ {
effects: Paints a line onto context filling absBox
caveats: Ignores value & style
r: Imager.Rectangle ← [x: absBox.Offset.x + absBox.Extents.leftExtent, y: absBox.Offset.y + absBox.Extents.descent, w: absBox.Width, h: absBox.Height];
Imager.MaskRectangle[context, r];
};
PaintSpace: AtomPaintProc ~ {
effects: none
RETURN;
};
Common Box Procs & AtomToRopeProcs
LineBox: AtomBoxProc ~ {
effects: Returns a bounding box for a line
Note that this is always a dummy value
don't really need any data from value; always return [0, 1, 0, 1]
RETURN[[leftExtent: 0.0, rightExtent: 1.0, descent: 0.0, ascent: 0.03]];
};
CvtOtherToRope: AtomToRopeProc ~ {
effects: Always returns the empty rope "".
RETURN[""];
};
CharBox: AtomBoxProc ~ {
effects: Returns a bounding box for value.char
font: ImagerFont.Font;
font ← ImagerFont.Scale[ImagerFont.Find[style.font], style.scale];
WITH value SELECT FROM
c: AtomCharValue => RETURN[ImagerFont.BoundingBox[font, c.char]];
anything but a char is a type error
ENDCASE => ERROR wrongAtomValueType;
};
CvtCharToRope: AtomToRopeProc ~ {
effects: Returns value as a rope.
WITH value SELECT FROM
c: AtomCharValue => RETURN[Convert.RopeFromChar[from: VAL[c.char.code], quote: FALSE]];
anything but a char is a type error
ENDCASE => ERROR wrongAtomValueType;
};
RopeBox: AtomBoxProc ~ {
effects: Returns a bounding box for value.rope
font: ImagerFont.Font ← ImagerFont.Scale[ImagerFont.Find[style.font], style.scale];
WITH value SELECT FROM
r: AtomRopeValue => RETURN[ImagerFont.RopeBoundingBox[font, r.rope]];
anything but a rope is a type error
ENDCASE => ERROR wrongAtomValueType;
};
CvtRopeToRope: AtomToRopeProc ~ {
effects: Returns value.
WITH value SELECT FROM
r: AtomRopeValue => RETURN[r.rope];
anything but a rope is a type error
ENDCASE => ERROR wrongAtomValueType;
};
SpaceBox: AtomBoxProc ~ {
effects: Returns a bounding box for value.box
WITH value SELECT FROM
b: AtomBoxValue => RETURN[b.box];
anything but a rope is a type error
ENDCASE => ERROR wrongAtomValueType;
};
CvtSpaceToRope: AtomToRopeProc ~ {
effects: Returns the empty rope NIL.
RETURN[NIL];
};
Common Compound Procs
Box Rules
FixedSizeBoxRule: CompoundBoxProc ~ {
effects: Returns unaltered boxes (i.e. no resizing takes place)
RETURN[boxes];
};
FractionBoxRule: CompoundBoxProc ~ {
effects: Sizes boxes for expr of form ($fractionBar $numerator $denominator)
should ENABLE noSuchBox
fbarBox: BOX ← MathBox.GetBox[$fractionBar, boxes];
numBox: BOX ← MathBox.GetBox[$numerator, boxes];
denomBox: BOX ← MathBox.GetBox[$denominator, boxes];
fraction bar must be as wide as the wider of numerator, denominator
scaleX: REAL ← 1.1 * MAX[numBox.Width[], denomBox.Width[]] / fbarBox.Width[];
adjust fbarBox extents
fbarBox ← MathBox.Scale[fbarBox, [scaleX, 1.0]];
RETURN[LIST[fbarBox, numBox, denomBox]];
};
ParenBoxRule: CompoundBoxProc ~ {
effects: Sizes boxes for expr of form ($paren $a)
leftParenBox: BOX ← MathBox.GetBox[$leftParen, boxes];
rightParenBox: BOX ← MathBox.GetBox[$rightParen, boxes];
aBox: BOX ← MathBox.GetBox[$a, boxes];
right and left parentheses must be as tall as expression a
scaleFactor: REAL ← 1.1 * aBox.Height[] / leftParenBox.Height[];
leftParenBox ← MathBox.Scale[leftParenBox, [scaleFactor, scaleFactor]];
rightParenBox ← MathBox.Scale[rightParenBox, [scaleFactor, scaleFactor]];
RETURN[LIST[aBox, leftParenBox, rightParenBox]];
};
RadicalBoxRule: CompoundBoxProc ~ {
effects: Sizes boxes for expr of form ($radRoot $radLine $n $radicand)
should ENABLE noSuchBox
radRootBox: BOX ← MathBox.GetBox[$radRoot, boxes];
radLineBox: BOX ← MathBox.GetBox[$radLine, boxes];
nBox: BOX ← MathBox.GetBox[$n, boxes];
radicandBox: BOX ← MathBox.GetBox[$radicand, boxes];
line must be exactly as long as radicand,
root symbol must be 1.2 * as tall as radicand
rootScale: REAL ← 1.2 * radicandBox.Height[] / radRootBox.Height[];
lineScale: VEC ← [radicandBox.Width[]/radLineBox.Width[], 1.0];
adjust symbol extents
radRootBox ← MathBox.Scale[radRootBox, [rootScale, rootScale]];
radLineBox ← MathBox.Scale[radLineBox, lineScale];
RETURN[LIST[radRootBox, radLineBox, nBox, radicandBox]];
};
Composition Rules
PowCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($exponent $base)
tempBox: BOX;
tempBoxes: LIST OF BOX;
vertOffsetExponent, vertOffsetBase: Offset;
alignments: LIST OF Alignment2D ← NIL;
IF MathBox.GetBox[$base, boxes].Height[] >
MathBox.GetBox[$exponent, boxes].Height[] THEN {
vertOffsetExponent ← [bottom, 0.2];
vertOffsetBase ← [top];
}
ELSE {
vertOffsetExponent ← [bottom];
vertOffsetBase ← [top, -0.2];
};
alignments ← LIST[
[$exponent,
[$base, [left], [right]],
[$base, vertOffsetExponent, vertOffsetBase]]];
[tempBox, tempBoxes] ← MathRules.Compose[boxes, alignments, $base, $base];
RETURN[tempBox, tempBoxes];
};
FractionCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($fractionBar $numerator $denominator)
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ←
LIST[[$denominator, [$fractionBar, [center], [center]],
[$fractionBar, [top], [bottom, -2*bigGap]]],
[$numerator, [$fractionBar, [center], [center]],
[$fractionBar, [bottom], [top, 2*bigGap]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $fractionBar, $fractionBar];
RETURN[tempBox, tempBoxes];
};
SummationCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($summation $lowerbound $upperbound
$summand)
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ←
LIST[[$lowerbound, [$sigma, [center], [center]],
[$sigma, [top], [bottom, -smallGap]]],
[$upperbound, [$sigma, [center], [center]],
[$sigma, [bottom], [top, smallGap]]],
[$summand, [$sigma, [left], [right, medGap]],
[$sigma, [center], [center]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $sigma, $summand];
RETURN[tempBox, tempBoxes];
};
RadicalCompRule: CompositionProc ~ {
effects: Compose layout for expr of form ($radRoot $radLine $n $radicand)
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ←
LIST[[$radRoot, [$radicand, [right], [left]],
[$radicand, [center], [center]]],
[$radLine, [$radRoot, [left], [right]],
[$radRoot, [top], [top]]],
[$n, [$radRoot, [right], [left, bigGap]],
[$radRoot, [bottom], [center, smallGap]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $n, $radicand];
RETURN[tempBox, tempBoxes];
};
IntegrationCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($integral $lowerlimit $upperlimit $integrand $dx $wrt)
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ←
LIST[[$lowerlimit, [$integral, [right], [left, medGap]],
[$integral, [top], [bottom, -smallGap]]],
[$upperlimit, [$integral, [left], [right, -medGap]],
[$integral, [bottom], [top, smallGap]]],
[$integrand, [$integral, [left], [right]],
[$integral, [center], [center]]],
[$dx, [$integrand, [left], [right, smallGap]],
[$integrand, [origin], [origin]]],
[$wrt, [$dx, [left], [right]],
[$dx, [origin], [origin]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $lowerlimit, $integrand];
RETURN[tempBox, tempBoxes];
};
UnaryOpCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($aliasUnaryOp $aliasA).
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ← LIST[
[$aliasSpace,
[$aliasUnaryOp, [left], [right]],
[$aliasUnaryOp, [origin], [origin]]],
[$aliasA,
[$aliasSpace, [left], [right]],
[$aliasSpace, [origin], [origin]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $aliasUnaryOp, $aliasUnaryOp];
RETURN[tempBox, tempBoxes];
};
BinaryOpCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($aliasBinOp $aliasA $aliasB) with
symbols $aliasLeftSpace & $aliasRightSpace.
tempBox: BOX;
tempBoxes: LIST OF BOX;
leftVertOffsetA, leftVertOffsetOp, rightVertOffsetB, rightVertOffsetOp: Offset;
alignments: LIST OF Alignment2D;
set vertical offset depending on format classes of A & B arguments
SELECT MathBox.GetBox[$aliasA, boxes].FormatClass[] FROM
over => {
leftVertOffsetA ← [origin];
leftVertOffsetOp ← [center];
};
matrix => {
leftVertOffsetA ← [center];
leftVertOffsetOp ← [center];
};
ENDCASE => {
leftVertOffsetA ← [origin];
leftVertOffsetOp ← [origin];
};
SELECT MathBox.GetBox[$aliasB, boxes].FormatClass[] FROM
over => {
rightVertOffsetB ← [origin];
rightVertOffsetOp ← [center];
};
matrix => {
rightVertOffsetB ← [center];
rightVertOffsetOp ← [center];
};
ENDCASE => {
rightVertOffsetB ← [origin];
rightVertOffsetOp ← [origin];
};
alignments ← LIST[
[$aliasLeftSpace,
[$aliasBinOp, [right], [left]],
[$aliasBinOp, [origin], [origin]]],
[$aliasA,
[$aliasLeftSpace, [right], [left]],
[$aliasBinOp, leftVertOffsetA, leftVertOffsetOp]],
[$aliasRightSpace,
[$aliasBinOp, [left], [right]],
[$aliasBinOp, [origin], [origin]]],
[$aliasB,
[$aliasRightSpace, [left], [right]],
[$aliasBinOp, rightVertOffsetB, rightVertOffsetOp]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $aliasA, $aliasBinOp];
RETURN[tempBox, tempBoxes];
};
RelationCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($aliasRelation $aliasLHS $aliasRHS) with
symbols $aliasLeftSpace & $aliasRightSpace.
tempBox: BOX;
tempBoxes: LIST OF BOX;
leftVertOffsetLHS, leftVertOffsetRel, rightVertOffsetRHS, rightVertOffsetRel: Offset;
alignments: LIST OF Alignment2D;
set vertical offset depending on format classes of lhs & rhs arguments
SELECT MathBox.GetBox[$aliasLHS, boxes].FormatClass[] FROM
over => {
leftVertOffsetLHS ← [origin];
leftVertOffsetRel ← [center];
};
matrix => {
leftVertOffsetLHS ← [center];
leftVertOffsetRel ← [center];
};
ENDCASE => {
leftVertOffsetLHS ← [origin];
leftVertOffsetRel ← [origin];
};
SELECT MathBox.GetBox[$aliasRHS, boxes].FormatClass[] FROM
over => {
rightVertOffsetRHS ← [origin];
rightVertOffsetRel ← [center];
};
matrix => {
rightVertOffsetRHS ← [center];
rightVertOffsetRel ← [center];
};
ENDCASE => {
rightVertOffsetRHS ← [origin];
rightVertOffsetRel ← [origin];
};
alignments ← LIST[
[$aliasLeftSpace,
[$aliasRelation, [right], [left]],
[$aliasRelation, [origin], [origin]]],
[$aliasLHS,
[$aliasLeftSpace, [right], [left]],
[$aliasRelation, leftVertOffsetLHS, leftVertOffsetRel]],
[$aliasRightSpace,
[$aliasRelation, [left], [right]],
[$aliasRelation, [origin], [origin]]],
[$aliasRHS,
[$aliasRightSpace, [left], [right]],
[$aliasRelation, rightVertOffsetRHS, rightVertOffsetRel]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $aliasLHS, $aliasRelation];
RETURN[tempBox, tempBoxes];
};
ComplexCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($complex $a $b)
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ←
LIST[[$a, [$plus, [right], [left, -smallGap]],
[$plus, [origin], [origin]]],
[$b, [$plus, [left], [right, smallGap]],
[$plus, [origin], [origin]]],
[$i, [$b, [left], [right, smallGap]],
[$b, [origin], [origin]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $a, $plus];
RETURN[tempBox, tempBoxes];
};
ProductCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($product $multiplier $multiplicand)
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ←
LIST[[$multiplier, [$multiplicand, [right], [left, -smallGap]],
[$multiplicand, [origin], [origin]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $multiplier, $multiplier];
RETURN[tempBox, tempBoxes];
};
ParenCompRule: CompositionProc ~ {
effects: Composes layout for expr of form ($paren $a) with symbols
$leftParen and $rightParen
tempBox: BOX;
tempBoxes: LIST OF BOX;
alignments: LIST OF Alignment2D ← LIST[
[$leftParen,
[$a, [right], [left]],
[$a, [center], [center]]],
[$rightParen,
[$a, [left], [right]],
[$a, [center], [center]]]];
[tempBox, tempBoxes] ←
MathRules.Compose[boxes, alignments, $leftParen, $a];
RETURN[tempBox, tempBoxes];
};
Class Constructors
MakeBinOpClass: PUBLIC PROC[class, op, a, b: ATOM, operation: EXPR,
description: ROPE, cvtAS: ROPE] RETURNS[CompoundClass] ~ {
effects: Creates and returns standard binary operation compound class named "class".
The alignment is "a operation b"; alignment is thru baselines.
All of a, b, op are of fixed size "normal".
aArg: Argument ← MakeArgument[a, LIST[$aliasA, $aliasHot], normal];
bArg: Argument ← MakeArgument[b, LIST[$aliasB], normal];
opSym: Symbol ← MakeSymbol[op, LIST[$aliasBinOp], normal, operation];
leftSpace: Symbol ← MakeSymbol[$leftThinSpace, LIST[$aliasLeftSpace], normal, MakeSpace[thinSpace]];
rightSpace: Symbol ← MakeSymbol[$rightThinSpace, LIST[$aliasRightSpace], normal, MakeSpace[thinSpace]];
RETURN[MakeCompoundClass[class, binaryOp, description, LIST[aArg, bArg], LIST[opSym, leftSpace, rightSpace], FixedSizeBoxRule, BinaryOpCompRule, cvtAS]];
};
MakeRelationClass: PUBLIC PROC[class, rel, lhs, rhs: ATOM, relation: EXPR,
description: ROPE, cvtAS: ROPE] RETURNS[CompoundClass] ~ {
effects: Creates and returns standard relation compound class named "class".
The alignment is "lhs relation rhs"; alignment is thru baselines.
All of lhs, rhs, rel are of fixed size "normal".
lhsArg: Argument ← MakeArgument[lhs, LIST[$aliasLHS, $aliasHot], normal];
rhsArg: Argument ← MakeArgument[rhs, LIST[$aliasRHS], normal];
relSym: Symbol ← MakeSymbol[rel, LIST[$aliasRelation], normal, relation];
leftSpace: Symbol ← MakeSymbol[$leftSpace, LIST[$aliasLeftSpace], normal, MakeSpace[medSpace]];
rightSpace: Symbol ← MakeSymbol[$rightSpace, LIST[$aliasRightSpace], normal, MakeSpace[medSpace]];
RETURN[MakeCompoundClass[class, relation, description, LIST[lhsArg, rhsArg], LIST[relSym, leftSpace, rightSpace], FixedSizeBoxRule, RelationCompRule, cvtAS]];
};
MakeUnaryOpClass: PUBLIC PROC[class, op, arg: ATOM, operation: EXPR, description: ROPE, cvtAS: ROPE] RETURNS[CompoundClass] ~ {
effects: Creates and returns standard unary operation compound class named "class".
The alignment is "operation arg"; alignment is thru baselines.
Both op, arg are of fixed size "normal".
argArg: Argument ← MakeArgument[arg, LIST[$aliasA, $aliasHot], normal];
spaceSym: Symbol ← MakeSymbol[$Space, LIST[$aliasSpace], normal, MakeSpace[medSpace]];
unaryOpSym: Symbol ← MakeSymbol[op, LIST[$aliasUnaryOp], normal, operation];
RETURN[MakeCompoundClass[class, unaryOp, description, LIST[argArg], LIST[unaryOpSym, spaceSym], FixedSizeBoxRule, UnaryOpCompRule, cvtAS]];
};
High Level Expression Constructors
Atoms
MakePlainSym: PROC[c: CHAR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$plainSym, MathExpr.MakeAtomChar[c]]];
};
MakeBigMathSym: PROC[c: CHAR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$bigMathSym, MathExpr.MakeAtomChar[c]]];
};
MakeSmallMathSym: PROC[c: CHAR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$smallMathSym, MathExpr.MakeAtomChar[c]]];
};
MakeItalSym: PROC[c: CHAR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$italicSym, MathExpr.MakeAtomChar[c]]];
};
MakeMathItalSym: PROC[c: CHAR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$mathItalicSym, MathExpr.MakeAtomChar[c]]];
};
MakeLine: PROC[] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$line, MathExpr.MakeAtomOther[NIL]]];
};
MakeSpace: PROC[b: ImagerFont.Extents] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$space, MathExpr.MakeAtomBox[b]]];
};
MakePlaceHolder: PUBLIC PROC[] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeAtomicExpr[$placeholder, MathExpr.MakeAtomRope["\056\057"]]];
};
MakeInt: PUBLIC PROC[n: ROPE] RETURNS[EXPR] ~ {
effects: Constructs and returns an integer expression for n.
SIGNALS badFormat if n is not a legal integer.
IF n.Length[] = 0 THEN ERROR badFormat;
SELECT n.Fetch[0] FROM
IN ['0..'9] => NULL;
'- => IF n.Length[] = 1 THEN ERROR badFormat; -- a lone minus sign is invalid
ENDCASE => ERROR badFormat;
check that each char in n is a legal digit
FOR i:INT IN[1..n.Length[]-1] DO
SELECT n.Fetch[i] FROM
IN ['0..'9] => NULL;
ENDCASE => ERROR badFormat;
ENDLOOP;
RETURN[MathExpr.MakeAtomicExpr[$integer, MathExpr.MakeAtomRope[n]]];
};
MakeReal: PUBLIC PROC[r: REAL] RETURNS[EXPR] ~ {
effects: Constructs and returns a real expression for n.
RETURN[MathExpr.MakeAtomicExpr[$real, MathExpr.MakeAtomRope[Convert.RopeFromReal[r]]]];
};
MakeVariable: PUBLIC PROC[var: ROPE] RETURNS[EXPR] ~ {
effects: Constructs and returns a variable expression for var.
SIGNALS badFormat if n is not a legal variable (e.g. invalid chars).
IF var.Length[] = 0 THEN ERROR badFormat;
check that each char is an alphabetic char A thru Z, either case
FOR i:INT IN[0..var.Length[]-1] DO
SELECT var.Fetch[i] FROM
IN ['A..'Z], IN ['a..'z] => NULL;
ENDCASE => ERROR badFormat;
ENDLOOP;
RETURN[MathExpr.MakeAtomicExpr[$variable, MathExpr.MakeAtomRope[var]]];
};
Binary Ops
MakeSum: PUBLIC PROC[addend, augend: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$sum, LIST[[$addend, addend], [$augend, augend]]]];
};
MakeDifference: PUBLIC PROC[subtrahend, minuend: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$difference, LIST[[$subtrahend, subtrahend], [$minuend, minuend]]]];
};
MakeAnd: PUBLIC PROC[a, b: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$and, LIST[[$a, a], [$b, b]]]];
};
MakeOr: PUBLIC PROC[a, b: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$or, LIST[[$a, a], [$b, b]]]];
};
Matrix
MakeMatrix: PUBLIC PROC[nRows, nCols: NAT, rows: LIST OF LIST OF EXPR]
RETURNS[EXPR] ~ {
local declarations
elements: LIST OF MathExpr.TaggedMathExpr ← NIL;
rowCount, colCount: NAT ← 0;
FOR l: LIST OF LIST OF EXPR ← rows, l.rest UNTIL l = NIL DO
rowCount ← rowCount + 1;
colCount ← 0;
FOR elts: LIST OF EXPR ← l.first, elts.rest UNTIL elts = NIL DO
colCount ← colCount + 1;
elements ← CONS[[MathRules.AtomFromRowCol[rowCount, colCount], elts.first], elements];
ENDLOOP;
ENDLOOP;
RETURN[MathExpr.MakeMatrixExpr[[$matrix, matrix], nRows, nCols, elements, MakeBigMathSym['\042], MakeBigMathSym['\043], MakeSpace[[leftExtent: 0.0, rightExtent: 0.9, descent: 0.0, ascent: 0.6]]]];
};
Other
MakeComplex: PUBLIC PROC[a, b: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$complex, LIST[[$a, a], [$b, b]]]];
};
MakeProduct: PUBLIC PROC[multiplier, multiplicand: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$product, LIST[[$multiplier, multiplier], [$multiplicand, multiplicand]]]];
};
MakeFraction: PUBLIC PROC[numerator, denominator: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$fraction, LIST[[$numerator, numerator], [$denominator, denominator]]]];
};
MakePow: PUBLIC PROC[base, exponent: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$pow, LIST[[$base, base], [$exponent, exponent]]]];
};
MakeParen: PUBLIC PROC[a: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$paren, LIST[[$a, a]]]];
};
Relations
MakeEqFormula: PUBLIC PROC[lhs, rhs: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$eqFormula, LIST[[$lhs, lhs], [$rhs, rhs]]]];
};
MakeLtFormula: PUBLIC PROC[lhs, rhs: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$ltFormula, LIST[[$lhs, lhs], [$rhs, rhs]]]];
};
MakeLeFormula: PUBLIC PROC[lhs, rhs: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$leFormula, LIST[[$lhs, lhs], [$rhs, rhs]]]];
};
MakeGtFormula: PUBLIC PROC[lhs, rhs: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$gtFormula, LIST[[$lhs, lhs], [$rhs, rhs]]]];
};
MakeGeFormula: PUBLIC PROC[lhs, rhs: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$geFormula, LIST[[$lhs, lhs], [$rhs, rhs]]]];
};
Radical
MakeRadical: PUBLIC PROC[radicand, n: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$radical, LIST[[$radicand, radicand], [$n, n]]]];
};
Ops
MakeSummation: PUBLIC PROC[lb, ub, summand: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$summation, LIST[[$lowerbound, lb], [$summand, summand], [$upperbound, ub]]]];
};
MakeIntegral: PUBLIC PROC[llim, ulim, integrand, wrt: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$integration, LIST[[$lowerlimit, llim], [$upperlimit, ulim], [$integrand, integrand], [$wrt, wrt]]]];
};
Unary Ops
MakeNot: PUBLIC PROC[a: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$not, LIST[[$a, a]]]];
};
MakeNegation: PUBLIC PROC[a: EXPR] RETURNS[EXPR] ~ {
RETURN[MathExpr.MakeCompoundExpr[$negation, LIST[[$a, a]]]];
};
Signals & Errors
wrongAtomValueType: PUBLIC ERROR = CODE;
wrongBoxType: PUBLIC ERROR = CODE;
badFormat: PUBLIC ERROR = CODE;
Define & Install Atom and Compound Classes
DefineClasses: PROC [] ~ {
local declarations (lots of 'em)
cmr10, cmti10, cmmi10, cmex10, cmsy10: Style;
integerClass, realClass, variableClass, plainSymClass, smallMathSymClass, bigMathSymClass, italSymClass, mathItalSymClass, lineClass, placeholderClass, spaceClass: AtomClass;
sumClass, summationClass, fractionClass, integrationClass, differenceClass, powClass, eqFormulaClass, ltFormulaClass, leFormulaClass, geFormulaClass, gtFormulaClass, radicalClass, complexClass, productClass, orClass, notClass, negationClass, andClass, parenClass: CompoundClass;
lbArg, ubArg, summandArg, llimArg, ulimArg, integrandArg, wrtArg, baseArg, exponentArg, numeratorArg, denominatorArg, nArg, radicandArg, multiplierArg, multiplicandArg, realPartArg, imaginaryPartArg, aParenArg: Argument;
plusSym, sigmaSym, integralSym, dxSym, lineSym, radRootSym, radLineSym, iSym, leftParenSym, rightParenSym: Symbol;
reset current DB state (i.e. clean slate)
MathDB.ResetAtomClasses[];
MathDB.ResetCompoundClasses[];
plain vanilla TeX fonts
cmr10 ← [font: "xerox/pressfonts/cmr60"]; -- standard times roman (1 unit high)
cmti10 ← [font: "xerox/pressfonts/cmti60"]; -- italic (1 unit high)
cmex10 ← [font: "xerox/pressfonts/cmex60"]; -- math extentsion font (1 unit high)
cmmi10 ← [font: "xerox/pressfonts/cmmi60"]; -- math italic font (1 unit high)
cmsy10 ← [font: "xerox/pressfonts/cmsy60"]; -- math symbols font (1 unit high)
define Atom Classes
integerClass ← MakeAtomClass[$integer, atom, argument, cmr10, RopeBox, PaintRope, CvtRopeToRope];
realClass ← MakeAtomClass[$real, atom, argument, cmr10, RopeBox, PaintRope, CvtRopeToRope];
variableClass ← MakeAtomClass[$variable, atom, argument, cmti10, RopeBox, PaintRope, CvtRopeToRope];
plainSymClass ← MakeAtomClass[$plainSym, atom, symbol, cmr10, CharBox, PaintChar, CvtCharToRope];
bigMathSymClass ← MakeAtomClass[$bigMathSym, atom, symbol, cmex10, CharBox, PaintChar, CvtCharToRope];
smallMathSymClass ← MakeAtomClass[$smallMathSym, atom, symbol, cmsy10, CharBox, PaintChar, CvtCharToRope];
mathItalSymClass ← MakeAtomClass[$mathItalicSym, atom, symbol, cmmi10, CharBox, PaintChar, CvtCharToRope];
italSymClass ← MakeAtomClass[$italicSym, atom, symbol, cmti10, CharBox, PaintChar, CvtCharToRope];
lineClass ← MakeAtomClass[$line, atom, symbol, cmr10, LineBox, PaintLine, CvtOtherToRope];
placeholderClass ← MakeAtomClass[$placeholder, atom, placeholder, cmmi10, RopeBox, PaintRope, CvtRopeToRope];
spaceClass ← MakeAtomClass[$space, atom, symbol, cmr10, SpaceBox, PaintSpace, CvtSpaceToRope];
register atom classes
MathDB.InstallAtomClass[integerClass];
MathDB.InstallAtomClass[realClass];
MathDB.InstallAtomClass[variableClass];
MathDB.InstallAtomClass[plainSymClass];
MathDB.InstallAtomClass[italSymClass];
MathDB.InstallAtomClass[smallMathSymClass];
MathDB.InstallAtomClass[bigMathSymClass];
MathDB.InstallAtomClass[mathItalSymClass];
MathDB.InstallAtomClass[lineClass];
MathDB.InstallAtomClass[placeholderClass];
MathDB.InstallAtomClass[spaceClass];
define info for "complex a b" (a + bi)
realPartArg ← MakeArgument[$a, LIST[$aliasA, $aliasHot], normal];
imaginaryPartArg ← MakeArgument[$b, LIST[$aliasB], normal];
iSym ← MakeSymbol[$i, NIL, normal, MakeItalSym['i]];
plusSym ← MakeSymbol[$plus, LIST[$aliasBinOp], normal, MakePlainSym['+]];
define info for "product multiplier multiplicand"
multiplierArg ← MakeArgument[$multiplier, LIST[$aliasA, $aliasHot], normal];
multiplicandArg ← MakeArgument[$multiplicand, LIST[$aliasB], normal];
define info for "summation lowerbound upperbound summand"
lbArg ← MakeArgument[$lowerbound, NIL, script];
ubArg ← MakeArgument[$upperbound, NIL, script];
summandArg ← MakeArgument[$summand, LIST[$aliasHot], normal];
sigmaSym ← MakeSymbol[$sigma, LIST[$aliasOp], normal, MakeBigMathSym['\130]];
define info for "integral lowerlimit upperlimit integrand"
llimArg ← MakeArgument[$lowerlimit, NIL, script];
ulimArg ← MakeArgument[$upperlimit, NIL, script];
integrandArg ← MakeArgument[$integrand, LIST[$aliasHot], normal];
wrtArg ← MakeArgument[$wrt, NIL, script];
integralSym ← MakeSymbol[$integral, LIST[$aliasOp], normal, MakeBigMathSym['\132]];
dxSym ← MakeSymbol[$dx, NIL, script, MakeItalSym['d]];
define info for "pow base exponent"
baseArg ← MakeArgument[$base, LIST[$aliasA, $aliasHot], normal];
exponentArg ← MakeArgument[$exponent, LIST[$aliasB], script];
define info for "fraction numerator denominator"
numeratorArg ← MakeArgument[$numerator, LIST[$aliasA, $aliasHot], normal];
denominatorArg ← MakeArgument[$denominator, LIST[$aliasB], normal];
lineSym ← MakeSymbol[$fractionBar, LIST[$aliasLine], normal, MakeLine[]];
define info for "radical n radicand"
nArg ← MakeArgument[$n, LIST[$aliasB], script];
radicandArg ← MakeArgument[$radicand, LIST[$aliasA, $aliasHot], normal];
radRootSym ← MakeSymbol[$radRoot, NIL, normal, MakeBigMathSym['\162]];
radLineSym← MakeSymbol[$radLine, LIST[$aliasLine], normal, MakeLine[]];
define info for "( a )"
aParenArg ← MakeArgument[$a, LIST[$aliasA, $aliasHot], normal];
leftParenSym ← MakeSymbol[$leftParen, NIL, normal, MakeBigMathSym['\040]];
rightParenSym ← MakeSymbol[$rightParen, NIL, normal, MakeBigMathSym['\041]];
define compound classes
binary operations
sumClass ← MakeBinOpClass[$sum, $plus, $addend, $augend, MakePlainSym['+], "a + b", "$addend + $augend"];
differenceClass ← MakeBinOpClass[$difference, $minus, $subtrahend, $minuend, MakePlainSym['\173], "a - b", "$subtrahend - $minuend"];
andClass ← MakeBinOpClass[$and, $andOp, $a, $b, MakeSmallMathSym['\136], "a AND b", "$a & $b"];
orClass ← MakeBinOpClass[$or, $orOp, $a, $b, MakeSmallMathSym['\137], "a OR b", "$a | $b"];
unary operations
negationClass ← MakeUnaryOpClass[$negation, $minus, $a, MakePlainSym['-], "-a", "-$a"];
notClass ← MakeUnaryOpClass[$not, $notOp, $a, MakeSmallMathSym['\072], "~a", "~ $a"];
relations
eqFormulaClass ← MakeRelationClass[$eqFormula, $equals, $lhs, $rhs, MakePlainSym['=], "lhs = rhs", "$lhs = $rhs"];
ltFormulaClass ← MakeRelationClass[$ltFormula, $lt, $lhs, $rhs, MakeMathItalSym['<], "lhs < rhs", "$lhs < $rhs"];
gtFormulaClass ← MakeRelationClass[$gtFormula, $gt, $lhs, $rhs, MakeMathItalSym['>], "lhs > rhs", "$lhs > $rhs"];
leFormulaClass ← MakeRelationClass[$leFormula, $le, $lhs, $rhs, MakeSmallMathSym['\024], "lhs <= rhs", "$lhs <= $rhs"];
geFormulaClass ← MakeRelationClass[$geFormula, $ge, $lhs, $rhs, MakeSmallMathSym['\025], "lhs >= rhs", "$lhs >= $rhs"];
others
complexClass ← MakeCompoundClass[$complex, other, "a + bi", LIST[realPartArg, imaginaryPartArg], LIST[iSym, plusSym], FixedSizeBoxRule, ComplexCompRule, "($a + $bi)"];
productClass ← MakeCompoundClass[$product, binaryOp, "a * b", LIST[multiplierArg, multiplicandArg], NIL, FixedSizeBoxRule, ProductCompRule, "$multiplier $multiplicand"];
summationClass ← MakeCompoundClass[$summation, op, "summation", LIST[lbArg, ubArg, summandArg], LIST[sigmaSym], FixedSizeBoxRule, SummationCompRule, "(summation ($lowerbound) ($upperbound) ($summand))"];
integrationClass ← MakeCompoundClass[$integration, op, "integration", LIST[llimArg, ulimArg, integrandArg, wrtArg], LIST[integralSym, dxSym], FixedSizeBoxRule, IntegrationCompRule, "(integral ($lowerlimit) ($upperlimit) ($integrand) ($wrt))"];
powClass ← MakeCompoundClass[$pow, other, "a^b", LIST[baseArg, exponentArg], NIL, FixedSizeBoxRule, PowCompRule, "$base^$exponent"];
parenClass ← MakeCompoundClass[$paren, paren, "( a )", LIST[aParenArg], LIST[leftParenSym, rightParenSym], ParenBoxRule, ParenCompRule, "( $a )"];
fractionClass ← MakeCompoundClass[$fraction, over, "a / b", LIST[numeratorArg, denominatorArg], LIST[lineSym], FractionBoxRule, FractionCompRule, "$numerator / $denominator"];
radicalClass ← MakeCompoundClass[$radical, radical, "radical", LIST[nArg, radicandArg], LIST[radRootSym, radLineSym], RadicalBoxRule, RadicalCompRule, "(root ($radicand) ($n))"];
register compound classes
binary ops
MathDB.InstallCompoundClass[sumClass];
MathDB.InstallCompoundClass[differenceClass];
MathDB.InstallCompoundClass[andClass];
MathDB.InstallCompoundClass[orClass];
unary ops
MathDB.InstallCompoundClass[notClass];
MathDB.InstallCompoundClass[negationClass];
others
MathDB.InstallCompoundClass[powClass];
MathDB.InstallCompoundClass[parenClass];
MathDB.InstallCompoundClass[complexClass];
MathDB.InstallCompoundClass[productClass];
MathDB.InstallCompoundClass[summationClass];
MathDB.InstallCompoundClass[integrationClass];
MathDB.InstallCompoundClass[fractionClass];
MathDB.InstallCompoundClass[radicalClass];
relations
MathDB.InstallCompoundClass[eqFormulaClass];
MathDB.InstallCompoundClass[ltFormulaClass];
MathDB.InstallCompoundClass[leFormulaClass];
MathDB.InstallCompoundClass[gtFormulaClass];
MathDB.InstallCompoundClass[geFormulaClass];
};
Install Classes Defined in this Module
DefineClasses[];
END.