
DIRECTORY Basics, CtBasic, CtEncode, FS, ImagerSample, IO, Rope, SF;

CtEncodeImpl: CEDAR PROGRAM
IMPORTS Basics, CtBasic, FS, ImagerSample, IO
EXPORTS CtEncode

~ BEGIN
	
ROPE:				TYPE ~ Rope.ROPE;
STREAM:			TYPE ~ IO.STREAM;
Box:				TYPE ~ CtBasic.Box;
RGB:				TYPE ~ CtBasic.RGB;
SampleMap:		TYPE ~ CtBasic.SampleMap;
SampleMaps:		TYPE ~ CtBasic.SampleMaps;
SampleBuffer:	TYPE ~ ImagerSample.SampleBuffer;
Error: PUBLIC ERROR [reason: ROPE] = CODE;

WriteEncoded: PUBLIC PROC [maps: SampleMaps, fileName: ROPE] ~ {
};
ReadEncoded: PUBLIC PROC [fileName: ROPE, maps: SampleMaps м NIL]
RETURNS [SampleMaps]
~ {
in: STREAM м FS.StreamOpen[fileName ! FS.Error => Error[error.explanation]];
r, g, b, bw: ImagerSample.SampleBuffer;
bpp: CARDINAL м IF IO.GetByte[in] = 0 THEN 8 ELSE 24;
xOrigin: CARDINAL м Basics.Card16FromH[IO.GetHWord[in]];
yOrigin: CARDINAL м Basics.Card16FromH[IO.GetHWord[in]];
w: CARDINAL м Basics.Card16FromH[IO.GetHWord[in]];
h: CARDINAL м Basics.Card16FromH[IO.GetHWord[in]];
CtBasic.ClipMaps[maps, maps.x, maps.y, maps.x+w, maps.y+h];
IF maps = NIL
THEN maps м CtBasic.CreateMaps[bpp, xOrigin, yOrigin, w, h]
ELSE CtBasic.ClipMaps[maps, xOrigin, yOrigin, w, h];
IF bpp = 24
THEN {
r м ImagerSample.NewSamples[maps.w];
g м ImagerSample.NewSamples[maps.w];
b м ImagerSample.NewSamples[maps.w];
}
ELSE bw м ImagerSample.NewSamples[maps.w];
FOR y: NAT IN [maps.y..maps.y+maps.h) DO
IF bpp = 8
THEN {
x: NAT м 0;
WHILE x < w DO
run: CARDINAL м IO.GetByte[in];
val: CARDINAL м IO.GetByte[in];
FOR n: NAT IN [x..x+run) DO bw[n] м val; ENDLOOP;
x м x+run;
REPEAT FINISHED =>
ImagerSample.PutSamples[maps[0].map, [y, maps.x], [0, 1], bw, 0, maps.w];
ENDLOOP;
}
ELSE {
x: NAT м 0;
WHILE x < w DO
run: CARDINAL м IO.GetByte[in];
rgb: RGB м [IO.GetByte[in], IO.GetByte[in], IO.GetByte[in]];
FOR n: NAT IN [x..x+run) DO
r[n] м rgb.r;
g[n] м rgb.g;
b[n] м rgb.b;
ENDLOOP;
x м x+run;
REPEAT FINISHED => {
ImagerSample.PutSamples[maps[0].map, [y, maps.x], [0, 1], r, 0, maps.w];
ImagerSample.PutSamples[maps[1].map, [y, maps.x], [0, 1], g, 0, maps.w];
ImagerSample.PutSamples[maps[2].map, [y, maps.x], [0, 1], b, 0, maps.w];
};
ENDLOOP;
};
ENDLOOP;
RETURN[maps];
};

END.


   z  
CtEncodeImpl.mesa
Copyright ╙ 1988, 1992 by Xerox Corporation.  All rights reserved.
Bloomenthal, July 3, 1992 1:30 pm PDT
Glassner, November 14, 1990 4:52 pm PST
Run Length Encoding Operations
IF maps = NIL OR (maps.bpp # 8 AND maps.bpp # 24)
THEN Error["Bad map"]
ELSE {
color: BOOL _ maps.bpp = 24;
r, g, b, bw: ImagerSample.SampleBuffer;
out: STREAM _ FS.StreamOpen[fileName, $create];
redGrn: SampleMap;
IF color
THEN {
redGrn _  CtBasic.GetRedGrn[maps[0].map];
r _ ImagerSample.NewSamples[maps.w];
g _ ImagerSample.NewSamples[maps.w];
b _ ImagerSample.NewSamples[maps.w];
}
ELSE bw _ ImagerSample.NewSamples[maps.w];
IO.PutByte[out, IF color THEN 1 ELSE 0];
IO.PutHWord[out, Basics.HFromCard16[maps.x]];
IO.PutHWord[out, Basics.HFromCard16[maps.y]];
IO.PutHWord[out, Basics.HFromCard16[maps.w]];
IO.PutHWord[out, Basics.HFromCard16[maps.h]];
FOR y: NAT IN [maps.y..maps.y+maps.h) DO
IF color
THEN {
WriteRGBRun: PROC ~ INLINE {
IO.PutByte[out, run];
IO.PutByte[out, rgb.r];
IO.PutByte[out, rgb.g];
IO.PutByte[out, rgb.b];
};
run: NAT _ 1;
rgb: RGB;
ImagerSample.GetSamples[redGrn, [y, 2*maps.x], [0, 2], r, 0, maps.w];
ImagerSample.GetSamples[redGrn, [y, 2*maps.x+1], [0, 2], g, 0, maps.w];
ImagerSample.GetSamples[maps[1].map, [y, maps.x], [0, 1], b, 0, maps.w];
rgb _ [r[0], g[0], b[0]];
FOR x: NAT IN (0..maps.w) DO
temp: RGB _ [r[x], g[x], b[x]];
IF temp = rgb AND run # 255 THEN {run _ run+1; LOOP};
WriteRGBRun[];
rgb _ temp;
run _ 1;
REPEAT
FINISHED => WriteRGBRun[];
ENDLOOP;
}
ELSE {
WriteBWRun: PROC ~ INLINE {
IO.PutByte[out, run];
IO.PutByte[out, val];
};
run: NAT _ 1;
val: CARDINAL;
ImagerSample.GetSamples[maps[0].map, [y, maps.x], [0, 1], bw, 0, maps.w];
val _ bw[0];
FOR x: NAT IN (0..maps.w) DO
temp: CARDINAL _ bw[x];
IF temp = val AND run # 255 THEN {run _ run+1; LOOP};
WriteBWRun[];
val _ temp;
run _ 1;
REPEAT
FINISHED => WriteBWRun[];
ENDLOOP;
};
ENDLOOP;
IO.Close[out]; 
};

 Э╩║  Ц"cedarcode" styleХNewlineDelimiter
Щ ЩJЪЬ	╧eЬ6ЩBJЩ%JЩ'ЧJШ JЪ╧k	Ь;ШDJШ Ъ╨blЬЮЬЮШJЪЮЬ&Ш-JЪЮЬ	ШЧJШ ЪЬЮШJШJЪЮЬЮЬЮЬШJЪЮЬЮЬЮЬЮЬШJЪЬЮЬШJЪЮЬЮЬЮЬШJЪЬ
ЮЬШ%JЪЬЮЬШ'JЪЬЮЬШ/ЧheadЪ╧lЩЪ
╧nЬЮЬЮЬ
ЮЬЮЬШ*JШ ЧЪбЬЮЬЮЬЮЬШ@ЪЮЬЮЬЮЬЮЬЩ1JЪЮЬЩЪЮЬЩJЪЬЮЬЩJЩ'JЪЬЮЬЮЬЩ/JЩЪЮЬЩЪЮЬЩJЩ)JЩ$JЩ$JЩ$JЩЧJЪЮЬ&Щ*ЧJЪЮЬЮЬЮЬЮЬЩ(JЪЮЬ+Щ-JЪЮЬ+Щ-JЪЮЬ+Щ-JЪЮЬ+Щ-ЪЮЬЮЬЮЬЮЩ(ЪЮЬЩЪЮЬЩЪбЬЮЬЮЬЩJЪЮЬЩJЪЮЬЩJЪЮЬЩJЪЮЬЩJЩЧJЪЬЮЬЩJЪЬЮЬЩ	JЩEJЩGJЩHJЩЪЮЬЮЬЮЬЮЩJЪЬЮЬЩJЪЮЬЮЬЮЬЮЬЩ5JЩJЩJЩЪЮЩJЪЮЬЩЧJЪЮЬЩЧJЩЧЪЮЬЩЪб
ЬЮЬЮЬЩJЪЮЬЩJЪЮЬЩJЩЧJЪЬЮЬЩJЪЬЮЬЩJЩIJЩЪЮЬЮЬЮЬЮЩJЪЬЮЬ	ЩJЪЮЬЮЬЮЬЮЬЩ5JЩJЩJЩЪЮЩJЪЮЬЩЧJЪЮЬЩЧJЩЧЧJЪЮЬЩЧJЪЮЬЩJЩЧЧJШJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬШAJЪЮЬШJЪЬШJЪЬЮЬЮЬЮЬ$ШLJШ'JЪЬЮЬЮЬЮЬЮЬЮЬШ5JЪЬ	ЮЬЮЬШ8JЪЬ	ЮЬЮЬШ8JЪЬЮЬЮЬШ2JЪЬЮЬЮЬШ2JШ;ЪЮЬЮШJЪЮЬ7Ш;JЪЮЬ0Ш4ЧЪЮЬ	ШЪЮЬШJШ$JШ$JШ$JШЧJЪЮЬ%Ш*ЧЪЮЬЮЬЮЬЮШ(ЪЮЬШ
ЪЮЬШJЪЬЮЬШЪЮЬЮШJЪЬЮЬЮЬШJЪЬЮЬЮЬШJЪ
ЮЬЮЬЮЬЮЬЮЬШ1JШ
ЪЮЬШJШIЧJЪЮЬШЧJШЧЪЮЬШJЪЬЮЬШЪЮЬЮШJЪЬЮЬЮЬШJЪ	ЬЮЬЮЬЮЬЮЬШ<ЪЮЬЮЬЮЬЮШJШJШJШJЪЮЬШЧJШ
ЪЮЬШJШHJШHJШHJШЧJЪЮЬШЧJШЧЧJЪЮЬШЧJЪЮЬШJШЧЧJШ ЪЮЬШJШ ЧJШ Ч ЕЧ    И  ╝  