DIRECTORY CustomBrick, Imager, ImagerFourColorContext, ImagerPixel, ImagerPrintContext, ImagerSample USING [SampleMap], ImagerTransformation USING [Direction], PrintColor, Rope, Scheme; SchemePrintColorImpl: CEDAR PROGRAM IMPORTS CustomBrick, ImagerFourColorContext, ImagerPrintContext, Scheme ~ BEGIN OPEN Scheme; defaultDots: Rope.ROPE ~ " [ [2 62 182 88 43 204 249 219 122 152 227 167 96 51 144 114 24 9 69 193 81 36 201 246 216 129 163 238 178 103 58 141 107 17] [32 197 242 212 133 159 234 174 99 54 137 111 21 6 66 186 84 39 208 253 223 126 156 231 171 92 47 148 118 28 13 73 189 77] ] 26 255 magenta brick [ [2 50 114 145 14 62 126 157] [66 161 225 209 78 169 237 221] [141 106 241 193 129 102 253 205] [26 42 177 86 22 38 189 90] [10 58 122 153 6 54 118 149] [74 173 233 217 70 165 229 213] [133 98 249 201 137 110 245 197] [18 34 185 94 30 46 181 82] ] 0 255 yellow brick [ [2 17 107 141 58 103 178 238 163 129 216 246 201 36 81 193 69 9 24 114 144 51 96 167 227 152 122 219 249 204 43 88 182 62] [32 77 189 73 13 28 118 148 47 92 171 231 156 126 223 253 208 39 84 186 66 6 21 111 137 54 99 174 234 159 133 212 242 197] ] 8 255 cyan brick [ [165 101 58 115 172 225 168 104 62 119 175 221] [80 136 186 143 97 41 83 140 189 147 94 37] [23 236 250 211 55 12 27 239 253 207 51 9] [122 179 218 161 112 69 126 182 214 158 108 66] [151 90 34 76 133 197 154 87 30 73 129 193] [204 48 5 19 232 246 200 44 2 16 228 243] ] 6 255 black brick "; ThePixelMap: PROC [a: Any] RETURNS [ImagerPixel.PixelMap] ~ { WITH a SELECT FROM pm: ImagerPixel.PixelMap => RETURN [pm]; ENDCASE => Complain[a, "not a pixelmap"]; }; oneColorTU: PrintColor.TonerUniverse ~ [black: TRUE, cyan: FALSE, magenta: FALSE, yellow: FALSE]; threeColorTU: PrintColor.TonerUniverse ~ [black: FALSE, cyan: TRUE, magenta: TRUE, yellow: TRUE]; fourColorTU: PrintColor.TonerUniverse ~ [black: TRUE, cyan: TRUE, magenta: TRUE, yellow: TRUE]; PrintColorPrim: PROC [self: Primitive, a, b, c: Any, rest: ProperList] RETURNS [result: Any ¬ NIL] ~ { SELECT self.data FROM $makeprintcontext => { local: Any ¬ rest; GetNextAny: PROC [] RETURNS [d: Any ¬ NIL] ~ { IF local # NIL THEN {d ¬ Car[local]; local ¬ Cdr[local]}; }; pixelmap: ImagerPixel.PixelMap ~ ThePixelMap[a]; thing: Any ¬ GetNextAny[]; brickspec: Rope.ROPE ~ IF thing = NIL THEN defaultDots ELSE RopeFromString[TheString[thing]]; scanSlow: ImagerTransformation.Direction ~ IF (thing ¬ GetNextAny[]) = NIL THEN down ELSE SELECT thing FROM $left => $left, $right => $right, $up => $up, $down => $down, ENDCASE => ERROR; scanFast: ImagerTransformation.Direction ~ IF (thing ¬ GetNextAny[]) = NIL THEN right ELSE SELECT thing FROM $left => $left, $right => $right, $up => $up, $down => $down, ENDCASE => ERROR; sSU: REAL ~ IF (thing ¬ GetNextAny[]) = NIL THEN 300 ELSE TheREAL[thing]; fSU: REAL ~ IF (thing ¬ GetNextAny[]) = NIL THEN 300 ELSE TheREAL[thing]; nColors: NAT ~ KCheck[c, 4]; context: Imager.Context ~ ImagerPrintContext.Create[ deviceSpaceSize: pixelmap.box.max, scanMode: [slow: scanSlow, fast: scanFast], surfaceUnitsPerInch: [sSU, fSU], logicalDevice: 0, halftoneProperties: CustomBrick.HalftonePropertiesFromRope[specs: brickspec, tonerUniverse: (SELECT nColors FROM 1 => oneColorTU, 3 => threeColorTU, 4 => fourColorTU, ENDCASE => Complain[c, "samplesPerPixel must be 1, 3, or 4"])], correction: NIL, interpolate: FALSE ]; ImagerPrintContext.SetBitmap[context, pixelmap[0]]; ImagerPrintContext.SetSeparation[ context: context, toner: SELECT b FROM $black => $black, $cyan => $cyan, $magenta => $magenta, $yellow => $yellow, ENDCASE => Complain[c, "toner must be black, cyan, magenta, or yellow"] ]; result ¬ context; }; $make4colorprintcontext => { local: Any ¬ rest; GetNextAny: PROC [] RETURNS [d: Any ¬ NIL] ~ { IF local # NIL THEN {d ¬ Car[local]; local ¬ Cdr[local]}; }; thing: Any; pixelmapC: ImagerPixel.PixelMap ~ ThePixelMap[a]; pixelmapM: ImagerPixel.PixelMap ~ ThePixelMap[b]; pixelmapY: ImagerPixel.PixelMap ~ ThePixelMap[c]; pixelmapK: ImagerPixel.PixelMap ~ ThePixelMap[(thing ¬ GetNextAny[])]; brickspec: Rope.ROPE ~ IF (thing ¬ GetNextAny[]) = NIL THEN defaultDots ELSE RopeFromString[TheString[thing]]; scanSlow: ImagerTransformation.Direction ~ IF (thing ¬ GetNextAny[]) = NIL THEN down ELSE SELECT thing FROM $left => $left, $right => $right, $up => $up, $down => $down, ENDCASE => ERROR; scanFast: ImagerTransformation.Direction ~ IF (thing ¬ GetNextAny[]) = NIL THEN right ELSE SELECT thing FROM $left => $left, $right => $right, $up => $up, $down => $down, ENDCASE => ERROR; sSU: REAL ~ IF (thing ¬ GetNextAny[]) = NIL THEN 300 ELSE TheREAL[thing]; fSU: REAL ~ IF (thing ¬ GetNextAny[]) = NIL THEN 300 ELSE TheREAL[thing]; bitmaps: ARRAY ImagerFourColorContext.Toner OF ImagerSample.SampleMap ¬ [ black: pixelmapK[0], cyan: pixelmapC[0], magenta: pixelmapM[0], yellow: pixelmapY[0]]; context: Imager.Context ~ ImagerFourColorContext.Create[ deviceSpaceSize: pixelmapK.box.max, scanMode: [slow: scanSlow, fast: scanFast], surfaceUnitsPerInch: [sSU, fSU], logicalDevice: 0, halftoneProperties: CustomBrick.HalftonePropertiesFromRope[specs: brickspec, tonerUniverse: fourColorTU], correction: NIL, interpolate: FALSE, bitmaps: bitmaps ]; result ¬ context; }; ENDCASE => ERROR; }; RegisterPrintColor: PROC [env: Environment] ~ { DefinePrimitive[name: "make-print-context", nArgs: 8, optional: 5, dotted: FALSE, proc: PrintColorPrim, env: env, data: $makeprintcontext, doc: "(pixelmap toner nColors [ brick-spec-string slow fast sSurfaceUnitsPerInch fSurfaceUnitsPerInch ]) Makes a color printer Imager context"]; DefinePrimitive[name: "make-four-color-print-context", nArgs: 9, optional: 5, dotted: FALSE, proc: PrintColorPrim, env: env, data: $make4colorprintcontext, doc: "(pixelmapC pixelmapM pixelmapY pixelmapK [ brick-spec-string slow fast sSurfaceUnitsPerInch fSurfaceUnitsPerInch ]) Makes a four color at a time Imager context"]; }; RegisterInit[RegisterPrintColor]; END. Κ SchemePrintColorImpl.mesa Copyright Σ 1988, 1989, 1991 by Xerox Corporation. All rights reserved. Michael Plass, September 21, 1988 1:09:04 pm PDT Tim Diebert: February 7, 1989 2:15:12 pm PST ΚΪ•NewlineDelimiter –(cedarcode) style™šœ™Icodešœ Οeœ=™HK™0K™,K™—šΟk ˜ K˜ K˜K˜K˜ Kšœ˜Kšœ žœ ˜Kšœžœ ˜'K˜ K˜Kšœ˜—Iheadšœž ˜#Kšžœ@˜Gšœžœžœ˜K˜šœžœ˜˜Kšœz˜zKšœz˜zK˜—šœ˜Kšœ˜Kšœ˜Kšœ!˜!Kšœ˜Kšœ˜Kšœ˜Kšœ ˜ Kšœ˜K˜K˜—˜K˜zK˜zK˜—˜Kšœ/˜/Kšœ+˜+Kšœ*˜*Kšœ/˜/Kšœ+˜+Kšœ)˜)K˜—K˜K˜—šΟn œžœ žœ˜=šžœžœž˜Kšœžœ˜(Kšžœ"˜)—Kšœ˜K˜—Kš œ/žœžœ žœ žœ˜aKš œ1žœžœ žœ žœ˜aš œ0žœžœ žœ žœ˜_K˜—šŸœžœ3žœžœ˜fšžœ ž˜šœ˜Kšœ˜šŸ œžœžœ žœ˜.Kšžœ žœžœ&˜9Kšœ˜—Kšœ0˜0Kšœ˜Kš œžœžœ žœžœ žœ"˜]šœ+žœž˜JKšžœ˜ Kš žœžœžœ?žœžœ˜f—šœ+žœž˜JKšžœ˜ Kš žœžœžœ?žœžœ˜f—Kš œžœžœžœžœžœ˜IKš œžœžœžœžœžœ˜IKšœ žœ˜šœ4˜4Kšœ"˜"Kšœ+˜+Kšœ ˜ Kšœ˜Kšœ]žœ žœ7žœ8˜ζKšœ žœ˜Kšœ ž˜Kšœ˜—Kšœ3˜3šœ!˜!Kšœ˜šœžœž˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšžœ@˜G—Kšœ˜—Kšœ˜Kšœ˜—šœ˜Kšœ˜šŸ œžœžœ žœ˜.Kšžœ žœžœ&˜9Kšœ˜—Kšœ ˜ Kšœ1˜1Kšœ1˜1Kšœ1˜1KšœF˜Fšœžœžœž˜6Kšžœ ˜Kšžœ"˜&—šœ+žœž˜JKšžœ˜ Kš žœžœžœ?žœžœ˜f—šœ+žœž˜JKšžœ˜ Kš žœžœžœ?žœžœ˜f—Kš œžœžœžœžœžœ˜IKš œžœžœžœžœžœ˜Išœ žœžœ˜IKšœ˜Kšœ˜Kšœ˜Kšœ˜—šœ8˜8Kšœ#˜#Kšœ+˜+Kšœ ˜ Kšœ˜Kšœi˜iKšœ žœ˜Kšœ ž˜K˜Kšœ˜—Kšœ˜Kšœ˜—Kšžœžœ˜—Kšœ˜K˜—K˜šŸœžœ˜/KšœKžœΛ˜›KšœVžœι˜ΔKšœ˜K˜—Kšœ!˜!K˜—Kšžœ˜K˜—…—4Ψ