DIRECTORY
Convert USING [Error, RealFromRope],
Graph USING [Entity, EntityGroupList, EntityList, NtNan, SegmentDataList, ROPE],
GraphPrivate USING [GraphAtomProc, PaintAllCurves, PaintEntity],
GraphUtil USING [BlinkMsg, ControllerViewerExits, GraphViewerExits, NotANumber, SetSegments, UpdateSegAll, UpdateSegEnd],
Real USING [ExceptionFlags, RealException],
RealFns USING [ArcTan, ArcTanDeg, Cos, CosDeg, Exp, Ln, Power, Root, Sin, SinDeg, SqRt, Tan, TanDeg],
Rope USING [Concat, IsEmpty],
ViewerTools USING [GetContents];
GraphOperations:
CEDAR
PROGRAM
IMPORTS Convert, GraphPrivate, GraphUtil, Real, RealFns, Rope, ViewerTools
EXPORTS GraphPrivate = { OPEN Graph, GraphPrivate, GraphUtil;
Operate:
PUBLIC GraphAtomProc = {
IF ControllerViewerExits[handle]
AND GraphViewerExits[handle]
THEN {
OPEN handle;
ActOnY:
PROC [et: Entity, op: OpType] = {
IF opType = original THEN UpdateSegAll[et, et.oldValues]
ELSE {
FOR sdl: SegmentDataList ← et.segments, sdl.rest
UNTIL sdl =
NIL
DO
sdl.first.end ←
IF opType = unary
THEN unaryProc[sdl.first.end]
ELSE binaryProc[sdl.first.end, arg];
ENDLOOP;
SetSegments[et];
};
}; -- ActOnY
ok: BOOL ← TRUE; -- may be false only if there is problem converting argument for binary operation.
unaryProc: UnaryProc ← NIL;
binaryProc: BinaryProc ← NIL;
arg: REAL;
opType: OpType ← original;
entity: Entity ← chart.selectedEntity;
IF entity = NIL THEN RETURN;
SELECT atom
FROM
$Sign, $Abs, $Reciprocal, $Exponential, $NaturalLog, $DB, $SqRt, $Sine, $Cosine, $Tangent, $ArcTan => {
-- unary procs
opType ← unary;
unaryProc ←
SELECT atom
FROM
$Sign => Sign,
$Abs => Abs,
$Reciprocal => Recip,
$Exponential => Exp,
$NaturalLog => Ln,
$DB => DB,
$SqRt => SqRt,
$Sine => IF controller.angle = radians THEN Sin ELSE SinDeg,
$Cosine => IF controller.angle = radians THEN Cos ELSE CosDeg,
$Tangent => IF controller.angle = radians THEN Tan ELSE TanDeg,
ENDCASE => IF controller.angle = radians THEN ArcTan ELSE ArcTanDeg;
}; -- unary procs
$Plus, $Minus, $Multiply, $Divide, $Root, $Power => {
ENABLE Convert.Error => {
-- binary procs
BlinkMsg["Problem parsing the argument."]; ok ← FALSE; CONTINUE};
argRope: ROPE ← ViewerTools.GetContents[controller.argument];
opType ← binary;
binaryProc ←
SELECT atom
FROM
$Plus => Plus, $Minus => Minus, $Multiply => Multiply,
$Divide => Divide, $Root => Root, ENDCASE => Power;
IF argRope.IsEmpty[] THEN {BlinkMsg["Argument is not specified."]; RETURN};
arg ← Convert.RealFromRope[argRope]; -- may raise Convert.Error.
SELECT atom
FROM
$Divide => {
ok ← arg # 0.0;
IF NOT ok THEN BlinkMsg["Can't divide by zero. Operation not performed."];
};
$Root => {
ok ← arg # 0.0;
IF NOT ok THEN BlinkMsg["Can't do it with index zero. Root operation not performed."];
};
$Power => {
ok ← arg <= 0.0;
IF NOT ok THEN BlinkMsg["Base must be nonnegative. Power operation not performed."];
};
ENDCASE;
}; -- binary procs
ENDCASE; -- original
IF ok
THEN
SELECT controller.operand
FROM
y => {
FOR el: EntityList ← graph.entityList, el.rest
UNTIL el =
NIL
DO
Use this loop to make sure entity is on the plotted list, graph.entityList.
IF el.first = entity
THEN {
PaintEntity[handle, entity, FALSE, erase];
ActOnY[entity, opType];
PaintEntity[handle, entity, FALSE, paint];
EXIT;
};
ENDLOOP;
};
plottedYs => {
FOR el: EntityList ← graph.entityList, el.rest
UNTIL el =
NIL
DO
ActOnY[el.first, opType];
ENDLOOP;
PaintAllCurves[handle, TRUE];
};
allX => {
FOR egl: EntityGroupList ← entityGroupList, egl.rest
UNTIL egl =
NIL
DO
IF opType = original THEN UpdateSegEnd[egl.first.x, egl.first.x.oldValues]
ELSE
FOR sdl: SegmentDataList ← egl.first.x.segments, sdl.rest
UNTIL sdl =
NIL
DO
sdl.first.end ←
IF opType = unary
THEN unaryProc[sdl.first.end]
ELSE binaryProc[sdl.first.end, arg];
ENDLOOP;
ENDLOOP;
FOR el: EntityList ← graph.entityList, el.rest
UNTIL el =
NIL
DO
SetSegments[el.first];
ENDLOOP;
PaintAllCurves[handle, TRUE];
};
ENDCASE;
}; -- viewers exist
}; -- Operate
ExceptionRope:
PROC [flags: Real.ExceptionFlags]
RETURNS [rope:
ROPE ←
NIL] = {
IF flags[fixOverflow] THEN rope ← rope.Concat["fixOverflow. "];
IF flags[inexactResult] THEN rope ← rope.Concat["inexactResult. "];
IF flags[invalidOperation] THEN rope ← rope.Concat["invalidOperation. "];
IF flags[divisionByZero] THEN rope ← rope.Concat["divisionByZero. "];
IF flags[overflow] THEN rope ← rope.Concat["overflow. "];
IF flags[underflow] THEN rope ← rope.Concat["underflow. "];
};
unary procs
Sign: UnaryProc = {
RETURN[
IF NotANumber[a]
THEN NtNan
ELSE -a]};
Abs: UnaryProc = {
RETURN[
IF NotANumber[a]
THEN NtNan
ELSE
ABS[a]]};
Recip: UnaryProc = {
msg: ROPE ← NIL;
IF a = 0 THEN msg ← "Divide by zero."
ELSE IF NotANumber[a] THEN r ← NtNan
ELSE {
ENABLE {
Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
RealError => RaiseError[$Other, "Real resume error."];
};
r ← 1.0/a;
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Recip
Exp: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE IF a > 88.7228 THEN {msg ← "Overflow."}
ELSE {
ENABLE {
Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
RealError => {msg ← "Real resume error."; CONTINUE}; -- ?
};
r ← RealFns.Exp[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Exp
Ln: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] OR a <= 0.0 THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.Ln[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Ln
DB: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] OR a <= 0.0 THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← DbFactor*RealFns.Ln[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- DB
SqRt: UnaryProc = {
msg: ROPE ← NIL;
IF a = 0.0 THEN r ← 0.0
ELSE IF NotANumber[a] OR a < 0.0 THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.SqRt[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- SqRt
Sin: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.Sin[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Sin
SinDeg: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.SinDeg[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- SinDeg
Cos: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.Cos[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Cos
CosDeg: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.CosDeg[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- CosDeg
Tan: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.Tan[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Tan
TanDeg: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.TanDeg[a];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- TanDeg
ArcTan: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.ArcTan[a, 1.0];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- ArcTan
ArcTanDeg: UnaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] THEN {msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.ArcTanDeg[a, 1.0];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- ArcTanDeg
binary procs
Plus: BinaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] OR NotANumber[b] THEN msg ← "Invalid operand."
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← a + b;
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Plus
Minus: BinaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] OR NotANumber[b] THEN msg ← "Invalid operand."
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← a - b;
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Minus
Multiply: BinaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] OR NotANumber[b] THEN msg ← "Invalid operand."
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← a * b;
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Multiply
Divide: BinaryProc = {
msg: ROPE ← NIL;
IF NotANumber[a] OR NotANumber[b] THEN msg ← "Invalid operand."
ELSE IF b = 0.0 THEN msg ← "Divide by zero."
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← a / b;
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Divide
Root: BinaryProc = {
-- a is arg and b is index !!
msg: ROPE ← NIL;
IF NotANumber[a] OR NotANumber[b] THEN msg ← "Invalid operand."
ELSE IF a = 0.0 THEN r ← 0.0
ELSE IF a < 0.0 THEN msg ← "Invalid operation."
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.Root[b, a]; -- note the order of arguments !!
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Root
Power: BinaryProc = {
a is base and b is exponent.
msg: ROPE ← NIL;
IF NotANumber[a] OR NotANumber[b] THEN msg ← "Invalid operand."
ELSE IF a = 0.0 THEN r ← 0.0
ELSE IF b = 0.0 THEN {IF a # 0.0 THEN r ← 1.0 ELSE msg ← "Invalid operation."}
ELSE {
ENABLE Real.RealException => {msg ← ExceptionRope[flags]; CONTINUE};
r ← RealFns.Power[a, b];
};
IF msg # NIL THEN {BlinkMsg[msg]; r ← NtNan};
}; -- Power