CDCreateLabelsImpl.mesa
Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved.
Created by: Jacobi, March 1, 1985 4:52:57 pm PST
Last Edited by: Jacobi, August 30, 1985 12:59:30 pm PDT
DIRECTORY
Basics,
CD,
CDCells,
CDCreateLabels,
CDDirectory,
CDBasics,
CDMenus,
CDMarkObjects,
CDOps,
CDProperties,
CDRects,
CDSequencer,
CornerStitching,
Imager,
ImagerBackdoor,
ImagerFont,
IO,
Real,
Rope,
TerminalIO;
CDCreateLabelsImpl: CEDAR PROGRAM
IMPORTS Basics, CD, CDBasics, CDMarkObjects, CDCells, CDDirectory, CDMenus, CDOps, CDProperties, CDSequencer, CDRects, CornerStitching, Imager, ImagerBackdoor, ImagerFont, IO, Real, Rope, TerminalIO
EXPORTS CDCreateLabels =
BEGIN
IntValue: PROC [ob: CD.Object, a: ATOM] RETURNS [i: INT𡤀] =
BEGIN
WITH CDProperties.GetPropFromObject[ob, a] SELECT FROM
ri: REF INT => i ← ri^;
ENDCASE => NULL;
END;
PutIntValue: PROC [ob: CD.Object, a: ATOM, i: INT𡤀] =
BEGIN
x: REF INTNIL;
IF i#0 THEN x ← NEW[INT ← i];
CDProperties.PutPropOnObject[ob, a, x];
END;
HashT: PROC [t: Imager.Transformation] RETURNS [Rope.ROPE] =
BEGIN
r: Rope.ROPEIO.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]]]
END;

MakeName: PROC [font: Imager.Font, ch: CHAR, scale: INT, lev: CD.Layer]
RETURNS [n: Rope.ROPENIL] =
--A NIL name should not be hashed
BEGIN
h: Rope.ROPE ← HashT[font.charToClient];
n ← IO.PutFR["#%g[%g|%d|%g|%g]",
IO.char[ch], IO.rope[font.name], IO.int[scale], IO.atom[CD.LayerKey[lev]], IO.rope[h]
];
END;
MakeChar: PROC [font: Imager.Font, char: CHAR, scale: INT𡤁, lev: CD.Layer]
RETURNS [cell: CD.Object] =
BEGIN
cellPtr: CD.CellPtr;
vec: Imager.VEC;
bitmap: ImagerBackdoor.Bitmap;
context: Imager.Context;
empty: BOOLTRUE;
tes: REF CornerStitching.Tesselation;
IncludeRectangle: CornerStitching.PerTileProc =
--PROCEDURE [tile: TilePtr, data: REF ANY];
BEGIN
empty ← FALSE;
[] ← CDCells.IncludeOb[
cell: cell,
ob: CDRects.CreateRect[
size: [x: (tile.EastEdge-tile.WestEdge)*scale, y: (tile.NorthEdge-tile.SouthEdge)*scale],
l: lev
],
position: [
x: tile.WestEdge*scale,
y: tile.SouthEdge*scale
],
cellCSystem: cdCoords,
obCSystem: cdCoords,
mode: dontPropagate
];
END;
--paint character in bitmap
e: ImagerFont.Extents ← ImagerFont.FontBoundingBox[font];
bitmap ← ImagerBackdoor.NewBitmap[
width: Real.RoundI[e.rightExtent+e.leftExtent],
height: Real.RoundI[e.ascent+e.descent]
];
context ← ImagerBackdoor.BitmapContext[bitmap];
--clear bitmap ImagerBackdoor.ViewReset[context];
Imager.SetColor[context, Imager.white];
Imager.MaskRectangleI[context, 0, 0, bitmap.width, bitmap.height];
Imager.SetColor[context, Imager.black];
Imager.SetXY[context, [x: e.leftExtent, y: e.descent]];
Imager.SetFont[context, font];
Imager.ShowChar[context, char];
--cornerstitch bitmap
tes ← CornerStitching.NewTesselation[];
FOR y: CARDINAL IN [0..bitmap.height) DO
FOR x: CARDINAL IN [0..bitmap.width) DO
TRUSTED {
bitsRef: LONG POINTER TO CARDINAL
LOOPHOLE[bitmap.base, LONG POINTER TO CARDINAL]
+ LONG[y]*bitmap.wordsPerLine
+ LONG[x/Basics.bitsPerWord];
bits: CARDINAL ← bitsRef^;
IF Basics.BITAND[8000h, Basics.BITSHIFT[bits, x MOD Basics.bitsPerWord]] # 0 THEN
tes.ChangeRect[[x1: x, x2: x+1, y1: bitmap.height-y-1, y2: bitmap.height-y], $covered];
}
ENDLOOP;
ENDLOOP;
--create cell from tesselation
cell ← CDCells.CreateEmptyCell[];
cellPtr ← NARROW[cell.specificRef];
[] ← tes.EnumerateArea[rect: CDBasics.universe, perTile: IncludeRectangle, data: NIL];
CornerStitching.FreeTesselation[tes];
IF empty THEN {
[] ← CDCells.IncludeOb[
cell: cell,
ob: CDMarkObjects.markOb,
position: [0, 0],
cellCSystem: originCoords,
mode: dontPropagate
];
};
[] ← CDCells.RepositionCell[cell, NIL];
cellPtr.simplifyOn ← MAX[cell.size.y-1, 4];
cellPtr.origin ← CDBasics.AddSize[cellPtr.origin, CD.Position[
x: scale*Real.RoundI[e.leftExtent],
y: scale*Real.RoundI[e.descent]
]];
--positioning and spacing
vec ← ImagerFont.RopeWidth[font, Rope.FromChar[char]];
PutIntValue[cell, $CDxWidth, scale*(Real.RoundI[vec.x])];
PutIntValue[cell, $CDxHeight, scale*(Real.RoundI[vec.y])];
END;
FindOrCreateCharCell: PUBLIC PROC [design: CD.Design, font: Imager.Font, char: CHAR, scale: INT𡤁, lev: CD.Layer]
RETURNS [cell: CD.Object←NIL] =
BEGIN
hashName: Rope.ROPE ← MakeName[font, char, scale, lev];
IF design#NIL AND hashName#NIL THEN
cell ← CDDirectory.Fetch[design, hashName].object;
IF cell=NIL THEN {
cell ← MakeChar[font, char, scale, lev];
IF design#NIL THEN {
IF hashName=NIL THEN hashName ← Rope.Cat["#", Rope.FromChar[char]];
[] ← CDDirectory.Include[design, cell, hashName];
};
}
END;
CreateTextCell: PUBLIC PROC [design: CD.Design, text: Rope.ROPE, font: Imager.Font, scale: INT𡤁, lev: CD.Layer] RETURNS [cell: CD.Object] =
--NIL if not done
BEGIN
empty: BOOLTRUE;
IncludeChar: PROC [c: CHAR] RETURNS [quit: BOOLFALSE] =
BEGIN
IF c=' THEN {
vec: Imager.VEC ← ImagerFont.RopeWidth[font, Rope.FromChar[' ]];
x ← x + scale*Real.RoundI[vec.x];
y ← y + scale*Real.RoundI[vec.y];
}
ELSE {
charCell: CD.Object ← FindOrCreateCharCell[design, font, c, scale, lev];
IF charCell#NIL THEN {
[] ← CDCells.IncludeOb[cell: cell, ob: charCell,
position: [x, y],
cellCSystem: originCoords,
obCSystem: originCoords
];
empty ← FALSE;
x ← x + IntValue[charCell, $CDxWidth];
y ← y + IntValue[charCell, $CDxHeight];
}
}
END;
x: CD.Number𡤀
y: CD.Number𡤀
cell ← CDCells.CreateEmptyCell[];
IF Rope.IsEmpty[text] THEN RETURN [NIL];
[] ← Rope.Map[base: text, action: IncludeChar];
IF empty THEN RETURN [NIL];
IF design#NIL THEN [] ← CDDirectory.Include[design, cell, Rope.Cat["Label[", text, "]"]];
END;
CreateTextCellComm: PROC[comm: CDSequencer.Command] =
BEGIN
fontName, text: Rope.ROPE;
font: Imager.Font;
layer: CD.Layer;
scale: INT;
cell: CD.Object;
layer ← comm.l;
TerminalIO.WriteRope[Rope.Cat["create a label (using ", CDOps.LayerName[layer], ")\n"]];
fontName ← TerminalIO.RequestRope["(tioga) font name -> "];
font ← ImagerFont.Find[fontName !
Imager.Error => {
TerminalIO.WriteRope[Rope.Cat["font not loaded: ", error.explanation]];
GOTO notFound
};
];
scale ← MAX[1, TerminalIO.RequestInt["scale -> "]];
text ← TerminalIO.RequestRope["text -> "];
IF Rope.IsEmpty[text] THEN {
TerminalIO.WriteRope["empty text\n"];
RETURN
};
cell ← CreateTextCell[comm.design, text, font, scale, layer];
IF cell=NIL THEN {
TerminalIO.WriteRope["not done\n"];
RETURN
};
CDOps.AddAnObject[comm.design, cell, comm.pos];
TerminalIO.WriteRope["done\n"];
EXITS notFound => NULL;
END;
CDSequencer.ImplementCommand[$CreateTextCell, CreateTextCellComm];
CDMenus.CreateEntry[menu: $RectProgramMenu, entry: "Enter text", key: $CreateTextCell];
END.