<> <> <> <> <<>> <> <> DIRECTORY Atom USING [MakeAtom], BasicTime USING [GMT, Now, OutOfRange, Period, Update], CD USING [CreateDrawRef, Design, DrawProc, DrawRectProc, DrawRef, Instance, InstanceList, Layer, LayerKey, Number, Object, Orientation, original, Position, Rect, undefLayer], CDBasics USING [BaseOfAnyRect, Intersection, NonEmpty, SizeOfRect], CDDirectory USING [EachEntryAction, Enumerate], CDColors USING [ColorTable, DisplayMode, DisplayType, globalColors], CDCurves USING [CurvePtr], CDInstances USING [NewInst], CDOps USING [DrawDesign, InstList], CDOrient USING [CreateTransform, mirrorX, rotate180, rotate180X, rotate270X, rotate90, rotate90X], CDTexts USING [TextPtr], CDValue USING [Fetch], Checksum USING [ComputeChecksum], CStitching USING [all, Area, ChangeEnumerateArea, ChangeRect, DumpCache, EnumerateArea, NewTesselation, RectProc, Region, ResetTesselation, Tesselation, Tile, TileProc], FS USING [ComponentPositions, Error, ExpandName, Position, SetKeep], HashTable USING [Create, EachPairAction, Fetch, GetSize, Insert, Key, Pairs, Table], Imager USING [black, ClipRectangle, Color, ColorOperator, ConcatT, Context, ConstantColor, DoSave, Font, MaskFillTrajectory, MaskRectangle, MaskStrokeTrajectory, Rectangle, ScaleT, SetColor, SetFont, SetPriorityImportant, SetStrokeEnd, SetStrokeJoint, SetStrokeWidth, SetXY, ShowRope, StrokeEnd, StrokeJoint, Trans, TranslateT, VEC], ImagerBrick USING [Brick, BrickRep], ImagerColor USING [ColorFromRGB, RGB], ImagerColorPrivate USING [ComponentFromColor], ImagerColorOperator USING [ColorOperator, RGBLinearColorModel], ImagerExtras USING [MaskDashedStrokeTrajectory], ImagerFont USING [Modify], ImagerInterpress USING [Close, Create, DeclareColor, DeclareColorOperator, DeclareFont, DoPage, Ref], ImagerPath USING [LineToX, LineToY, MoveTo, Trajectory], ImagerPDPublic USING [Toner], ImagerTransformation USING [Cat, Create, Invert, Rotate, Scale2, Transformation, Translate], Interpress USING [classAppearanceError, classAppearanceWarning, classComment, classMasterError, classMasterWarning, LogProc], IO USING [atom, int, PutFR1, real, time], MessageWindow USING [Append, Blink, Clear], Nectarine USING [], NodeStyle USING [FontFace], NodeStyleFont USING [FontFromStyleParams], PeachPrint USING [DoPeachPrintCommand, PupAborted], PrincOpsUtils USING [], PrintFileConvert USING [InterpressToPD, ParamsFromPrinterType, PDParams, ProgressProc], Process USING [CheckForAbort, Detach, priorityBackground, SetPriority], Real USING [Fix, Float], RefTab USING [Create, Delete, EachPairAction, Fetch, GetSize, Insert, Pairs, Ref], Rope USING [Cat, Equal, Fetch, IsEmpty, Length, Replace, ROPE, SkipTo, Substr], TerminalIO USING [TOS, WriteF, WriteInt, WriteRope], UserProfile USING [Boolean, CallWhenProfileChanges, ProfileChangedProc, Token]; NectarineImpl: CEDAR PROGRAM IMPORTS Atom, BasicTime, CD, CDBasics, CDColors, CDDirectory, CDInstances, CDOps, CDOrient, CDValue, Checksum, CStitching, FS, HashTable, Imager, ImagerColor, ImagerColorPrivate, ImagerColorOperator, ImagerExtras, ImagerFont, ImagerInterpress, ImagerPath, ImagerTransformation, IO, MessageWindow, NodeStyleFont, PeachPrint, PrintFileConvert, Process, Real, RefTab, Rope, TerminalIO, UserProfile EXPORTS Nectarine ~ BEGIN OPEN Real; <> <> break: SIGNAL = CODE; -- for debugging invalidPrinter: PUBLIC SIGNAL = CODE; communicationsFailure: PUBLIC SIGNAL = CODE; tooComplex: PUBLIC SIGNAL = CODE; Font: TYPE = Imager.Font; Color: TYPE = Imager.Color; Transformation: TYPE = ImagerTransformation.Transformation; State: TYPE = REF StateRec; StateRec: TYPE = RECORD [ previousColour: Color _ NIL, previousStrokeWidth: REAL _ -1.0, previousFont: Font _ NIL, previousTextOrientation: CD.Orientation _ CD.original, cardTile: CARD _ 0, -- |{tile}| startTime: BasicTime.GMT, context: Imager.Context, design: CD.Design, interpress: ImagerInterpress.Ref, tess: Tess, abort: REF BOOL, clip: BOOL _ FALSE, -- Wysiwyg or selectedOnly cdClip: CD.Rect, -- Wysiwyg or selectedOnly selectedOnly: BOOL, band: REF CD.Rect _ NIL]; medium: Imager.Rectangle ~ [x: 0.0, y: 0.0, w: 215.9, h: 279.4]; -- in mm field: Imager.Rectangle ~ [x: medium.x + 10.0, y: medium.y + 10.0, w: medium.w - 20.0, h: medium.h - 20.0]; -- in mm << [Artwork node; type 'ArtworkInterpress on' to command tool]  Insert caption here >> mmXin: REAL ~ 25.4; statistics: BOOL _ FALSE; debug: BOOL _ FALSE; remindFontConventions: BOOL _ TRUE; risk: INT _ 2; -- decrease if Nectarine runs out of VM. More risk mean much more speed. Geometric interpretation: consider a horizontal straight line through the design; you state that you have a rectangle only each risk only 14 MB of memory in the worst case. <> Region: TYPE ~ LIST OF REF CStitching.Region; Tess: TYPE ~ CStitching.Tesselation; Tile: TYPE ~ CStitching.Tile; empty: REF ~ NIL; nothing: REF INT ~ NEW [INT]; StartDecomposition: PROC [state: State] RETURNS [dec: Tess] ~ {RETURN [CStitching.NewTesselation[stopFlag: state.abort]]}; FlushDecomposition: PROC [dec: Tess] ~ BEGIN <> CStitching.ResetTesselation [dec] END; -- FlushDecomposition PrintAlignedTile: CStitching.TileProc ~ BEGIN <> <> state: State ~ NARROW [data]; b: Blend ~ NARROW [tile.value]; r: CD.Rect ~ CStitching.Area [tile]; -- not the area but the rectangle ! ir: Imager.Rectangle ~ ImagerRect [r]; MaskAlignedRectangle: PROC ~ BEGIN state.context.SetXY [[ir.x, ir.y]]; state.context.Trans []; state.context.MaskRectangle [[0, 0, ir.w, ir.h]] END; -- MaskAlignedRectangle ChangeColour [state, b.blend]; state.context.DoSave [MaskAlignedRectangle]; IF state.abort^ THEN ERROR ABORTED; IF statistics THEN BEGIN l: CD.Number ~ state.design.technology.lambda; b.area _ b.area + ((r.x2 - r.x1) / l) * ((r.y2 - r.y1) / l); state.cardTile _ SUCC [state.cardTile] END END; -- PrintAlignedTile PrintTile: CStitching.TileProc ~ BEGIN <> state: State ~ NARROW [data]; b: Blend ~ NARROW [tile.value]; r: CD.Rect ~ CStitching.Area [tile]; -- not the area but the rectangle ! ChangeColour [state, b.blend]; state.context.MaskRectangle [ImagerRect [r]]; IF state.abort^ THEN ERROR ABORTED; IF statistics THEN BEGIN l: CD.Number ~ state.design.technology.lambda; b.area _ b.area + ((r.x2 - r.x1) / l) * ((r.y2 - r.y1) / l); state.cardTile _ SUCC [state.cardTile] END END; -- PrintTile PrintBand: PROC [state: State] ~ BEGIN <> decomposition: Tess _ StartDecomposition [state]; gdr: CD.DrawRef ~ CD.CreateDrawRef [[]]; EnumerateGeometry: PROC ~ BEGIN state.context.SetPriorityImportant [FALSE]; -- works for the devices at PARC today decomposition.EnumerateArea [rect: CStitching.all, eachTile: PrintAlignedTile, data: state, skip: empty] END; -- EnumerateGeometry Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED; IF (state.clip OR (state.band # NIL)) THEN gdr.interestClip _ IF (state.band = NIL) THEN state.cdClip ELSE CDBasics.Intersection [state.cdClip, state.band^]; state.tess _ decomposition; gdr.drawRect _ NewRect; gdr.devicePrivate _ state; IF state.selectedOnly THEN DrawSelection [state.design, gdr] ELSE CDOps.DrawDesign [state.design, gdr]; -- pass 2 TerminalIO.WriteRope ["."]; BlendAllColours []; TerminalIO.WriteRope ["."]; -- pass 3 state.previousColour _ NIL; -- needed by Interpress state.context.DoSave [EnumerateGeometry]; -- pass 4 FlushDecomposition [decomposition]; TerminalIO.WriteRope [". "]; -- state.tess _ decomposition _ NIL END; -- PrintBand NewRect: CD.DrawRectProc ~ BEGIN <<[r: Rect, l: Layer, pr: DrawRef]>> state: State ~ NARROW [pr.devicePrivate, State]; rect: CD.Rect _ IF (state.band = NIL) THEN r ELSE CDBasics.Intersection [r, state.band^]; IF (CDBasics.NonEmpty [rect]) THEN BEGIN <> dec: Tess ~ state.tess; InsertRect: CStitching.RectProc = BEGIN <<[plane: REF Tesselation, rect: Rect, oldValue: REF, data: REF]>> WITH oldValue SELECT FROM b: Blend => IF NOT b.flavours[l] THEN dec.ChangeRect [rect: rect, new: ColourTile [b, l]]; ENDCASE => BEGIN b: Blend _ NEW [BlendRec]; dec.ChangeRect [rect: rect, new: ColourTile [b, l]] END END; -- InsertRect dec.ChangeEnumerateArea [rect: rect, eachRect: InsertRect, skip: nothing]; IF state.abort^ THEN ERROR ABORTED END END; -- NewRect <> mirrorY: Transformation ~ ImagerTransformation.Scale2 [[-1, 1]]; rot180: Transformation ~ ImagerTransformation.Rotate [180]; SpecialHack: PROC [obj: CD.Object, or: CD.Orientation] RETURNS [t: Transformation] ~ BEGIN <> adjustX: Transformation ~ ImagerTransformation.Translate [[-obj.size.x, 0]]; adjustXY: Transformation ~ ImagerTransformation.Translate [[-obj.size.x, -obj.size.y]]; IF (obj.class.objectType # $FlipText) THEN ERROR; -- tocca ferro t _ SELECT or FROM CDOrient.mirrorX, CDOrient.rotate90X => ImagerTransformation.Cat [adjustX, mirrorY], CDOrient.rotate180X, CDOrient.rotate270X => ImagerTransformation.Cat [adjustXY, rot180, adjustX, mirrorY], CDOrient.rotate180, CDOrient.rotate90 => ImagerTransformation.Cat [adjustXY, rot180], ENDCASE => ImagerTransformation.Create [1, 0, 0, 0, 1, 0] END; -- SpecialHack DrawText: CD.DrawProc ~ BEGIN <<[inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef]>> state: State ~ NARROW [pr.devicePrivate]; context: Imager.Context ~ state.context; text: CDTexts.TextPtr ~ NARROW [inst.ob.specificRef]; offset: Imager.VEC ~ text.cdFont.xy; transf, invTransf: Transformation; Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED; transf _ CDOrient.CreateTransform [cellSize: inst.ob.size, cellInstOrient: orient, cellInstPos: pos]; IF (inst.ob.class.objectType = $FlipText) THEN transf _ ImagerTransformation.Cat [SpecialHack [inst.ob, orient], transf]; invTransf _ ImagerTransformation.Invert [transf]; context.ConcatT [transf]; context.SetXY [offset]; ChangeColour [state, LayerColour [inst.ob.layer]]; ChangeFont [state, text.cdFont.font]; context.ShowRope [text.text]; context.ConcatT [invTransf] END; -- DrawText DrawPath: CD.DrawProc ~ BEGIN <<[inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef]>> state: State ~ NARROW [pr.devicePrivate]; context: Imager.Context ~ state.context; curve: CDCurves.CurvePtr ~ NARROW [inst.ob.specificRef]; transf: Transformation ~ CDOrient.CreateTransform [cellSize: inst.ob.size, cellInstOrient: orient, cellInstPos: pos]; invTransf: Transformation ~ ImagerTransformation.Invert [transf]; Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED; context.ConcatT [transf]; -- context.SetXY [offset]; ChangeColour [state, LayerColour [inst.ob.layer]]; ChangeStrokeWidth [state, Float [curve.w]]; context.MaskStrokeTrajectory [curve.path]; context.ConcatT [invTransf] END; -- DrawPath DrawArea: CD.DrawProc ~ BEGIN <<[inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef]>> state: State ~ NARROW [pr.devicePrivate]; context: Imager.Context ~ state.context; curve: CDCurves.CurvePtr ~ NARROW [inst.ob.specificRef]; transf: Transformation ~ CDOrient.CreateTransform [cellSize: inst.ob.size, cellInstOrient: orient, cellInstPos: pos]; invTransf: Transformation ~ ImagerTransformation.Invert [transf]; Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED; context.ConcatT [transf]; -- context.SetXY [offset]; ChangeColour [state, LayerColour [inst.ob.layer]]; ChangeStrokeWidth [state, Float [curve.w]]; context.MaskFillTrajectory [curve.path, TRUE]; context.ConcatT [invTransf] END; -- DrawArea DrawObjectBorder: CD.DrawRectProc ~ BEGIN <<[r: Rect, l: Layer, pr: DrawRef]>> <> state: State ~ NARROW [pr.devicePrivate, State]; pen: REAL ~ Float [state.design.technology.lambda]; halfPen: REAL ~ pen / 2.0; object: Imager.Rectangle ~ ImagerRect [r]; border: ImagerPath.Trajectory; Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED; ChangeColour [state, black]; ChangeStrokeWidth [state, pen]; <> border _ ImagerPath.MoveTo [[object.x - halfPen, object.y - halfPen]]; border _ border.LineToX [object.x + object.w + halfPen]; -- South border _ border.LineToY [object.y + object.h + halfPen]; -- East border _ border.LineToX [object.x - halfPen]; -- North border _ border.LineToY [object.y - halfPen]; -- West <> <> state.context.MaskStrokeTrajectory [trajectory: border] END; -- DrawObjectBorder DrawDashedObjectBorder: CD.DrawRectProc ~ BEGIN <<[r: Rect, l: Layer, pr: DrawRef]>> <> state: State ~ NARROW [pr.devicePrivate, State]; pen: REAL ~ Float [state.design.technology.lambda / 2]; halfPen: REAL ~ pen / 2.0; object: Imager.Rectangle ~ ImagerRect [r]; border: ImagerPath.Trajectory; patternElements: NAT ~ 8; DotDotDotDash: PROC [i: NAT] RETURNS [REAL] ~ BEGIN pattern: ARRAY [0 .. patternElements) OF REAL ~ [0, 5*pen, 0, 5*pen, 0, 10*pen, 30*pen, 10*pen]; RETURN [pattern[i]] END; -- DotDotDotDash Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED; ChangeColour [state, black]; ChangeStrokeWidth [state, pen]; <> border _ ImagerPath.MoveTo [[object.x - halfPen, object.y - halfPen]]; border _ border.LineToX [object.x + object.w + halfPen]; -- South border _ border.LineToY [object.y + object.h + halfPen]; -- East border _ border.LineToX [object.x - halfPen]; -- North border _ border.LineToY [object.y - halfPen]; -- West <> <> ImagerExtras.MaskDashedStrokeTrajectory [context: state.context, trajectory: border, offset: 0, length: 2*(object.w+object.h), patternLen: patternElements, pattern: DotDotDotDash] END; -- DrawDashedObjectBorder <> <<[r: Rect, l: Layer, pr: DrawRef]>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> DrawObject: CD.DrawProc ~ BEGIN <<[inst: Instance, pos: Position, orient: Orientation, pr: REF DrawInformation]>> Process.CheckForAbort []; SELECT inst.ob.class.objectType FROM $Text, $RigidText, $FlipText => DrawText [inst, pos, orient, pr]; $Spline0, $Line0 => DrawPath [inst, pos, orient, pr]; $FilledCurve0, $Polygon0 => DrawArea [inst, pos, orient, pr]; <> ENDCASE => inst.ob.class.drawMe [inst, pos, orient, pr] END; -- DrawObject <> DoInterpress: PUBLIC PROC [design: CD.Design, chipNDaleWindow: CD.Rect, clip, onlySel: BOOL _ FALSE, abortFlag: REF BOOL] RETURNS [masterName: Rope.ROPE, usedField: Imager.Rectangle] ~ BEGIN <> <> <> <> interpress: ImagerInterpress.Ref; state: State ~ NEW [StateRec]; rgbLinear: Imager.ColorOperator ~ ImagerColorOperator.RGBLinearColorModel [255]; OpenIPMaster: PROC [] RETURNS [ImagerInterpress.Ref] ~ BEGIN <> ENABLE {FS.Error => GOTO failure}; subDir: Rope.ROPE ~ "[]<>Temp>Nectarine>"; -- follows the religion pos: FS.ComponentPositions; ext: Rope.ROPE ~ ".dummy"; -- anything, just not to lose the dot IF NOT design.name.IsEmpty[] THEN masterName _ design.name.Cat [ext] ELSE BEGIN cdName: Rope.ROPE ~ NARROW [CDValue.Fetch [design, $CDxLastFile]]; IF cdName.IsEmpty[] THEN masterName _ Rope.Cat ["UnnamedMaster", ext] ELSE BEGIN shortFName: Rope.ROPE; [fullFName: masterName, cp: pos] _ FS.ExpandName [cdName, subDir]; shortFName _ masterName.Substr [start: pos.base.start, len: pos.base.length]; masterName _ shortFName.Cat [ext] END END; [fullFName: masterName, cp: pos] _ FS.ExpandName [masterName, subDir]; masterName _ masterName.Replace [pos.ext.start, pos.ext.length, "Interpress"]; RETURN [ImagerInterpress.Create [masterName]]; EXITS failure => BEGIN masterName _ "[]<>Temp>Nectarine>UnnamedMaster.Interpress"; RETURN [ImagerInterpress.Create [masterName]] END END; -- OpenIPMaster DrawToIP: PROC [context: Imager.Context] ~ BEGIN <> tdr: CD.DrawRef ~ CD.CreateDrawRef [[]]; window: Imager.Rectangle ~ ImagerRect [chipNDaleWindow]; -- in the CG sense ratioW, ratioH, y0: REAL; iterations, bandSize: INT; -- number and size of bands chronos: BOOL; lap, end: BasicTime.GMT; EnumerateTextInDesign: PROC ~ BEGIN state.context.SetPriorityImportant [TRUE]; -- see EnumerateGeometry IF state.selectedOnly THEN DrawSelection [state.design, tdr] ELSE CDOps.DrawDesign [state.design, tdr] END; -- EnumerateTextInDesign state.context _ context; state.clip _ clip; state.selectedOnly _ onlySel; state.cdClip _ chipNDaleWindow; SetLayerColourTable []; ratioW _ field.w / window.w; ratioH _ field.h / window.h; usedField.x _ field.x; usedField.y _ field.y; -- in mm IF ratioH < ratioW THEN {usedField.w _ window.w * ratioH; usedField.h _ field.h} ELSE {usedField.w _ field.w; usedField.h _ window.h * ratioW}; <> <> y0 _ 0.0; context.TranslateT [[field.x, y0 + field.y]]; context.ScaleT [MIN [ratioW, ratioH]]; context.TranslateT [[-window.x, -window.y]]; context.SetStrokeJoint [mitered]; -- I hope that's faster for rectangles IF statistics THEN CleanColourTable [state]; state.startTime _ BasicTime.Now []; IF clip THEN context.ClipRectangle [window]; -- global to context !!! <> <> bandSize _ Fix [(1000000.0 * (risk+1)) / (window.w / design.technology.lambda)]; IF bandSize < 4 * design.technology.lambda THEN SIGNAL tooComplex; iterations _ Fix [window.h] / bandSize; -- "zero relative" ! IF (iterations > 5) THEN BEGIN TerminalIO.WriteRope [" There will be "]; TerminalIO.WriteInt [iterations]; TerminalIO.WriteRope [" sets of 3 dots "] END ELSE {IF debug THEN TerminalIO.WriteInt [iterations]}; IF ((iterations = 0) AND (NOT state.clip)) THEN PrintBand [state] -- shortcut ELSE BEGIN halftime: INT ~ iterations / 2; currentBand: REF CD.Rect ~ NEW [CD.Rect _ chipNDaleWindow]; <> state.band _ currentBand; chronos _ iterations > 5; FOR b: INT DECREASING IN [0 .. iterations] DO <> currentBand.y1 _ chipNDaleWindow.y1 + b * bandSize; currentBand.y2 _ MIN [chipNDaleWindow.y2, currentBand.y1 + bandSize + 1]; IF chronos THEN BEGIN <> fudge: INT ~ 8; IF (b = iterations - 3) THEN lap _ BasicTime.Now []; IF (b = iterations - 4) THEN BEGIN duration: INT ~ BasicTime.Period [lap, BasicTime.Now[]]; end _ BasicTime.Update [lap, fudge * duration * (b + 2) ! BasicTime.OutOfRange => GOTO endless]; TerminalIO.WriteF ["\nInterpress master will be ready ca. %g\n", IO.time [end]]; chronos _ FALSE END END; PrintBand [state]; IF (b = halftime) AND (iterations > 10) THEN BEGIN fudge: INT ~ 3; -- more than 2 because of memory fragmentation duration: INT ~ BasicTime.Period [state.startTime, BasicTime.Now[]]; end _ BasicTime.Update [state.startTime, fudge * duration ! BasicTime.OutOfRange => GOTO endless]; TerminalIO.WriteF ["\nInterpress master will be ready ca. %g\n", IO.time [end]] END ENDLOOP; state.band _ NIL END; IF (state.tess # NIL) THEN {CStitching.DumpCache []; state.tess _ NIL}; <> context.SetStrokeEnd [round]; context.SetStrokeJoint [round]; <> IF clip THEN tdr.interestClip _ chipNDaleWindow; tdr.drawChild _ DrawObject; tdr.drawOutLine _ DrawObjectBorder; tdr.borders _ TRUE; tdr.devicePrivate _ state; state.previousColour _ NIL; -- needed by Interpress state.previousStrokeWidth _ -1.0; -- needed by Interpress context.DoSave [EnumerateTextInDesign]; TerminalIO.WriteRope [". "]; -- pass 5 TerminalIO.WriteRope [TimeToRope [state.startTime, BasicTime.Now[]]]; TerminalIO.WriteRope ["\n"]; EXITS endless => BEGIN ImportantMessage [" Nectarine would not terminate before 2036"]; SIGNAL tooComplex END END; -- DrawToIP Action: PROC [] ~ BEGIN <> DeclareColours: HashTable.EachPairAction ~ BEGIN blendRec: Blend ~ NARROW [value]; IF (blendRec.blend # NIL) THEN interpress.DeclareColor [blendRec.blend]; RETURN [FALSE] END; DeclareFonts: RefTab.EachPairAction ~ {interpress.DeclareFont [NARROW [val,Font]]; RETURN [FALSE]}; ListFonts: RefTab.EachPairAction ~ {TerminalIO.WriteRope [NARROW[val,Font].name]; TerminalIO.WriteRope ["\n"]; RETURN [FALSE]}; state.interpress _ interpress _ OpenIPMaster []; TerminalIO.WriteRope [Rope.Cat ["Producing Interpress master ", masterName, "\n"]]; <> interpress.DeclareColorOperator [rgbLinear]; <> IF (colourTable.GetSize[] + fontMap.GetSize[] < 50) THEN [] _ colourTable.Pairs [DeclareColours]; -- this is a terrible hack, since the colours in the table are those from the previuos run. A request to provide a clean solution has been filed with the Imaging People. <> UpdateFontMap [state]; -- pass 1 IF (fontMap.GetSize[] < 50) THEN [] _ fontMap.Pairs [DeclareFonts]; TerminalIO.WriteRope [". "]; IF debug THEN BEGIN TerminalIO.WriteRope ["\nThe following fonts are in the preamble:\n"]; [] _ fontMap.Pairs [ListFonts] END; <> TRUSTED {Process.SetPriority [Process.priorityBackground]}; interpress.DoPage [action: DrawToIP, scale: 0.001]; <> interpress.Close []; <> FS.SetKeep [masterName, 3]; <> IF (statistics OR debug) THEN ListColourTable [state]; TerminalIO.WriteRope [Rope.Cat ["Interpress master ", masterName, " is ready.\n"]] END; -- Action state.design _ design; state.abort _ IF abortFlag # NIL THEN abortFlag ELSE NEW [BOOL _ FALSE]; Action [] -- fork END; -- DoInterpress DrawSelection: PROC [design: CD.Design, d: CD.DrawRef] ~ BEGIN <> FOR all: CD.InstanceList _ CDOps.InstList [design], all.rest WHILE all # NIL DO IF all.first.selected THEN d.drawChild [all.first, all.first.location, all.first.orientation, d] ENDLOOP END; -- DrawSelection EnumerateObjects: PROC [design: CD.Design, d: CD.DrawRef] ~ BEGIN <> DoObject: CDDirectory.EachEntryAction ~ BEGIN <> i: CD.Instance ~ CDInstances.NewInst [ob]; d.drawChild [i, [0,0], 0, d] END; -- DoObject [] _ CDDirectory.Enumerate [design, DoObject] END; -- EnumerateObjects ChangeColour: PROC [state: State, colour: Color] ~ INLINE BEGIN <> context: Imager.Context ~ state.context; a: ImagerColor.RGB ~ RGBFromColour [colour]; b: ImagerColor.RGB ~ RGBFromColour [state.previousColour]; IF (a.R # b.R) OR (a.G # b.G) OR (a.B # b.B) OR (state.previousColour = NIL) THEN BEGIN <> IF (a.R = 0.0) AND (a.G = 0.0) AND (a.B = 0.0) THEN context.SetColor [blackBlack] ELSE context.SetColor [colour]; state.previousColour _ colour END END; -- ChangeColour ChangeStrokeWidth: PROC [state: State, w: REAL] ~ INLINE BEGIN <> context: Imager.Context ~ state.context; IF (w < 0) OR (w # state.previousStrokeWidth) THEN BEGIN context.SetStrokeWidth [w]; state.previousStrokeWidth _ w END END; -- ChangeStrokeWidth ChangeFont: PROC [state: State, skFont: Font] ~ INLINE BEGIN <> context: Imager.Context ~ state.context; IF (skFont # state.previousFont) THEN BEGIN prFont: Font _ NARROW [fontMap.Fetch[skFont].val]; IF (prFont = NIL) THEN BEGIN <> prFont _ Mapping [skFont]; [] _ fontMap.Insert [skFont, prFont] END; context.SetFont [prFont]; state.previousFont _ skFont END END; -- ChangeFont LogInterpress: Interpress.LogProc ~ BEGIN <> TerminalIO.WriteRope [SELECT class FROM Interpress.classMasterError => "Master Error: ", Interpress.classMasterWarning => "Master Warning: ", Interpress.classAppearanceError => "Appearance Error: ", Interpress.classAppearanceWarning => "Appearance Warning: ", Interpress.classComment => "Comment: ", ENDCASE => IO.PutFR1 ["Class %g error: ", IO.int [class]]]; TerminalIO.WriteRope [explanation]; TerminalIO.WriteRope [" . . . \n"] END; -- LogInterpress ProgressLog: PrintFileConvert.ProgressProc ~ BEGIN <<[begin: BOOL, page: INT]>> IF begin THEN TerminalIO.WriteRope [IO.PutFR1 ["[%g", IO.int [page]]] ELSE TerminalIO.WriteRope ["] "] END; -- ProgressLog <> <> Bitset: TYPE ~ PACKED ARRAY CD.Layer OF BOOLEAN _ ALL [FALSE]; BlendKey: TYPE ~ REF Bitset; Blend: TYPE ~ REF BlendRec; BlendRec: TYPE ~ RECORD [count: CD.Layer _ 0, flavours: Bitset, blend: Color _ black, area: CARD _ 0]; colourTable: HashTable.Table ~ HashTable.Create [557, Match, Hash]; -- or 997 layerColorTable: ARRAY CD.Layer OF Color; -- must be set for each task ColourTile: PROC [old: Blend, l: CD.Layer] RETURNS [new: Blend] ~ BEGIN <> key: BlendKey ~ NEW [Bitset _ old.flavours]; key[l] _ TRUE; new _ NARROW [colourTable.Fetch[key].value, Blend]; IF (new = NIL) THEN BEGIN copy: Blend _ NEW [BlendRec _ [flavours: old.flavours]]; copy.count _ SUCC [old.count]; copy.flavours[l] _ TRUE; new _ copy; IF NOT colourTable.Insert [key, copy] THEN ERROR END END; -- ColourTile black: Color ~ ImagerColor.ColorFromRGB [[0.0, 0.0, 0.0]]; blackBlack: Color ~ Imager.black; blue: Color ~ ImagerColor.ColorFromRGB [[0.0, 0.0, 1.0]]; unColour: ImagerColor.RGB ~ [0.0, 0.0, 0.0]; yellowRGB: ImagerColor.RGB ~ [1.0, 1.0, 0.0]; magentaRGB: ImagerColor.RGB ~ [1.0, 0.0, 1.0]; cyan: Color ~ ImagerColor.ColorFromRGB [[0.0, 1.0, 1.0]]; lightYellow: Color ~ ImagerColor.ColorFromRGB [[6.0/7.0, 6.0/7.0, 3.0/7.0]]; lightMagenta: Color ~ ImagerColor.ColorFromRGB [[5.0/7.0, 0.0, 5.0/7.0]]; BlendColours: HashTable.EachPairAction ~ BEGIN <> <<[key: Key, value: Value] RETURNS [quit: BOOLEAN _ FALSE]>> components: Blend ~ NARROW [value]; n: REAL _ Float [components.count]; comp: PACKED ARRAY CD.Layer OF BOOLEAN _ components.flavours; mix: ImagerColor.RGB _ unColour; IF (components.blend # black) THEN RETURN [FALSE]; -- caching across sessions SELECT n FROM 0 => ERROR; -- should never have been allocated 1 => BEGIN i: CD.Layer _ 0; WHILE NOT comp[i] DO i _ SUCC [i] ENDLOOP; components.blend _ LayerColour [i] END; ENDCASE => BEGIN poly, diff, met, met2, cut, cut2, well: CD.Layer _ 0; <> FOR i: CD.Layer IN CD.Layer DO IF comp[i] THEN SELECT CD.LayerKey[i] FROM $pol => poly _ i; $ndif, $pdif => diff _ i; $met => met _ i; $met2 => met2 _ i; $nwel => well _ i; $cut => cut _ i; $cut2 => {cut _ i; cut2 _ i}; ENDCASE => NULL ENDLOOP; <> IF (cut # 0) THEN components.blend _ IF (cut2 # 0) THEN blue ELSE black ELSE BEGIN -- Assume: all other colours have the same weight. IF (poly # 0) AND (diff # 0) THEN BEGIN -- Handle gates. <> mix _ yellowRGB; n _ n - 1.0; comp[poly] _ comp[diff] _ FALSE END; IF (poly # 0) AND (met # 0) AND (diff = 0) THEN BEGIN -- Handle metal over poly. mix _ magentaRGB; n _ n - 1.0; comp[poly] _ comp[met] _ FALSE END; FOR i: CD.Layer IN CD.Layer DO -- Compute mean colour. IF comp[i] THEN BEGIN v: ImagerColor.RGB ~ RGBFromColour [LayerColour[i]]; mix.R _ mix.R + v.R; mix.G _ mix.G + v.G; mix.B _ mix.B + v.B END ENDLOOP; IF (met2 # 0) THEN BEGIN -- make metal-2 transparent mix.R _ mix.R - 4.0/7.0; mix.B _ mix.B - 4.0/7.0; n _ n - 4.0/7.0 END; IF (well # 0) THEN BEGIN -- make wells transparent mix.R _ mix.R - 5.0/7.0; mix.G _ mix.G - 5.0/7.0; n _ n - 5.0/7.0; mix.B _ mix.B - (3.0/7.0 * 2.0/7.0) -- take out well lightener END; mix.R _ mix.R / n; mix.G _ mix.G / n; mix.B _ mix.B / n; components.blend _ ImagerColor.ColorFromRGB [mix] END END; RETURN [FALSE] END; -- BlendColours LayerColour: PROC [l: CD.Layer] RETURNS [Color] ~ INLINE BEGIN <> RETURN [layerColorTable[l]] END; -- LayerColour SetLayerColourTable: PROC ~ BEGIN <> FOR i: CD.Layer IN CD.Layer DO SELECT CD.LayerKey[i] FROM $nwel => layerColorTable[i] _ lightYellow; $met => layerColorTable[i] _cyan; $met2 => layerColorTable[i] _ lightMagenta; ENDCASE => layerColorTable[i] _ CDColors.globalColors[bit8][normal].cols[i] ENDLOOP END; -- SetLayerColourTable BlendAllColours: PROC ~ BEGIN <> [] _ colourTable.Pairs [BlendColours] END; -- BlendAllColours Hash: PROC [k: HashTable.Key] RETURNS [CARDINAL] ~ BEGIN <> TRUSTED BEGIN RETURN [Checksum.ComputeChecksum [0, SIZE [BlendKey], LOOPHOLE [k]]] END END; -- Hash Match: PROC [a, b: HashTable.Key] RETURNS [BOOL] ~ BEGIN <> k1: BlendKey ~ NARROW [a, BlendKey]; k2: BlendKey ~ NARROW [b, BlendKey]; RETURN [(k1^ = k2^)] END; -- Match <> <> fontMap: RefTab.Ref ~ RefTab.Create []; -- global fontPrefix: ATOM ~ Atom.MakeAtom ["xerox/pressfonts/"]; visitedCells: RefTab.Ref; DrawFilter: CD.DrawProc ~ BEGIN <<[inst: Instance, pos: Position, orient: Orientation, pr: REF DrawInformation]>> SELECT inst.ob.class.objectType FROM $Text, $RigidText, $FlipText => FindFont [inst, pos, orient, pr]; $Cell => <> IF visitedCells.Insert [inst.ob, $hack] THEN inst.ob.class.drawMe [inst, pos, orient, pr]; ENDCASE => NULL END; -- DrawFilter FindFont: CD.DrawProc ~ BEGIN <<[inst: Instance, pos: Position, orient: Orientation, pr: REF DrawInformation]>> text: CDTexts.TextPtr ~ NARROW [inst.ob.specificRef]; font: Font ~ text.cdFont.font; IF NOT fontMap.Fetch[font].found THEN [] _ fontMap.Insert [font, Mapping [font]] END; -- FindFont UpdateFontMap: PROC [state: State] ~ BEGIN <> tdr: CD.DrawRef ~ CD.CreateDrawRef [[]]; Evict: RefTab.EachPairAction ~ {[] _ visitedCells.Delete [key]; RETURN [FALSE]}; remindFontConventions _ TRUE; tdr.drawChild _ DrawFilter; tdr.devicePrivate _ state; IF state.selectedOnly THEN DrawSelection [state.design, tdr] ELSE BEGIN <> visitedCells _ RefTab.Create [557]; EnumerateObjects [state.design, tdr]; [] _ visitedCells.Pairs [Evict]; visitedCells _ NIL END END; -- UpdateFontMap Mapping: PROC [sk: Font] RETURNS [mr: Font] ~ BEGIN <> shortFName, subDir, fullFName, family, attributes: Rope.ROPE; cp: FS.ComponentPositions; sizePos, facePos: INTEGER; face: NodeStyle.FontFace _ Regular; size: REAL; [fullFName, cp] _ FS.ExpandName [name: sk.name]; subDir _ fullFName.Substr [start: cp.subDirs.start, len: cp.subDirs.length]; SELECT TRUE FROM subDir.Equal ["Xerox>PressFonts", FALSE] => BEGIN IF remindFontConventions THEN BEGIN TerminalIO.WriteRope ["Nectarine takes care of all the font substitutions. You can use the strike fonts for the layout.\n"]; remindFontConventions _ FALSE END; mr _ sk END; subDir.Equal ["Xerox>TiogaFonts", FALSE] => BEGIN <> shortFName _ fullFName.Substr [start: cp.base.start, len: cp.base.length]; <> sizePos _ shortFName.SkipTo [0, "0123456789"]; attributes _ shortFName.Substr [sizePos, shortFName.Length[]-sizePos]; facePos _ attributes.SkipTo [0, "bBiI"]; <> size _ (ORD [attributes.Fetch[0]] - ORD ['0]); FOR i: INT IN [1 .. facePos) DO size _ size * 10.0 + (ORD [attributes.Fetch[i]] - ORD ['0]) ENDLOOP; <> IF (facePos # attributes.Length[]) THEN BEGIN it: BOOL ~ (attributes.SkipTo [0, "iI"] # attributes.Length[]); b: BOOL ~ (attributes.SkipTo [0, "bB"] # attributes.Length[]); SELECT TRUE FROM it AND b => face _ BoldItalic; it AND NOT b => face _ Italic; NOT it AND b => face _ Bold; ENDCASE => ERROR END; family _ shortFName.Substr [0, sizePos]; mr _ NodeStyleFont.FontFromStyleParams [prefix: fontPrefix, family: Atom.MakeAtom[family], face: face, size: size, alphabets: CapsAndLower]; mr _ ImagerFont.Modify [mr, sk.charToClient] END; ENDCASE => BEGIN TerminalIO.WriteRope [Rope.Cat [fullFName, "font class", subDir, " unknown, not substituted.\n"]]; mr _ sk END END; -- Mapping ImagerRect: PROC [r: CD.Rect] RETURNS [Imager.Rectangle] ~ BEGIN base: CD.Position ~ CDBasics.BaseOfAnyRect [r]; size: CD.Position ~ CDBasics.SizeOfRect [r]; RETURN [[Float[base.x], Float[base.y], Float[size.x], Float[size.y]]] END; -- ImagerRect ImagerVec: PROC [p: CD.Position] RETURNS [Imager.VEC] ~ BEGIN RETURN [[Float[p.x], Float[p.y]]] END; -- ImagerVec <> <> <> RGBFromColour: PROC [c: Color] RETURNS [rgb: ImagerColor.RGB] ~ INLINE BEGIN <> WITH c SELECT FROM constant: Imager.ConstantColor => BEGIN rgb.R _ ImagerColorPrivate.ComponentFromColor [constant, $Red]; rgb.G _ ImagerColorPrivate.ComponentFromColor [constant, $Green]; rgb.B _ ImagerColorPrivate.ComponentFromColor [constant, $Blue] END; ENDCASE => rgb _ unColour; RETURN [rgb] END; -- RGBFromColour ImportantMessage: PROC [msg: Rope.ROPE] ~ BEGIN <> TerminalIO.WriteRope [msg]; TerminalIO.WriteRope ["\n"]; MessageWindow.Clear []; MessageWindow.Append [msg]; MessageWindow.Blink [] END; -- ImportantMessage <> PeachProcess: PROC [masterName, peachName: Rope.ROPE, printerKey: ATOM, copies: INT, sizeHint: REF Imager.Rectangle _ NIL] ~ BEGIN <> <> <> ENABLE {PeachPrint.PupAborted => GOTO failure}; serverName: Rope.ROPE; deviceParameters: PrintFileConvert.PDParams; scale: REAL; FillSample: PROC [s: ImagerBrick.Brick, a, b, c, d: REAL] ~ BEGIN <> IF (s.size # 4 )THEN ERROR; s.sSize _ 2; s.fSize _ 2; s.phase _ 0; s.u _ 0; s.v _ 0; s.samples[0] _ a; s.samples[1] _ b; s.samples[2] _ c; s.samples[3] _ d END; -- FillSample TRUSTED {Process.SetPriority [Process.priorityBackground]}; SELECT printerKey FROM $NVersatec => BEGIN <> deviceParameters _ PrintFileConvert.ParamsFromPrinterType [$versatec]; IF (sizeHint # NIL) AND (sizeHint.h > sizeHint.w) THEN BEGIN scale _ (mmXin * deviceParameters.pageFSize) / sizeHint.w; IF (scale * sizeHint.h > 2000) THEN ImportantMessage [" Your plot will be longer than 2 metres."] END ELSE scale _ (mmXin * deviceParameters.pageFSize) / field.w; serverName _ UserProfile.Token ["Nectarine.Versatec", "Sleepy"] END; $NColorVersatec, $NPeachExpand => BEGIN <> brickB: ImagerBrick.Brick _ NEW [ImagerBrick.BrickRep[4]]; brickC: ImagerBrick.Brick _ NEW [ImagerBrick.BrickRep[4]]; brickM: ImagerBrick.Brick _ NEW [ImagerBrick.BrickRep[4]]; brickY: ImagerBrick.Brick _ NEW [ImagerBrick.BrickRep[4]]; deviceParameters _ PrintFileConvert.ParamsFromPrinterType [$colorVersatec]; IF (sizeHint # NIL) AND (sizeHint.h > sizeHint.w) THEN BEGIN scale _ (mmXin * deviceParameters.pageFSize) / sizeHint.w; IF (scale * sizeHint.h > 2000) THEN ImportantMessage [" Your plot will be longer than 2 metres."] END ELSE scale _ (mmXin * deviceParameters.pageFSize) / field.w; serverName _ IF (printerKey = $NColorVersatec) THEN UserProfile.Token ["Nectarine.ColorVersatec", "Sleepy"] ELSE UserProfile.Token ["Nectarine.PeachExpand", "Kearsarge"]; FillSample [brickB, 0.6, 0.4, 0.2, 0.8]; FillSample [brickC, 0.2, 0.8, 0.6, 0.4]; FillSample [brickM, 0.6, 0.4, 0.2, 0.8]; FillSample [brickY, 0.42, 0.15, 0.7, 0.3]; -- delicate ! <> deviceParameters.bricks [black] _ brickB; deviceParameters.bricks [cyan] _ brickC; deviceParameters.bricks [magenta] _ brickM; deviceParameters.bricks [yellow] _ brickY <> <> END; $NBw400 => BEGIN <> deviceParameters _ PrintFileConvert.ParamsFromPrinterType [$bw400]; scale _ (mmXin * deviceParameters.pageFSize) / field.w; serverName _ UserProfile.Token ["Nectarine.Bw400", "MtFuji"] END; $NColor400 => BEGIN <> deviceParameters _ PrintFileConvert.ParamsFromPrinterType [$color400]; deviceParameters.ppd _ 4.0; scale _ (mmXin * deviceParameters.pageFSize) / field.w; serverName _ UserProfile.Token ["Nectarine.Color400", "MtFuji"] END; $NPlateMaker => BEGIN <> deviceParameters _ PrintFileConvert.ParamsFromPrinterType [$plateMaker]; deviceParameters.tonerUniverse _ LIST [black, cyan, magenta, yellow]; <> scale _ MIN [(mmXin*deviceParameters.pageFSize)/field.w, (mmXin*deviceParameters.pageSSize)/field.h] END; $NRaven300 => serverName _ UserProfile.Token ["Nectarine.Raven300", "Quoth"]; ENDCASE => NULL; -- can never happen <> SELECT printerKey FROM $NRaven300 => NULL; $NPlateMaker => BEGIN tx: REAL ~ - (field.x * scale) / mmXin; ty: REAL ~ - (field.y * scale) / mmXin; separation: Rope.ROPE _ peachName.Cat ["-Black"]; deviceParameters.toners _ LIST [black]; PrintFileConvert.InterpressToPD [inputName: masterName, outputName: separation, params: deviceParameters, sx: scale, sy: scale, tx: tx, ty: ty, logProc: LogInterpress, progressProc: ProgressLog]; TerminalIO.WriteRope [Rope.Cat ["Black separation written on ", separation, "\n"]]; separation _ peachName.Cat ["-Cyan"]; deviceParameters.toners _ LIST [cyan]; PrintFileConvert.InterpressToPD [inputName: masterName, outputName: separation, params: deviceParameters, sx: scale, sy: scale, tx: tx, ty: ty, logProc: LogInterpress, progressProc: ProgressLog]; TerminalIO.WriteRope [Rope.Cat ["Cyan separation written on ", separation, "\n"]]; separation _ peachName.Cat ["-Magenta"]; deviceParameters.toners _ LIST [magenta]; PrintFileConvert.InterpressToPD [inputName: masterName, outputName: separation, params: deviceParameters, sx: scale, sy: scale, tx: tx, ty: ty, logProc: LogInterpress, progressProc: ProgressLog]; TerminalIO.WriteRope [Rope.Cat ["Magenta separation written on ", separation, "\n"]]; separation _ peachName.Cat ["-Yellow"]; deviceParameters.toners _ LIST [yellow]; PrintFileConvert.InterpressToPD [inputName: masterName, outputName: separation, params: deviceParameters, sx: scale, sy: scale, tx: tx, ty: ty, logProc: LogInterpress, progressProc: ProgressLog]; TerminalIO.WriteRope [Rope.Cat ["Yellow separation written on ", separation, "\n"]]; TerminalIO.WriteRope ["Copy these files onto [Indigo]your name> and message the operator . Please advise him that the separations make use of the full device size.\n\n"] END; ENDCASE => BEGIN PrintFileConvert.InterpressToPD [inputName: masterName, outputName: peachName, params: deviceParameters, sx: scale, sy: scale, tx: - (field.x * scale) / mmXin, ty: - (field.y * scale) / mmXin, logProc: LogInterpress, progressProc: ProgressLog]; <> FS.SetKeep [peachName, 3] <> END; IF (printerKey # $NPlateMaker) THEN BEGIN TerminalIO.WriteRope [Rope.Cat ["Sending ", peachName, " to ", serverName, "\n."]]; PeachPrint.DoPeachPrintCommand [serverName, peachName, TerminalIO.TOS[], FALSE, copies] END; IF (printerKey = $NPeachExpand) THEN BEGIN pos: FS.ComponentPositions ~ FS.ExpandName[peachName].cp; server2Name: Rope.ROPE ~ UserProfile.Token ["Nectarine.ExpandedPeach", "Sleepy"]; simpleName: Rope.ROPE ~ peachName.Substr [pos.base.start, pos.base.length]; peachName _ Rope.Cat ["[", serverName, "]PD>", simpleName, "-1.PD"]; TerminalIO.WriteRope [Rope.Cat ["Sending ", peachName, " to ", server2Name, "\n."]]; PeachPrint.DoPeachPrintCommand [server2Name, peachName, TerminalIO.TOS[], FALSE, copies] END; EXITS failure => BEGIN ImportantMessage [Rope.Cat ["Peach communications failure. File saved on ", peachName, " for manual retry."]]; <> END END; -- PeachProcess Print: PUBLIC PROC [masterName: Rope.ROPE, printerKey: ATOM, copies: INT _ 1, sizeHint: REF Imager.Rectangle _ NIL] RETURNS [peachName: Rope.ROPE] ~ BEGIN <> <> IF (masterName = NIL) THEN TerminalIO.WriteRope ["Produce an Interpress master first.\n"] ELSE BEGIN pos: FS.ComponentPositions ~ FS.ExpandName[masterName].cp; SELECT printerKey FROM $NVersatec, $NColorVersatec, $NBw400, $NColor400, $NPeachExpand, $NPlateMaker => peachName _ masterName.Replace [pos.ext.start, pos.ext.length, "PD"]; $NRaven300 => peachName _ masterName; -- understands Interpress ENDCASE => SIGNAL invalidPrinter; Process.CheckForAbort []; TRUSTED BEGIN Process.Detach [FORK PeachProcess [masterName, peachName, printerKey, copies, sizeHint]] END; TerminalIO.WriteRope ["Peach printing process forked off.\n"] END END; -- Print <> GetStatisticsToggle: UserProfile.ProfileChangedProc ~ BEGIN statistics _ UserProfile.Boolean [key: "Nectarine.Statistics"] END; ListColourTable: PROC [state: State] ~ BEGIN <> totalArea: REAL _ 0.0; -- It is the way it is because of numerical stability. ComputeArea: HashTable.EachPairAction ~ BEGIN data: Blend ~ NARROW [value]; totalArea _ totalArea + Float [data.area] END; -- ComputeArea ListEntry: HashTable.EachPairAction ~ BEGIN data: Blend ~ NARROW [value]; comp: ImagerColor.RGB ~ RGBFromColour [data.blend]; IF totalArea = 0.0 THEN totalArea _ 1.0; TerminalIO.WriteF ["%g\t%g\t%g\t\t%g\t", IO.real[comp.R], IO.real[comp.G], IO.real[comp.B], IO.real[Float[data.area]/totalArea]]; FOR i: CD.Layer IN CD.Layer DO IF data.flavours[i] THEN TerminalIO.WriteF [" %g", IO.atom [CD.LayerKey[i]]] ENDLOOP; TerminalIO.WriteRope ["\n"] END; -- ListEntry TerminalIO.WriteF ["Statistical data gathered by Nectarine:\n\tSize of color table: %g; number of tiles: %g\n\tColor (R, G, B), relative area and layers\n", IO.int [colourTable.GetSize[]], IO.int [state.cardTile]]; [] _ colourTable.Pairs [ComputeArea]; IF debug THEN BEGIN [] _ colourTable.Pairs [ListEntry]; TerminalIO.WriteRope ["Colors with null area were intermediate.\n"] END END; -- ListColourTable CleanColourTable: PROC [state: State] ~ BEGIN <> ResetArea: HashTable.EachPairAction ~ {rec: Blend ~ NARROW [value]; rec.area _ 0}; [] _ colourTable.Pairs [ResetArea]; state.cardTile _ 0 END; -- CleanColourTable TimeToRope: PROC [from, to: BasicTime.GMT] RETURNS [time: Rope.ROPE] ~ BEGIN <> tmp: Rope.ROPE; sec: INT = BasicTime.Period [from, to]; min: INT = sec / 60; h: INT = min / 60; tmp _ IO.PutFR1 [value: IO.int [h]]; time _ SELECT h FROM = 0 => "00", < 10 => Rope.Cat ["0", tmp], ENDCASE => tmp; tmp _ IO.PutFR1 [value: IO.int [min MOD 60]]; time _ Rope.Cat [time, ":", SELECT min FROM = 0 => "00", < 10 => Rope.Cat ["0", tmp], ENDCASE => tmp]; tmp _ IO.PutFR1 [value: IO.int [sec MOD 60]]; time _ Rope.Cat [time, ":", SELECT sec FROM = 0 => "00", < 10 => Rope.Cat ["0", tmp], ENDCASE => tmp] END; -- TimeToRope <> UserProfile.CallWhenProfileChanges [GetStatisticsToggle] END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>>