~
BEGIN
OPEN ImagerDither;
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;
Mod4:
PROC [a, b:
CARDINAL]
RETURNS [
CARDINAL] ~
INLINE {
RETURN [IF b = 4 THEN a MOD 4 ELSE 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 ~ Mod4[sTile, sTileSize]*fTileSize;
lastTileIndex: NAT ~ sTileComp + (fTileSize-1);
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
tileIndex: CARDINAL ← sTileComp + Mod4[fTile, fTileSize];
initCount: CARDINAL ← count;
IF bytesPerWord=2 AND count > 4 AND fTileSize=4 THEN initCount ← 4 + (start MOD 2);
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 {
words: CARDINAL ~ (count-initCount)/2;
residual: [0..1] ~ count-initCount-2*words;
startAddr: LONG POINTER TO WORD ~ LOOPHOLE[destLine, LONG POINTER TO WORD] + (start+initCount)/2;
PrincOpsUtils.LongCopy[from: startAddr-2, 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 ~ Mod4[sTile, sTileSize]*fTileSize;
lastTileIndex: NAT ~ sTileComp + (fTileSize-1);
tableBase: LONG POINTER TO RawBytes ~ table.space.pointer;
tileIndex: CARDINAL ← sTileComp + Mod4[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: ImagerPixelMap.PixelMap] ~
TRUSTED {
For debugging the table builder; pm should describe the eight bpp color display.
t: ImagerPixelMap.PixelMap ~ ImagerPixelMap.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[];
};
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;
};
};