[Pixel]<Images>Compression>PressNetCompressor.mesa!1

decompressP: BOOLEAN ← FALSE;--decompress the data and check it for consistency
reportP: BOOLEAN ← TRUE;
timingsP: BOOLEAN ← TRUE;
pauseP: BOOLEAN ← TRUE; --pause for operator input if error
nibbleSize: CARDINAL = 7;
remTable: PUBLIC ARRAY [0..nibbleSize] OF CARDINAL ←
[0, 1, 3B, 7B, 17B, 37B, 77B, 177B];--the 177B is for masking on the sink side

AqSwitches: TYPE=RECORD[
length: INTEGER,
options: ARRAY[1..9]OF Option,
num: INTEGER];
Option: TYPE = RECORD[c: CHARACTER, value: BOOLEAN];
Switches: TYPE = POINTER TO AqSwitches;
headerBufferSeg: FileSegmentHandle;--to hold page one of Press.bits
headerFh: FileHandle;
headerAddress: POINTER TO ARRAY [0..1024) OF WORD;
headerInCore: BOOLEAN ← FALSE;
filename: STRING ← [200];
numPages: CARDINAL;--# of printed pages (or separations)
pageGArray: POINTER TO ARRAY [1..93] OF PageG;
atomCount, runCount, runLengthCount: LONG INTEGER;
putBackChar: CHARACTER ← NUL;--for ReadCommandFile
--logfile stuff
logFile: DiskHandle;
comH: StreamHandle;
timeStarted, timeDone: PackedTime;

CompressErrCode: TYPE = {badBitsFile, fileNotFound, notEnoughScans, noImage, noError};
compressAbort: ERROR[compressErrCode: CompressErrCode] = CODE;
--Procs

SinkEncoding: PROC[nib: NibbleRunSpec]=
BEGIN
WITH nib SELECT FROM
run => {runCount ← runCount + 1; runLengthCount ← runLengthCount + nibbleCt};
atom => atomCount ← atomCount + 1;
ENDCASE;
IF decompressP THEN GetNibble[nib];
END;--SinkEncoding

CompressorDriver: PUBLIC PROC[]=
--Raises no signals or errors
BEGIN
proceed, empty: BOOLEAN;
compressSpec: CompressSpec ← @ compressSpecRec;
compressSpecRec: CompressSpecRec;
i, wordsRead: CARDINAL;
h: DiskHandle;
srcASeg, srcBSeg: DataSegmentHandle;
srcA, srcB, flipper: POINTER TO ARRAY OF WORD;--"flipper" for flipping srcA&srcB
gotFileP: BOOLEAN ← FALSE;
realsInited: BOOLEAN ← FALSE;

--file positioning stuff
roundedBytesPerBand, totalBands, bandNum, bitPage: LONG CARDINAL;
totalWordsRead: LONG INTEGER;
scanNum, scanLineLength--in 16-bit words--, arrayLength: CARDINAL;
streamPosition: StreamPosition;
--scan line info
bandWidth: CARDINAL = 16;
localState: CompressErrCode ← noError;

BEGIN
[proceed, empty] ← ReadCommandFile[filename];
IF ~proceed THEN GOTO getOut;
UNTIL gotFileP DO
IF empty THEN
{WriteString["Filename to read: "];
ReadLine[filename]; WriteChar[CR]};

empty ← TRUE;
h ← NewWordStream[filename, Read!FileNameError=>
{WriteString["Can’t find file: "L]; WriteString[filename]; WriteChar[CR];
LOOP};
];--open bits file.
gotFileP ← TRUE;
ENDLOOP;
IF reportP THEN {InitReals[]; InitWFReals[]};
GetPageGs[!compressAbort => GOTO exit];

OpenLog[filename];
atomCount ← runCount ← totalWordsRead ← runLengthCount ← 0;--keep count on a per file basis
FOR i IN [1..numPages]
DO
--set up for this page
IF ~(pageGArray[i].LastBand > pageGArray[i].FirstBand)
THEN {localState ← noImage; GOTO exit};
scanLineLength ← pageGArray[i].BitWc;
bitPage ← pageGArray[i].BitPage;
totalBands ← (pageGArray[i].LastBand - pageGArray[i].FirstBand) + 1;
roundedBytesPerBand ← ((scanLineLength * bandWidth + 1023)/1024) * 1024 * 2;--bytes in band, rounded up to 1K bound

--the scan line length may change from page to page.
arrayLength ← scanLineLength + 1;
srcASeg ← NewDataSegment[DefaultBase, (arrayLength+255)/256];
srcA ← SegmentAddress[srcASeg];
srcBSeg ← NewDataSegment[DefaultBase, (arrayLength+255)/256];
srcB ← SegmentAddress[srcBSeg];

IF decompressP THEN
OpenDecompressor[scanLineLength, nibbleSize];--let the destination get buffers
SetBlock[srcB, 0, arrayLength];--start the first scan with all zero’s

timeStarted ← CurrentDayTime[];
FOR bandNum IN [0..totalBands) -- Use the Press.bits format for getting scan lines
DO
streamPosition ← bandNum*roundedBytesPerBand+(2048 * bitPage);
SetPosition[h, streamPosition];--now positioned to first word of band.

FOR scanNum IN [0..bandWidth)
DO
IF h.endof[h] THEN {localState ← notEnoughScans; GOTO exit};
--alternate buffers on fill
wordsRead ← ReadBlock[h, srcA, scanLineLength];
totalWordsRead ← totalWordsRead + wordsRead;
flipper ← srcA; srcA ←srcB; srcB ← flipper;
compressSpec↑ ← [src1: srcA, src2: srcB, sink: SinkEncoding, srcLen: scanLineLength, nibbleSize: 7];
Compressor[compressSpec];
IF decompressP THEN NextLine[];
IF decompressP THEN [] ← CompareLines[srcB];
ENDLOOP;--FOR scanNum IN [0..bandWidth]
ENDLOOP;--FOR bandNum: CARDINAL IN [0..totalBands)

DeleteDataSegment[srcASeg];
DeleteDataSegment[srcBSeg];
timeDone ← CurrentDayTime[];
ReportStats[totalWordsRead, atomCount, runCount];
IF decompressP THEN CloseDecompressor[];
ENDLOOP;--this is the page loop

--close file streams, etc here.
h.destroy[h];
Unlock[headerBufferSeg];
SwapOut[headerBufferSeg];
DeleteFileSegment[headerBufferSeg];
headerInCore ← FALSE;
CloseLog[];

EXITS
exit => {
SELECT localState FROM
badBitsFile => WriteLine["Doesn’t look like a Press.bits format file"L];--ERROR
fileNotFound => NULL;
notEnoughScans => {WriteLine["Input file ended before all scans were processed."L];
DeleteDataSegment[srcASeg];
DeleteDataSegment[srcBSeg];};

ENDCASE;

h.destroy[h];
IF headerInCore THEN
{Unlock[headerBufferSeg];
SwapOut[headerBufferSeg];
DeleteFileSegment[headerBufferSeg];
headerInCore ← FALSE;};
};
getOut=> NULL;
END;
END;--of CompressorDriver

Compressor: PROC[cSpec: CompressSpec]=
--takes two src’s and xor’s them, destroying one of them
--it passes the nibbles to a call-back routine
{i, byte, mask: CARDINAL;
runCt: CARDINAL ← 0;
curLoc: CARDINAL ← 0; pos: CARDINAL ← 6;--the first 7-bit byte ends 6 bits into first word from left.
src1: POINTER TO ARRAY OF WORD ← cSpec.src1;
src2: POINTER TO ARRAY OF WORD ← cSpec.src2;
runState: RunState ← random;
increment: BOOLEAN ← FALSE;
srcLen: CARDINAL ← cSpec.srcLen;--length of data, spare loc not included
srcLenBits: CARDINAL ← srcLen*16;
lastDataLoc: CARDINAL ← srcLen - 1;--src1[lastDataLoc] is last data item
nibbleCount: CARDINAL ← (srcLenBits/cSpec.nibbleSize) + 1; --# of nibbles to pull out

NextNibble: PROC [high, low: WORD] RETURNS [nibble: WORD]=
{
SELECT pos FROM
6 => {increment ← FALSE; pos ← 13; nibble ← BITSHIFT [high, -9]; GOTO exit};
13 => {increment ← FALSE; pos ← 4; nibble ← BITSHIFT [high, -2]; GOTO exit};
4 => {increment ← TRUE; pos ← 11; nibble ← BITOR [BITSHIFT [high, 5], BITSHIFT [low, -11]]; GOTO exit};
11 => {increment ← FALSE; pos ← 2; nibble ← BITSHIFT [high, -4]; GOTO exit};
2 => {increment ← TRUE; pos ← 9; nibble ← BITOR [BITSHIFT [high, 3], BITSHIFT [low, -13]]; GOTO exit};
9 => {increment ← FALSE; pos ← 0; nibble ← BITSHIFT [high, -6]; GOTO exit};
0 => {increment ← TRUE; pos ← 7; nibble ← BITOR [BITSHIFT [high, 1], BITSHIFT [low, -15]]; GOTO exit};
7 => {increment ← FALSE; pos ← 14; nibble ← BITSHIFT [high, -8]; GOTO exit};
14 => {increment ← FALSE; pos ← 5; nibble ← BITSHIFT [high, -1]; GOTO exit};
5 => {increment ← TRUE; pos ← 12; nibble ← BITOR [BITSHIFT [high, 6], BITSHIFT [low, -10]]; GOTO exit};
12 => {increment ← FALSE; pos ← 3; nibble ← BITSHIFT [high, -3]; GOTO exit};
3 => {increment ← TRUE; pos ← 10; nibble ← BITOR [BITSHIFT [high, 4], BITSHIFT [low, -12]]; GOTO exit};
10 => {increment ← FALSE; pos ← 1; nibble ← BITSHIFT [high, -5]; GOTO exit};
1 => {increment ← TRUE; pos ← 8; nibble ← BITOR [BITSHIFT [high, 2], BITSHIFT [low, -14]]; GOTO exit};
8 => {increment ← FALSE; pos ← 15; nibble ← BITSHIFT [high, -7]; GOTO exit};
15 => {increment ← TRUE; pos ← 6; nibble ← high; GOTO exit};
ENDCASE;
EXITS
exit => RETURN[BITAND[nibble, 177B]];
};--NextNibble

FOR i IN [0..lastDataLoc] DO src1[i] ← BITXOR[src1[i], src2[i]]; ENDLOOP;
--make overflow word match the last nibble’s signature
mask ← remTable[(srcLenBits MOD nibbleSize)];
IF (BITAND [src1[lastDataLoc], mask] = mask) THEN src1[srcLen] ← 177777B ELSE src1[srcLen] ← 0;

FOR i IN [1..nibbleCount]
DO
byte ← NextNibble[src1[curLoc], src1[curLoc+1]];
IF increment THEN curLoc ← curLoc + 1;

SELECT byte FROM
0=>SELECT runState FROM
random =>{runState ← zeros; runCt ← 1};
zeros=>{IF (runCt ← runCt + 1) = LAST[NibbleRange]
THEN {cSpec.sink[[0, run[black, runCt]]]; runCt ← 0}};
ones=>{runState ← zeros; cSpec.sink[[0, run[white, runCt]]]; runCt ← 1};
ENDCASE;
177B=> SELECT runState FROM
random =>{runState ← ones; runCt ← 1};
zeros =>{ runState ← ones; cSpec.sink[[0, run[black, runCt]]]; runCt ← 1};
ones =>{IF (runCt ← runCt + 1) = LAST[NibbleRange]
THEN {cSpec.sink[[0, run[white, runCt]]]; runCt ← 0}};
ENDCASE;
ENDCASE => SELECT runState FROM
random => {cSpec.sink[[0, atom[byte]]];};--send another byte of randomness
zeros => { runState ← random; cSpec.sink[[0, run[black, runCt]]]; cSpec.sink[[0, atom[byte]]]};
ones => { runState ← random; cSpec.sink[[0, run[white, runCt]]]; cSpec.sink[[0, atom[byte]]]};
ENDCASE;

ENDLOOP;--FOR i IN [1..nibbleCount]

--flush any leftover state
SELECT runState FROM
zeros => cSpec.sink[[0, run[black, runCt]]];
ones => cSpec.sink[[0, run[white, runCt]]];
ENDCASE;
};

GetPageGs: PROC[]=
BEGIN

headerFh ← NewFile[filename, Read, OldFileOnly!
FileNameError => {WriteString["File "L]; WriteString[filename]; WriteString[" is required"L];
compressAbort[fileNotFound];};];

headerBufferSeg ← NewFileSegment[headerFh, DefaultBase, 4, ];--point to one page; default access, 1K
SwapIn[headerBufferSeg];--get it into core
headerAddress ← LOOPHOLE[SegmentAddress[headerBufferSeg]];--find out where it is
headerInCore ← TRUE;

numPages ← headerAddress[0];
IF headerAddress[3] # PressPassword THEN GOTO inconsistentFile;
pageGArray ← LOOPHOLE[@headerAddress[4]];

EXITS
inconsistentFile => {Unlock[headerBufferSeg];
SwapOut[headerBufferSeg];
DeleteFileSegment[headerBufferSeg];
headerInCore ← FALSE;
compressAbort[badBitsFile]};
END;--GetPageG

ReportStats: PROC[wordsRead, atoms, runs: LONG INTEGER]=
BEGIN
bytesRead: LONG INTEGER ← wordsRead*2;
totalSpecs: LONG INTEGER ← atoms + runs;
bytesReadRl, atomsRl, runsRl, compressionFactorRl, totalSpecsRl, averageRun: REAL;
tTime: PackedTime ← timeDone - timeStarted;
totalTime: LONG INTEGER ← tTime;

IF ~reportP THEN GOTO getOut;
bytesReadRl ← bytesRead;
atomsRl ← atoms;
runsRl ← runs;
totalSpecsRl ← atoms + runs;

compressionFactorRl ← (totalSpecsRl / bytesReadRl) * 100.0;
averageRun ← (runLengthCount/runs);

FWF4[logFile, "%ld bytes read: %ld were runs and %ld were atoms, for a total of %ld specification bytes*n", @bytesRead, @runs, @atoms, @totalSpecs];

FWF3[logFile, "Average run length (runLengthCount/runCount): (%ld/%ld) = %7.1f.*n", @runLengthCount, @runs, @averageRun];

FWF1[logFile, "The data was compressed to %7.3f%% of orignial volume.*n", @compressionFactorRl];
FWF1[logFile, "Total seconds: %ld.*n", @totalTime];
PutString[logFile, "Decompression was "];
PutLine[logFile, (IF decompressP THEN "enabled." ELSE "disabled.")];
EXITS
getOut => NULL;
END;--ReportStats

OpenLog: PROC[file: STRING]=
BEGIN
logName: STRING ← [100];

IF ~reportP THEN GOTO getOut;
logName.length ← 0;
FOR i: CARDINAL IN [0..file.length) DO
IF file[i] = ’. THEN EXIT ELSE AppendChar[logName, file[i]];
ENDLOOP;
AppendString[logName, ".CLog"L];
IF decompressP THEN AppendChar[logName, ’D];

logFile ← NewByteStream[logName, WriteAppend];
PutString[logFile, "Input file was: "L];
PutString[logFile, file];
PutCR[logFile]; PutCR[logFile];

EXITS
getOut => NULL;
END;--of OpenLog

CloseLog: PROC[]=
BEGIN
IF reportP THEN logFile.destroy[logFile];
END;--of CloseLog

PutString: PROC[sH: DiskHandle, s: STRING]=
BEGIN
FOR i: CARDINAL IN [0..s.length) DO sH.put[sH, s[i]] ENDLOOP;
END;--of PutString

PutLine: PROC[sH: DiskHandle, s: STRING]=
BEGIN
PutString[sH, s];
PutCR[sH];
END;

PutCR: PROC[sH: DiskHandle]=
BEGIN
sH.put[sH, CR];
END;--of PutCR

ReadCommandFile: PROC[file: STRING] RETURNS[okToProceed: BOOLEAN ← FALSE, empty: BOOLEAN ← FALSE]=
--Raises no signals or errors
BEGIN
errorNote: STRING ← "Switches are U[ncompress],D[ebug],T[imings],R[eport],P[ause on errors]. Grammar is PressCompress</switches>* filename command*";
swIndex: INTEGER ← 1;
aqSwitches: AqSwitches←[0, [[NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE]], -1];
switches: Switches = @aqSwitches;
BEGIN

command: STRING ← [20];
switches.length ← 0;

ReadComInit[];-- open Com.cm etc.

UNTIL ReadCom[command, switches]--returns eof
DO
FOR swIndex IN [1..switches.length] DO
SELECT switches.options[swIndex].c FROM
’U => decompressP ← switches.options[swIndex].value;
’D => NULL;
’T => timingsP ← switches.options[swIndex].value;
’R => reportP ← switches.options[swIndex].value;
’P => pauseP ← switches.options[swIndex].value;
ENDCASE => GOTO illegalComSwitch;
ENDLOOP;
--Grammar: PressCompress/<single-letter switches>* filename com*
IF EquivalentString[command, "Mesa.Image"] THEN command.length ← 0;
IF EquivalentString[command, "PressCompress.bcd"] THEN command.length ← 0;
IF command.length # 0 AND file.length = 0 THEN AppendString[file, command];
--look for other commands here
IF FALSE THEN GOTO illegalCom;--placeholder for future commands

ENDLOOP;

IF file.length=0 THEN GOTO noCom;
comH.destroy[comH];--close file

okToProceed ← TRUE;
EXITS
illegalComSwitch => {WriteString["Illegal Switch: "];
WriteChar[switches.options[swIndex].c];
WriteLine[""];
WriteLine["Type any key to finish"];
IF pauseP THEN []←ReadChar[]; comH.destroy[comH];};
illegalCom => {WriteLine["Illegal command Line"];
WriteLine[errorNote];
WriteLine["Type any key to finish"];
IF pauseP THEN []←ReadChar[]; comH.destroy[comH];};
noCom => okToProceed ← empty ← TRUE;
END;--for EXITS to be able to see switches

END;--of ReadCommandFile

ReadCom: PROC[com: STRING, sw: Switches] RETURNS[eof: BOOLEAN ← FALSE]=
--This routine is called repeatedly until it returns true.
--Raises no Errors or Signals
{c: CHARACTER ← NUL;
nm: STRING ← [10];
com.length ← 0;
nm.length ← 0;

sw↑ ← [0, [[NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE], [NUL, TRUE]], -1];

UNTIL comH.endof[comH] DO--get command
c ← GetChar[];
SELECT c FROM
CR, ’/ => EXIT;
SP, TAB => {IF com.length#0 THEN EXIT ELSE LOOP}; --elim leading spaces
IN [’a..’z] => AppendChar[com, UpperCase[c]];
ENDCASE => AppendChar[com,c];
ENDLOOP;

IF c = ’/ THEN
{UNTIL comH.endof[comH] DO
c← GetChar[];
SELECT c FROM
’/, TAB => LOOP;
SP, CR => EXIT;
’- => sw.options[sw.length+1].value ← FALSE;
IN [’a..’z] => {sw.length ← sw.length + 1;
sw.options[sw.length].c ← UpperCase[c]};
IN [’A..’Z] => {sw.length ← sw.length + 1;
sw.options[sw.length].c ← c;};
ENDCASE => EXIT;
ENDLOOP;
}
ELSE--look for a number
{UNTIL comH.endof[comH] DO
SELECT c FROM
CR => EXIT;
SP, TAB => {c←GetChar[]; LOOP};
IN [’0..’9] => AppendChar[nm, c];
ENDCASE => {putBackChar ← c; EXIT};--save other chars for later scan
c←GetChar[];
ENDLOOP;
};

IF nm.length # 0 THEN sw.num ← StringToDecimal[nm];
IF com.length =0 AND comH.endof[comH] THEN eof ← TRUE;
};--ReadCom

ReadComInit: PROC[]=
{comH ← NewByteStream["Com.cm", Read];
};--ReadComInit

GetChar: PROC[]RETURNS[ch: CHARACTER]=
{IF putBackChar # NUL
THEN {ch ← putBackChar; putBackChar ← NUL}
ELSE ch ← comH.get[comH];
};--GetChar

--initilization code (again, for testing only)

CompressorDriver[];
ImageDefs.StopMesa[];
END. -- PressNetCompressor.mesa