<> <> <> <> <> DIRECTORY Imager, ImagerColor, ImagerColorDefs, ImagerFont, Real, Rope, TSFont, TSTypes, TSOutput, TSOutputDisplay, ViewerClasses, ViewerOps; TSOutputDisplayImpl: CEDAR PROGRAM IMPORTS Imager, ImagerColor, ImagerFont, TSFont, TSTypes, ViewerOps, Rope EXPORTS TSOutput = BEGIN OPEN TSOutputDisplay; ROPE: TYPE ~ Rope.ROPE; CreateViewer: PUBLIC PROCEDURE [viewerName: Rope.ROPE _ NIL] RETURNS [handle: TSOutput.Handle] = { v: ViewerClasses.Viewer _ ViewerOps.FindViewer[viewerName]; IF v # NIL THEN ViewerOps.DestroyViewer[v]; v _ ViewerOps.CreateViewer[ flavor: $TSDisplay, info: [ name: viewerName, iconic: FALSE, column: left, scrollable: TRUE, data: handle], paint: TRUE]; handle _NARROW [ViewerOps.FetchProp[v, $TSDisplayHandle]]; }; Char: TSOutput.CharProc = { -- [self: Handle, x, y: TSTypes.Dimn, char: CHAR, font: TSFont.Ref] displayState: DisplayState _ NARROW[self.outputState]; CharPaint: DisplayProc = { ShowOne: Imager.XStringProc ~ { charAction[[0, ORD[char]]]; }; Imager.SetColor[dc, displayState.color]; Imager.SetXY[dc, [x.DimnInt[TSTypes.pt], y.DimnInt[TSTypes.pt]]]; Imager.SetFont[dc, displayState.imagerFont]; Imager.Show[dc, ShowOne]; }; SetFont[displayState, font]; Painter[CharPaint, displayState]; }; SetFont: PROCEDURE [displayState: DisplayState, font: TSFont.Ref] = { IF displayState.currentFont # font AND font # NIL THEN { family: Rope.ROPE; micaSize: INTEGER; pointsPerMica: REAL = 72.0/2540.0; face: [0..255]; rotation: INTEGER; imagerFont: Imager.Font; fontName: ROPE; [family, micaSize, face, rotation] _ TSFont.ParcFontSpecification[font]; fontName _ Rope.Cat[ "xerox/pressfonts/", family, SELECT face FROM 0 => "-MRR", 1 => "-MIR", 2 => "-BRR", 3 => "-BIR", ENDCASE => NIL ]; imagerFont _ ImagerFont.Find[fontName]; displayState.imagerFont _ ImagerFont.Scale[imagerFont, micaSize * pointsPerMica]; }; displayState.currentFont _ font; }; Rule: TSOutput.RuleProc = { -- [self: Handle, leftX, bottomY, width, height: TSTypes.Dimn] displayState: DisplayState _ NARROW[self.outputState]; RulePaint: DisplayProc = { Imager.SetColor[dc, displayState.color]; Imager.MaskBox[dc, [leftX.DimnInt[TSTypes.pt], bottomY.DimnInt[TSTypes.pt], leftX.AddDimn[width].DimnInt[TSTypes.pt], bottomY.AddDimn[height].DimnInt[TSTypes.pt]]]; }; Painter[RulePaint, displayState]; }; Color: TSOutput.ColorProc = { -- [self: Handle, hue, saturation, brightness: REAL] displayState: DisplayState _ NARROW[self.outputState]; color: ImagerColorDefs.ConstantColor _ ImagerColor.ColorFromGray[1.0-brightness]; displayState.color _ color; }; NewPage: TSOutput.NewPageProc = { -- [self: Handle] displayState: DisplayState _ NARROW[self.outputState]; ViewerOps.PaintViewer[viewer: displayState.viewer, hint: all, whatChanged: NIL, clearClient: TRUE]; }; PageSize: TSOutput.PageSizeProc = { -- [self: Handle, height, width: TSTypes.Dimn] displayState: DisplayState _ NARROW[self.outputState]; displayState.pageHeight _ height.texPts; }; Finish: TSOutput.FinishProc = { -- [self: Handle] <> }; TSDisplayInitViewer: ViewerClasses.InitProc = { displayState: DisplayState _ NEW[DisplayStateRec]; handle: TSOutput.Handle _ NEW[TSOutput.OutputRec]; handle.charProc _ Char; handle.ruleProc _ Rule; handle.colorProc _ Color; handle.newPageProc _ NewPage; handle.pageSizeProc _ PageSize; handle.finishProc _ Finish; handle.outputState _ displayState; displayState.viewer _ self; ViewerOps.AddProp[self, $TSDisplayHandle, handle]; }; TSDisplayPaint: ViewerClasses.PaintProc = { -- [self: ViewerClasses.Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL] displayState: DisplayState; IF whatChanged # NIL AND ISTYPE[whatChanged, DisplayState] THEN { displayState _ NARROW[whatChanged, DisplayState]; Imager.TranslateT[context, [0.0, self.ch - displayState.pageHeight]]; displayState.callBackProc[context]; }; }; Painter: PROCEDURE [proc: DisplayProc, displayState: DisplayState] = { CallBack: DisplayProc = { proc[dc]; }; TRUSTED { displayState.callBackProc _ CallBack; ViewerOps.PaintViewer[viewer: displayState.viewer, hint: client, whatChanged: displayState, clearClient: FALSE]; }; }; tsDisplayClass: ViewerClasses.ViewerClass ~ NEW[ViewerClasses.ViewerClassRec _ ViewerOps.FetchViewerClass[$Container]^]; containerInit: ViewerClasses.InitProc ~ tsDisplayClass.init; containerPaint: ViewerClasses.PaintProc ~ tsDisplayClass.paint; tsDisplayClass.init _ TSDisplayInitViewer; tsDisplayClass.paint _ TSDisplayPaint; ViewerOps.RegisterViewerClass[$TSDisplay, tsDisplayClass]; END. <> <> <<>> <<>> << >>