DIRECTORY
CD,
CDBasics,
CDCells,
CDCreateLabels,
CDDirectory,
CDOps,
CDPanelFonts,
CDProperties,
CDRects,
CDSequencer, 
CDSymbolicObjects,
CDTexts,
CStitching,
Imager,
ImagerBitmapContext,
ImagerFont,
ImagerSample,
IO,
Real,
Rope,
SF,
TerminalIO;

CDCreateLabelsImpl: CEDAR PROGRAM
IMPORTS  CD, CDBasics, CDCells, CDDirectory, CDOps, CDPanelFonts, CDProperties, CDRects, CDSequencer, CDSymbolicObjects, CStitching, Imager, ImagerBitmapContext, ImagerFont, ImagerSample, IO, Real, Rope, SF, TerminalIO
EXPORTS CDCreateLabels =
BEGIN

DoStop: ERROR = CODE;

IntValue: PROC [ob: CD.Object, a: ATOM] RETURNS [i: INT_0] = {
WITH  CDProperties.GetObjectProp[ob, a] SELECT FROM
ri: REF INT => i _ ri^;
ENDCASE => NULL;
};

PutIntValue: PROC [ob: CD.Object, a: ATOM, i: INT_0] = {
CDProperties.PutObjectProp[ob, a, (IF i=0 THEN NIL ELSE NEW[INT _ i])];
};

NameForCharCache: PROC [font: Imager.Font, ch: CHAR, scale: INT, layer: CD.Layer] RETURNS [n: Rope.ROPE_NIL] = {

HashT: PROC [t: Imager.Transformation] RETURNS [Rope.ROPE] = {
r: Rope.ROPE _ IO.PutFR["%g,%g,%g,%g", IO.real[t.a], IO.real[t.b], IO.real[t.c], IO.real[t.d]];
RETURN [IO.PutFR["%g,%g,%g", IO.rope[r], IO.real[t.e], IO.real[t.f]]]
};

h: Rope.ROPE _ HashT[font.charToClient];
n _ IO.PutFR["#%g[%g|%d|%g|%g]", 
IO.char[ch], IO.rope[ImagerFont.Name[font]], IO.int[scale], IO.atom[CD.LayerKey[layer]], IO.rope[h]
];
};

CStitchSampleMap: PUBLIC PROC [map: ImagerSample.SampleMap, stop: REF BOOL_NIL] RETURNS [plane: CStitching.Tesselation] = {
box: ImagerSample.Box = ImagerSample.GetBox[map];
height: INTEGER _ box.max.s-box.min.s;
IF stop=NIL THEN stop _ NEW[BOOL_FALSE];
plane _ CStitching.NewTesselation[stopFlag: stop];
FOR y: INTEGER IN [box.min.s..box.max.s) DO
IF stop^ THEN RETURN;
FOR x: INTEGER IN [box.min.f..box.max.f) DO 
IF ImagerSample.Get[map, [s: y, f: x]]#0 THEN
CStitching.ChangeRect[
plane: plane, 
rect: [x1: x, x2: x+1, y1: y, y2: y+1],
new: $covered
];
ENDLOOP;
ENDLOOP;
};

CreateCellFromCStitching: PUBLIC PROC [plane: CStitching.Tesselation, layer: CD.Layer, csOrigin: CStitching.Pos _ [0, 0], scale: INT _ 1] RETURNS [cell: CD.Object] = {
stop: REF BOOL _ plane.stopFlag;

IncludeRect: CStitching.TileProc = {
r: CD.Rect = CStitching.Area[tile];
IF CDBasics.NonEmpty[r] THEN { 
IF stop^ THEN ERROR DoStop;
[] _ CDCells.IncludeOb[cell: cell,
ob: CDRects.CreateRect[size: [x: (r.x2-r.x1)*scale, y: (r.y2-r.y1)*scale], l: layer],
trans: [[(r.x1-csOrigin.x)*scale, (r.y1-csOrigin.y)*scale], original],
mode: dontResize
];
};
}; 

stop _ plane.stopFlag;
IF stop=NIL THEN stop _ NEW[BOOL_FALSE];
cell _ CDCells.CreateEmptyCell[];
[] _ CStitching.EnumerateArea[plane: plane, rect: CDBasics.universe, eachTile: IncludeRect, data: NIL ! DoStop => CONTINUE];
IF CDCells.IsEmpty[cell] THEN
[] _ CDCells.IncludeOb[cell: cell, ob: CDSymbolicObjects.CreateMark[]];
[] _ CDCells.ResizeCell[NIL, cell];
};

BuildCharCell: PROC [font: Imager.Font, char: ImagerFont.XChar, scale: INT_1, layer: CD.Layer, stop: REF BOOL_NIL] RETURNS [cell: CD.Object] = {
bitmap: ImagerSample.SampleMap; context: Imager.Context; plane: CStitching.Tesselation;
ext: ImagerFont.Extents _ ImagerFont.BoundingBox[font, char];
descent: INT _ Real.Ceiling[ext.descent];
ascent: INT _ Real.Ceiling[ext.ascent];
leftExtent: INT _ Real.Ceiling[ext.leftExtent];
rightExtent: INT _ Real.Ceiling[ext.rightExtent];
box: ImagerSample.Box _ [min: [0, 0], max: [ascent+descent, rightExtent+leftExtent]]; 
bitmap _ ImagerSample.NewSampleMap[box: box]; ImagerSample.Clear[bitmap];
context _ ImagerBitmapContext.Create[
deviceSpaceSize: SF.Size[box],
scanMode: Imager.ScanMode[slow: up, fast: right],
surfaceUnitsPerInch: [1, 1], --???
pixelUnits: TRUE 
];
ImagerBitmapContext.SetBitmap[context, bitmap];
Imager.SetColor[context, Imager.black]; 
Imager.SetXY[context, [leftExtent, descent]];
Imager.SetFont[context, font];
Imager.ShowXChar[context, char];
plane _ CStitchSampleMap[bitmap, stop];
cell _ CreateCellFromCStitching[plane: plane, layer: layer, scale: scale, csOrigin: [leftExtent, descent]];
BEGIN
esc: Imager.VEC _ ImagerFont.Escapement[font, char];
PutIntValue[cell, $CDxWidth, scale*Real.Round[esc.x]];
PutIntValue[cell, $CDxHeight, scale*Real.Round[esc.y]];
END;
CDProperties.PutObjectProp[cell, $CreatedBy, $CreateLabel];
};  

MakeCharCell: PUBLIC PROC [design: CD.Design, font: Imager.Font, char: CHAR, scale: INT, layer: CD.Layer, stop: REF BOOL_NIL] RETURNS [cell: CD.Object_NIL] = {
cacheName: Rope.ROPE;
IF stop=NIL THEN stop _ NEW[BOOL_FALSE];
IF scale<=0 THEN scale _ design.technology.lambda;
cacheName _ NameForCharCache[font, char, scale, layer];
IF design#NIL AND cacheName#NIL THEN { 
cell _ CDDirectory.Fetch[design, cacheName].object;
IF cell#NIL THEN 
IF CDProperties.GetProp[cell, $CreatedBy]#$CreateLabel THEN cell _ NIL
};
IF cell=NIL THEN {
cell _ BuildCharCell[font, [0, LOOPHOLE[char]], scale, layer, stop];
IF design#NIL THEN {
IF cacheName=NIL THEN cacheName _ Rope.Cat["#", Rope.FromChar[char]];
[] _ CDDirectory.Include[design, cell, IF stop^ THEN "@stopped" ELSE cacheName];
};
}
};

MakeRopeCell: PUBLIC PROC [design: CD.Design, text: Rope.ROPE, font: Imager.Font, scale: INT_1, layer: CD.Layer, stop: REF BOOL_NIL] RETURNS [cell: CD.Object] = {

IncludeChar: PROC [c: CHAR] RETURNS [quit: BOOL _ FALSE] = {
IF c='  THEN {
vec: Imager.VEC _ ImagerFont.RopeEscapement[font, Rope.FromChar[' ]];
x _ x + scale*Real.Round[vec.x];
y _ y + scale*Real.Round[vec.y];
}
ELSE {
charCell: CD.Object _ MakeCharCell[design, font, c, scale, layer, stop];
IF charCell#NIL THEN {
[] _ CDCells.IncludeOb[cell: cell, ob: charCell, trans: [[x, y]]];
x _ x + IntValue[charCell, $CDxWidth];
y _ y + IntValue[charCell, $CDxHeight];
}
}
};

x, y: CD.Number_0;
IF scale<=0 THEN scale _ design.technology.lambda;
cell _ CDCells.CreateEmptyCell[];
[] _ Rope.Map[base: text, action: IncludeChar ! DoStop => CONTINUE];
IF CDCells.IsEmpty[cell] THEN RETURN [NIL];
IF design#NIL THEN [] _ CDDirectory.Include[design, cell, Rope.Cat["Label[", text, "]"]];
};

CreateTextCellComm: PROC[comm: CDSequencer.Command] = {

SelectFont: PROC [design: CD.Design] RETURNS [font: Imager.Font_NIL] = {
cdFont: CDTexts.CDFont _ CDPanelFonts.CurrentFont[design];
IF cdFont#NIL THEN font _ cdFont.font
};

text: Rope.ROPE; font: Imager.Font;
layer: CD.Layer; scale: INT; cell: CD.Object;
stop: REF BOOL _ NEW[BOOL_FALSE];
layer _ comm.l;
TerminalIO.PutRopes["create a label (on layer ", CDOps.LayerRope[layer], ")\n"];
CDSequencer.UseAbortFlag[comm.design, stop];
font _ SelectFont[comm.design];
IF font=NIL THEN {
TerminalIO.PutRope["font not found\n"]; RETURN
};
text _ TerminalIO.RequestRope["  text -> "];
scale _ MAX[1, TerminalIO.RequestInt["  post scale factor > "]];
IF Rope.IsEmpty[text] THEN {
TerminalIO.PutRope["empty text\n"]; RETURN
};
cell _ MakeRopeCell[comm.design, text, font, scale, layer];
IF cell=NIL THEN TerminalIO.PutRope["not done\n"]
ELSE {
[] _ CDOps.IncludeObjectI[comm.design, cell, comm.pos];
TerminalIO.PutRope["done\n"];
}
}; 

CDSequencer.ImplementCommand[$CreateTextCell, CreateTextCellComm];
END.




��
¬��CDCreateLabelsImpl.mesa
Copyright (C) 1984, 1985, 1987 by Xerox Corporation.  All rights reserved.
Created by: Christian Jacobi, March 1, 1985 4:52:57 pm PST  
Last edited by: Christian Jacobi, April 13, 1987 1:37:33 pm PDT
--A NIL name should not be hashed
--returns a rope for hashing transformation
--prevent empty cell
--paint character in bitmap
--create cell from bitmap
--positioning and spacing
--NIL if not done
�Ê	��˜�
codeš
œ™K™JK™<K™?—K˜�š
Ïk	˜	Kšœ
˜K˜	K˜Kš
œ˜Kš
œ˜Kš
œ˜K˜
K˜
K˜K˜
Kš
œ˜K˜Kš
œ˜K˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ˜K˜Kš
œ˜Kš
œ˜K˜�—šÏbœœ
˜!Kšœœ¡
œœ˜Ú
Kšœ˜—Kš
˜K˜�KšÏnœœœ
˜K˜�šŸœœœœœœ˜>šœ$œ
˜3Kšœœ
œ˜Kšœœ
˜—Kš
œ˜—K˜�š
Ÿœœœœœ˜8Kš
œ#œœ
œ
œ
œ
œ˜GKš
œ˜—K˜�šŸœœœ	œ	œœ
œ
œ˜pKš
Ïc!™!K˜�šŸœœœœ˜>Kš
 +™+Kš
œœœœœœœ˜_Kš
œœœ
œœ˜EKš
œ˜—K˜�Kšœœ˜(šœœ˜!Kšœœœ
œœœ˜cKš
œ˜—Kš
œ˜—K˜�šŸœœ%œ
œ
œœ$˜{Kš
œ1˜1Kšœœ˜&Kšœœ
œœ
œ
œ˜(Kš
œ2˜2šœœ
œ˜+Kšœœ
œ
˜šœœ
œœ
˜,šœ'˜-š
œ˜Kš
œ˜Kš
œ'˜'Kš
œ
˜
Kš
œ˜——Kšœ
˜—Kšœ
˜—Kš
œ˜—K˜�šŸœœ(œ2œœœ˜§
Kšœœ
œ˜ K˜�šÐbnœ˜$Kšœœ˜#šœœ˜Kšœœ
œ˜š
œ"˜"Kš
œU˜UKš
œF˜FKš
œ˜Kš
œ˜—K˜—Kš
œ˜K˜�—Kš
œ˜Kšœœ
œœ
œ
œ˜(Kš
œ!˜!Kšœbœ
œ˜|Kš
 ™šœ˜Kš
œG˜G—Kšœœ˜#Kš
œ˜—K˜�šŸ
œœ4œœœ
œ
œœœ˜
Kš
œW˜WKš
œ=˜=Kšœ	œ˜)Kšœœ˜'Kšœœ ˜/Kšœ
œ!˜1Kš
œV˜VKš
 ™Kš
œI˜Iš
œ%˜%Kšœœ˜Kš
œ1˜1Kšœ ˜"Kšœœ
˜Kš
œ˜—Kš
œ/˜/Kš
œ(˜(Kš
œ-˜-Kš
œ˜Kš
œ ˜ Kš
 ™Kš
œ'˜'Kš
œk˜kKš
 ™š
˜Kšœœ%˜4Kš
œ6˜6Kš
œ7˜7Kšœ
˜—Kš
œ;˜;š
œ˜K˜�——šŸœœ
œ
œ"œ	œ	œœ
œ
œœœœ˜Ÿ
Kšœœ
˜Kšœœ
œœ
œ
œ˜(Kšœ
œ"˜2Kš
œ7˜7š
œœ
œœ
œ˜'Kš
œ3˜3šœœ
œ
˜Kšœ5œ˜F—K˜—šœœ
œ˜Kšœœ˜Dšœœ
œ˜Kšœœ
œ0˜EKšœ'œœœ˜PK˜—K˜
—Kš
œ˜—K˜�šŸœœ
œ
œœœœœ
œ
œœœ˜¢
Kš
œ™K˜�š
¡ž
œ
œœœœœ˜<šœœ˜Kšœœ6˜EKš
œ ˜ Kš
œ ˜ K˜
—šœ˜Kšœ
œ<˜Hšœ
œ
œ˜Kš
œB˜BKš
œ&˜&Kš
œ'˜'K˜
—K˜
—Kš
œ˜—K˜�Kšœœ
˜Kšœ
œ"˜2Kš
œ!˜!Kšœ:œ˜DKšœœ
œœ˜+Kšœœ
œG˜YKš
œ˜—K˜�šŸœœ˜7K˜�š
Ÿ
œœ
œ	œœ˜HKš
œ:˜:Kšœœ
œ˜%Kš
œ˜—K˜�Kšœœ˜#Kšœœœœ˜-Kšœœ
œœ
œ
œ˜!Kš
œ˜Kš
œP˜PKš
œ,˜,Kš
œ˜šœœ
œ˜Kšœ'˜.K˜—Kš
œ,˜,Kšœœ5˜@šœœ˜Kšœ#˜*K˜—Kš
œ;˜;Kšœœ
œ!˜1šœ˜Kš
œ7˜7Kš
œ˜K˜
—š
œ˜K˜�——Kš
œB˜Bšœ
˜˜�˜�K˜�K˜�————�…—����œ��&Y��