ImagerDitherImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Michael Plass, September 12, 1986 1:43:20 pm PDT
DIRECTORY Basics, CountedVM, PrincOps, PrincOpsUtils, Real, IIDither;
IIDitherImpl: CEDAR PROGRAM
IMPORTS Basics, CountedVM, PrincOpsUtils
EXPORTS IIDither
~ BEGIN OPEN IIDither;
bitsPerWord: NAT ~ Basics.bitsPerWord;
MaxPackedColor: PUBLIC PROC [packing: PackedColorDesc] RETURNS [CARDINAL] ~ {
totalBits: [0..16] ~ packing.redBits+packing.greenBits+packing.blueBits+packing.tileIndexBits;
RETURN [Basics.BITSHIFT[1, totalBits]-1];
};
Pack1: PROC [a: CARDINAL, b: BYTE, bits: NAT] RETURNS [CARDINAL] ~ {
RETURN [Basics.BITSHIFT[a, bits] + Basics.BITSHIFT[b, bits-8]];
};
Pack: PUBLIC PROC [red, green, blue: BYTE, packing: PackedColorDesc] RETURNS [PackedColor] ~ {
totalBits: [0..16] ~ packing.redBits+packing.greenBits+packing.blueBits+packing.tileIndexBits;
RETURN [Pack1[Pack1[Pack1[Pack1[0, red, packing.redBits], green, packing.greenBits], blue, packing.blueBits], 0, packing.tileIndexBits]];
};
Unpack1: PROC [a: CARDINAL, bits: NAT] RETURNS [CARDINAL, BYTE] ~ {
max: CARDINAL ~ Basics.BITSHIFT[1, bits]-1;
b: BYTE ← Basics.BITSHIFT[Basics.BITAND[a, max], 8-bits];
FOR k: NAT ← bits, 2*k UNTIL k >= 8 DO
b ← b + Basics.BITSHIFT[b, -k];
ENDLOOP;
RETURN [Basics.BITSHIFT[a, -bits], b];
};
Unpack: PUBLIC PROC [packed: PackedColor, packing: PackedColorDesc] RETURNS [red, green, blue: BYTE, tileIndex: CARDINAL] ~ {
zero: [0..0] ← 0;
[packed, tileIndex] ← Unpack1[packed, packing.tileIndexBits];
[packed, blue] ← Unpack1[packed, packing.blueBits];
[packed, green] ← Unpack1[packed, packing.greenBits];
[zero, red] ← Unpack1[packed, packing.redBits];
};
PackSequence: PUBLIC UNSAFE PROC [dest, red, green, blue: LONG POINTER TO RawWords, count: NAT, packing: PackedColorDesc] ~ UNCHECKED {
totalBits: [0..bitsPerWord] ~ packing.redBits+packing.greenBits+packing.blueBits+packing.tileIndexBits;
redBit0: NAT ~ bitsPerWord-totalBits;
greenBit0: NAT ~ redBit0+packing.redBits;
blueBit0: NAT ~ greenBit0+packing.greenBits;
bbspace: PrincOps.BBTableSpace;
bb: PrincOps.BitBltTablePtr ~ PrincOpsUtils.AlignedBBTable[@bbspace];
bb^ ← [
dst: [word: dest, bit: redBit0],
dstBpl: bitsPerWord,
src: [word: red, bit: bitsPerWord-8],
srcDesc: [srcBpl[bitsPerWord]],
width: packing.redBits,
height: count,
flags: [disjoint: TRUE]
];
PrincOpsUtils.LongZero[where: dest, nwords: count];
PrincOpsUtils.BITBLT[bb];
bb.dst.bit ← greenBit0;
bb.src.word ← green;
PrincOpsUtils.BITBLT[bb];
bb.dst.bit ← blueBit0;
bb.src.word ← blue;
PrincOpsUtils.BITBLT[bb];
};
PreDither: PUBLIC UNSAFE PROC [words: LONG POINTER TO RawWords, count: NAT, s: NAT ← 0, bits: NAT ← 8, fractionBits: NAT ← 4] ~ UNCHECKED {
max: CARDINAL ~ Basics.BITSHIFT[1, bits]-1;
maxFrac: CARDINAL ~ Basics.BITSHIFT[1, fractionBits]-1;
mask: CARDINAL ~ max-maxFrac;
d: CARDINAL ← Basics.BITAND[Basics.BITAND[s, maxFrac]*16+s, maxFrac];
FOR j: NAT IN [0..count) DO
c: CARDINAL ~ words[j]+d;
words[j] ← Basics.BITAND[Basics.BITAND[c, mask] - Basics.BITSHIFT[c, -bits], max];
d ← Basics.BITAND[d+7, maxFrac];
ENDLOOP;
};
Dither: PUBLIC UNSAFE PROC [destLine: LONG POINTER TO RawBytes, start, count: NAT, packed: LONG POINTER TO RawWords, sTile, fTile: CARDINAL, table: Table] ~ UNCHECKED {
sTileSize: NAT ~ table.sTileSize;
fTileSize: NAT ~ table.fTileSize;
sTileComp: NAT ~ (sTile MOD sTileSize)*fTileSize;
lastTileIndex: NAT ~ sTileComp + (fTileSize-1);
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
tileIndex: CARDINAL ← sTileComp + (fTile MOD fTileSize);
IF destLine = NIL THEN ERROR;
FOR j: NAT IN [0..count) DO
destLine[start+j] ← tableBase[packed[j]+tileIndex];
tileIndex ← IF tileIndex # lastTileIndex THEN tileIndex+1 ELSE sTileComp;
ENDLOOP;
};
WordDither: PUBLIC UNSAFE PROC [destLine: LONG POINTER TO RawWords, start, count: NAT, packed: LONG POINTER TO RawWords, sTile, fTile: CARDINAL, table: Table] ~ UNCHECKED {
sTileSize: NAT ~ table.sTileSize;
fTileSize: NAT ~ table.fTileSize;
sTileComp: NAT ~ (sTile MOD sTileSize)*fTileSize;
lastTileIndex: NAT ~ sTileComp + (fTileSize-1);
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
tileIndex: CARDINAL ← sTileComp + (fTile MOD fTileSize);
IF destLine = NIL THEN ERROR;
FOR j: NAT IN [0..count) DO
destLine[start+j] ← tableBase[packed[j]+tileIndex];
tileIndex ← IF tileIndex # lastTileIndex THEN tileIndex+1 ELSE sTileComp;
ENDLOOP;
};
bytesPerWord: NAT ~ Basics.bytesPerWord;
Mod: PROC [a, b: CARDINAL] RETURNS [CARDINAL] ~ INLINE {
May want to special case for a certain value of b here.
RETURN [a MOD b];
};
DitherConstant: PUBLIC UNSAFE PROC [destLine: LONG POINTER TO RawBytes, start, count: NAT, packed: PackedColor, sTile, fTile: CARDINAL, table: Table] ~ UNCHECKED {
sTileSize: NAT ~ table.sTileSize;
fTileSize: NAT ~ table.fTileSize;
sTileComp: NAT ~ Mod[sTile, sTileSize]*fTileSize;
lastTileIndex: NAT ~ sTileComp + (fTileSize-1);
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
tileIndex: CARDINAL ← sTileComp + Mod[fTile, fTileSize];
initCount: CARDINAL ← count;
longCopyRipple: CARDINAL ← 0;
IF bytesPerWord=2 AND count > 6 THEN {
SELECT fTileSize FROM
3 => {initCount ← 6 + (start MOD 2); longCopyRipple ← 3};
4 => {initCount ← 4 + (start MOD 2); longCopyRipple ← 2};
ENDCASE => NULL;
};
IF destLine = NIL THEN ERROR;
FOR j: NAT IN [start..start+initCount) DO
destLine[j] ← tableBase[packed+tileIndex];
tileIndex ← IF tileIndex # lastTileIndex THEN tileIndex+1 ELSE sTileComp;
ENDLOOP;
IF longCopyRipple # 0 THEN {
words: CARDINAL ~ (count-initCount)/bytesPerWord;
residual: [0..1] ~ count-initCount-bytesPerWord*words;
startAddr: LONG POINTER TO WORD ~ LOOPHOLE[destLine, LONG POINTER TO WORD] + (start+initCount)/bytesPerWord;
PrincOpsUtils.LongCopy[from: startAddr-longCopyRipple, nwords: words, to: startAddr];
IF residual # 0 THEN destLine[start+count-1] ← destLine[start+count-1-fTileSize];
};
};
WordDitherConstant: PUBLIC UNSAFE PROC [destLine: LONG POINTER TO RawWords, start, count: NAT, packed: PackedColor, sTile, fTile: CARDINAL, table: Table] ~ UNCHECKED {
sTileSize: NAT ~ table.sTileSize;
fTileSize: NAT ~ table.fTileSize;
sTileComp: NAT ~ Mod[sTile, sTileSize]*fTileSize;
lastTileIndex: NAT ~ sTileComp + (fTileSize-1);
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
tileIndex: CARDINAL ← sTileComp + Mod[fTile, fTileSize];
initCount: CARDINAL ← MIN[count, fTileSize];
IF destLine = NIL THEN ERROR;
FOR j: NAT IN [start..start+initCount) DO
destLine[j] ← tableBase[packed+tileIndex];
tileIndex ← IF tileIndex # lastTileIndex THEN tileIndex+1 ELSE sTileComp;
ENDLOOP;
IF count > initCount THEN {
startAddr: LONG POINTER TO WORD ~ @(destLine[start+initCount]);
PrincOpsUtils.LongCopy[from: startAddr-fTileSize, nwords: count-initCount, to: startAddr];
};
};
CreateTable: PUBLIC PROC [packing: PackedColorDesc, sTileSize: NAT ← 4, fTileSize: NAT ← 4] RETURNS [Table] ~ {
maxPackedColor: CARDINAL ~ MaxPackedColor[packing];
tileSize: NAT ~ Basics.BoundsCheck[sTileSize*fTileSize-1, Basics.BITSHIFT[1, packing.tileIndexBits]];
RETURN [NEW[TableRep ← [
packing: packing,
maxPackedColor: maxPackedColor,
sTileSize: sTileSize,
fTileSize: fTileSize,
space: CountedVM.SimpleAllocate[(INT[maxPackedColor]+1)/Basics.bytesPerWord]
]]];
};
ShowTable: PROC [table: Table, pm: IIPixelMap.PixelMap] ~ TRUSTED {
-- For debugging the table builder; pm should describe the eight bpp color display.
t: IIPixelMap.PixelMap ~ IIPixelMap.CreateFrameBuffer[pointer: table.space.pointer, words: table.space.words, lgBitsPerPixel: 3, rast: 2, lines: 4096*4, ref: table.space];
pm ← pm.ShiftMap[-40, -60].Clip[[0,0,324,324+82]];
pm.Fill[[0,0,324,324+82], 0];
FOR r: NAT IN [0..16) DO
sr: NAT ← (r/4) * 81 + 1;
fr: NAT ← (r MOD 4) * 81 + 1;
FOR g: NAT IN [0..16) DO
s: NAT ← sr + g*5;
FOR b: NAT IN [0..16) DO
f: NAT ← fr + b*5;
pm.Transfer[t.ShiftMap[-((r*16+g)*16+b)*4, 0].Clip[[0,0,4,4]].ShiftMap[s,f]];
ENDLOOP;
ENDLOOP;
ENDLOOP;
pm ← pm.ShiftMap[0, -324].Clip[[0,0,324,82]];
FOR i: NAT IN [0..32) DO
s: NAT ← i * 10 + 2;
FOR j: NAT IN [0..8) DO
f: NAT ← j * 10 + 1;
pm.Fill[[s, f, 9, 9], i*8+j];
ENDLOOP;
ENDLOOP;
};
InitTable: PUBLIC PROC [table: Table, map: LIST OF MapEntry, scaleMap: NAT] ~ {
tableBytes: INT ~ INT[table.space.words]*Basics.bytesPerWord;
redMap: ARRAY ChannelValue OF INTEGER ← ALL[NAT.LAST];
greenMap: ARRAY ChannelValue OF INTEGER ← ALL[NAT.LAST];
blueMap: ARRAY ChannelValue OF INTEGER ← ALL[NAT.LAST];
InitMaps: PROC ~ {
FOR p: LIST OF MapEntry ← map, p.rest UNTIL p=NIL DO
redMap[p.first.mapIndex] ← p.first.red*scaleMap;
greenMap[p.first.mapIndex] ← p.first.green*scaleMap;
blueMap[p.first.mapIndex] ← p.first.blue*scaleMap;
ENDLOOP;
};
Closest: PROC [red, green, blue: INTEGER, guess: ChannelValue] RETURNS [ChannelValue] ~ {
best: ChannelValue ← 0;
bestDistSqr: LONG CARDINAL ← LAST[LONG CARDINAL];
bestDistBound: NAT ← LAST[NAT];
Try: PROC [a: ChannelValue, r, g, b: INTEGER] ~ INLINE {
absRed, absGreen, absBlue: CARDINAL;
distSqr: LONG CARDINAL;
IF (absRed←ABS[redMap[a]-red]) <= bestDistBound
AND (absGreen←ABS[greenMap[a]-green]) <= bestDistBound
AND (absBlue←ABS[blueMap[a]-blue]) <= bestDistBound
AND (distSqr�sics.LongMult[absRed,absRed] + Basics.LongMult[absGreen,absGreen] + Basics.LongMult[absBlue,absBlue]) < bestDistSqr
THEN {
bestDistBound ← absRed+absGreen+absBlue;
bestDistSqr ← distSqr;
best ← a;
};
};
Try[guess, redMap[guess], greenMap[guess], blueMap[guess]];
FOR p: LIST OF MapEntry ← map, p.rest UNTIL p=NIL OR bestDistSqr=0 DO
mapIndex: ChannelValue ~ p.first.mapIndex;
Try[mapIndex, redMap[mapIndex], greenMap[mapIndex], blueMap[mapIndex]];
ENDLOOP;
RETURN [best];
};
ComputeClosestColors: PROC ~ TRUSTED {
delta: NAT ~ Basics.BITSHIFT[1, table.packing.tileIndexBits];
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
guess: ChannelValue ← 0;
maxPackedColor: CARDINAL ~ table.maxPackedColor;
IF maxPackedColor >= tableBytes THEN ERROR;
IF tableBase = NIL THEN ERROR;
FOR c: INT ← 0, c + delta UNTIL c > maxPackedColor DO
packed: CARDINAL ~ c;
r, g, b: ColorValue;
[r, g, b, ----] ← Unpack[packed, table.packing];
tableBase[packed] ← guess ← Closest[r, g, b, guess];
ENDLOOP;
};
ClosestTabulated: PROC [red, green, blue: INTEGER] RETURNS [ChannelValue] ~ TRUSTED {
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
r: ColorValue ~ MIN[MAX[red, 0], ColorValue.LAST];
g: ColorValue ~ MIN[MAX[green, 0], ColorValue.LAST];
b: ColorValue ~ MIN[MAX[blue, 0], ColorValue.LAST];
packed: CARDINAL ~ Pack[r, g, b, table.packing];
RETURN [tableBase[packed]]
};
ComputeTiles: PROC ~ TRUSTED {
delta: NAT ~ Basics.BITSHIFT[1, table.packing.tileIndexBits];
tileSize: NAT ~ table.sTileSize*table.fTileSize;
maxPackedColor: CARDINAL ~ table.maxPackedColor;
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
FOR c: INT ← 0, c + delta UNTIL c > maxPackedColor DO
packed: CARDINAL ~ c;
r0, g0, b0, r, g, b: INTEGER;
[r0, g0, b0, ----] ← Unpack[packed, table.packing];
r ← r0; g ← g0; b ← b0;
FOR i: NAT IN [1..tileSize) DO
close: ChannelValue ~ ClosestTabulated[r, g, b];
IF LONG[packed]+i >= tableBytes THEN ERROR;
tableBase[packed+i] ← close;
r ← r - redMap[close] + r0;
g ← g - greenMap[close] + g0;
b ← b - blueMap[close] + b0;
ENDLOOP;
ENDLOOP;
};
SortTiles: PROC ~ TRUSTED {
delta: NAT ~ Basics.BITSHIFT[1, table.packing.tileIndexBits];
tileSize: NAT ~ table.sTileSize*table.fTileSize;
maxPackedColor: CARDINAL ~ table.maxPackedColor;
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
intensity: ARRAY BYTE OF REAL ← ALL[Real.TrappingNaN];
inverseOrder: PACKED ARRAY BYTE OF BYTE ← GetTileOrder[table.sTileSize, table.fTileSize];
FOR p: LIST OF MapEntry ← map, p.rest UNTIL p=NIL DO
intensity[p.first.mapIndex] ← p.first.red*0.30 + p.first.green*0.59 + p.first.blue*0.11;
ENDLOOP;
FOR c: INT ← 0, c + delta UNTIL c > maxPackedColor DO
packed: CARDINAL ~ c;
At: PROC [j: NAT] RETURNS [CARDINAL] ~ CHECKED INLINE {RETURN [packed+inverseOrder[j]]};
IF c >= trapVal THEN {trapVal ← c};
FOR i: NAT IN [1..tileSize) DO
channelI: BYTE ~ tableBase[packed+inverseOrder[i]];
intensityI: REAL ~ intensity[channelI];
j: NAT ← i;
WHILE j#0 AND intensityI < intensity[tableBase[At[j-1]]] DO
tableBase[At[j]] ← tableBase[At[j-1]];
j ← j-1;
ENDLOOP;
tableBase[At[j]] ← channelI;
ENDLOOP;
ENDLOOP;
};
InitMaps[];
ComputeClosestColors[];
ComputeTiles[];
SortTiles[];
};
trapVal: INT ← 0;
sSizeSpecial: NAT ← 4;
fSizeSpecial: NAT ← 4;
specialTileOrder: REF ARRAY [0..20) OF NAT ← NEW[ARRAY [0..20) OF NAT ← [
0, 14, 3, 13,
11, 5, 8, 6,
12, 2, 15, 1,
7, 9, 4, 10,
0, 0, 0, 0
]];
tileDelta: NAT ← 7;
GetTileOrder: PROC [sTileSize, fTileSize: NAT] RETURNS [inverseOrder: PACKED ARRAY BYTE OF BYTE] ~ {
tileSize: NAT ~ sTileSize*fTileSize;
IF sTileSize = sSizeSpecial AND fTileSize = fSizeSpecial THEN {
FOR i: NAT IN [0..tileSize) DO inverseOrder[specialTileOrder[i]] ← i ENDLOOP;
}
ELSE {
j: NAT ← 0;
FOR i: NAT IN [0..tileSize) DO
inverseOrder[j] ← i;
j ← (j + tileDelta) MOD tileSize;
ENDLOOP;
};
};
END.