<> <> <> 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; <> 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 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]}; <> 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] = { <> 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] = { <> 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 _ 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; <> <> 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 <> 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] = { <> 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] = { <> 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] = { <> 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 <> 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 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[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] = { <> 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 <> <> <> <> <> <> <= max DO>> <> <<[eg, m, incomplete] _ CopyEntityGroup[eg, max - n];>> <> <> <> <<}; -- CopyEntityGroupList>> <<>> <> <> <> <= max DO>> <> <<[el, m, incomplete] _ CopyEntities[ne, max - n];>> <> <> <> <<}; -- 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 <> 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 <> 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 <> <> < 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] = { 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.