DIRECTORY Atom USING [GetPName, PutPropOnList], CD USING [Layer, LayerKey, LayerTechnology, Technology], CDColors USING [ColorTable, DisplayMode, DisplayType, globalColors], Commander USING [CommandProc, Register], Convert USING [AppendReal], Imager USING [Color, ConstantColor], ImagerColor USING [ColorFromRGB, HSL, HSLFromRGB, RGB], ImagerColorPrivate USING [ComponentFromColor], PrincOpsUtils USING [], Real USING [Float], Rope USING [ActionType, Map, ROPE], Terminal USING [ChannelValue, ColorValue, Current, GetColor, GetColorBitmapState, Virtual], TerminalIO USING [WriteRope], TiogaAccess USING [Create, GetInternalProp, Looks, Put, TiogaChar, WriteFile, Writer]; NectarineTune: CEDAR PROGRAM IMPORTS Atom, CD, CDColors, Commander, Convert, ImagerColor, ImagerColorPrivate, Real, Rope, Terminal, TerminalIO, TiogaAccess ~ BEGIN OPEN Imager, ImagerColor, ImagerColorPrivate, Real; break: SIGNAL = CODE; -- for debugging Blend: TYPE ~ REF BlendRec; BlendRec: TYPE ~ RECORD [count: CD.Layer _ 0, flavours: PACKED ARRAY CD.Layer OF BOOLEAN _ ALL[FALSE]]; BlendColours: PROC [components: Blend] RETURNS [blended: Color] ~ BEGIN n: INT _ components.count; comp: PACKED ARRAY CD.Layer OF BOOLEAN _ components.flavours; mix: RGB _ [0, 0, 0]; SELECT n FROM 0 => ERROR; -- should never have been allocated 1 => BEGIN i: CD.Layer _ 0; WHILE NOT comp[i] DO i _ SUCC [i] ENDLOOP; blended _ LayerColour [i] END; ENDCASE => BEGIN poly, diff, well: CD.Layer _ 0; hasCut: BOOL _ FALSE; FOR i: CD.Layer IN CD.Layer DO IF comp[i] THEN SELECT CD.LayerKey[i] FROM $pol => poly _ i; $ndif, $pdif => diff _ i; $cut, $cut2 => hasCut _ TRUE; $nwel => well _ i; ENDCASE => NULL; ENDLOOP; IF hasCut THEN blended _ ColorFromRGB [[0, 0, 0]] ELSE BEGIN IF (poly # 0) AND (diff # 0) THEN BEGIN mix _ [1, 1, 0]; n _ PRED [n]; comp[poly] _ comp[diff] _ FALSE END; FOR i: CD.Layer IN CD.Layer DO IF comp[i] THEN BEGIN v: ImagerColor.RGB ~ RGBFromColor [LayerColour[i]]; IF (i = well) AND (i # 0) THEN NULL; -- not yet decided mix.R _ mix.R + v.R; mix.G _ mix.G + v.G; mix.B _ mix.B + v.B END ENDLOOP; mix.R _ mix.R / n; mix.G _ mix.G / n; mix.B _ mix.B / n; blended _ ColorFromRGB [mix] END END; RETURN [blended] END; -- BlendColours RGBFromColor: PROC [c: Color] RETURNS [rgb: RGB] ~ INLINE BEGIN WITH c SELECT FROM constant: ConstantColor => BEGIN rgb.R _ ComponentFromColor [constant, $Red]; rgb.G _ ComponentFromColor [constant, $Green]; rgb.B _ ComponentFromColor [constant, $Blue] END; ENDCASE => rgb _ [0.0, 0.0, 0.0]; RETURN [rgb] END; -- RGBFromColor LayerColour: PROC [l: CD.Layer] RETURNS [Color] ~ BEGIN original: Color ~ CDColors.globalColors[bit8][normal].cols[l]; RETURN [original] END; -- LayerColour document: TiogaAccess.Writer = TiogaAccess.Create []; vanillaLook: TiogaAccess.Looks = ALL [FALSE]; vanillaChar: TiogaAccess.TiogaChar = [0, 0C, vanillaLook, $lead3, FALSE, FALSE, 0, NIL]; symbolLook, charLook, labelLook: TiogaAccess.Looks _ vanillaLook; InitDocument: PROC ~ BEGIN rootCharacter: TiogaAccess.TiogaChar _ vanillaChar; -- 1st char written rootCharacter.endOfNode _ TRUE; rootCharacter.deltaLevel _ 1; rootCharacter.propList _ Atom.PutPropOnList [propList: rootCharacter.propList, prop: $Postfix, val: TiogaAccess.GetInternalProp [$Postfix, "11 in pageWidth 8.5 in pageLength"]]; TiogaAccess.Put [document, rootCharacter] END; WriteChar: PROC [c: CHAR, l: TiogaAccess.Looks _ charLook] ~ BEGIN tc: TiogaAccess.TiogaChar _ vanillaChar; tc.char _ c; tc.looks _ l; TiogaAccess.Put [document, tc] END; -- WriteChar WriteTab: PROC [] ~ BEGIN tab: CHAR = 'I - 100B; WriteChar [tab] END; -- WriteTab WriteRope: PROC [r: Rope.ROPE, l: TiogaAccess.Looks _ labelLook] ~ BEGIN PutChar: Rope.ActionType ~ {WriteChar [c, l]}; [] _ Rope.Map [base: r, action: PutChar] END; -- WriteRope WriteEOL: PROC ~ BEGIN tc: TiogaAccess.TiogaChar _ vanillaChar; tc.endOfNode _ TRUE; TiogaAccess.Put [document, tc] END; -- WriteEOL WriteNewPage: PROC ~ BEGIN tc: TiogaAccess.TiogaChar _ vanillaChar; tc.endOfNode _ TRUE; tc.format _ $pageBreak; TiogaAccess.Put [document, tc] END; -- WriteNewPage WriteBigLead: PROC ~ BEGIN tc: TiogaAccess.TiogaChar _ vanillaChar; tc.endOfNode _ TRUE; tc.format _ $lead3; TiogaAccess.Put [document, tc]; TiogaAccess.Put [document, tc] END; -- WriteBigLead WriteReal: PROC [n: REAL] ~ BEGIN buffer: REF TEXT _ NEW [TEXT]; buffer _ Convert.AppendReal [to: buffer, from: n, precision: 3]; WriteTab []; FOR i: NAT IN [0 .. buffer.length) DO WriteChar [buffer[i]] ENDLOOP END; -- WriteReal FindAllColours: Commander.CommandProc ~ BEGIN vt: Terminal.Virtual ~ Terminal.Current []; prevTech: CD.Technology _ NIL; InitDocument []; FOR layer: CD.Layer IN CD.Layer DO tech: CD.Technology ~ CD.LayerTechnology[layer]; key: ATOM _ CD.LayerKey [layer]; rgb: RGB ~ RGBFromColor [LayerColour [layer]]; hsl: HSL ~ HSLFromRGB [rgb]; IF (key # NIL) THEN BEGIN IF (tech # prevTech) THEN BEGIN prevTech _ tech; WriteBigLead []; IF (tech # NIL) THEN WriteRope [tech.name] ELSE WriteRope ["Unnamed Technology"]; WriteEOL [] END; IF (tech # NIL) THEN {WriteRope [tech.name, charLook]; WriteChar ['.]}; WriteRope [Atom.GetPName [key]]; WriteTab []; WriteRope ["R, G, B: "]; WriteReal [rgb.R]; WriteReal [rgb.G]; WriteReal [rgb.B]; WriteTab []; WriteRope ["H, S, L: "]; WriteReal [hsl.H]; WriteReal [hsl.S]; WriteReal [hsl.L]; WriteEOL [] END; ENDLOOP; IF (Terminal.GetColorBitmapState [vt] = displayed) THEN BEGIN ir, ig, ib: Terminal.ColorValue; norm: REAL ~ 1.0 / Float [LAST[Terminal.ColorValue]]; WriteBigLead []; WriteRope ["Contents of the ColorMap (r, g, b):"]; WriteEOL []; FOR i: Terminal.ChannelValue IN Terminal.ChannelValue DO [ir, ig, ib] _ Terminal.GetColor [vt, i]; WriteReal [Float[ir] * norm]; WriteReal [Float[ig] * norm]; WriteReal [Float[ib] * norm]; WriteEOL [] ENDLOOP END; TiogaAccess.WriteFile [document, "[]<>Users>Beretta.pa>CD>NectarineTune.tioga"]; TerminalIO.WriteRope ["[]<>Users>Beretta.pa>CD>NectarineTune.tioga created.\n"] END; -- FindAllColours symbolLook ['l] _ TRUE; symbolLook ['m] _ TRUE; labelLook ['l] _ TRUE; labelLook ['b] _ TRUE; charLook ['l] _ TRUE; Commander.Register [key: "Nectar", proc: FindAllColours, doc: "To tune-up Nectarine"] END. |NectarineTune.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Giordano Bruno Beretta, July 18, 1986 11:32:03 am PDT gbb July 18, 1986 4:33:08 pm PDT To tune-up Nectarine Color Blending The Probably Controversial Code Takes the layers covering a tile and blend an RBG-colour out of them. BlendRec: TYPE ~ RECORD [count: CD.Layer _ 0, flavours: PACKED ARRAY CD.Layer OF BOOLEAN _ ALL[FALSE]]; Find exception layers. Cuts always win. Handle gates. Reinitialize mix by yellow and eliminate poly and diff. Compute mean colour. Assume: all colours except black have the same weight. Conversions Assume that LayerColour had previously been called. Ensure that only one colour representation is used. I/O Causes document to be printed in landscape format. Must hang on root node. Main Find all currently defined colours and write them into a Tioga document. Initialisations Κd˜codešœ™Kšœ Οmœ1™˜>Kšžœ ˜Kšžœ ˜——™Kšœ5˜5Kšœ!žœžœ˜-KšœBžœžœžœ˜XKšœA˜Aš‘ œžœž˜K™JKšœ4 ˜GKšœžœ˜Kšœ˜Kšœ±˜±Kšœ)˜)Kšžœ˜—š‘ œžœžœ%ž˜BKšœ(˜(Kšœ9˜9Kšžœ  ˜—š‘œžœž˜Kšœžœ ˜Kšœ˜Kšžœ  ˜—š‘ œžœ žœ&ž˜HKš‘œ'˜.K˜(Kšžœ  ˜—š‘œžœž˜Kšœ(˜(Kšœžœ ˜3Kšžœ ˜—š‘ œžœž˜Kšœ(˜(Kšœžœ˜,Kšœ˜Kšžœ ˜—š‘ œžœž˜Kšœ(˜(Kšœžœ˜(Kšœ>˜>Kšžœ ˜—š‘ œžœžœž˜!Kš œžœžœžœžœ˜Mšœ@˜@Kšœ ˜ Kš žœžœžœžœž˜CKšžœ  ˜——™š‘œ žœž˜-K™HKšœ+˜+Kšœ žœžœ˜M˜š žœžœžœžœž˜"Kšœžœžœ˜0Kšœžœžœ˜ Kšœžœ&˜.Kšœžœ˜šžœžœžœž˜šžœžœž˜Kšœ!˜!Kšžœ žœžœ˜*Kšžœ"˜&Kšœ ˜ Kšžœ˜—Kšžœ žœžœ3˜GKšœ.˜.Kšœ˜Kšœ8˜8Kšœ%˜%Kšœ8˜8Kšœ ˜ Kšžœ˜—Kšžœ˜—šžœ1žœž˜=Kšœ ˜ Kšœžœžœ˜5Kšœ˜Kšœ?˜?šžœžœž˜8Kšœ)˜)KšœY˜YKšœ ˜ Kšž˜—Kšžœ˜—MšœP˜PLšœO˜OKšžœ ˜——™Lšœžœžœ˜/Kšœžœžœ˜-Kšœžœ˜LšœU˜U—Lšžœ˜—…—$$