DIRECTORY
Atom USING [MakeAtom],
BasicTime USING [GMT, Now, OutOfRange, Period, Update],
CD USING [CreateDrawRef, Design, DrawProc, DrawRectProc, DrawRef, Instance, InstanceList, Layer, LayerKey, 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],
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],
HashTable USING [Create, EachPairAction, Fetch, GetSize, Insert, Key, Pairs, Table],
Imager USING [ClipRectangle, Color, ColorOperator, ConcatT, Context, ConstantColor, DoSave, Font, MaskRectangle, MaskStrokeTrajectory, Rectangle, ScaleT, SetColor, SetFont, SetPriorityImportant, SetStrokeEnd, SetStrokeWidth, SetXY, ShowRope, StrokeEnd, TranslateT, VEC],
ImagerBrick USING [Brick, BrickRep],
ImagerColor USING [ColorFromRGB, RGB],
ImagerColorPrivate USING [ComponentFromColor],
ImagerColorOperator USING [ColorOperator, RGBLinearColorModel],
ImagerFont USING [Modify],
ImagerInterpress USING [Close, Create, DeclareColor, DeclareColorOperator, DeclareFont, DoPage, Ref],
ImagerPDPublic USING [Toner],
ImagerTransformation USING [Invert, Transformation],
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, 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];
OPEN Real;
Implementation note on clipping: If bands have to be created because of the size of the design, true clipping to bands must be done when traversing the design. The penalty on the corner stitched data structure may be swallowed, since it is an overnight job anyway. However, leaving clipping to the Imager, you will have all those rectangles in the Interpress master with their multiciplity. A large disk can hold only about 90% of a thing like the Cross-RAM, and every single file on your disk will have been flushed off when you come in in the morning.
If you insist on leaving the clipping to the imager, then you must be very careful deciding where to place it. The reason is that clipping in the Imager is relative, and therefore the window must be specified inside Do-Save-Simple-Body, in order not to disturb the global clipping window. The places would be EnumerateGeometry and EnumerateTextInDesign.
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;
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];
statistics: BOOL ← FALSE;
debug: BOOL ← FALSE;
remindFontConventions: BOOL ← TRUE;
risk: [0 .. 10) ← 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 l. At zero risk, Nectarine uses only 14 MB of memory in the worst case.
Geometry
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
Does what FreeTesselation supposedly did once upon a time.
CStitching.ResetTesselation [dec]
END; -- FlushDecomposition
PrintTile: CStitching.TileProc ~
BEGIN
PROC [tile: REF Tile, data: REF]
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
b.area ← b.area + (r.x2 - r.x1) * (r.y2 - r.y1);
state.cardTile ← SUCC [state.cardTile]
END
END; -- PrintTile
PrintBand:
PROC [state: State] ~
BEGIN
Prints a band. If there is only one band and no clipping is necessary, setting clip to false will make it faster.
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: PrintTile, 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
Note that merging works correctly because of the use of the colour table.
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
Annotation
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: ImagerTransformation.Transformation ~ CDOrient.CreateTransform [cellSize: inst.ob.size, cellInstOrient: orient, cellInstPos: pos];
invTransf: ImagerTransformation.Transformation ~ ImagerTransformation.Invert [transf];
Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED;
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: ImagerTransformation.Transformation ~ CDOrient.CreateTransform [cellSize: inst.ob.size, cellInstOrient: orient, cellInstPos: pos];
invTransf: ImagerTransformation.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
DrawObjectBorder:
CD.DrawRectProc ~
BEGIN
[r: Rect, l: Layer, pr: DrawRef]
The border is drawn outside the cell, since this is the way they are used by Rick Barth, currently the only creator of documents using boxes.
state: State ~ NARROW [pr.devicePrivate, State];
pen: REAL ~ Float [state.design.technology.lambda / 4];
object, border: Imager.Rectangle;
Process.CheckForAbort []; IF state.abort^ THEN ERROR ABORTED;
ChangeColour [state, black];
object ← ImagerRect [r];
South:
object.x ← object.x - pen; object.y ← object.y - pen;
object.w ← object.w + 2 * pen; object.h ← object.h + 2 * pen;
border ← [x: object.x, y: object.y, w: object.w , h: pen];
state.context.MaskRectangle [border];
West:
border ← [x: object.x, y: object.y, w: pen, h: object.h];
state.context.MaskRectangle [border];
East:
border ← [x: object.x + object.w - pen, y: object.y, w: pen, h: object.h];
state.context.MaskRectangle [border];
North:
border ← [x: object.x, y: object.y + object.h - pen, w: object.w, h: pen];
state.context.MaskRectangle [border]
END; -- DrawObjectBorder
DrawObject:
CD.DrawProc ~
BEGIN
[inst: Instance, pos: Position, orient: Orientation, pr: REF DrawInformation]
Process.CheckForAbort [];
SELECT inst.ob.class.objectType
FROM
$Text => DrawText [inst, pos, orient, pr];
$Spline0, $Line0, $Polygon0 => DrawPath [inst, pos, orient, pr];
$FilledCurve0 =>
The procedure for rectangles is called through the recursion step.
ENDCASE => inst.ob.class.drawMe [inst, pos, orient, pr]
END; -- DrawObject
Interpress
DoInterpress:
PUBLIC
PROC [design:
CD.Design, chipNDaleWindow:
CD.Rect, clip, onlySel:
BOOL ←
FALSE, abortFlag:
REF
BOOL]
RETURNS [masterName: Rope.
ROPE, usedField: Imager.Rectangle] ~
BEGIN
Produces an Interpress master of the design. The master is scaled such that it fits a whole page. chipNDaleWindow is either the bounding box of the design or a window in it. In the latter case, clip must be set to TRUE, and objects completetly outside the window will be ommitted from the Interpress master (because of things like mitering, actual clipping can be performed only when a bitmap is created).
The usedField is specified in millimeters. It is useful for subsequent processing of the Interpress master as long as this field cannot be specified in the preamble of Interpress masters themselves.
If onlySel is true, only the selected object are included in the Interpress master.
May return signal tooComplex if it is believed that there might be too many rectangles in a horizontal cross section. The used criterion is the width of the design; if you do not agree, use the Interpreter to increase the risk.
interpress: ImagerInterpress.Ref;
state: State ~ NEW [StateRec];
rgbLinear: Imager.ColorOperator ~ ImagerColorOperator.RGBLinearColorModel [255];
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
OpenIPMaster:
PROC []
RETURNS [ImagerInterpress.Ref] ~
BEGIN
Creates the interpress master.
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
Called back by the Interpress machinery.
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};
Preview considers the top of the page to be most important, because we write text from top to bottom. Also designers want have images to be flush to the top of the field, so they can use the bottom of the medium for hand-annotations. Unfortunately, this causes a severe problem when producing a PD file. In fact there is said to be a hack fixing a hard bug in the Peach software. This hack is said to be a white rectangle at the lower left corner of the medium. On the Versatec this means that with every image in landscape format you would get meters of white paper. This is why images are positioned in the lower left corner of the field.
y0 ← IF ratioH < ratioW THEN 0.0 ELSE field.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]];
IF statistics THEN CleanColourTable [state];
state.startTime ← BasicTime.Now [];
IF clip THEN context.ClipRectangle [window]; -- global to context !!!
Rectangles:
Magic numbers: Assume 14 MB of memory may be used. Each tile requires 7 words of storage, hence 106 tiles can be stored. In the current worst case, a die is 10 mm wide. If a gate can be 2 mm long, in the worst case there is a rectangle each mm.
bandSize ← (1000000 * (risk+1)) / Fix[window.w / design.technology.lambda];
IF bandSize < 4 * design.technology.lambda THEN SIGNAL tooComplex;
iterations ← Fix [window.h] / bandSize; -- "zero relative" !
IF debug
THEN
BEGIN
TerminalIO.WriteRope [" there will be "];
TerminalIO.WriteInt [iterations]; TerminalIO.WriteRope [" reiterations "]
END
ELSE 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];
The intersection of the current band with the clipping window is performed by PrintBand. The field state.cdClip is assigned earlier.
state.band ← currentBand;
chronos ← iterations > 5;
FOR b:
INT
DECREASING
IN [0 .. iterations]
DO
Produce bands from high to low y-coordinate values in order to avoid paging in succeeding software.
currentBand.y1 ← chipNDaleWindow.y1 + b * bandSize;
currentBand.y2 ← MIN [chipNDaleWindow.y2, currentBand.y1 + bandSize];
IF chronos
THEN
BEGIN
The first bands are not typical, because they are not dense.
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};
Text:
context.SetStrokeEnd [square];
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
TerminalIO.WriteRope [" Would not terminate before 2036.\n"];
MessageWindow.Clear [];
MessageWindow.Append ["Nectarine would not terminate before 2036"];
MessageWindow.Blink [];
SIGNAL tooComplex
END
END; -- DrawToIP
Action:
PROC [] ~
BEGIN
Does it at background priority.
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]};
TRUSTED {Process.SetPriority [Process.priorityBackground]};
state.interpress ← interpress ← OpenIPMaster [];
TerminalIO.WriteRope [Rope.Cat ["Producing Interpress master ", masterName, "\n"]];
Produce preamble.
interpress.DeclareColorOperator [rgbLinear];
[] ← 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.
Create a table of the fonts and them in the preamble.
UpdateFontMap [state]; -- pass 1
[] ← fontMap.Pairs [DeclareFonts]; TerminalIO.WriteRope [". "];
IF debug
THEN
BEGIN
TerminalIO.WriteRope ["\nThe following fonts are in the preamble:\n"];
[] ← fontMap.Pairs [ListFonts]
END;
Produce the page. All coordinates will be in millimeters.
interpress.DoPage [action: DrawToIP, scale: 0.001];
Close.
interpress.Close [];
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
Same as CDOps.DrawDesign, but visits only the selected objects.
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
Same as CDOps.DrawDesign, but visits objects only once.
DoObject: CDDirectory.EachEntryAction ~
BEGIN
PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE]
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
At this point we know that only one colour representation is used. Must be fast as a bullet.
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
context.SetColor [colour]; state.previousColour ← colour
END
END; -- ChangeColour
ChangeStrokeWidth:
PROC [state: State, w:
REAL] ~
INLINE
BEGIN
w < 0 means that it has not yet been set in this body. Must be fast as a bullet.
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
Must be fast as a bullet
context: Imager.Context ~ state.context;
IF (skFont # state.previousFont)
THEN
BEGIN
context.SetFont [NARROW [fontMap.Fetch[skFont].val, Font]];
state.previousFont ← skFont
END
END; -- ChangeFont
LogInterpress: Interpress.LogProc ~
BEGIN
Called for errors during interpress execution. [class: INT, code: ATOM, explanation: ROPE]
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
Color Blending
Data is global
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
Sets up a blending record for a tile. Must be fast as a bullet.
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]];
blue: Color ~ ImagerColor.ColorFromRGB [[0.0, 0.0, 1.0]];
blackRGB: 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
Takes the layers covering a tile and blend an RBG-colour out of them.
components: Blend ~ NARROW [value];
n: REAL ← Float [components.count];
comp: PACKED ARRAY CD.Layer OF BOOLEAN ← components.flavours;
mix: ImagerColor.RGB ← blackRGB;
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;
Find exception layers.
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;
Cuts always win.
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.
Reinitialize mix by yellow and eliminate poly and diff.
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
Ensure that only one colour representation is used.
RETURN [layerColorTable[l]]
END; -- LayerColour
SetLayerColourTable:
PROC ~
BEGIN
Spread out hues & make "more subtractive".
FOR i:
CD.Layer
IN
CD.Layer
DO
SELECT
CD.LayerKey[i]
FROM
$nwel => layerColorTable[i] ← lightYellow;
$met => layerColorTable[i] 𡤌yan;
$met2 => layerColorTable[i] ← lightMagenta;
ENDCASE => layerColorTable[i] ← CDColors.globalColors[bit8][normal].cols[i]
ENDLOOP
END; -- SetLayerColourTable
BlendAllColours:
PROC ~
BEGIN
The logarithm of the number of colours is two, that of the rectangles is six.
[] ← colourTable.Pairs [BlendColours]
END; -- BlendAllColours
Hash:
PROC [k: HashTable.Key]
RETURNS [
CARDINAL] ~
BEGIN
PROC [Key] RETURNS [CARDINAL]
TRUSTED
BEGIN
RETURN [Checksum.ComputeChecksum [0, SIZE [BlendKey], LOOPHOLE [k]]]
END
END; -- Hash
Match:
PROC [a, b: HashTable.Key]
RETURNS [
BOOL] ~
BEGIN
HashTable.EqualProc
k1: BlendKey ~ NARROW [a, BlendKey]; k2: BlendKey ~ NARROW [b, BlendKey];
RETURN [(k1^ = k2^)]
END; -- Match
Conversions
Data is global
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 => FindFont [inst, pos, orient, pr];
$Cell =>
There is no facility offered by ChipNDale to visit only a cell without recursing to its subcells, so here is a homebrew hack.
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
The map is global, because fonts rarely change across designs.
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
DrawDesign is an overkill, which easily takes 20 minutes on the CrossRAM. There is no facility offered by ChipNDale to visit only a cell without recursing to its subcells, so here is a homebrew hack.
visitedCells ← RefTab.Create [557];
EnumerateObjects [state.design, tdr];
[] ← visitedCells.Pairs [Evict]; visitedCells ← NIL
END
END; -- UpdateFontMap
Mapping:
PROC [sk: Font]
RETURNS [mr: Font] ~
BEGIN
Translates from strike to spline fonts.
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
Construct the old style name:
shortFName ← fullFName.Substr [start: cp.base.start, len: cp.base.length];
Find the size and face from the old style name:
sizePos ← shortFName.SkipTo [0, "0123456789"];
attributes ← shortFName.Substr [sizePos, shortFName.Length[]-sizePos];
facePos ← attributes.SkipTo [0, "bBiI"];
Compute the size (assume: there always is a size):
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;
Determine the face:
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
CdPos: PROC [v: Imager.VEC] RETURNS [CD.Position] ~ BEGIN
RETURN [[Round[v.x], Round[v.y]]]
END; -- CdPos
RGBFromColour:
PROC [c: Color]
RETURNS [rgb: ImagerColor.
RGB] ~
INLINE
BEGIN
Assume that LayerColour had previously been called.
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 ← [0.0, 0.0, 0.0];
RETURN [rgb]
END; -- RGBFromColour