GraphUtilImpl.mesa, Copyright © 1985 by Xerox Corporation. All rights reserved.
Last Edited by:
Sweetsun Chen, October 22, 1985 10:08:40 pm PDT
DIRECTORY
Buttons USING [Button, SetDisplayStyle],
Convert USING [BoolFromRope, Error, IntFromRope, RealFromRope, RopeFromInt, RopeFromReal],
FS USING [Error, ComponentPositions, ExpandName],
Graph USING [CaretIndex, CaretSpecRec, ColorIndex, Entity, EntityGroup, EntityList, FontIndex, GRAPH, GraphColorsArray, GraphFont, GraphFontsArray, GraphRec, NestedEntities, NullBox, NullRect, NullVec, ROPE, SegmentDataList, SegmentDataRec, TargetSpecRec, Text, Texts, ValueList, Viewer, XY],
GraphCleanUp USING [CleanUpEL, CleanUpSDL, CleanUpTexts, CleanUpVL],
GraphPrivate USING [BackgroundIndex, CaretStateRec, Chart, ChartRec, Controller, defaultColorsArray, defaultFontsArray, Draw, EntityHashArray, EntityGroupList, EntityHash, EntityHashSize, FontArray, GraphHandle, GraphHandleRec, IsController, IsGraphViewer, OutputType, PaintInfoRec, systemColor],
GraphUtil,
ImagerInterpress USING [Close, Create, DoPage, Ref],
Imager USING [Box, ConstantColor, Context, Error, Rectangle, RotateT, ScaleT, VEC],
ImagerColor USING [GrayFromColor, RGB],
ImagerColorDefs USING [ConstantColor],
ImagerColorMap USING [LoadEntries, MapEntry, SetStandardColorMap],
ImagerDitheredDevice USING [ColorFromSpecialRGB],
ImagerFont USING [Extents, Font, Find, FontBoundingBox, RopeBoundingBox, Scale],
IO USING [int, PutFR],
MessageWindow USING [Append, Blink],
Process USING [MsecToTicks, SetTimeout],
Real USING [Float, LargestNumber, RoundC, RoundI],
RealFns USING [SqRt],
Rope USING [Cat, Concat, IsEmpty, Substr],
Terminal USING [ColorCursorPresentation, Current, GetColorCursorPresentation, SetColorCursorPresentation, Virtual],
UserProfile USING [ListOfTokens],
VFonts USING [EstablishFont],
ViewerOps USING [FetchProp],
ViewerTools USING [GetContents, GetSelectionContents, SetContents],
WindowManager USING [RestoreCursor];
GraphUtilImpl: CEDAR PROGRAM
IMPORTS Buttons, Convert, FS, GraphCleanUp, GraphPrivate, Imager, ImagerColor, ImagerColorMap, ImagerDitheredDevice, ImagerFont, ImagerInterpress, IO, MessageWindow, Process, Real, RealFns, Rope, Terminal, UserProfile, VFonts, ViewerOps, ViewerTools, WindowManager
EXPORTS Graph, GraphUtil = { OPEN Graph, GraphPrivate;
error checking
Warning, Error: PUBLIC SIGNAL[atom: ATOM, info: ROPE ← NIL]= CODE;
RaiseError: PUBLIC PROC[atom: ATOM, msg: ROPE ← NIL] = {
info: ROPE ← NilMessage[atom, msg];
IF info = NIL THEN info ← SELECT atom FROM
$NullBox => "Box = [0, 0, 0, 0]",
$BadBox => "xmin = xmax or ymin = ymax",
$UnknownInfo => "Unknown PaintInfo",
$UnknownAtom => "Unknown ATOM",
$Other => "Error",
ENDCASE => "Unknown error";
Error[atom, info];
}; -- RaiseError
BlinkMsg: PUBLIC PROC[msg: ROPE ← NIL] = {
MessageWindow.Blink[];
MessageWindow.Append[msg, TRUE];
}; -- BlinkMsg
NilMessage: PROC [atom: ATOM ← $Ref, msg: ROPE ← NIL] RETURNS [ROPE] = {
header: ROPE ← SELECT atom FROM
$NilViewer => "Viewer",
$NilHandle => "GraphHandle",
$NilChart => "Chart",
$NilController => "Controller",
$NilEntityGroup => "EntityGroup",
$NilEntityList => "EntityList",
$NilEntity => "Entity",
$NilText => "Text",
$NilFont => "Font",
$NilValueList => "ValueList",
$Ref => "REF",
ENDCASE => NIL;
IF header # NIL THEN header ← header.Concat[" is NIL"];
RETURN[IF msg = NIL THEN header ELSE Rope.Cat[header, " ", msg]];
}; -- NilMessage
CheckNil: PROC[ref: REF ANY ← NIL, atom: ATOM ← $Other, msg: ROPE ← NIL, degug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {
IF ref = nil and degug then raise error.
IF ref = NIL THEN {
ok ← FALSE;
IF degug THEN RaiseError[atom, msg] ELSE BlinkMsg[NilMessage[atom, msg]];
};
}; -- CheckNil
HandleNotNil: PUBLIC PROC[handle: GraphHandle ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[handle, $NilHandle, msg, debug]};
ViewerNotNil: PUBLIC PROC[viewer: Viewer ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[viewer, $NilViewer, msg, debug]};
ChartNotNil: PUBLIC PROC[chart: Chart ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[chart, $NilChart, msg, debug]};
ControllerNotNil: PUBLIC PROC[c: Controller ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[c, $NilController, msg, debug]};
EntityGroupNotNil: PUBLIC PROC[eg: EntityGroup ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[eg, $NilEntityGroup, msg, debug]};
EntityListNotNil: PUBLIC PROC[el: EntityList ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[el, $NilEntityList, msg, debug]};
EntityNotNil: PUBLIC PROC[entity: Entity ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[entity, $NilEntity, msg, debug]};
ValueListNotNil: PUBLIC PROC[vl: ValueList ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[vl, $NilValueList, msg, debug]};
TextNotNil: PUBLIC PROC [text: Text ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[text, $NilText, msg, debug]};
FontNotNil: PUBLIC PROC[font: REF ANY ← NIL, msg: ROPE ← NIL, debug: BOOL ← FALSE] RETURNS [ok: BOOL ← TRUE] = {ok ← CheckNil[font, $NilFont, msg, debug]};
BoundsValid: PUBLIC PROC[box: Imager.Box ← NullBox] RETURNS [BOOL] = {
RETURN[box.xmax > box.xmin AND box.ymax > box.ymin]};
DivisionsValid: PUBLIC PROC[divX, divY: INT] RETURNS [BOOL] = {
RETURN[(divX IN [2..50]) AND (divY IN [2..50])]};
RectangleValid: PUBLIC PROC[rect: Imager.Rectangle ← NullRect] RETURNS [BOOL] = {
RETURN[rect.w > 0 AND rect.h > 0.0]};
colors & fonts
ColorValueOk: PUBLIC PROC[value: REAL ← 0.0, blinkMsg: BOOL ← TRUE] RETURNS [ok: BOOL ← TRUE] = {
IF value > 1.0 OR value < 0.0 THEN {
IF blinkMsg THEN BlinkMsg["Value must be in [0..1]."];
RETURN[FALSE];
};
}; -- ColorValueOk
ForegroundColor: PUBLIC PROC[background: BackgroundIndex ← white, output: OutputType ← screen] RETURNS [Imager.ConstantColor] ={
RETURN[IF output = interpress THEN systemColor[15]
ELSE IF background = black OR background = darkGray THEN systemColor[0]
ELSE systemColor[15]];
}; -- ForegroundColor
BackgroundColor: PUBLIC PROC[background: BackgroundIndex ← white, output: OutputType ← screen] RETURNS [Imager.ConstantColor] ={
RETURN[IF output = interpress THEN systemColor[0]
ELSE SELECT background FROM
gray => systemColor[13], darkGray => systemColor[14], black => systemColor[15],
ENDCASE => systemColor[0]];
}; -- ForegroundColor
UseMyColors: PUBLIC PROC[handle: GraphHandle ← NIL] = {
IF HandleNotNil[handle] THEN FOR index: ColorIndex IN ColorIndex DO
systemColor[index] ← SetColor[index, handle.graph.color[index]];
ENDLOOP;
}; -- UseMyColors
SetColor: PUBLIC PROC[index: ColorIndex ← 0, rgb: ImagerColor.RGB ← [0, 0, 0]] RETURNS [ImagerColorDefs.ConstantColor] = {
entry: ImagerColorMap.MapEntry ← [
mapIndex: index+100,
red: Real.RoundC[rgb.R*255],
green: Real.RoundC[rgb.G*255],
blue: Real.RoundC[rgb.B*255]
];
ImagerColorMap.LoadEntries[
vt: Terminal.Current[],
mapEntries: LIST[entry],
shared: FALSE];
RETURN[ImagerDitheredDevice.ColorFromSpecialRGB[specialPixel: [index+100, null], rgb: rgb]];
}; -- SetColor
UseDefaultColors: PUBLIC PROC[handle: GraphHandle ← NIL] = {
GetColor: PUBLIC PROC [num: ColorIndex] RETURNS [ImagerColor.RGB] = {
get color spec from user profile, or return default
ColorSpec: TYPE = LIST OF ROPE;
list: ColorSpec ← UserProfile.ListOfTokens[
key: IO.PutFR["Graph.Color%g", IO.int[num]],
default: NIL
];
c: ARRAY[1..3] OF REAL ← [
defaultColorsArray[num].R, defaultColorsArray[num].G, defaultColorsArray[num].B];
i: CARDINAL ← 1;
FOR lr: ColorSpec ← list, list.rest UNTIL list = NIL OR i > 3 DO
c[i] ← Convert.RealFromRope[list.first ! Convert.Error => EXIT];
c[i] ← MAX[0, MIN[1.0, c[i]]];
i ← i + 1;
ENDLOOP;
RETURN[[R: c[1], G: c[2], B: c[3]]];
}; -- GetColor
FOR i: ColorIndex IN ColorIndex DO
c: ImagerColor.RGB ← GetColor[i];
systemColor[i] ← SetColor[i, c];
IF handle # NIL THEN IF handle.graph # NIL THEN handle.graph.color[i] ← c;
ENDLOOP;
}; -- UseDefaultColors
UseCedarColors: PUBLIC PROC[] = {
virtual: Terminal.Virtual = Terminal.Current[];
ImagerColorMap.SetStandardColorMap[virtual];
WindowManager.RestoreCursor[];
IF Terminal.GetColorCursorPresentation[virtual] # onesAreBlack THEN
[] ← Terminal.SetColorCursorPresentation[virtual, onesAreBlack];
}; -- UseCedarColors
SetCursorForBackgroundIndex: PUBLIC PROC [bkgnd: BackgroundIndex ← white] = {
bkGndColor: Imager.ConstantColor ← SELECT bkgnd FROM
gray => systemColor[13], darkGray => systemColor[14], black => systemColor[15],
ENDCASE => systemColor[0];
cursorType: Terminal.ColorCursorPresentation ←
IF ImagerColor.GrayFromColor[bkGndColor] > 0.5 THEN onesAreWhite ELSE onesAreBlack;
virtual: Terminal.Virtual ← Terminal.Current[];
IF cursorType # Terminal.GetColorCursorPresentation[virtual] THEN
[] ← Terminal.SetColorCursorPresentation[virtual, cursorType];
}; -- SetCursorForBackgroundIndex
UseDefaultFonts: PUBLIC PROC [handle: GraphHandle] = {
handle must not be nil !!
GetFont: PUBLIC PROC [num: FontIndex] RETURNS [gf: GraphFont] = {
get font spec from user profile, or return default
FontSpec: TYPE = LIST OF ROPE;
keyRope: ROPE ← Rope.Concat["Graph.Font", Convert.RopeFromInt[num]];
list: FontSpec ← UserProfile.ListOfTokens[key: keyRope, default: NIL];
i: CARDINAL ← 1;
gf ← defaultFontsArray[num];
FOR lr: FontSpec ← list, list.rest UNTIL list = NIL OR i > 3 DO
SELECT i FROM
1 => gf.family ← list.first;
2 => gf.bold ← Convert.BoolFromRope[list.first ! Convert.Error => {gf.bold ← FALSE; CONTINUE}];
3 => gf.italic ← Convert.BoolFromRope[list.first ! Convert.Error => {gf.italic ← FALSE; CONTINUE}];
4 => gf.vFontSize ← Convert.IntFromRope[list.first ! Convert.Error => {gf.vFontSize ← 8; CONTINUE}];
5 => gf.pFontScale ← Convert.RealFromRope[list.first ! Convert.Error => {gf.pFontScale ← 9.0; CONTINUE}];
ENDCASE => BlinkMsg[Rope.Cat[
"more than five values found in profile after '", keyRope, "'."]];
i ← i + 1;
ENDLOOP;
}; -- GetFont
FOR i: FontIndex IN FontIndex DO
handle.graph.font[i] ← GetFont[i];
ENDLOOP;
UseMyFonts[handle];
}; -- UseDefaultFonts
UseMyFonts: PUBLIC PROC [handle: GraphHandle] = { OPEN handle;
handle can not be nil !! for vfonts only, but display is not altered.
press fonts are initialized when user wants to print the plot.
FOR i: FontIndex IN FontIndex DO OPEN handle;
pFontName: ROPE ← Rope.Cat[
"Xerox/PressFonts/",
graph.font[i].family,
Rope.Concat[
IF graph.font[i].bold THEN "-b" ELSE "-m",
IF graph.font[i].italic THEN "ir" ELSE "rr"]
];
pFont: ImagerFont.Font;
pFont ← ImagerFont.Find[pFontName
! Imager.Error => {
pFont ← ImagerFont.Find["Xerox/PressFonts/TimesRoman-mrr"];
CONTINUE}];
imagerFonts[interpress][i] ← ImagerFont.Scale[pFont, graph.font[i].pFontScale
! Imager.Error => {
imagerFonts[interpress][i] ← ImagerFont.Scale[pFont, 9.0];
CONTINUE}];
imagerFonts[screen][i] ← VFonts.EstablishFont[graph.font[i].family, graph.font[i].vFontSize, graph.font[i].bold, graph.font[i].italic];
ENDLOOP;
}; -- UseMyFonts
coordinates and coordinates transformation
InViewer: PUBLIC PROC [viewer: Viewer ← NIL, x, y: INTEGER ← 0] RETURNS [BOOL] ~ {
IF viewer = NIL THEN RETURN[FALSE];
RETURN[x IN[0..viewer.cw) AND y IN[0..viewer.ch)]};
CrossSegment: PUBLIC PROC[xseg, yseg: SegmentDataList ← NIL, at: REAL ← 0.0] RETURNS [ok: BOOL ← FALSE, v1, v2: Imager.VEC ← NullVec] = {
find the segment that crosses the vertical line, x = at.
IF xseg # NIL THEN IF xseg.rest # NIL THEN {
ok ← TRUE;
IF xseg.first.end >= at THEN GOTO normal
ELSE FOR xseg ← xseg, xseg.rest UNTIL xseg = NIL DO
IF xseg.rest = NIL THEN GOTO right;
v1 ← [xseg.first.end, yseg.first.end];
IF xseg.rest.first.end > at THEN GOTO normal;
yseg ← yseg.rest;
ENDLOOP;
EXITS
right => v2 ← [xseg.first.end, yseg.first.end]; -- Note: that v1.x may still be = v2.x.
normal => {
v1 ← [xseg.first.end, yseg.first.end];
v2 ← [xseg.rest.first.end, yseg.rest.first.end];
};
};
}; -- CrossSegment
InterOrExtraPolate: PUBLIC PROC[v1, v2: Imager.VEC ← NullVec, x: REAL ← 0.0] RETURNS [REAL] = {
Client should make sure that x1 # x2.
IF v1.x = v2.x THEN RaiseError[$Other, "x1 = x2 in InterOrExtraPolate"];
RETURN[v1.y + (v2.y - v1.y)/(v2.x - v1.x)*(x - v1.x)]
}; -- InterOrExtraPolate
Crosssections: PUBLIC PROC[xseg, yseg: SegmentDataList ← NIL, at: REAL ← 0.0] RETURNS [ok: BOOL ← FALSE, value: REAL] = {
v1, v2: Imager.VEC;
[ok, v1, v2] ← CrossSegment[xseg, yseg, at];
IF ok THEN {
IF v1.x = v2.x THEN {value ← v1.y; ok ← FALSE}
ELSE value ← InterOrExtraPolate[v1, v2, at];
};
}; -- Crosssection
RealToScreen: PUBLIC PROC [handle: GraphHandle ← NIL, r: REAL ← 0.0, xy: XY ← x] RETURNS [s: REAL ← 0] = {
IF HandleNotNil[handle] THEN { OPEN handle;
RETURN[IF xy = x THEN axesRect.x + (r - realRect.x)*scale[x] ELSE axesRect.y + (r - realRect.y)*scale[y]]};
}; -- RealToScreen
RealToScreenI: PUBLIC PROC [handle: GraphHandle ← NIL, r: REAL ← 0.0, xy: XY ← x] RETURNS [s: INTEGER] = {
rs: REAL ← RealToScreen[handle, r, xy];
IF rs > LAST[INTEGER] OR rs < FIRST[INTEGER] THEN {
s ← IF rs > 0 THEN LAST[INTEGER] ELSE FIRST[INTEGER];
BlinkMsg["The place is too far off the screen."];
}
ELSE s ← Real.RoundI[rs];
}; -- RealToScreenI
RealVecToScreenVec: PUBLIC PROC [handle: GraphHandle ← NIL, vec: Imager.VEC ← NullVec] RETURNS [svec: Imager.VEC ← NullVec] = {
IF HandleNotNil[handle] THEN RETURN[
[RealToScreen[handle, vec.x, x], RealToScreen[handle, vec.y, y]]];
}; -- RealVecToScreenVec
RealToScreenRel: PUBLIC PROC [handle: GraphHandle ← NIL, r: REAL ← 0.0, xy: XY ← x] RETURNS [s: REAL ← 0.0] = { -- relative to origin of the axes.
IF HandleNotNil[handle] THEN { OPEN handle;
RETURN[IF xy = x THEN (r - realRect.x)*scale[x] ELSE (r - realRect.y)*scale[y]];
};
}; -- RealToScreen
ScreenToReal: PUBLIC PROC [handle: GraphHandle ← NIL, s: REAL ← 0.0, xy: XY ← x] RETURNS [r: REAL ← 0.0] = {
IF HandleNotNil[handle] THEN { OPEN handle;
RETURN[IF xy = x THEN realRect.x + (s - axesRect.x)/scale[x] ELSE realRect.y + (s - axesRect.y)/scale[y]];
};
}; -- ScreenToReal
ScreenIToReal: PUBLIC PROC [handle: GraphHandle ← NIL, s: INTEGER ← 0, xy: XY ← x] RETURNS [REAL] = {RETURN[ScreenToReal[handle, Real.Float[s], xy]]}; -- ScreenIToReal
ScreenIToRealVec: PUBLIC PROC [handle: GraphHandle ← NIL, sx, sy: INTEGER ← 0] RETURNS [Imager.VEC ← NullVec] = {
RETURN[[ScreenToReal[handle, Real.Float[sx], x], ScreenToReal[handle, Real.Float[sy], y]]]}; -- ScreenIToRealVec
TextPosToChartPos: PUBLIC PROC[axesRect: Imager.Rectangle ← NullRect, textPos: Imager.VEC ← NullVec] RETURNS [chartPos: Imager.VEC ← NullVec] = {
IF RectangleValid[axesRect] THEN {
chartPos.x ← axesRect.x + textPos.x*axesRect.w;
chartPos.y ← axesRect.y + textPos.y*axesRect.h;
};
}; -- TextPosToChartPos
ChartPosToTextPos: PUBLIC PROC[axesRect: Imager.Rectangle ← NullRect, chartPos: Imager.VEC ← NullVec] RETURNS [textPos: Imager.VEC ← NullVec] = {
IF RectangleValid[axesRect] THEN {
textPos.x ← (chartPos.x - axesRect.x)/axesRect.w;
textPos.y ← (chartPos.y - axesRect.y)/axesRect.h;
};
}; -- ChartPosToTextPos
TextRect: PUBLIC PROC[text: Text ← NIL, font: ImagerFont.Font ← NIL, axesRect: Imager.Rectangle ← NullRect] RETURNS [rect: Imager.Rectangle ← NullRect, hotPoint: Imager.VEC ← NullVec] = {
returns the rectangle and hotpoint of text on graph viewer.
IF text # NIL AND font # NIL THEN {
extents: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[font, text.text];
rect.w ← extents.rightExtent - extents.leftExtent;
rect.h ← extents.descent + extents.ascent;
hotPoint ← TextPosToChartPos[axesRect, text.place];
rect.x ← hotPoint.x - extents.leftExtent - (SELECT text.justifX FROM
right => rect.w, center => rect.w*0.5, ENDCASE => 0.0);
rect.y ← hotPoint.y + extents.descent - (SELECT text.justifY FROM
top => rect.h, center => rect.h*0.5, ENDCASE => 0.0);
};
}; -- TextRect
panel fields
SetToggleColor: PUBLIC PROC[switch: Buttons.Button ← NIL, on: BOOL ← TRUE, paint: BOOL ← TRUE] RETURNS [BOOL] = {
IF ViewerNotNil[switch] THEN
Buttons.SetDisplayStyle[switch, IF on THEN $WhiteOnBlack ELSE $BlackOnWhite, paint];
RETURN[on];
}; -- SetToggleColor
SetIntField: PUBLIC PROC[field: Viewer ← NIL, value: INT ← 0] = {
IF ViewerNotNil[field] THEN
ViewerTools.SetContents[field, Convert.RopeFromInt[value]];
}; -- SetIntField
GetIntField: PUBLIC PROC[field: Viewer ← NIL, showMsg: BOOL ← TRUE] RETURNS [msg: ROPE ← NIL, int: INT ← 0] = {
IF ViewerNotNil[field] THEN
int ← Convert.IntFromRope[ViewerTools.GetContents[field] !
Convert.Error => {
msg ← SELECT reason FROM
empty => "field empty",
syntax => Rope.Cat["syntax error at location [", Convert.RopeFromInt[index], "]"],
overflow => "input string cannot be expressed as an INT",
ENDCASE => "error in convertion";
IF showMsg THEN BlinkMsg[msg.Cat[" in the ",
NARROW[ViewerOps.FetchProp[field, $Label]], " field."]];
int ← 0;
CONTINUE;
}
];
}; -- GetIntField
SetRealField: PUBLIC PROC[field: Viewer ← NIL, value: REAL ← 0.0] = {
IF ViewerNotNil[field] THEN
ViewerTools.SetContents[field, Convert.RopeFromReal[value]];
}; -- SetRealField
GetRealField: PUBLIC PROC[field: Viewer ← NIL, showMsg: BOOL ← TRUE] RETURNS [msg: ROPE ← NIL, real: REAL ← 0.0] = {
IF ViewerNotNil[field] THEN {
real ← Convert.RealFromRope[ViewerTools.GetContents[field] !
Convert.Error => {
msg ← SELECT reason FROM
empty => "field empty",
syntax => Rope.Cat["syntax error at location [", Convert.RopeFromInt[index], "]"],
ENDCASE => "convertion error";
IF showMsg THEN BlinkMsg[msg.Cat["in the ",
NARROW[ViewerOps.FetchProp[field, $Label]], " field."]];
real ← 0.0;
CONTINUE;
}
];
};
}; -- GetRealField
text and entity
FontHeight: PUBLIC PROC [font: ImagerFont.Font ← NIL] RETURNS [height: REAL ← 0] = {
IF font # NIL THEN {
extents: ImagerFont.Extents ← ImagerFont.FontBoundingBox[font];
height ← extents.descent+extents.ascent;
};
}; -- FontHeight
FullName: PUBLIC PROC [entity: Entity ← NIL] RETURNS [fullName: ROPE ← NIL] = {
Returns the full name of the entity.
IF entity # NIL THEN {
fullName ← entity.name;
FOR gen: NestedEntities ← entity.parent, gen.parent UNTIL gen = NIL DO
fullName ← IF gen.parent = NIL AND gen.name = NIL THEN fullName
ELSE IF gen.name = NIL THEN Rope.Concat["/", fullName]
ELSE gen.name.Cat["/", fullName];
ENDLOOP;
};
}; -- FullName
TextFromId: PUBLIC PROC[texts: Texts ← NIL, id: INT ← 0] RETURNS [text: Text ← NIL] = {
FOR ts: Texts ← texts, ts.rest UNTIL ts = NIL DO
IF ts.first.id = id THEN text ← ts.first;
ENDLOOP;
}; -- TextFromId
EntityFromId: PUBLIC PROC[ref: REF ANY ← NIL, id: INT ← 0] RETURNS [entity: Entity ← NIL] = { -- ref may be EntityList or EntityHash.
entityList: EntityList ← NIL;
IF ISTYPE[ref, EntityList] THEN entityList ← NARROW[ref]
ELSE IF ISTYPE[ref, EntityHash] THEN {
hash: EntityHash ← NARROW[ref];
entityList ← hash[id MOD EntityHashSize];
};
FOR el: EntityList ← entityList, el.rest UNTIL el = NIL DO
IF el.first.id = id THEN entity ← el.first;
ENDLOOP;
}; -- EntityFromId
PanelIndexedText: PUBLIC PROC [controller: Controller ← NIL, texts: Texts ← NIL] RETURNS [text: Text ← NIL] = {
get it from the id specified on panel.
IF ControllerNotNil[controller] THEN {
msg: ROPE; i: INT;
[msg, i] ← GetIntField[controller.textId];
IF msg = NIL THEN {
text ← TextFromId[texts, i];
IF text = NIL THEN BlinkMsg[Rope.Concat[
"There is no text with id = ", Convert.RopeFromInt[i]]];
};
};
}; -- PanelIndexedText
PanelIndexedEntity: PUBLIC PROC [controller: Controller ← NIL, ref: REF ANY ← NIL] RETURNS [entity: Entity ← NIL] = { -- ref may be an entityList or an entityHash.
IF ControllerNotNil[controller] THEN {
msg: ROPE; i: INT;
[msg, i] ← GetIntField[controller.entityId];
IF msg = NIL THEN {
entity ← EntityFromId[ref, i];
IF entity = NIL THEN BlinkMsg[Rope.Concat[
"There is no curve with id = ", Convert.RopeFromInt[i]]];
};
};
}; -- PanelIndexedEntity
ReverseTexts: PUBLIC PROC [old: Texts, killOld: BOOL ← TRUE] RETURNS [new: Texts] = { -- killOld only "partially" kills the old list.
new ← NIL;
FOR ts: Texts ← old, ts.rest UNTIL ts = NIL DO
new ← CONS[ts.first, new];
ENDLOOP;
IF killOld THEN old ← GraphCleanUp.CleanUpTexts[old, FALSE];
}; -- ReverseTexts
ReverseEntityList: PUBLIC PROC [old: EntityList, killOld: BOOL ← TRUE] RETURNS [new: EntityList] = { -- killOld only "partially" kills the old list.
new ← NIL;
FOR el: EntityList ← old, el.rest UNTIL el = NIL DO
new ← CONS[el.first, new];
ENDLOOP;
IF killOld THEN old ← GraphCleanUp.CleanUpEL[old, FALSE];
}; -- ReverseEntityList
ReverseValueList: PUBLIC PROC [old: ValueList ← NIL, killOld: BOOL ← TRUE] RETURNS [new: ValueList] = {
new ← NIL;
FOR vl: ValueList ← old, vl.rest UNTIL vl = NIL DO
new ← CONS[vl.first, new];
ENDLOOP;
IF killOld THEN old ← GraphCleanUp.CleanUpVL[old];
}; -- ReverseValueList
CopyValueList: PUBLIC PROC [old: ValueList ← NIL] RETURNS [new: ValueList] = {
new ← ReverseValueList[old, FALSE];
new ← ReverseValueList[new, TRUE];
}; -- CopyValueList
ReverseSDL: PUBLIC PROC [old: SegmentDataList ← NIL, killOld: BOOL ← TRUE] RETURNS [new: SegmentDataList] = {
new ← NIL;
FOR sdl: SegmentDataList ← old, sdl.rest UNTIL sdl = NIL DO
new ← CONS[sdl.first, new];
ENDLOOP;
IF killOld THEN old ← GraphCleanUp.CleanUpSDL[old];
}; -- ReverseSDL
InitSegEnd: PUBLIC PROC [entity: Entity ← NIL] = {
entity.segments ← NIL;
FOR vl: ValueList ← entity.oldValues, vl.rest UNTIL vl = NIL DO
entity.segments ← CONS[NEW[SegmentDataRec ← [end: vl.first]],
entity.segments];
ENDLOOP;
entity.segments ← ReverseSDL[entity.segments];
}; -- InitSegEnd
InitSegAll: PUBLIC PROC [entity: Entity ← NIL] = {
xseg: SegmentDataList ← entity.group.x.segments; -- should have been initialized.
InitSegEnd[entity];
IF entity.segments # NIL THEN
FOR yseg: SegmentDataList ← entity.segments, yseg.rest UNTIL yseg.rest = NIL DO
x1: REAL ← xseg.first.end;
x2: REAL ← xseg.rest.first.end;
y1: REAL ← yseg.first.end;
y2: REAL ← yseg.rest.first.end;
a: REAL ← y2 - y1;
b: REAL ← x1 - x2;
factor: REAL ← 1.0/RealFns.SqRt[a*a+b*b];
yseg.first^ ← [end: y1, nx: a*factor, ny: b*factor, d0: (x1*y2 - x2*y1)*factor];
xseg ← xseg.rest;
ENDLOOP;
}; -- InitSegAll
UpdateSegEnd: PUBLIC PROC [entity: Entity, values: ValueList] = {
vl: ValueList ← values;
IF values = NIL THEN RETURN;
FOR sdl: SegmentDataList ← entity.segments, sdl.rest UNTIL sdl = NIL DO
sdl.first.end ← vl.first;
vl ← vl.rest;
ENDLOOP;
}; -- UpdateSegEnd
UpdateSegAll: PUBLIC PROC [entity: Entity, values: ValueList] = {
xseg: SegmentDataList ← entity.group.x.segments;
IF values = NIL THEN RETURN;
UpdateSegEnd[entity, values];
FOR yseg: SegmentDataList ← entity.segments, yseg.rest UNTIL yseg.rest = NIL DO
x1: REAL ← xseg.first.end;
x2: REAL ← xseg.rest.first.end;
y1: REAL ← yseg.first.end;
y2: REAL ← yseg.rest.first.end;
a: REAL ← y2 - y1;
b: REAL ← x1 - x2;
factor: REAL ← 1.0/RealFns.SqRt[a*a+b*b];
yseg.first^ ← [end: y1, nx: a*factor, ny: b*factor, d0: (x1*y2 - x2*y1)*factor];
xseg ← xseg.rest;
ENDLOOP;
}; -- UpdateSegAll
graphs and entity groups
CopyEntityGroupList: PUBLIC PROC[entityGroupList: EntityGroupList ← NIL, max: INT ← 0]
RETURNS [new: EntityGroupList ← NIL, incomplete: BOOL ← FALSE] = {
copy at most max elements on a to b and preserve the order.
if there are more than max elements on a then set incomplete to TRUE.
n: INT ← 0;
FOR eg: EntityGroup ← entityGroupList.first, eg.rest UNTIL eg = NIL OR n >= max DO
eg: EntityGroup; m: INT;
[eg, m, incomplete] ← CopyEntityGroup[eg, max - n];
new ← CONS[t, new];
n ← n + m;
ENDLOOP;
}; -- CopyEntityGroupList
CopyEntityGroup: PUBLIC PROC[entityGroup: EntityGroup ← NIL, max: INT ← 0] RETURNS [
new: EntityGroup ← NIL, m: INT ← 0, incomplete: BOOL ← FALSE] = {
n: INT ← 0;
FOR ne: NestedEntities ← entityGroup.y, ne.child UNTIL ne = NIL OR n >= max DO
el: EntityList; m: INT;
[el, m, incomplete] ← CopyEntities[ne, max - n];
new ← CONS[t, new];
n ← n + m;
ENDLOOP;
}; -- CopyEntityGroup
MergeGraph: PUBLIC PROC[handle: GraphHandle ← NIL, graph: GRAPH ← NIL, paint: BOOL ← TRUE] = {
}; -- MergeGraph
ReplaceGraph: PUBLIC PROC[handle: GraphHandle ← NIL, graph: GRAPH ← NIL, paint: BOOL ← TRUE] = {
}; -- ReplaceGraph
VanilaGraph: PUBLIC PROC[] RETURNS [graph: GRAPH] = {
graph ← NEW[GraphRec ← []];
FOR i: CaretIndex IN CaretIndex DO
graph.caret[i] ← NEW[CaretSpecRec ← []];
ENDLOOP;
FOR xy: XY IN XY DO
graph.target[xy] ← NEW[TargetSpecRec ← []];
ENDLOOP;
}; -- VanilaGraph
strings
FileFromSelection: PUBLIC PROC[] RETURNS [file, msg: ROPE ← NIL] = {
file ← ViewerTools.GetSelectionContents[];
IF file.IsEmpty[] THEN msg ← "Please select a file name."
ELSE [file, ] ← FS.ExpandName[file !
FS.Error => {msg ← error.explanation; CONTINUE}];
}; -- FileFromSelection
ReplaceFileExt: PUBLIC PROC[file: ROPE, extension: ROPE ← NIL] RETURNS [ROPE] = {
cp: FS.ComponentPositions;
fullName, msg: ROPE;
ok: BOOL ← TRUE;
IF file.IsEmpty[] THEN msg ← "File name is empty";
IF msg = NIL THEN [fullName, cp, ] ← FS.ExpandName[file !
FS.Error => {
msg ← error.explanation;
CONTINUE}];
IF msg = NIL THEN RETURN[fullName.Substr[0, cp.base.start + cp.base.length].Cat[".", extension]]
ELSE {
BlinkMsg[msg.Concat[". Graph.graph is used instead."]];
RETURN["Graph.graph"];
};
}; -- ReplaceFileExt
viewer, handle, properties
HandleFromViewer: PUBLIC PROC[viewer: Viewer ← NIL] RETURNS [GraphHandle] = {
RETURN[
IF IsGraphViewer[viewer] THEN NARROW[viewer.data]
ELSE IF IsController[viewer] THEN NARROW[
ViewerOps.FetchProp[viewer, $GraphController]]
ELSE NIL
];
}; -- HandleFromViewer
VanillaHandle: PUBLIC PROC [] RETURNS [handle: GraphHandle ← NIL] = {
handle ← NEW[GraphHandleRec ← []];
{ OPEN handle;
chart ← VanillaChart[];
graph ← VanillaGraph[];
entityHash ← NEW[EntityHashArray ← ALL[NIL]];
imagerFonts ← [NEW[FontArray ← ALL[NIL]], NEW[FontArray ← ALL[NIL]]];
paintInfo ← NEW[PaintInfoRec ← []];
TRUSTED {Process.SetTimeout[@unlocked, Process.MsecToTicks[500]]};
};
}; -- VanillaHandle
VanillaChart: PROC [] RETURNS [chart: Chart ← NIL] = {
chart ← NEW[ChartRec ← []];
FOR i: CaretIndex IN CaretIndex DO
chart.caretState[i] ← NEW[CaretStateRec ← []]; ENDLOOP;
}; -- VanillaChart
VanillaGraph: PROC [] RETURNS [graph: GRAPH ← NIL] = {
graph ← NEW[GraphRec ← []];
FOR i: CaretIndex IN CaretIndex DO
graph.caret[i] ← NEW[CaretSpecRec ← []]; ENDLOOP;
FOR i: XY IN XY DO
graph.target[i] ← NEW[TargetSpecRec ← []]; ENDLOOP;
graph.color ← NEW[GraphColorsArray ← defaultColorsArray];
graph.font ← NEW[GraphFontsArray ← defaultFontsArray];
}; -- VanillaGraph
AddProp: PUBLIC PROC [object: REF ANY, prop: ATOM, val: REF ANY] = {
WITH object SELECT FROM
c: Entity => ATOM.PutPropOnList[c.props, prop, val];
cs: EntityList => ATOM.PutPropOnList[cs.props, prop, val];
t: Text => ATOM.PutPropOnList[t.props, prop, val];
ENDCASE => RaiseError[$UnknowObject, "in AddProp"];
}; -- AddProp
FetchProp: PUBLIC PROC [object: REF ANY, prop: ATOM] RETURNS [val: REF ANY] = {
WITH object SELECT FROM
c: Entity => val ← ATOM.GetPropFromList[c.props, prop];
cs: EntityList => val ← ATOM.GetPropFromList[cs.props, prop];
t: Text => val ← ATOM.GetPropFromList[t.props, prop];
ENDCASE => RaiseError[$UnknowObject, "in FetchProp"];
}; -- FetchProp
misc
Almost: PUBLIC PROC [p, q: REAL] RETURNS [a: BOOL ← TRUE] = {
max: REAL ← MAX[ABS[p], ABS[q]];
IF max # 0.0 THEN a ← (ABS[p - q]/max) < 0.00001;
}; -- Almost
DataBounds: PUBLIC PROC[entityList: EntityList ← NIL] RETURNS [Imager.Box] = {
xmin, ymin, xmax, ymax: REAL;
prevX: Entity ← NIL;
IF entityList = NIL THEN RETURN[NullBox];
xmin ← ymin ← Real.LargestNumber;
xmax ← ymax ← -xmin;
FOR el: EntityList ← entityList, el.rest UNTIL el = NIL DO
currX: Entity ← el.first.group.x;
IF currX # prevX THEN {
FOR sdl: SegmentDataList ← currX.segments, sdl.rest UNTIL sdl = NIL DO
xmin ← MIN[sdl.first.end, xmin];
xmax ← MAX[sdl.first.end, xmax];
ENDLOOP;
prevX ← currX;
};
FOR sdl: SegmentDataList ← el.first.segments, sdl.rest UNTIL sdl = NIL DO
ymin ← MIN[sdl.first.end, ymin];
ymax ← MAX[sdl.first.end, ymax];
ENDLOOP;
ENDLOOP;
RETURN[[xmin, ymin, xmax, ymax]];
}; -- DataBounds
Print: PUBLIC PROC[handle: GraphHandle ← NIL] = {
IF HandleNotNil[handle] THEN IF handle.graph # NIL THEN { OPEN handle;
coordRatio: REAL = 0.25/600.0; -- 0.25 m ~ 600 pixels
InterpressDrawGraph: PUBLIC PROC[context: Imager.Context] ~ {
context.RotateT[90];
context.ScaleT[coordRatio];
Draw[context, handle];
};
fileName: ROPE ← ReplaceFileExt[graph.fileName, "ip"];
interpress: ImagerInterpress.Ref ← NIL;
paintInfo.item ← all;
paintInfo.action ← paint;
paintInfo.output ← interpress;
paintInfo.clear ← FALSE;
interpress ← ImagerInterpress.Create[fileName
! FS.Error => {BlinkMsg[error.explanation]; GOTO skip}];
ImagerInterpress.DoPage[interpress, InterpressDrawGraph];
ImagerInterpress.Close[interpress];
MessageWindow.Append[Rope.Cat[fileName, " is written."], TRUE];
EXITS
skip => NULL;
};
}; -- Print
}.
LOG.
SChen, October 9, 1985 8:59:32 pm PDT, created.