DIRECTORY
Buttons USING [Button, SetDisplayStyle],
Convert USING [BoolFromRope, Error, IntFromRope, RealFromRope, RopeFromInt, RopeFromReal],
FS USING [Error, ComponentPositions, ExpandName],
Graph USING [BackgroundIndex, CaretIndex, CaretSpecRec, CaretStateRec, Chart, ChartRec, ColorIndex, Controller, Entity, EntityGroup, EntityGroupList, EntityHash, EntityHashArray, EntityHashSize, EntityList, FontArray, FontIndex, GRAPH, GraphColorsArray, GraphFont, GraphFontsArray, GraphHandle, GraphHandleRec, GraphRec, NestedEntities, NullRect, NullVec, OutputType, ROPE, SegmentDataList, SegmentData, SegmentDataRec, TargetSpecRec, Text, Texts, ValueList, Viewer, XY],
GraphCleanUp USING [CleanUpEL, CleanUpSDL, CleanUpTexts, CleanUpVL],
GraphOps USING [Black, DarkGray, Gray, White],
GraphPrivate USING [defaultColors, defaultFonts, IsController, IsGraphViewer, systemColor],
GraphUtil,
Imager USING [Box, ConstantColor, Rectangle, VEC],
ImagerColor USING [GrayFromColor, RGB],
ImagerColorDefs USING [ConstantColor],
ImagerColorMap USING [LoadEntries, MapEntry, SetStandardColorMap],
ImagerDitheredDevice USING [ColorFromSpecialRGB],
ImagerFont USING [Extents, Font, FontBoundingBox, RopeBoundingBox],
IO USING [int, PutFR],
MessageWindow USING [Append, Blink],
Process USING [MsecToTicks, SetTimeout],
Real USING [Float, LargestNumber, RealException, 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, GraphUtil, ImagerColor, ImagerColorMap, ImagerDitheredDevice, ImagerFont, IO, MessageWindow, Process, Real, RealFns, Rope, Terminal, UserProfile, VFonts, ViewerOps, ViewerTools, WindowManager
EXPORTS Graph, GraphUtil = { OPEN Graph, GraphPrivate, GraphUtil;
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[GraphOps.Black]
ELSE IF background = black OR background = darkGray THEN systemColor[GraphOps.White]
ELSE systemColor[GraphOps.Black]];
}; -- ForegroundColor
BackgroundColor:
PUBLIC
PROC[background: BackgroundIndex ← white, output: OutputType ← screen]
RETURNS [Imager.ConstantColor] ={
RETURN[
IF output = interpress
THEN systemColor[GraphOps.White]
ELSE
SELECT background
FROM
gray => systemColor[GraphOps.Gray],
darkGray => systemColor[GraphOps.DarkGray],
black => systemColor[GraphOps.Black],
ENDCASE => systemColor[GraphOps.White]];
}; -- 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 ← [
defaultColors[num].R, defaultColors[num].G, defaultColors[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[GraphOps.Gray],
darkGray => systemColor[GraphOps.DarkGray],
black => systemColor[GraphOps.Black],
ENDCASE => systemColor[GraphOps.White];
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 ← defaultFonts[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 or when font is updated through control-panel.
FOR i: FontIndex
IN FontIndex
DO
OPEN handle;
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, x, y:
INTEGER]
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, at:
REAL]
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 {
IF GraphUtil.NotANan[xseg.first.end] THEN IF xseg.first.end >= at THEN GOTO normal;
FOR xseg ← xseg, xseg.rest
UNTIL xseg =
NIL
DO
IF xseg.rest = NIL THEN GOTO right;
v1 ← [xseg.first.end, yseg.first.end];
IF GraphUtil.NotANan[xseg.rest.first.end]
THEN
IF xseg.rest.first.end > at THEN GOTO normal;
yseg ← yseg.rest;
ENDLOOP;
EXITS
right => {
IF GraphUtil.NotANan[v1.x]
AND GraphUtil.NotANan[v1.y]
AND
GraphUtil.NotANan[xseg.first.end] AND GraphUtil.NotANan[yseg.first.end] THEN {
ok ← TRUE;
v2 ← [xseg.first.end, yseg.first.end]; -- Note: that v1.x may still be = v2.x.
};
};
normal => {
IF GraphUtil.NotANan[xseg.first.end]
AND GraphUtil.NotANan[yseg.first.end]
AND
GraphUtil.NotANan[xseg.rest.first.end] AND GraphUtil.NotANan[yseg.rest.first.end] THEN {
ok ← TRUE;
v1 ← [xseg.first.end, yseg.first.end];
v2 ← [xseg.rest.first.end, yseg.rest.first.end];
};
};
};
}; -- CrossSegment
InterOrExtraPolate:
PUBLIC
PROC[v1, v2: Imager.
VEC, x:
REAL]
RETURNS [
REAL] = {
Client should make sure that x1 # x2, and their components are not NtNan.
IF v1.x = v2.x THEN RaiseError[$Other, "x1 = x2 in InterOrExtraPolate"]; -- for now.
RETURN[v1.y + (v2.y - v1.y)/(v2.x - v1.x)*(x - v1.x)]
}; -- InterOrExtraPolate
Crosssection:
PUBLIC
PROC[xseg, yseg: SegmentDataList, at:
REAL]
RETURNS [ok:
BOOL ←
FALSE, value:
REAL] = {
v1, v2: Imager.VEC;
[ok, v1, v2] ← CrossSegment[xseg, yseg, at];
IF ok
THEN {
-- v1 and v2 don't have NtNan as component.
IF v1.x = v2.x THEN {value ← v1.y; ok ← FALSE}
ELSE value ← InterOrExtraPolate[v1, v2, at];
};
}; -- Crosssection
RealToScreen:
PUBLIC
PROC [handle: GraphHandle, r:
REAL, 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, r:
REAL, 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, vec: Imager.
VEC]
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, r:
REAL, 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]];
};
}; -- RealToScreenRel
ScreenToReal:
PUBLIC
PROC [handle: GraphHandle, s:
REAL, 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, s:
INTEGER, xy:
XY ← x]
RETURNS [
REAL] = {
RETURN[ScreenToReal[handle, Real.Float[s], xy]]};
-- ScreenIToReal
ScreenIToRealVec:
PUBLIC
PROC [handle: GraphHandle, sx, sy:
INTEGER]
RETURNS [Imager.
VEC ← NullVec] = {
RETURN[[ScreenToReal[handle, Real.Float[sx], x], ScreenToReal[handle, Real.Float[sy], y]]]}; -- ScreenIToRealVec
TextPosToChartPos:
PUBLIC
PROC[axesRect: Imager.Rectangle, textPos: Imager.
VEC]
RETURNS [x, y:
INTEGER ← 0] = {
IF RectangleValid[axesRect]
THEN {
x ← Real.RoundI[axesRect.x + textPos.x*axesRect.w];
y ← Real.RoundI[axesRect.y + textPos.y*axesRect.h];
};
}; -- TextPosToChartPos
ChartPosToTextPos:
PUBLIC
PROC[axesRect: Imager.Rectangle, chartPos: Imager.
VEC]
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.x, hotPoint.y] ← 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
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
RopeSize:
PUBLIC
PROC [rope:
ROPE ←
NIL, font: ImagerFont.Font]
RETURNS [width, height:
REAL ← 0] = {
IF
NOT rope.IsEmpty[]
THEN {
extents: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[font: font, rope: rope];
width ← extents.rightExtent - extents.leftExtent;
height ← extents.descent + extents.ascent;
};
}; -- RopeSize
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[entityList: EntityList, id:
INT]
RETURNS [entity: Entity ←
NIL] = {
-- ref may be EntityList or EntityHash.
FOR el: EntityList ← entityList, el.rest
UNTIL el =
NIL
DO
IF el.first.id = id THEN entity ← el.first;
ENDLOOP;
}; -- EntityFromId
SpecIndexedText:
PUBLIC
PROC [controller: Controller ←
NIL, texts: Texts ←
NIL]
RETURNS [text: Text ←
NIL] = {
get it from the id specified on spec.
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]]];
};
};
}; -- SpecIndexedText
SpecIndexedEntity:
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 {
entityList: EntityList;
entityList ←
WITH ref
SELECT
FROM
h: EntityHash => h[i MOD EntityHashSize],
e: EntityList => e,
ENDCASE => NIL;
entity ← EntityFromId[entityList, i];
IF entity =
NIL
THEN BlinkMsg[Rope.Concat[
"There is no curve with id = ", Convert.RopeFromInt[i]]];
};
};
}; -- SpecIndexedEntity
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, last: ValueList ←
NIL] = {
FOR vl: ValueList ← old, vl.rest
UNTIL vl =
NIL
DO
new ← CONS[vl.first, new];
IF vl = old THEN last ← new;
ENDLOOP;
IF killOld THEN old ← GraphCleanUp.CleanUpVL[old];
}; -- ReverseValueList
CopyValueList:
PUBLIC
PROC [old: ValueList ←
NIL, killOld:
BOOL ←
TRUE]
RETURNS [new, last: ValueList] = {
[new, ] ← ReverseValueList[old, killOld];
[new, last] ← ReverseValueList[new, TRUE];
}; -- CopyValueList
ReverseSDL:
PUBLIC
PROC [old: SegmentDataList ←
NIL, killOld:
BOOL ←
TRUE]
RETURNS [new, last: SegmentDataList ←
NIL] = {
FOR sdl: SegmentDataList ← old, sdl.rest
UNTIL sdl =
NIL
DO
new ← CONS[sdl.first, new];
IF sdl = old THEN last ← new;
ENDLOOP;
IF killOld THEN old ← GraphCleanUp.CleanUpSDL[old];
}; -- ReverseSDL
InitSegEnd:
PUBLIC
PROC [entity: Entity ←
NIL] = {
sdl: SegmentDataList ← NIL;
entity.segments ← NIL;
FOR vl: ValueList ← entity.oldValues, vl.rest
UNTIL vl =
NIL
DO
sdl ← CONS[NEW[SegmentDataRec ← [end: vl.first]], sdl];
ENDLOOP;
[entity.segments, entity.lastSegment] ← ReverseSDL[sdl];
}; -- InitSegEnd
SetSegment:
PROC [seg: SegmentData, x1, x2, y2:
REAL] = {
IF seg #
NIL
THEN {
ENABLE Real.RealException => {seg^ ← [ok: FALSE, end: seg.end]; CONTINUE};
a, b, factor: REAL;
IF GraphUtil.NotANan[x1]
AND GraphUtil.NotANan[x2]
AND GraphUtil.NotANan[seg.end]
AND GraphUtil.NotANan[y2]
THEN {
a ← y2 - seg.end;
b ← x1 - x2;
IF (factor ← RealFns.SqRt[a*a+b*b]) > 0.0
THEN {
factor ← 1.0/factor;
seg^ ← [ok:
TRUE, end: seg.end,
nx: a*factor, ny: b*factor, d0: (x1*y2 - x2*seg.end)*factor];
};
};
};
}; -- SetSegment
SetSegments:
PUBLIC
PROC [entity: Entity] = {
assume entity.segments.end's and entity.group.x.segments have been set.
xseg: SegmentDataList ← entity.group.x.segments;
FOR yseg: SegmentDataList ← entity.segments, yseg.rest
UNTIL yseg.rest =
NIL
DO
SetSegment[yseg.first, xseg.first.end, xseg.rest.first.end, yseg.rest.first.end];
xseg ← xseg.rest;
ENDLOOP;
}; -- SetSegments
InitSegAll:
PUBLIC
PROC [entity: Entity ←
NIL] = {
InitSegEnd[entity];
SetSegments[entity];
}; -- InitSegAll
UpdateSegEnd:
PUBLIC PROC [entity: Entity, values: ValueList] = {
should check that values and entity.segments have the same length before calling this proc.
oldSDL: SegmentDataList ← entity.segments;
vl: ValueList ← values;
entity.segments ← NIL;
IF values #
NIL
THEN
FOR sdl: SegmentDataList ← oldSDL, sdl.rest UNTIL sdl = NIL DO
sdl.first.end ← vl.first;
vl ← vl.rest;
ENDLOOP;
entity.segments ← oldSDL;
}; -- UpdateSegEnd
UpdateSegAll:
PUBLIC PROC [entity: Entity, values: ValueList] = {
IF values #
NIL
THEN {
UpdateSegEnd[entity, values];
SetSegments[entity];
};
}; -- UpdateSegAll
LengthOfVL:
PUBLIC
PROC [valueList: ValueList ←
NIL]
RETURNS [
INT] = {
length: INT ← 0;
FOR vl: ValueList ← valueList, vl.rest
UNTIL vl =
NIL
DO
length ← length + 1;
ENDLOOP;
RETURN[length];
}; -- LengthOfVL
LengthOfEL:
PUBLIC
PROC [entityList: EntityList ←
NIL, group: EntityGroup ←
NIL]
RETURNS [
INT] = {
length: INT ← 0;
FOR el: EntityList ← entityList, el.rest
UNTIL el =
NIL
DO
IF group = NIL THEN length ← length + 1
ELSE IF el.first.group.id = group.id THEN length ← length + 1;
ENDLOOP;
RETURN[length];
}; -- LengthOfEL
LengthOfSDL:
PUBLIC
PROC [segmentDataList: SegmentDataList ←
NIL]
RETURNS [
INT] = {
length: INT ← 0;
FOR sdl: SegmentDataList ← segmentDataList, sdl.rest
UNTIL sdl =
NIL
DO
length ← length + 1;
ENDLOOP;
RETURN[length];
}; -- LengthOfSDL
AppendX:
PUBLIC
PROC [xEntity: Entity, newx:
REAL]
RETURNS [oldx:
REAL ← 0.0] = {
Note that segments will always be appended. cf. AppendY.
vl: Graph.ValueList ← CONS[newx, NIL];
sdl: Graph.SegmentDataList ← CONS[NEW[Graph.SegmentDataRec ← [end: newx]], NIL];
IF xEntity.lastValue =
NIL
THEN {
xEntity.oldValues ← xEntity.lastValue ← vl;
xEntity.segments ← xEntity.lastSegment ← sdl;
}
ELSE {
xEntity.lastValue.rest ← vl;
xEntity.lastValue ← vl;
oldx ← xEntity.lastSegment.first.end;
xEntity.lastSegment.rest ← sdl;
xEntity.lastSegment ← sdl;
};
}; -- AppendX
AppendY:
PUBLIC
PROC [entity: Entity, y, x1, x2:
REAL ← 0.0]
RETURNS [oldy:
REAL ← 0.0] = {
Note that segments will be appended for first value (iff lastValue = nil).
But if lastValue # nil, segments won't be appended if segments is nil. (When user has removed it from plot.)
vl: Graph.ValueList ← CONS[y, NIL];
sdl: Graph.SegmentDataList ← CONS[NEW[Graph.SegmentDataRec ← [end: y]], NIL];
IF entity.lastValue =
NIL
THEN {
entity.oldValues ← entity.lastValue ← vl;
entity.segments ← entity.lastSegment ← sdl;
}
ELSE {
entity.lastValue.rest ← vl;
entity.lastValue ← vl;
IF entity.segments #
NIL
THEN {
oldy ← entity.lastSegment.first.end;
SetSegment[entity.lastSegment.first, x1, x2, y];
entity.lastSegment.rest ← sdl;
entity.lastSegment ← sdl;
};
};
}; -- AppendY
AppendX: PUBLIC PROC [entity: Entity, newx: REAL] RETURNS [first: BOOL ← FALSE, oldx: REAL] = { -- so far called by GraphOps.AddCrossSection only.
Append new value on x entity.
IF entity.lastValue # NIL THEN {
entity.lastValue.rest ← CONS[newx, NIL];
entity.lastValue ← entity.lastValue.rest;
}
ELSE {
IF entity.oldValues = NIL THEN {
first ← TRUE;
entity.lastValue ← entity.oldValues ← CONS[newx, NIL];
}
ELSE {
entity.lastValue ← entity.oldValues;
UNTIL entity.lastValue.rest = NIL DO
entity.lastValue ← entity.lastValue.rest;
ENDLOOP;
entity.lastValue.rest ← CONS[newx, NIL];
entity.lastValue ← entity.lastValue.rest;
};
};
IF entity.lastSegment = NIL AND entity.segments = NIL THEN {
InitSegEnd[entity];
entity.lastSegment ← entity.segments;
UNTIL entity.lastSegment.rest = NIL DO
IF entity.lastSegment.rest.rest = NIL THEN oldx ← entity.lastSegment.first.end;
entity.lastSegment ← entity.lastSegment.rest;
ENDLOOP;
}
ELSE {
IF entity.lastSegment = NIL THEN {
entity.lastSegment ← entity.segments;
UNTIL entity.lastSegment.rest = NIL DO
entity.lastSegment ← entity.lastSegment.rest;
ENDLOOP;
};
oldx ← entity.lastSegment.first.end;
entity.lastSegment.rest ← CONS[NEW[SegmentDataRec ← [end: newx]], NIL];
entity.lastSegment ← entity.lastSegment.rest;
};
}; -- AppendX
AppendY: PUBLIC PROC [entity: Entity, x1, x2, y: REAL] RETURNS [first: BOOL ← FALSE, oldy: REAL] = { -- so far called by GraphOps.AddCrossSection only.
AppendX must have been called.
IF entity.lastValue # NIL THEN {
oldy ← entity.lastValue.first;
entity.lastValue.rest ← CONS[y, NIL];
entity.lastValue ← entity.lastValue.rest;
}
ELSE {
IF entity.oldValues = NIL THEN {
entity.lastValue ← entity.oldValues ← CONS[y, NIL];
first ← TRUE;
}
ELSE {
entity.lastValue ← entity.oldValues;
UNTIL entity.lastValue.rest = NIL DO
entity.lastValue ← entity.lastValue.rest;
ENDLOOP;
oldy ← entity.lastValue.first;
entity.lastValue.rest ← CONS[y, NIL];
entity.lastValue ← entity.lastValue.rest;
};
};
IF entity.lastSegment = NIL AND entity.segments = NIL THEN {
InitSegAll[entity];
entity.lastSegment ← entity.segments;
UNTIL entity.lastSegment.rest = NIL DO
entity.lastSegment ← entity.lastSegment.rest;
ENDLOOP;
}
ELSE {
either lastSegment # nil or segments # nil. but if segments = nil then lastSegment must be nil. so segments # nil for sure. So we only have to make sure lastSegment # nil here.
IF entity.lastSegment = NIL THEN {
entity.lastSegment ← entity.segments;
UNTIL entity.lastSegment.rest = NIL DO
entity.lastSegment ← entity.lastSegment.rest;
ENDLOOP;
};
If y is the first value on entity, then it must have been taken care of above. (segments = lastsegment = nil.)
IF first THEN RaiseError[$Other,
"unexpected condition in GraphOpsImpl.AppendValueAndSegment."]
ELSE {
a: REAL ← y - oldy;
b: REAL ← x1 - x2;
factor: REAL ← 1.0/RealFns.SqRt[a*a+b*b];
entity.lastSegment.first^ ← [end: oldy, nx: a*factor, ny: b*factor, d0: (x1*y - x2*oldy)*factor];
entity.lastSegment.rest ← CONS[NEW[SegmentDataRec ← [end: y]], NIL];
entity.lastSegment ← entity.lastSegment.rest;
};
};
}; -- AppendY
AppendTexts:
PUBLIC
PROC [first, second: Texts ←
NIL]
RETURNS [new: Texts] = {
order: old texts followed by new texts.
IF first = NIL THEN new ← second
ELSE {
FOR txs: Texts ← first, txs.rest
UNTIL txs =
NIL
DO
IF txs.rest = NIL THEN {txs.rest ← second; EXIT};
ENDLOOP;
new ← first;
};
}; -- AppendTexts
AppendEntityList:
PUBLIC
PROC [first, second: EntityList ←
NIL]
RETURNS [new: EntityList] = {
order: old texts followed by new texts.
IF first = NIL THEN new ← second
ELSE {
FOR txs: EntityList ← first, txs.rest
UNTIL txs =
NIL
DO
IF txs.rest = NIL THEN {txs.rest ← second; EXIT};
ENDLOOP;
new ← first;
};
}; -- AppendEntityList
AppendEGL:
PUBLIC
PROC [first, second: EntityGroupList ←
NIL]
RETURNS [new: EntityGroupList] = {
order: old texts followed by new texts.
IF first = NIL THEN new ← second
ELSE {
FOR txs: EntityGroupList ← first, txs.rest
UNTIL txs =
NIL
DO
IF txs.rest = NIL THEN {txs.rest ← second; EXIT};
ENDLOOP;
new ← first;
};
}; -- AppendEntityList
NewTextId:
PUBLIC
PROC [handle: GraphHandle, tryId:
INT]
RETURNS [newId:
INT ← -1] = {
IF HandleNotNil[handle]
THEN {
OPEN handle;
IF tryId <= lastTextId
THEN {
IF TextFromId[allTexts, tryId] = NIL THEN RETURN[tryId]
ELSE BlinkMsg[IO.PutFR["Warning: Text id %g already used.", IO.int[tryId]]];
};
RETURN[lastTextId ← lastTextId + 1];
};
}; -- NewTextId
NewEntityId:
PUBLIC
PROC [handle: GraphHandle, tryId:
INT]
RETURNS [newId:
INT ← -1] = {
IF HandleNotNil[handle]
THEN {
OPEN handle;
IF tryId < 0 THEN tryId ← 0;
IF tryId <= lastEntityId
THEN {
IF EntityFromId[entityHash[tryId MOD EntityHashSize], tryId] = NIL THEN RETURN[tryId]
ELSE BlinkMsg[IO.PutFR["Warning: Entity id %g already used.", IO.int[tryId]]];
};
RETURN[lastEntityId ← lastEntityId + 1];
};
}; -- NewEntityId
NewGroupId:
PUBLIC
PROC [handle: GraphHandle, tryId:
INT]
RETURNS [newId:
INT ← -1] = {
IF HandleNotNil[handle]
THEN {
OPEN handle;
lastId: INT ← -1;
used: BOOL ← FALSE;
FOR egl: EntityGroupList ← entityGroupList, egl.rest
UNTIL egl =
NIL
DO
IF tryId = egl.first.id THEN used ← FALSE;
lastId ← MAX[lastId, egl.first.id];
ENDLOOP;
IF used THEN BlinkMsg[IO.PutFR["Warning: Group id %g already used.", IO.int[tryId]]];
RETURN[IF used THEN lastId + 1 ELSE tryId];
};
}; -- NewGroupId
}.