<> <> <> <> 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 [RGB, ColorFromRGB, ConstantColor], ImagerColorMap USING [LoadEntries, MapEntry, SetStandardColorMap], ImagerDitherContext USING [MakeSpecialColor], ImagerFont USING [Extents, Font, FontBoundingBox, RopeBoundingBox], IO USING [int, PutFR], MessageWindow USING [Append, Blink], Process USING [MsecToTicks, SetTimeout], Real USING [Float, LargestNumber, RealException, InlineRoundC, InlineRoundI], 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, ImagerDitherContext, ImagerFont, IO, MessageWindow, Process, Real, RealFns, Rope, Terminal, UserProfile, VFonts, ViewerOps, ViewerTools, WindowManager EXPORTS Graph, GraphUtil = { OPEN Graph, GraphPrivate, GraphUtil; <> 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", $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 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]}; ChartNotNil: PUBLIC PROC[chart: Chart _ NIL, msg: ROPE _ NIL, debug: BOOL _ FALSE] RETURNS [ok: BOOL _ TRUE] = {ok _ CheckNil[chart, $NilChart, msg, debug]}; ViewerNotNil: PUBLIC PROC[viewer: Viewer _ NIL, msg: ROPE _ NIL, debug: BOOL _ FALSE] RETURNS [ok: BOOL _ TRUE] = {ok _ CheckNil[viewer, $NilViewer, msg, debug]}; GraphViewerExits: PUBLIC PROC [handle: GraphHandle, msg: ROPE _ NIL, debug: BOOL _ FALSE] RETURNS [ok: BOOL _ FALSE] = { IF HandleNotNil[handle, msg, debug] THEN IF ChartNotNil[handle.chart, msg, debug] THEN IF ViewerNotNil[handle.chart.viewer, msg, debug] THEN ok _ TRUE; }; -- GraphViewerExits ControllerNotNil: PUBLIC PROC[c: Controller _ NIL, msg: ROPE _ NIL, debug: BOOL _ FALSE] RETURNS [ok: BOOL _ TRUE] = {ok _ CheckNil[c, $NilController, msg, debug]}; ControllerViewerExits: PUBLIC PROC [handle: GraphHandle _ NIL, msg: ROPE _ NIL, debug: BOOL _ FALSE] RETURNS [ok: BOOL _ FALSE] = { IF HandleNotNil[handle, msg, debug] THEN IF ControllerNotNil[handle.controller, msg, debug] THEN IF ViewerNotNil[handle.controller.viewer, msg, debug] THEN ok _ TRUE; }; -- GraphViewerExits BoundsValid: PUBLIC PROC[box: Imager.Box] 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]}; <> 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 [ImagerColor.ConstantColor] = { entry: ImagerColorMap.MapEntry _ [ mapIndex: index+100, red: Real.InlineRoundC[rgb.R*255], green: Real.InlineRoundC[rgb.G*255], blue: Real.InlineRoundC[rgb.B*255] ]; ImagerColorMap.LoadEntries[ vt: Terminal.Current[], mapEntries: LIST[entry], shared: FALSE]; <> RETURN[ImagerDitherContext.MakeSpecialColor[ordinaryColor: ImagerColor.ColorFromRGB[rgb], specialPixel: [index+100, null]]]; }; -- SetColor UseDefaultColors: PUBLIC PROC[handle: GraphHandle _ NIL] = { GetColor: PUBLIC PROC [num: ColorIndex] RETURNS [ImagerColor.RGB] = { <> 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]; <> < 0.5 THEN onesAreWhite ELSE onesAreBlack;>> cursorType: Terminal.ColorCursorPresentation _ SELECT bkgnd FROM black => onesAreWhite, darkGray => onesAreWhite, gray => onesAreBlack, ENDCASE => onesAreBlack; virtual: Terminal.Virtual _ Terminal.Current[]; IF cursorType # Terminal.GetColorCursorPresentation[virtual] THEN [] _ Terminal.SetColorCursorPresentation[virtual, cursorType]; }; -- SetCursorForBackgroundIndex UseDefaultFonts: PUBLIC PROC [handle: GraphHandle] = { <> GetFont: PUBLIC PROC [num: FontIndex] RETURNS [gf: GraphFont] = { <> 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; <> <> 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 <> 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] = { <> 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] = { <> 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.InlineRoundI[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.InlineRoundI[axesRect.x + textPos.x*axesRect.w]; y _ Real.InlineRoundI[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] = { <> 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 <> 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 <> 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] = { <> 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] = { <> 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] = { <> 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] = { <> 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] = { <> 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] = { <> <> 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>> <<>> <> <> <> <> <> <> <<}>> <> <> <> <> <<}>> <> <> <> <> <> <> <> <> <<};>> <<}; >> <<>> <> <> <> <> <> <> <<}>> <> <> <> <> <> <> <> <<};>> <> <> <<"unexpected condition in GraphOpsImpl.AppendValueAndSegment."]>> <> <> <> <> <> <> <> <<};>> <<};>> <<}; -- AppendY>> <<>> AppendTexts: PUBLIC PROC [first, second: Texts _ NIL] RETURNS [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] = { <> 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] = { <> 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] <> }; 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] <> }; 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; <> RETURN[IF used THEN lastId + 1 ELSE tryId]; }; }; -- NewGroupId <<>> <> <> <> <> <> <> <= max DO>> <> <<[eg, m, incomplete] _ CopyEntityGroup[eg, max - n];>> <> <> <> <<}; -- CopyEntityGroupList>> <<>> <> <> <> <= max DO>> <> <<[el, m, incomplete] _ CopyEntities[ne, max - n];>> <> <> <> <<}; -- CopyEntityGroup>> <<>> <> <<}; -- MergeGraph>> <<>> <> <<}; -- 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 <> FileFromSelection: PUBLIC PROC[wDir: ROPE _ NIL] RETURNS [file, msg: ROPE _ NIL] = { file _ ViewerTools.GetSelectionContents[]; IF file.IsEmpty[] THEN msg _ "Please select a file name." ELSE [file, ] _ FS.ExpandName[file, wDir! FS.Error => {msg _ error.explanation; CONTINUE}]; }; -- FileFromSelection ReplaceFileExt: PUBLIC PROC[file: ROPE, extension: ROPE _ NIL] RETURNS [new: ROPE _ NIL] = { cp: FS.ComponentPositions; fullName, msg: ROPE; ok: BOOL _ TRUE; IF file.IsEmpty[] THEN {msg _ "File name is empty. "; file _ "Graph"}; IF extension.IsEmpty[] THEN { msg _ msg.Concat["Extension is empty. "]; extension _ "graph"}; IF msg = NIL THEN [fullName, cp, ] _ FS.ExpandName[file ! FS.Error => {msg _ error.explanation; CONTINUE}]; IF msg = NIL THEN new _ Rope.Cat[fullName.Substr[0, cp.base.start + cp.base.length], ".", extension] ELSE { new _ file.Cat[".", extension]; BlinkMsg[msg.Cat[new, " ok?"]]; }; }; -- ReplaceFileExt WDirOfViewer: PUBLIC PROC [viewer: Viewer] RETURNS [wDir: ROPE] = { <> wDir _ "[]<>"; IF viewer # NIL THEN { cp: FS.ComponentPositions; viewerName: ROPE _ NIL; [viewerName, cp, ] _ FS.ExpandName[viewer.name ! FS.Error => {viewerName _ NIL}]; IF NOT viewerName.IsEmpty[] THEN wDir _ viewerName.Substr[0, cp.base.start]; }; }; -- WDirOfChartViewer waitProgramMsg: PUBLIC ROPE = "Graph is currently controlled by a program. Please wait till it finishes to do this."; <> 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]]]; <> 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 _ defaultColors^]; graph.font _ NEW[GraphFontsArray _ defaultFonts^]; }; -- VanillaGraph <> <> < ATOM.PutPropOnList[c.props, prop, val];>> < ATOM.PutPropOnList[cs.props, prop, val];>> < ATOM.PutPropOnList[t.props, prop, val];>> < RaiseError[$UnknowObject, "in AddProp"];>> <<}; -- AddProp>> <<>> <> <> < val _ ATOM.GetPropFromList[c.props, prop];>> < val _ ATOM.GetPropFromList[cs.props, prop];>> < val _ ATOM.GetPropFromList[t.props, prop];>> < RaiseError[$UnknowObject, "in FetchProp"];>> <<}; -- FetchProp>> <<>> <> Almost: PUBLIC PROC [p, q: REAL] RETURNS [a: BOOL _ TRUE] = { IF GraphUtil.NotANumber[p] THEN RETURN[GraphUtil.NotANumber[q]] ELSE IF GraphUtil.NotANumber[q] THEN RETURN[FALSE] ELSE { 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, old: Imager.Box] RETURNS [Imager.Box] = { ValidateMax: PROC [min, max: REAL] RETURNS [REAL] = { RETURN[IF min = 0.0 AND max = 0.0 THEN 1.0 ELSE IF min >= max THEN min + (ABS[min] + ABS[max])/2.0 ELSE max]; }; xmin, ymin, xmax, ymax: REAL; IF entityList = NIL THEN { IF BoundsValid[old] THEN RETURN[old] ELSE [xmin, ymin, xmax, ymax] _ old; } ELSE { -- entityList # nil prevX: Entity _ NIL; 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 rx: REAL _ sdl.first.end; IF GraphUtil.NotANan[rx] THEN {xmin _ MIN[rx, xmin]; xmax _ MAX[rx, xmax]}; ENDLOOP; prevX _ currX; }; <> FOR sdl: SegmentDataList _ el.first.segments, sdl.rest UNTIL sdl = NIL DO ry: REAL _ sdl.first.end; IF GraphUtil.NotANan[ry] THEN {ymin _ MIN[ry, ymin]; ymax _ MAX[ry, ymax]}; ENDLOOP; ENDLOOP; }; RETURN[[xmin, ymin, ValidateMax[xmin, xmax], ValidateMax[ymin, ymax]]]; }; -- DataBounds }. LOG. SChen, October 9, 1985 8:59:32 pm PDT, created.