<<>> <> <> <> 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] = { <> 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] = { <> <> <> <> <> <> <> <> <> <> <> <> 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 <> mwp: Ptr ¬ maskBase; maskMod: BitOffset ¬ maskOffset; maskWord: WORD ¬ BITLSHIFT[mwp­, maskMod]; dbo: CARDINAL ¬ 0; DO <> 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}; <> 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 <> mwp: Ptr ¬ maskBase; maskMod: BitOffset ¬ maskOffset; maskWord: WORD ¬ BITLSHIFT[mwp­, maskMod]; dbo: CARDINAL ¬ dstOffset; lim: CARDINAL = dbo+width; DO <> IF maskWord = 0 THEN { <> 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}; <> 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 <> 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 <> 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}; <> 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] = { <> <> <> <> <> <> <> <> unitsPerLine: CARDINAL = dstWpl*unitsPerWord; SELECT TRUE FROM mask = NIL OR mask.len = 0 => {}; fastBytes AND logDepth = 3 => { <> 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 { <> dstBase ¬ dstBase + unitsPerLine; dbo ¬ dstOffset; }; ENDLOOP; }; fastWords AND logDepth = logBitsPerWord => { <> 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 { <> dstBase ¬ dstBase + unitsPerLine; dbo ¬ 0; }; ENDLOOP; }; ENDCASE => { <> dbo: CARDINAL ¬ BITLSHIFT[dstOffset, logDepth]; dstOffset ¬ dbo; <> 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 { <> 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 <> wp­ ¬ colorWord; rem ¬ rem - bitsPerWord; wp ¬ wp + unitsPerWord; ENDLOOP; IF rem # 0 THEN { <> 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] = { <> <> <> <> <> <> <> <> unitsPerLine: CARDINAL = dstWpl*unitsPerWord; SELECT TRUE FROM mask = NIL OR mask.len = 0 => {}; fastBytes AND logDepth = 3 => { <> 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; <> 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 <> LOOPHOLE[dstBase, WordsPtr][dbo] ¬ colorWord; dbo ¬ dbo + 1; ENDLOOP; IF run.lastRun THEN dstBase ¬ dstBase + unitsPerLine; <> ENDLOOP; }; ENDCASE => { <> 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 { <> 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 <> wp­ ¬ colorWord; rem ¬ rem - bitsPerWord; wp ¬ wp + unitsPerWord; ENDLOOP; IF rem # 0 THEN { <> mask: WORD = BITRSHIFT[CARD.LAST, rem]; wp­ ¬ BITOR[BITAND[wp­, mask], BITAND[colorWord, BITNOT[mask]]]; }; EXITS done => {}; }; IF run.lastRun THEN dstBase ¬ dstBase + unitsPerLine; <> ENDLOOP; }; }; BadRun: PUBLIC ERROR = CODE; MaskToRun: PUBLIC PROC [run: RunSeq, maskPtr: Ptr, offset: CARDINAL, wpl: CARDINAL, height: CARDINAL, width: CARDINAL] RETURNS [CARDINAL] = { <> 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; <> WHILE j < lim DO bit: BIT = mp[j+offset]; IF runLen = 0 THEN runBit ¬ bit; IF bit = runBit THEN { <> runLen ¬ runLen + 1; j ¬ j + 1; SELECT TRUE FROM j = lim => runLast ¬ TRUE; runLen < MaskWithColor.RunCount.LAST => LOOP; ENDCASE; }; <> 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] = { <> 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; <> 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.