MaskWithColorImpl.mesa
Copyright Ó 1989, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) February 25, 1990 4:50:16 pm PST
DIRECTORY
Basics USING [BITAND, BITOR, BITNOT, BITLSHIFT, BITRSHIFT, RawBytes, RawWords],
MaskWithColor;
MaskWithColorImpl: PROGRAM
IMPORTS Basics
EXPORTS MaskWithColor
= BEGIN OPEN Basics, MaskWithColor;
fastBytes: BOOL = TRUE;
fastWords: BOOL = TRUE;
BitsPtr: TYPE = LONG POINTER TO RawBits;
RawBits: TYPE = RECORD [PACKED SEQUENCE COMPUTED CARDINAL OF BIT];
BytesPtr: TYPE = LONG POINTER TO Basics.RawBytes;
WordsPtr: TYPE = LONG POINTER TO Basics.RawWords;
bytesPerUnit: NAT = BYTES[UNIT];
bytesPerWord: NAT = BYTES[WORD];
BitCount: TYPE = [0..bitsPerWord];
logBitsPerWord: CARDINAL = BITS[BitOffset];
MakeColorWord: PUBLIC PROC [sampleColor: WORD, logDepth: LogBitOffset] RETURNS [WORD] = {
Takes a sample color and propagates it through the word as required by MaskWithColor and MaskWithColorRuns, returning the propagated word.
bitsValid: BitCount ¬ BITLSHIFT[1, logDepth];
color: WORD ¬ BITAND[sampleColor, BITRSHIFT[CARD.LAST, bitsPerWord-bitsValid]];
WHILE bitsValid < bitsPerWord DO
color ¬ color + BITLSHIFT[color, bitsValid];
bitsValid ¬ bitsValid + bitsValid;
ENDLOOP;
RETURN [color];
};
StoreWithColorMask: PUBLIC PROC [
maskBase: Ptr, maskOffset: CARDINAL, maskWpl: CARDINAL,
dstBase: Ptr, dstOffset: CARDINAL, dstWpl: CARDINAL,
height: CARDINAL, width: CARDINAL, logDepth: LogBitOffset, colorWord: WORD] = {
In the rectangle given by width & height, for each "one" in the mask (specified by maskBase, maskOffset, and maskWpl), the specified color is stored into the corresponding pixel in the the destination (specified by dstBase, dstOffset, and dstWpl).
Argument interpretations
maskBase: a word pointer to the base of the mask
maskOffset: a bit offset into the mask
maskWpl: the # of words between lines in the mask
dstBase: a word pointer to the base of the destination
dstOffset: a pixel index into the destination
dstWpl: a # of words between lines in the destination
height: the # of lines in the rectangle to color
width: the # of pixels per line in the rectangle to color
logDepth: 2**logDepth = the number of bits in a pixel
colorWord: a word filled with the color (as by MakeColorWord)
unitsPerLine: CARDINAL = dstWpl*unitsPerWord;
maskBase ¬ maskBase + (maskOffset / bitsPerWord) * unitsPerWord;
maskOffset ¬ maskOffset MOD bitsPerWord;
SELECT TRUE FROM
height = 0 OR width = 0 => {};
fastWords AND logDepth = logBitsPerWord => {
dstBase ¬ dstBase + dstOffset*unitsPerWord;
DO
Iterate through the lines
mwp: Ptr ¬ maskBase;
maskMod: BitOffset ¬ maskOffset;
maskWord: WORD ¬ BITLSHIFT[mwp­, maskMod];
dbo: CARDINAL ¬ 0;
DO
Iterate through the pixels in a line
IF LOOPHOLE[maskWord, INTEGER] < 0 THEN
LOOPHOLE[dstBase, WordsPtr][dbo] ¬ colorWord;
maskWord ¬ BITLSHIFT[maskWord, 1];
dbo ¬ dbo + 1;
IF dbo = width THEN EXIT;
IF maskMod < bitsPerWord-1 THEN {maskMod ¬ maskMod + 1; LOOP};
We need a new mask word
maskMod ¬ 0;
mwp ¬ mwp + unitsPerWord;
maskWord ¬ mwp­;
ENDLOOP;
IF height = 1 THEN EXIT;
height ¬ height - 1;
maskBase ¬ maskBase + maskWpl*unitsPerWord;
dstBase ¬ dstBase + unitsPerLine;
ENDLOOP;
};
fastBytes AND logDepth = 3 => {
DO
Iterate through the lines
mwp: Ptr ¬ maskBase;
maskMod: BitOffset ¬ maskOffset;
maskWord: WORD ¬ BITLSHIFT[mwp­, maskMod];
dbo: CARDINAL ¬ dstOffset;
lim: CARDINAL = dbo+width;
DO
Iterate through the pixels in a line
IF maskWord = 0 THEN {
Fast skipping case
remMask: CARDINAL ¬ bitsPerWord - maskMod;
rem: CARDINAL ¬ lim - dbo;
IF remMask >= rem THEN EXIT; -- done with line
dbo ¬ dbo + remMask;
maskMod ¬ 0;
mwp ¬ mwp + unitsPerWord;
maskWord ¬ mwp­;
LOOP;
};
IF LOOPHOLE[maskWord, INTEGER] < 0 THEN
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 1;
IF dbo = lim THEN EXIT;
maskWord ¬ BITLSHIFT[maskWord, 1];
IF maskMod < bitsPerWord-1 THEN {maskMod ¬ maskMod + 1; LOOP};
We need a new mask word
maskMod ¬ 0;
mwp ¬ mwp + unitsPerWord;
maskWord ¬ mwp­;
ENDLOOP;
IF height = 1 THEN EXIT;
height ¬ height - 1;
maskBase ¬ maskBase + maskWpl*unitsPerWord;
dstBase ¬ dstBase + unitsPerLine;
ENDLOOP;
};
ENDCASE => {
depth: BitCount = BITLSHIFT[1, logDepth];
leftMask: WORD = BITLSHIFT[WORD.LAST, bitsPerWord-depth];
dstOffset ¬ BITLSHIFT[dstOffset, logDepth]; -- convert to bits
dstBase ¬ dstBase + (dstOffset / bitsPerWord) * unitsPerWord;
dstOffset ¬ dstOffset MOD bitsPerWord;
DO
Iterate through the lines
mwp: Ptr ¬ maskBase;
maskMod: BitOffset ¬ maskOffset;
maskWord: WORD ¬ BITLSHIFT[mwp­, maskMod];
dwp: Ptr ¬ dstBase;
rem: CARDINAL ¬ width;
accum: WORD ¬ 0;
eachMask: WORD ¬ BITRSHIFT[leftMask, dstOffset];
DO
Iterate through the pixels in a line
IF LOOPHOLE[maskWord, INTEGER] < 0 THEN accum ¬ accum + eachMask;
eachMask ¬ BITRSHIFT[eachMask, depth];
IF rem = 1 THEN {
IF accum # 0 THEN
dwp­ ¬ BITOR[BITAND[dwp­, BITNOT[accum]], BITAND[colorWord, accum]];
EXIT;
};
IF eachMask = 0 THEN {
IF accum # 0 THEN
dwp­ ¬ BITOR[BITAND[dwp­, BITNOT[accum]], BITAND[colorWord, accum]];
dwp ¬ dwp + unitsPerWord;
eachMask ¬ leftMask;
accum ¬ 0;
};
rem ¬ rem - 1;
maskWord ¬ BITLSHIFT[maskWord, 1];
IF maskMod < bitsPerWord-1 THEN {maskMod ¬ maskMod + 1; LOOP};
We need a new mask word
maskMod ¬ 0;
mwp ¬ mwp + unitsPerWord;
maskWord ¬ mwp­;
ENDLOOP;
IF height = 1 THEN EXIT;
height ¬ height - 1;
maskBase ¬ maskBase + maskWpl*unitsPerWord;
dstBase ¬ dstBase + unitsPerLine;
ENDLOOP;
};
};
StoreWithColorRuns: PUBLIC PROC [
mask: RunSeq,
dstBase: Ptr, dstOffset: CARDINAL, dstWpl: CARDINAL,
logDepth: LogBitOffset, colorWord: WORD] = {
For each "one" in the run-encoded mask the specified color is stored into the corresponding pixel in the the destination (specified by dstBase, dstOffset, and dstWpl). The height and width are implicit in the mask.
Argument interpretations
mask: the runs encoded as a packed sequence of RunByte values
dstBase: a word pointer to the base of the destination
dstOffset: a pixel index into the destination
dstWpl: a # of words between lines in the destination
logDepth: 2**logDepth = the number of bits in a pixel
colorWord: a word filled with the color (as by MakeColorWord)
unitsPerLine: CARDINAL = dstWpl*unitsPerWord;
SELECT TRUE FROM
mask = NIL OR mask.len = 0 => {};
fastBytes AND logDepth = 3 => {
Special case, storing bytes
dbo: CARDINAL ¬ dstOffset;
FOR i: NAT IN [0..mask.len) DO
rb: RunByte = mask[i];
rem: CARDINAL = rb.count;
lim: CARDINAL = dbo + rem;
IF rb.color THEN {
IF rem < 4
THEN {
IF rem >= 2 THEN {
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
LOOPHOLE[dstBase, BytesPtr][dbo+1] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 2;
};
IF rem MOD 2 = 1 THEN
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
}
ELSE {
WHILE (dbo MOD bytesPerWord) # 0 DO
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 1;
IF dbo = lim THEN GO TO runDone;
ENDLOOP;
WHILE (dbo+bytesPerWord) <= lim DO
(dstBase + (dbo / BYTES[UNIT]))­ ¬ colorWord;
dbo ¬ dbo + bytesPerWord;
ENDLOOP;
WHILE dbo < lim DO
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 1;
ENDLOOP;
EXITS runDone => {};
};
};
dbo ¬ lim;
IF rb.last THEN {
Move to the next line
dstBase ¬ dstBase + unitsPerLine;
dbo ¬ dstOffset;
};
ENDLOOP;
};
fastWords AND logDepth = logBitsPerWord => {
Special case, storing words
dbo: CARDINAL ¬ 0;
dstBase ¬ dstBase + dstOffset*unitsPerWord;
FOR i: NAT IN [0..mask.len) DO
rb: RunByte = mask[i];
lim: CARDINAL = dbo + rb.count;
IF rb.color THEN {
WHILE dbo < lim DO
LOOPHOLE[dstBase, WordsPtr][dbo] ¬ colorWord;
dbo ¬ dbo + 1;
ENDLOOP;
};
dbo ¬ lim;
IF rb.last THEN {
Move to the next line
dstBase ¬ dstBase + unitsPerLine;
dbo ¬ 0;
};
ENDLOOP;
};
ENDCASE => {
General case, samples are not bytes
dbo: CARDINAL ¬ BITLSHIFT[dstOffset, logDepth];
dstOffset ¬ dbo;
convert to a bit offset
FOR i: NAT IN [0..mask.len) DO
rb: RunByte = mask[i];
bits: CARDINAL = BITLSHIFT[rb.count, logDepth];
IF rb.color AND bits # 0 THEN {
rem: CARDINAL ¬ bits;
wp: Ptr ¬ dstBase + (dbo / bitsPerWord) * unitsPerWord;
mod: CARDINAL = dbo MOD bitsPerWord;
IF mod # 0 THEN {
Store a partial word to get on a word boundary
mask: WORD ¬ BITRSHIFT[CARD.LAST, mod];
lim: CARDINAL = rem + mod;
IF lim < bitsPerWord THEN mask ¬ mask - BITRSHIFT[CARD.LAST, lim];
wp­ ¬ BITOR[BITAND[wp­, BITNOT[mask]], BITAND[colorWord, mask]];
IF lim <= bitsPerWord THEN GO TO runDone;
wp ¬ wp + unitsPerWord;
rem ¬ lim - bitsPerWord;
};
WHILE rem >= bitsPerWord DO
Store a full word of color
wp­ ¬ colorWord;
rem ¬ rem - bitsPerWord;
wp ¬ wp + unitsPerWord;
ENDLOOP;
IF rem # 0 THEN {
Store a final partial word
mask: WORD = BITRSHIFT[CARD.LAST, rem];
wp­ ¬ BITOR[BITAND[wp­, mask], BITAND[colorWord, BITNOT[mask]]];
};
EXITS runDone => {};
};
dbo ¬ dbo + bits;
IF NOT rb.last THEN LOOP;
dstBase ¬ dstBase + unitsPerLine;
dbo ¬ dstOffset;
ENDLOOP;
};
};
StoreWithLongColorRuns: PUBLIC PROC [
mask: LongRunSeq,
dstBase: Ptr, dstOffset: CARDINAL, dstWpl: CARDINAL,
logDepth: LogBitOffset, colorWord: WORD] = {
For each "one" in the run-encoded mask the specified color is stored into the corresponding pixel in the the destination (specified by dstBase, dstOffset, and dstWpl). The height and width are implicit in the mask.
Argument interpretations
mask: the runs encoded as a packed sequence of RunByte values
dstBase: a word pointer to the base of the destination
dstOffset: a pixel index into the destination
dstWpl: a # of words between lines in the destination
logDepth: 2**logDepth = the number of bits in a pixel
colorWord: a word filled with the color (as by MakeColorWord)
unitsPerLine: CARDINAL = dstWpl*unitsPerWord;
SELECT TRUE FROM
mask = NIL OR mask.len = 0 => {};
fastBytes AND logDepth = 3 => {
Special case, storing bytes
FOR i: NAT IN [0..mask.len) DO
run: LongRun = mask[i];
dbo: CARDINAL ¬ dstOffset + run.fMin;
rem: CARDINAL = run.fSize;
IF rem < 4
THEN {
IF rem >= 2 THEN {
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
LOOPHOLE[dstBase, BytesPtr][dbo+1] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 2;
};
IF rem MOD 2 = 1 THEN
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
}
ELSE {
lim: CARDINAL ¬ dbo + rem;
IF dbo < lim THEN {
WHILE (dbo MOD bytesPerWord) # 0 DO
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 1;
IF dbo = lim THEN GO TO runDone;
ENDLOOP;
WHILE (dbo+bytesPerWord) <= lim DO
(dstBase + (dbo / BYTES[UNIT]))­ ¬ colorWord;
dbo ¬ dbo + bytesPerWord;
ENDLOOP;
WHILE dbo < lim DO
LOOPHOLE[dstBase, BytesPtr][dbo] ¬ LOOPHOLE[colorWord, BYTE];
dbo ¬ dbo + 1;
ENDLOOP;
EXITS runDone => {};
};
};
IF run.lastRun THEN dstBase ¬ dstBase + unitsPerLine;
Move to the next line
ENDLOOP;
};
fastWords AND logDepth = logBitsPerWord => {
dstBase ¬ dstBase + dstOffset*unitsPerWord;
FOR i: NAT IN [0..mask.len) DO
run: LongRun = mask[i];
dbo: CARDINAL ¬ run.fMin;
lim: CARDINAL = dbo + run.fSize;
WHILE dbo < lim DO
Store a final partial word
LOOPHOLE[dstBase, WordsPtr][dbo] ¬ colorWord;
dbo ¬ dbo + 1;
ENDLOOP;
IF run.lastRun THEN dstBase ¬ dstBase + unitsPerLine;
Move to the next line
ENDLOOP;
};
ENDCASE => {
General case
FOR i: NAT IN [0..mask.len) DO
run: LongRun = mask[i];
rem: CARDINAL ¬ BITLSHIFT[run.fSize, logDepth];
IF rem # 0 THEN {
dbo: CARDINAL ¬ BITLSHIFT[dstOffset + run.fMin, logDepth];
wp: Ptr ¬ dstBase + (dbo / bitsPerWord) * unitsPerWord;
mod: CARDINAL = dbo MOD bitsPerWord;
IF mod # 0 THEN {
Store a partial word to get on a word boundary
mask: WORD ¬ BITRSHIFT[CARD.LAST, mod];
lim: CARDINAL = rem + mod;
IF lim < bitsPerWord THEN mask ¬ mask - BITRSHIFT[CARD.LAST, lim];
wp­ ¬ BITOR[BITAND[wp­, BITNOT[mask]], BITAND[colorWord, mask]];
IF lim <= bitsPerWord THEN GO TO done;
wp ¬ wp + unitsPerWord;
rem ¬ lim - bitsPerWord;
};
WHILE rem >= bitsPerWord DO
Store a full word of color
wp­ ¬ colorWord;
rem ¬ rem - bitsPerWord;
wp ¬ wp + unitsPerWord;
ENDLOOP;
IF rem # 0 THEN {
Store a final partial word
mask: WORD = BITRSHIFT[CARD.LAST, rem];
wp­ ¬ BITOR[BITAND[wp­, mask], BITAND[colorWord, BITNOT[mask]]];
};
EXITS done => {};
};
IF run.lastRun THEN dstBase ¬ dstBase + unitsPerLine;
Move to the next line
ENDLOOP;
};
};
BadRun: PUBLIC ERROR = CODE;
MaskToRun: PUBLIC PROC
[run: RunSeq,
maskPtr: Ptr, offset: CARDINAL, wpl: CARDINAL,
height: CARDINAL, width: CARDINAL]
RETURNS [CARDINAL] = {
Takes a mask specification and calculates the length of run required to describe the mask. If run = NIL, then it calculates the size of the run. If run # NIL, then it fills in the run, raising BadRun if the length is not correct.
seqLen: CARDINAL ¬ 0;
mp: BitsPtr ¬ LOOPHOLE[maskPtr];
IF height # 0 AND width # 0 THEN
THROUGH [0..height) DO
runLen: CARDINAL ¬ 0;
runBit: CARDINAL ¬ 0;
runLast: BOOL ¬ FALSE;
emptyLine: BOOL ¬ TRUE;
j: CARDINAL ¬ 0;
lim: CARDINAL ¬ width;
WHILE lim > 1 AND mp[lim-1+offset] = 0 DO lim ¬ lim - 1; ENDLOOP;
Try to shorten sequence by skipping zeros that end a line, but there must be at least one sample in a line!
WHILE j < lim DO
bit: BIT = mp[j+offset];
IF runLen = 0 THEN runBit ¬ bit;
IF bit = runBit THEN {
Consume the bit & increase the count
runLen ¬ runLen + 1;
j ¬ j + 1;
SELECT TRUE FROM
j = lim => runLast ¬ TRUE;
runLen < MaskWithColor.RunCount.LAST => LOOP;
ENDCASE;
};
At this point we have to store a new accumulated run (or just count it)
IF run # NIL THEN {
IF seqLen >= run.len THEN ERROR BadRun;
run[seqLen] ¬ [count: runLen, color: VAL[runBit], last: runLast];
};
seqLen ¬ seqLen + 1;
runLen ¬ 0;
runLast ¬ FALSE;
ENDLOOP;
mp ¬ mp + wpl*UNITS[WORD];
ENDLOOP;
IF run # NIL AND seqLen # run.len THEN ERROR BadRun;
RETURN [seqLen];
};
MaskToLongRun: PUBLIC PROC
[run: LongRunSeq,
maskPtr: Ptr, offset: CARDINAL, wpl: CARDINAL,
height: CARDINAL, width: CARDINAL]
RETURNS [CARDINAL] = {
Takes a mask specification and calculates the length of run required to describe the mask. If run = NIL, then it calculates the size of the run. If run # NIL, then it fills in the run, raising BadRun if the length is not correct.
seqLen: CARDINAL ¬ 0;
mp: BitsPtr ¬ LOOPHOLE[maskPtr];
IF height # 0 AND width # 0 THEN
THROUGH [0..height) DO
j: CARDINAL ¬ 0;
lim: CARDINAL ¬ width;
WHILE lim > 1 AND mp[lim-1+offset] = 0 DO lim ¬ lim - 1; ENDLOOP;
Try to shorten sequence by skipping zeros that end a line, but there must be at least one sample in a line!
DO
start: CARDINAL;
WHILE j < lim AND mp[j+offset] = 0 DO j ¬ j + 1; ENDLOOP;
start ¬ j;
WHILE j < lim AND mp[j+offset] = 1 DO j ¬ j + 1; ENDLOOP;
IF run # NIL THEN {
IF seqLen >= run.len THEN ERROR BadRun;
run[seqLen] ¬ [fMin: start, lastRun: j = lim, fSize: j-start];
};
seqLen ¬ seqLen + 1;
IF j = lim THEN EXIT;
ENDLOOP;
mp ¬ mp + wpl*UNITS[WORD];
ENDLOOP;
IF run # NIL AND seqLen # run.len THEN ERROR BadRun;
RETURN [seqLen];
};
END.