DIRECTORY
FileIO USING [Open],
IO USING [card, Close, EndOfStream, GetCard, GetReal, PutF, real, STREAM],
Map,
Real USING [Float, LargestNumber, SqRt],
Rope USING [ROPE];
MapImpl:
PROGRAM
IMPORTS FileIO, IO, Map, Real
EXPORTS Map = BEGIN
OPEN Map;
ListToTable:
PUBLIC PROCEDURE [list: ColorList, error: ErrorFunc ← Vector3D] RETURNS [colorTable: ColorTable, pal:PalTable]= {
redRange: TYPE = [0..16);
greenRange: TYPE = [0..16);
blueRange: TYPE = [0..16);
tableIndex: TYPE = [0..(LAST[redRange]+1)*(LAST[greenRange]+1)*(LAST[blueRange]+1));
Nearest:
PROCEDURE [pal:PalTable, error: ErrorFunc, lr,lg,lb:
REAL]
RETURNS [palix:ColorMapSize] = {
newError:REAL;
bestError:REAL ← Real.LargestNumber;
lr ← lr / (LAST[redRange]);
lg ←lg / (LAST[greenRange]);
lb ← lb / (LAST[blueRange]);
FOR this:
CARDINAL
IN [0..pal.size)
DO
OPEN pal[this];
newError ← error[lr,lg,lb, r,g,b];
IF newError<bestError
THEN {
bestError ← newError;
palix ← this;
};
ENDLOOP;
};
palSize, tix:CARDINAL ← 0;
IF list=
NIL
THEN
SIGNAL NullList[];
FOR l:ColorList ← list, l.rest
UNTIL l=
NIL
DO -- compute length of palette list
palSize ← palSize + 1;
ENDLOOP;
colorTable ← NEW[ColorTableRec[LAST[tableIndex]+1]];
colorTable.size ← LAST[tableIndex]+1;
pal ← NEW[PalTableRec[palSize]];
pal.size ← palSize;
palSize ← 0;
FOR l:ColorList ← list, l.rest
UNTIL l=
NIL
DO
pal[palSize] ← l.first^;
palSize ← palSize + 1;
ENDLOOP;
FOR redIndex:
CARDINAL
IN redRange
DO
FOR greenIndex:
CARDINAL
IN greenRange
DO
FOR blueIndex:
CARDINAL
IN blueRange
DO
colorTable.data[tix] ← Nearest[pal, error, redIndex, greenIndex, blueIndex];
tix ← tix + 1;
ENDLOOP
ENDLOOP;
ENDLOOP;
};
NullList: PUBLIC SIGNAL = CODE;
Vector3D:
PUBLIC ErrorFunc = {
error ← Real.SqRt[(r1-r2)*(r1-r2) + (g1-g2)*(g1-g2) + (b1-b2)*(b1-b2)]
};
MakeStandardList:
PUBLIC PROCEDURE [redMax, greenMax, blueMax, grayMax:
CARDINAL]
RETURNS [l:ColorList] = {
l ← NIL;
redMax ← redMax - 1;
greenMax ← greenMax - 1;
blueMax ← blueMax - 1;
grayMax ← grayMax - 1;
FOR grayIx:
CARDINAL
DECREASING IN [1..grayMax+1]
DO
realGray:REAL ← Real.Float[grayIx]/(grayMax+2);
l ← InsertColor[realGray, realGray, realGray, l];
ENDLOOP;
FOR redIx:
CARDINAL
DECREASING IN [0..redMax]
DO
FOR greenIx:
CARDINAL
DECREASING IN [0..greenMax]
DO
FOR blueIx:
CARDINAL
DECREASING IN [0..blueMax]
DO
l ← InsertColor[Real.Float[redIx]/redMax, Real.Float[greenIx]/greenMax, Real.Float[blueIx]/blueMax, l];
ENDLOOP
ENDLOOP
ENDLOOP;
};
Save:
PUBLIC PROCEDURE [fileName:Rope.
ROPE, table:ColorTable←
NIL, pal:PalTable] = {
out:IO.STREAM ← FileIO.Open[fileName:fileName, accessOptions:overwrite];
IF table=NIL THEN IO.PutF[out, "0\n"]
ELSE {
perLine:CARDINAL ← 0;
IO.PutF[out, "\n%g\n", IO.card[table.size]];
FOR i:
CARDINAL
IN [0..table.size)
DO
IO.PutF[out, "%g ", IO.card[table.data[i]]];
perLine ← perLine + 1;
IF perLine=20
THEN {
perLine ← 0;
IO.PutF[out, "\n"];
};
ENDLOOP;
};
IO.PutF[out, "\n"];
WritePal[out, pal];
IO.Close[out];
};
Restore:
PUBLIC
PROCEDURE [fileName:Rope.
ROPE]
RETURNS [table:ColorTable, pal:PalTable] = {
in:IO.STREAM ← FileIO.Open[fileName:fileName, accessOptions:read];
length:CARDINAL ← IO.GetCard[in];
table ← NEW[ColorTableRec[length]];
table.size ← length;
FOR i:
CARDINAL
IN [0..length)
DO
table.data[i] ←
IO.GetCard[in
! IO.EndOfStream => GOTO QUIT];
REPEAT
QUIT => ERROR; -- unexpected eof
ENDLOOP;
pal ← ReadPal[in];
IO.Close[in];
};
ReadPal:
PROCEDURE [in:
IO.
STREAM]
RETURNS [pal:PalTable ←
NIL] = {
length:CARDINAL ← IO.GetCard[in];
pal ← NEW[PalTableRec[length]];
pal.size ← length;
FOR i:
CARDINAL
IN [0..length)
DO
OPEN pal[i];
r ← IO.GetReal[in
! IO.EndOfStream => GOTO QUIT];
g ← IO.GetReal[in
! IO.EndOfStream => GOTO QUIT];
b ← IO.GetReal[in
! IO.EndOfStream => GOTO QUIT];
REPEAT
QUIT => ERROR; -- unexpected eof
ENDLOOP;
};
WritePal:
PROCEDURE [out:
IO.
STREAM, pal:PalTable] = {
IO.PutF[out, "\n%g\n", IO.card[pal.size]];
FOR palix:
CARDINAL
IN [0..pal.size)
DO
OPEN pal[palix];
IO.PutF[out, "%g %g %g\n", IO.real[r], IO.real[g], IO.real[b]];
ENDLOOP;
};
END.