<> <> <> <> <> DIRECTORY CD, CDBasics, CDColors, CDCommandOps, CDIO, CDCommandOpsExtras2, CDOps, CDProperties, CDSequencer, CDTexts, FS, Imager, ImagerInterpress, IO, Real, RefTab, Rope, SymTab, TerminalIO; CDInterpressPlotImpl: CEDAR PROGRAM IMPORTS CD, CDBasics, CDColors, CDCommandOps, CDIO, CDCommandOpsExtras2, CDOps, CDProperties, CDTexts, FS, Imager, ImagerInterpress, IO, Real, RefTab, Rope, SymTab, TerminalIO = BEGIN <<>> <<--constant sizes and scales >> standardPageX: REAL = 0.216; --(72*8.5; points) United States standard page with.... standardPageY: REAL = 0.277; --(72*11.0; points) versatecDeviceX: REAL = 0.97; --of the very special versatec plotter sitting close to my office... It really doe not store in this constant the with of any other versatec plotter available... c400PageX: REAL = 0.292; c400PageY: REAL = 0.419; <<>> <<--default sizes and scales >> defaultPageX: REAL _ standardPageX; defaultPageY: REAL _ standardPageY; defaultStripeX: REAL _ versatecDeviceX; defaultBorder: REAL _ Imager.metersPerInch; defaultScale: REAL _ 0; --Imager.metersPerPoint/comm.design.technology.lambda <<>> <<--others >> abortFlag: REF BOOL = NEW[BOOL_FALSE]; fileNameDefault: Rope.ROPE _ "///temp/temp.IP"; ColorMode: TYPE = {allBlack, color, special}; colorMode: ColorMode _ allBlack; <<>> <<>> <<--set ups for this very plot which will be created right now>> pageX: REAL; pageY: REAL; contextColors: REF CD.ContextColors = NEW[CD.ContextColors_ALL[Imager.black]]; RectToRectangle: PROC [r: CD.Rect] RETURNS [Imager.Rectangle] = BEGIN RETURN [[x: r.x1, y: r.y1, w: r.x2-r.x1, h: r.y2-r.y1]] END; SetUpBW: PROC [] = BEGIN FOR layer: CD.Layer IN CD.Layer DO contextColors[layer] _ Imager.black; ENDLOOP; contextColors[CD.backgroundLayer] _ NIL; END; SetUpColor: PROC [] = BEGIN FOR layer: CD.Layer IN CD.Layer DO WITH CDProperties.GetLayerProp[layer, $CDxInterpressPlotColor] SELECT FROM c: Imager.Color => {contextColors[layer] _ c; LOOP}; a: ATOM => IF a=$FALSE THEN {contextColors[layer] _ NIL; LOOP}; ENDCASE => NULL; contextColors[layer] _ CDColors.globalColors[bit8][normal].cols[layer]; ENDLOOP; contextColors[CD.backgroundLayer] _ NIL; END; SetUpSpecial: PROC [] = BEGIN FOR layer: CD.Layer IN CD.Layer DO contextColors[layer] _ IF CDProperties.GetLayerProp[layer, $CDxInterpressPlot]=$do THEN Imager.black ELSE NIL; ENDLOOP; contextColors[CD.backgroundLayer] _ NIL; END; HardCopyCommand: PROC [comm: CDSequencer.Command] = BEGIN TerminalIO.WriteRope["HardCopy\n"]; abortFlag^ _ FALSE; [] _ CDCommandOps.CallWithResource[ proc: ProtectedHardCopy, comm: comm, resource: $CDSimplePlotImpl, abortFlag: abortFlag ]; END; DrawOutLine: PUBLIC PROC [r: CD.Rect, l: CD.Layer, pr: CD.DrawRef] = BEGIN ActionWithContext: PROC [] = BEGIN Imager.SetColor[pr.deviceContext, pr.contextColors[l]]; Imager.MaskVector[pr.deviceContext, [r.x1, r.y1], [r.x2, r.y1]]; Imager.MaskVector[pr.deviceContext, [r.x2, r.y1], [r.x2, r.y2]]; Imager.MaskVector[pr.deviceContext, [r.x2, r.y2], [r.x1, r.y2]]; Imager.MaskVector[pr.deviceContext, [r.x1, r.y2], [r.x1, r.y1]]; END; IF pr.deviceContext#NIL THEN { IF pr.contextColors[l]#NIL THEN Imager.DoSave[pr.deviceContext, ActionWithContext] } END; ProtectedHardCopy: PROC [comm: CDSequencer.Command] = <<--not re-entrant: using a global abort flag (abortFlag)>> BEGIN fileName: Rope.ROPE _ fileNameDefault; pageNumX: INT _ 1; --number of vertical stripes pageNumY: INT _ 1; --number of horizontal stripes nX, nY: INT; --number of current page borderX, borderY: REAL; --border of page absolutelyNoAdjustments: BOOL _ FALSE; ref: ImagerInterpress.Ref; dr: CD.DrawRef; clip: CD.Rect; start: CD.Position; sizePerPage: CD.Position; scale: REAL; substituteFonts: BOOL _ FALSE; deviceTranslation: Imager.VEC _ [0, 0]; help: Rope.ROPE_NIL; PlotPage: PROC [context: Imager.Context] = <<--the real stuff>> BEGIN r: CD.Rect _ CDBasics.RectAt[start, sizePerPage]; r _ CDBasics.Intersection[r, clip]; IF ~CDBasics.NonEmpty[r] THEN RETURN; IF abortFlag^ THEN RETURN; Imager.TranslateT[context, deviceTranslation]; Imager.ScaleT[context, scale]; Imager.TranslateT[context, [-r.x1, -r.y1]]; Imager.ClipRectangle[context, RectToRectangle[r]]; dr _ CD.CreateDrawRef[[ design: comm.design, stopFlag: abortFlag, drawOutLine: DrawOutLine, contextColors: contextColors, borders: TRUE, interestClip: r, deviceContext: context ]]; IF substituteFonts THEN { dr.specialFonts _ TRUE; CDProperties.PutProp[dr.properties, $FontExchange, fontReplace]; }; CDOps.DrawDesign[comm.design, dr]; END; PreAmble: PROC [ref: ImagerInterpress.Ref, contextColors: REF CD.ContextColors] = BEGIN declared: RefTab.Ref _ RefTab.Create[]; FOR layer: CD.Layer IN CD.Layer DO IF contextColors[layer]#NIL THEN IF RefTab.Insert[declared, contextColors[layer], contextColors[layer]] THEN ImagerInterpress.DeclareColor[ref, contextColors[layer]] ENDLOOP; declared _ NIL; END; SetUp: PROC [] = BEGIN RequestBorder: PROC [anyWay: BOOL _ FALSE] = BEGIN borderY _ borderX _ 0; IF (anyWay AND ~special) THEN borderY _ borderX _ defaultBorder ELSE { SELECT TerminalIO.RequestSelection[label: "border", choice: LIST["yes", "fill space", "never"]] FROM 1 => borderY _ borderX _ defaultBorder; 3 => absolutelyNoAdjustments _ TRUE; ENDCASE => NULL; } END; SetUpVaryingScaling: PROC [clip: CD.Rect] = BEGIN insidePageX, insidePageY: REAL; --what fits in a page without border IF special AND TerminalIO.Confirm["multiple pages ?"] THEN { pageNumX _ TerminalIO.RequestInt["Number of pages in x direction? >"]; IF pageNumX<1 OR pageNumX>20 THEN { TerminalIO.WriteRope[" to bad\n"]; ERROR ABORTED }; } ELSE { pageNumX _ 0; }; RequestBorder[anyWay: pageNumX=0]; insidePageX _ pageX-2*borderX; insidePageY _ pageY-2*borderY; IF pageNumX=0 THEN { <<--single page>> pageNumY _ 1; pageNumX _ 1; sizePerPage _ CDBasics.SizeOfRect[clip]; scale _ MIN[insidePageX/sizePerPage.x, insidePageY/sizePerPage.y]; } ELSE { <<--multiple pages>> sizePerPage.x _ (clip.x2-clip.x1)/pageNumX+1; sizePerPage.y _ Real.Fix[insidePageY*((sizePerPage.x-1.0)/insidePageX)]; scale _ insidePageX/sizePerPage.x; pageNumY _ ( (clip.y2-clip.y1)+(sizePerPage.y-1) )/sizePerPage.y; }; help _ IF pageY=c400PageY THEN " Example usage:\n InterpressToPD tem.pd _ ///temp/temp.IP bw400\n" ELSE " Example usage:\n InterpressToPD tem.pd _ ///temp/temp.IP raven384\n"; END;--SetUpVaryingScaling SetUpStriped: PROC [clip: CD.Rect] = BEGIN borderY _ defaultBorder; borderX _ 0; pageNumY _ 1; IF special AND TerminalIO.Confirm["multiple stripes ?"] THEN { pageNumX _ TerminalIO.RequestInt["How many stripes? >"]; IF pageNumX<1 OR pageNumX>20 THEN { TerminalIO.WriteRope[" to bad\n"]; ERROR ABORTED } } ELSE { pageNumX _ 1; }; help _ " Example usage:\n InterpressToPD tem.pd _ ///temp/temp.IP versatec\n"; sizePerPage.x _ (clip.x2-clip.x1)/pageNumX; sizePerPage.y _ clip.y2-clip.y1; scale _ pageX/sizePerPage.x; pageY _ scale*sizePerPage.y+2*borderY; END; SetUpFixedScaling: PROC [clip: CD.Rect] = BEGIN borderAnyway: BOOL; scale _ defaultScale; borderAnyway _ ( (clip.x2-clip.x1)*scale < (pageX - 0.05) ) AND ( (clip.y2-clip.y1)*scale < (pageY - 0.05) ); RequestBorder[borderAnyway]; sizePerPage.x _ Real.Round[(pageX-2*borderX)/scale]; sizePerPage.y _ Real.Round[(pageY-2*borderY)/scale]; pageNumX _ (clip.x2-clip.x1+sizePerPage.x-1)/sizePerPage.x; pageNumY _ (clip.y2-clip.y1+sizePerPage.y-1)/sizePerPage.y; help _ IF pageY=c400PageY THEN " Example usage:\n InterpressToPD tem.pd _ ///temp/temp.IP bw400\n" ELSE " Example usage:\n InterpressToPD tem.pd _ ///temp/temp.IP raven384\n"; END; AdjustPosition: PROC [] = BEGIN IF absolutelyNoAdjustments THEN RETURN; IF pageNumX=1 THEN { borderX _ MIN[(pageX - (clip.x2-clip.x1)*scale)/2, defaultBorder]; }; IF pageNumY=1 THEN { pictureHeight: REAL _ (clip.y2-clip.y1)*scale; borderY _ MAX[pageY-defaultBorder-pictureHeight, (pageY-pictureHeight)/2]; }; END; SubstituteFonts: PROC = BEGIN SELECT TerminalIO.RequestSelection["substitute fonts ?", LIST["no substitution", "standard substitution file", "user substitution file"]] FROM 2 => { substituteFonts _ TRUE; TerminalIO.WriteRope["use standard font substitution file\n"]; fontTab _ InitFontTab[]; }; 3 => { r: Rope.ROPE; r _ TerminalIO.RequestRope["fullpath name for font substitution file > "]; substituteFonts _ TRUE; fontTab _ InitFontTab[r]; }; ENDCASE => { TerminalIO.WriteRope["don't substitute fonts\n"]; substituteFonts _ FALSE; }; END; GetClipRect: PROC [comm: CDSequencer.Command] = BEGIN n: INT _ TerminalIO.RequestSelection[label: "plot area", choice: LIST["complete design", "area of selected objects", "rectangle of command"] ]; SELECT n FROM 3 => { TerminalIO.WriteRope["plot area drawn with command\n"]; clip _ CDBasics.ToRect[comm.pos, comm.sPos]; }; 2 => { TerminalIO.WriteRope["plot area of selected objects\n"]; clip _ CDCommandOps.BoundingBox[design: comm.design, onlySelected: TRUE]; }; ENDCASE => { TerminalIO.WriteRope["plot complete design\n"]; clip _ CDCommandOps.BoundingBox[design: comm.design, onlySelected: FALSE]; }; IF ~CDBasics.NonEmpty[clip] THEN { TerminalIO.WriteRope["clip rectangle is empty\n"]; ERROR ABORTED }; END; GetMedium: PROC [] = BEGIN special _ FALSE; fixedScale _ FALSE; striped _ FALSE; SELECT TerminalIO.RequestSelection["Plot", LIST["standard page and scale", "fill standard page", "fill versatec stripe", "fill c400 page", "other"]] FROM 1 => { fixedScale _ TRUE; TerminalIO.WriteRope["standard page and scale\n"]; }; 3 => { striped _ TRUE; pageX _ defaultStripeX; TerminalIO.WriteRope["fill versatec stripe\n"]; }; 4 => { pageX _ c400PageX; pageY _ c400PageY; TerminalIO.WriteRope["fill c400 page\n"]; }; 5 => { TerminalIO.WriteRope["special:\n"]; special _ TRUE; SELECT TerminalIO.RequestSelection["Plot", LIST["fill standard pages", "fill versatec stripes", "standard scale standard pages", "fill c400 pages", "standard scale c400 pages"]] FROM 1 => { TerminalIO.WriteRope["fill standard pages\n"]; }; 2 => { striped _ TRUE; pageX _ defaultStripeX; TerminalIO.WriteRope["fill versatec stripes\n"]; }; 3 => { fixedScale _ TRUE; TerminalIO.WriteRope["standard scale standard pages\n"]; }; 4 => { pageX _ c400PageX; pageY _ c400PageY; TerminalIO.WriteRope["fill c400 pages\n"]; }; 5 => { pageX _ c400PageX; pageY _ c400PageY; fixedScale _ TRUE; TerminalIO.WriteRope["standard scale c400 pages\n"]; }; ENDCASE => ERROR ABORTED; }; --2,-- ENDCASE => { TerminalIO.WriteRope["fill standard page\n"]; }; END; --GetMedium --Setup special: BOOL _ FALSE; clipRect: BOOL _ FALSE; fixedScale: BOOL _ FALSE; striped: BOOL _ FALSE; defaultScale _ Imager.metersPerPoint/comm.design.technology.lambda; IF comm.key=$InterpressPlotC THEN { TerminalIO.WriteRope["** COLORS\n"]; SetUpColor[] } ELSE SELECT colorMode FROM special => { TerminalIO.WriteRope["** SPECIAL COLORS\n"]; SetUpSpecial[] }; color => { TerminalIO.WriteRope["** COLORS\n"]; SetUpColor[] }; allBlack => { TerminalIO.WriteRope["** BW\n"]; SetUpBW[] }; ENDCASE => ERROR; pageX _ defaultPageX; pageY _ defaultPageY; fontTab _ NIL; SubstituteFonts[]; GetClipRect[comm]; GetMedium[]; sizePerPage _ CDBasics.SizeOfRect[clip]; IF striped THEN SetUpStriped[clip] ELSE IF fixedScale THEN SetUpFixedScaling[clip] ELSE SetUpVaryingScaling[clip]; AdjustPosition[]; TerminalIO.WriteF[" printing %01g rows and %01g columns\n", IO.int[pageNumX], IO.int[pageNumY]]; END; --Setup SetUp[]; ref _ ImagerInterpress.Create[fileName]; PreAmble[ref, contextColors]; deviceTranslation _ [borderX, borderY]; FOR nX IN [0..pageNumX) DO FOR nY IN [0..pageNumY) DO IF abortFlag^ THEN EXIT; start.x _ clip.x1+nX*sizePerPage.x; start.y _ clip.y1+nY*sizePerPage.y; ImagerInterpress.DoPage[ref, PlotPage]; ENDLOOP; ENDLOOP; ImagerInterpress.Close[ref]; TerminalIO.WriteF1[" ""%01g"" created\n", IO.rope[fileName]]; IF ~Rope.IsEmpty[help] THEN TerminalIO.WriteRope[help]; IF ~abortFlag^ THEN TerminalIO.WriteRope[" done\n"]; END; --************************************************ <<--Font replacement stuff>> fontTab: SymTab.Ref; wDir: Rope.ROPE; fontReplace: REF PROC [CDTexts.CDFont] RETURNS [CDTexts.CDFont] _ NEW[PROC [CDTexts.CDFont] RETURNS [CDTexts.CDFont] _ FontReplace]; FontKeyRope: PROC[name: Rope.ROPE, scale: INT] RETURNS[key: Rope.ROPE] = BEGIN RETURN[ IO.PutFR["%g-%g", IO.rope[name], IO.int[scale] ]] END; FontReplace: PROC [cdFont: CDTexts.CDFont] RETURNS [CDTexts.CDFont] = BEGIN newFont: CDTexts.CDFont _ NIL; fontKey: Rope.ROPE _ FontKeyRope[cdFont.supposedName, cdFont.scaleI]; WITH SymTab.Fetch[fontTab, fontKey].val SELECT FROM f: CDTexts.CDFont => RETURN [f]; f: REF CDTexts.FontRec => RETURN [f]; ENDCASE => NULL; WITH SymTab.Fetch[fontTab, cdFont.supposedName].val SELECT FROM l: LIST OF REF ANY => { IF l.first#NIL AND l.rest#NIL AND l.rest.rest=NIL THEN { scale: INT _ 0; name: Rope.ROPE _ CDCommandOps.ToRope[l.first]; WITH l.rest.first SELECT FROM ri: REF INT => scale _ ri^*cdFont.scaleI ENDCASE => NULL; IF scale>0 AND ~Rope.IsEmpty[name] THEN { newFont _ CDTexts.MakeFont[name, scale]; IF newFont#NIL THEN { x: REF CDTexts.FontRec; TRUSTED {x _ LOOPHOLE[newFont]}; [] _ SymTab.Store[fontTab, fontKey, x]; } }; } }; f: CDTexts.CDFont => newFont _ f; f: REF CDTexts.FontRec => newFont _ f; ENDCASE => NULL; IF newFont=NIL THEN newFont_cdFont; RETURN [newFont] END; InitFontTab: PROC [fileName: Rope.ROPE_NIL] RETURNS [fontTab: SymTab.Ref] = BEGIN OneLine: PROC [line: Rope.ROPE] = BEGIN stream: IO.STREAM _IO.RIS[line]; scale: INT; subst, by: Rope.ROPE; subst _ IO.GetRopeLiteral[stream]; by _ IO.GetRopeLiteral[stream]; scale _ IO.GetInt[stream]; [] _ fontTab.Store[subst, LIST[by, NEW[INT_scale]]]; END; file: IO.STREAM _ NIL; fontTab _ SymTab.Create[]; IF Rope.IsEmpty[fileName] THEN fileName _ "CDSubstituteFonts"; fileName _ CDIO.MakeName[base: fileName, ext: "SubstituteFonts", wDir: wDir]; file _ FS.StreamOpen[fileName ! FS.Error => { TerminalIO.WriteRopes["no font substitution: ", error.explanation, "\n"]; GOTO thatsIt }]; DO line: Rope.ROPE; line _ IO.GetLineRope[file ! IO.EndOfStream => GOTO thatsIt]; IF ~Rope.IsEmpty[line] THEN OneLine[line ! IO.EndOfStream => GOTO thatsIt; IO.Error => { TerminalIO.WriteRopes["**error reading font substitution: ", line, "\n"]; CONTINUE }; ]; ENDLOOP; EXITS thatsIt => NULL; END; --************************************************ Init: PROC = BEGIN wDir _ CDIO.GetWorkingDirectory[NIL]; CDCommandOpsExtras2.RegisterWithMenu[menu: $HardCopyMenu, entry: "b&w interpress", key: $InterpressPlot, proc: HardCopyCommand]; CDCommandOpsExtras2.RegisterWithMenu[menu: $HardCopyMenu, entry: "color interpress", key: $InterpressPlotC, proc: HardCopyCommand]; TerminalIO.WriteRope["BW Interpress plot loaded\n"]; END; Init[]; END.