<> <> <> DIRECTORY Graphics, GraphicsColor, Inline, Real, Rope, TSFont, TSTypes, TSOutput, VFonts, ViewerClasses, ViewerOps; TSOutputDisplayImpl: CEDAR PROGRAM IMPORTS Graphics, GraphicsColor, Inline, Real, TSFont, TSTypes, VFonts, ViewerOps EXPORTS TSOutput = BEGIN DisplayState: TYPE = REF DisplayStateRec; DisplayStateRec: TYPE = RECORD [ viewer: ViewerClasses.Viewer _ NIL, color: Graphics.Color _ Graphics.black, callBackProc: DisplayProc _ NIL, currentFont: TSFont.Ref _ NIL, graphicsFont: Graphics.FontRef _ NIL, pageHeight: REAL ]; DisplayProc: TYPE = PROCEDURE [dc: Graphics.Context]; CreateViewer: PUBLIC PROCEDURE [viewerName: Rope.ROPE _ NIL] RETURNS [handle: TSOutput.Handle] = { displayState: DisplayState _ NEW[DisplayStateRec]; v: ViewerClasses.Viewer _ ViewerOps.FindViewer[viewerName]; IF v # NIL THEN ViewerOps.DestroyViewer[v]; 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 _ ViewerOps.CreateViewer[ flavor: $TSDisplay, info: [ name: viewerName, iconic: FALSE, column: left, scrollable: TRUE, data: handle], paint: TRUE]; }; Char: TSOutput.CharProc = { -- [self: Handle, x, y: TSTypes.Dimn, char: CHAR, font: TSFont.Ref] displayState: DisplayState _ NARROW[self.outputState]; CharPaint: DisplayProc = { Graphics.SetColor[dc, displayState.color]; Graphics.SetCP[dc, x.DimnInt[TSTypes.pt], y.DimnInt[TSTypes.pt]]; Graphics.DrawChar[dc, char, displayState.graphicsFont]; }; 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; [family, micaSize, face, rotation] _ TSFont.ParcFontSpecification[font]; displayState.graphicsFont _ VFonts.GraphicsFont[ VFonts.EstablishFont[ family: family, size: Real.RoundI[micaSize * pointsPerMica], bold: Inline.BITAND[face, 2], italic: Inline.BITAND[face, 1], defaultOnFailure: TRUE ] ]; }; displayState.currentFont _ font; }; Rule: TSOutput.RuleProc = { -- [self: Handle, leftX, bottomY, width, height: TSTypes.Dimn] displayState: DisplayState _ NARROW[self.outputState]; RulePaint: DisplayProc = { Graphics.SetColor[dc, displayState.color]; Graphics.DrawBox[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]; displayState.color _ GraphicsColor.HSVToColor[hue, saturation, brightness]; }; 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] <> }; 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]; Graphics.Translate[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]^]; containerPaint: ViewerClasses.PaintProc = tsDisplayClass.paint; tsDisplayClass.coordSys _ bottom; tsDisplayClass.paint _ TSDisplayPaint; ViewerOps.RegisterViewerClass[$TSDisplay, tsDisplayClass]; END. <> <> <<>> <<>> << >>