<> <> <> <> DIRECTORY Basics, CD, CDCells, CDCreateLabels, CDDirectory, CDBasics, CDMenus, CDSymbolicObjects, CDOps, CDPanelFonts, CDProperties, CDRects, CDSequencer, CDTexts, CStitching, Imager, ImagerBackdoor, ImagerFont, IO, Real, Rope, TerminalIO; CDCreateLabelsImpl: CEDAR PROGRAM IMPORTS Basics, CD, CDBasics, CDSymbolicObjects, CDCells, CDDirectory, CDMenus, CDOps, CDPanelFonts, CDProperties, CDSequencer, CDRects, CStitching, Imager, ImagerBackdoor, ImagerFont, IO, Real, Rope, TerminalIO EXPORTS CDCreateLabels = BEGIN IntValue: PROC [ob: CD.Object, a: ATOM] RETURNS [i: INT_0] = BEGIN WITH CDProperties.GetObjectProp[ob, a] SELECT FROM ri: REF INT => i _ ri^; ENDCASE => NULL; END; PutIntValue: PROC [ob: CD.Object, a: ATOM, i: INT_0] = BEGIN CDProperties.PutObjectProp[ob, a, (IF i=0 THEN NIL ELSE NEW[INT _ i])]; END; HashT: PROC [t: Imager.Transformation] RETURNS [Rope.ROPE] = BEGIN 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]]] END; MakeName: PROC [font: Imager.Font, ch: CHAR, scale: INT, lev: CD.Layer] RETURNS [n: Rope.ROPE_NIL] = <<--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; BitmapToCornerstitching: PROC [bitmap: ImagerBackdoor.Bitmap] RETURNS [plane: CStitching.Tesselation] = BEGIN plane _ CStitching.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]; IF Basics.BITAND[8000h, Basics.BITSHIFT[bitsRef^, x MOD Basics.bitsPerWord]]#0 THEN CStitching.ChangeRect[ plane: plane, rect: [x1: x, x2: x+1, y1: bitmap.height-y-1, y2: bitmap.height-y], new: $covered ]; } ENDLOOP; ENDLOOP; END; CornerstitchingToCell: PROC [plane: CStitching.Tesselation, layer: CD.Layer, csOrigin: CStitching.Pos _ [0, 0], scale: INT _ 1] RETURNS [cell: CD.Object] = <<--does not yet include cell into a design>> <<--csOrigin: in CStitching coords; will be origin of cell >> <<--scale: applied after offset for csOrigin>> BEGIN offset: CD.Position _ [-csOrigin.x*scale, -csOrigin.y*scale]; IncludeRectangle: CStitching.TileProc = BEGIN r: CD.Rect ~ CStitching.Area[tile]; IF CDBasics.NonEmpty[r] THEN [] _ CDCells.IncludeOb[cell: cell, ob: CDRects.CreateRect[size: [x: (r.x2-r.x1)*scale, y: (r.y2-r.y1)*scale], l: layer], position: CDBasics.AddPoints[[x: r.x1*scale, y: r.y1*scale], offset], cellCSystem: cdCoords, obCSystem: cdCoords, mode: dontPropagate ]; END; cell _ CDCells.CreateEmptyCell[]; [] _ CStitching.EnumerateArea[plane: plane, rect: CDBasics.universe, eachTile: IncludeRectangle, data: NIL]; <<--prevent empty cell>> IF NARROW[cell.specificRef, CD.CellPtr].contents=NIL THEN [] _ CDCells.IncludeOb[cell: cell, ob: CDSymbolicObjects.CreateMark[], mode: dontPropagate]; [] _ CDCells.RepositionCell[cell, NIL]; END; Up: PROC [r: REAL] RETURNS [i: INT] = { <<-- returns integer i: i >= r; there exists no integer j such that j < i and j >= r >> i _ Real.Fix[r]; IF Real.Float[i]#r THEN i _ i+1; }; MakeChar: PROC [font: Imager.Font, char: CHAR, scale: INT_1, lev: CD.Layer] RETURNS [cell: CD.Object] = BEGIN vec: Imager.VEC; bitmap: ImagerBackdoor.Bitmap; context: Imager.Context; plane: CStitching.Tesselation; ext: ImagerFont.Extents _ ImagerFont.FontBoundingBox[font]; p1: CD.Position _ [Up[ext.leftExtent], Up[ext.descent]]; p2: CD.Position _ [Up[ext.rightExtent], Up[ext.ascent]]; <<--paint character in bitmap>> bitmap _ ImagerBackdoor.NewBitmap[width: p1.x+p2.x, height: p1.y+p2.y]; context _ ImagerBackdoor.BitmapContext[bitmap]; Imager.SetColor[context, Imager.white]; Imager.MaskRectangleI[context, 0, 0, bitmap.width, bitmap.height]; Imager.SetColor[context, Imager.black]; Imager.SetXY[context, [x: p1.x, y: p1.y]]; Imager.SetFont[context, font]; Imager.ShowChar[context, char]; <<--create cell from bitmap>> plane _ BitmapToCornerstitching[bitmap]; cell _ CornerstitchingToCell[plane, lev, p1, scale]; <<--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; IF scale<=0 THEN scale _ design.technology.lambda; hashName _ 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_1, lev: CD.Layer] RETURNS [cell: CD.Object] = <<--NIL if not done>> BEGIN IncludeChar: PROC [c: CHAR] RETURNS [quit: BOOL _ FALSE] = 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 ]; x _ x + IntValue[charCell, $CDxWidth]; y _ y + IntValue[charCell, $CDxHeight]; } } END; x: CD.Number_0; y: CD.Number_0; IF scale<=0 THEN scale _ design.technology.lambda; cell _ CDCells.CreateEmptyCell[]; [] _ Rope.Map[base: text, action: IncludeChar]; IF NARROW[cell.specificRef, CD.CellPtr].contents=NIL THEN RETURN [NIL]; IF design#NIL THEN [] _ CDDirectory.Include[design, cell, Rope.Cat["Label[", text, "]"]]; END; CreateTextCellComm: PROC[comm: CDSequencer.Command] = BEGIN SelectFont: PROC [design: CD.Design] RETURNS [font: Imager.Font_NIL] = BEGIN IF TerminalIO.RequestSelection[label: "font", choice: LIST["from control panel", "type in"]]=1 THEN { cdFont: CDTexts.CDFont _ CDPanelFonts.CurrentFont[design]; IF cdFont#NIL THEN font _ cdFont.font } ELSE { fontName: Rope.ROPE _ TerminalIO.RequestRope[" font name -> "]; font _ ImagerFont.Find[fontName ! Imager.Error => { TerminalIO.WriteRope[Rope.Cat["font not loaded: ", error.explanation]]; GOTO oops }; ]; }; EXITS oops => NULL END; ScaleHelp: PROC [lambda: INT] = BEGIN TerminalIO.WriteRope[" normal scaling\n scale applied after scan conversion\n"]; TerminalIO.WriteRope[" makes text larger by blowing up the rectangles\n"]; TerminalIO.WriteRope[" PRE scaling\n scale applied before scan conversion\n"]; TerminalIO.WriteRope[" different for spline fonts only!\n"]; TerminalIO.WriteRope[" makes text larger by using more rectangles for font\n"]; TerminalIO.WriteF[" text height _ scale*preScale*fontHeight*lambda/%g", IO.int[lambda]]; TerminalIO.WriteLn[]; END; SelectPostScaling: PROC [] RETURNS [scale: INT_1] = BEGIN IF TerminalIO.RequestSelection[label: "normal scale factor", choice: LIST["yes, type in", "no, use 1"]]=1 THEN { scale _ MAX[1, TerminalIO.RequestInt[" normal scale factor > "]]; } END; SelectPreScaling: PROC [font: Imager.Font] RETURNS [Imager.Font] = BEGIN IF TerminalIO.RequestSelection[label: "pre scale factor", choice: LIST["yes, type in", "no, use 1"]]=1 THEN { scale: INT _ MAX[1, TerminalIO.RequestInt[" pre scale factor -> "]]; font _ ImagerFont.Scale[font, scale]; }; RETURN [font] END; text: Rope.ROPE; font: Imager.Font; layer: CD.Layer; scale: INT; cell: CD.Object; layer _ comm.l; TerminalIO.WriteRopes["create a label (on layer ", CDOps.LayerName[layer], ")\n"]; ScaleHelp[comm.design.technology.lambda]; font _ SelectFont[comm.design]; IF font=NIL THEN { TerminalIO.WriteRope["font not found\n"]; RETURN }; scale _ SelectPostScaling[]; font _ SelectPreScaling[font]; 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"] ELSE { CDOps.IncludeObjectI[comm.design, cell, comm.pos]; TerminalIO.WriteRope["done\n"]; } END; CDSequencer.ImplementCommand[$CreateTextCell, CreateTextCellComm]; CDMenus.CreateEntry[menu: $RectProgramMenu, entry: "Create Label", key: $CreateTextCell]; END.