~ {
Comp: TYPE ~ ColorTrixMap.Comp;
Cmap: TYPE ~ ColorTrixMap.Cmap;
rec: TYPE ~ RECORD [data: SEQUENCE num: NAT OF Cmap];
Blends: Commander.CommandProc ~ {
nCmaps: NAT ← 0;
ok: BOOL ← FALSE;
outer: Controls.Viewer;
cmaps: REF rec ← NEW[rec[Args.NArgs[cmd]]];
FOR a:
NAT
IN[0..Args.NArgs[cmd])
DO
IF ColorTrixMap.Load[Args.GetRope[cmd, a], cmaps.data[nCmaps] ← ColorTrixMap.NewCmap[]]
THEN nCmaps ← nCmaps+1
ELSE cmd.out.PutF["Can't read %g\n", IO.rope[Args.GetRope[cmd, a]]];
ENDLOOP;
IF nCmaps = 0 THEN RETURN;
outer ← Controls.OuterViewer[
name: "Color Map Blender",
controls: LIST[Controls.NewControl[name: "speed", type: horiz, report: FALSE, x: 60, y: 10, w: 200, h: 20, min: 0.01, max: 1.0, init: 0.1]]];
TRUSTED {
Process.Detach[FORK Blender[NARROW[outer.data, Controls.OuterData], cmaps, nCmaps]]
};
};
Blender:
PROC [d: Controls.OuterData, cmaps:
REF rec, nCmaps:
NAT] ~ {
n0, n1: NAT ← 0;
out: Cmap ← ColorTrixMap.NewCmap[];
WHILE
NOT d.destroyed
DO
Process.CheckForAbort[];
n1 ← (n0+1) MOD nCmaps;
FOR t:
REAL ← 0, t+d.val
WHILE t <= 1.0
AND
NOT d.destroyed
DO
ColorTrixMap.Write[CmBlend[t, cmaps.data[n0], cmaps.data[n1], out]];
ENDLOOP;
n0 ← (n0+1) MOD nCmaps;
ENDLOOP;
};
BlendData: TYPE ~ REF BlendDataRec;
BlendDataRec: TYPE ~ RECORD [cm: ARRAY[0..1] OF Cmap, blend: Cmap];
Blend: Commander.CommandProc ~ {
ok: BOOL;
t, show, out: Args.Arg;
name: ARRAY[0..1] OF Args.Arg;
d: BlendData ← NEW[BlendDataRec];
[ok, t, name[0], name[1], show, out] ← Args.ArgsGet[cmd, "%rss-s%b-o%s"];
IF NOT (ok AND name[0].ok AND name[1].ok AND t.ok) THEN RETURN[$Failure, "bad args."];
IF NOT ColorTrixMap.Load[name[0].rope, d.cm[0] ← ColorTrixMap.NewCmap[]]
OR
NOT ColorTrixMap.Load[name[1].rope, d.cm[1] ← ColorTrixMap.NewCmap[]]
THEN RETURN[$Failure, "Can't read color map."];
d.blend ← CmBlend[t.real, d.cm[0], d.cm[1]];
IF out.ok THEN ColorTrixMap.Save[d.blend, out.rope];
IF show.ok
AND show.bool
THEN
[] ← Controls.OuterViewer[name: "Blender", graphicsHeight: 450, graphicsShow: Show, data: d];
};
Show: Controls.GraphicsShow ~ {
d: BlendData ← NARROW[data];
hh: NAT ← h/9;
FOR n:
NAT
IN[0..2]
DO
y: NAT ← (2-n)*h/3;
color: Rope.ROPE ← SELECT n FROM 0 => "r", 1 => "g", ENDCASE => "b";
ColorTrixMap.ShowComp[context, d.cm[0][n], 0, y, w, hh,, Rope.Concat["Cm0-", color]];
ColorTrixMap.ShowComp[context, d.blend[n], 0, y+hh, w, hh,, Rope.Concat["Blend-", color]];
ColorTrixMap.ShowComp[context, d.cm[1][n], 0, y+2*hh, w, hh,, Rope.Concat["Cm1-", color]];
ENDLOOP;
};
CmBlend:
PROC [t:
REAL, cm0, cm1: Cmap, out: Cmap ←
NIL]
RETURNS [Cmap] ~ {
IF out = NIL THEN out ← ColorTrixMap.NewCmap[];
FOR n: NAT IN[0..2] DO MaxDivide[t, cm0[n], 0, 255, cm1[n], 0, 255, out[n]]; ENDLOOP;
RETURN[out];
};
Max:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [
NAT] ~ {
i, imid, m: NAT; imid ← (i0+i1)/2; m ← 0;
FOR n:
NAT
IN[i0..i1]
DO
cc: NAT ← c[n];
IF cc > m THEN {i ← n; m ← cc}
ELSE IF cc = m THEN {IF ABS[n-imid] < ABS[i-imid] THEN i ← n};
ENDLOOP;
RETURN[IF i = i0 OR i = i1 THEN LocalMin[c, i0, i1] ELSE i];
};
Min:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [
NAT] ~ {
i, imid, m: NAT; imid ← (i0+i1)/2; m ← 255;
FOR n:
NAT
IN[i0..i1]
DO
cc: NAT ← c[n];
IF cc < m THEN {i ← n; m ← cc}
ELSE IF cc = m THEN {IF ABS[n-imid] < ABS[i-imid] THEN i ← n};
ENDLOOP;
RETURN[IF i = i0 OR i = i1 THEN LocalMin[c, i0, i1] ELSE i];
};
LocalMax:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [i:
NAT] ~ {
i ← i0+1;
WHILE c[i] < c[i-1] AND i < i1 DO i ← i+1; ENDLOOP;
WHILE c[i] > c[i-1] AND i < i1 DO i ← i+1; ENDLOOP;
};
LocalMin:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [i:
NAT] ~ {
i ← i0+1;
WHILE c[i] > c[i-1] AND i < i1 DO i ← i+1; ENDLOOP;
WHILE c[i] < c[i-1] AND i < i1 DO i ← i+1; ENDLOOP;
};
Monotonic:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [
BOOL] ~ {
RETURN[IF c[i1] > c[i0] THEN MonotonicUp[c, i0, i1] ELSE MonotonicDown[c, i0, i1]];
};
MonotonicUp:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [
BOOL ← TRUE] ~ {
m: NAT ← c[i0];
FOR n: NAT IN(i0..i1] DO IF c[n] < m THEN RETURN[FALSE]; m ← c[n]; ENDLOOP;
};
MonotonicDown:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [
BOOL ← TRUE] ~ {
m: NAT ← c[i0];
FOR n: NAT IN(i0..i1] DO IF c[n] > m THEN RETURN[FALSE]; m ← c[n]; ENDLOOP;
};
Done:
PROC [c: Comp, i0, i1:
NAT]
RETURNS [
BOOL] ~ {
RETURN[i1-i0 < 3 OR Monotonic[c, i0, i1]];
};
MaxDivide:
PROC [t:
REAL, a: Comp, a0, a1:
NAT, b: Comp, b0, b1:
NAT, c: Comp] ~ {
IF Done[a, a0, a1]
OR Done[b, b0, b1]
THEN Average[t, a, a0, a1, b, b0, b1, c]
ELSE {
aa: NAT ← Max[a, a0, a1];
bb: NAT ← Max[b, b0, b1];
MinDivide[t, a, a0, aa, b, b0, bb, c];
MinDivide[t, a, aa, a1, b, bb, b1, c];
};
};
MinDivide:
PROC [t:
REAL, a: Comp, a0, a1:
NAT, b: Comp, b0, b1:
NAT, c: Comp] ~ {
IF Done[a, a0, a1]
OR Done[b, b0, b1]
THEN Average[t, a, a0, a1, b, b0, b1, c]
ELSE {
aa: NAT ← Min[a, a0, a1];
bb: NAT ← Min[b, b0, b1];
MaxDivide[t, a, a0, aa, b, b0, bb, c];
MaxDivide[t, a, aa, a1, b, bb, b1, c];
};
};
Average:
PROC [t:
REAL, a: Comp, a0, a1:
NAT, b: Comp, b0, b1:
NAT, c: Comp] ~ {
c0: NAT ← (a0+b0)/2;
c1: NAT ← (a1+b1+1)/2;
dt: REAL ← 1.0/(c1-c0+1);
t0, t1: REAL ← 0.0;
FOR n:
NAT
IN[c0..c1]
DO
t0 ← t1;
t1 ← t0+dt;
c[n] ← Real.Round[0.5*((1.0-t)*Piece[a, a0, a1, t0, t1]+t*Piece[b, b0, b1, t0, t1])];
ENDLOOP;
};
Piece:
PROC [c: Comp, c0, c1:
NAT, t0, t1:
REAL]
RETURNS [
NAT] ~ {
cc0: NAT ← Real.Round[(1.0-t0)*c0+t0*c1];
cc1: NAT ← Real.Round[(1.0-t1)*c0+t1*c1];
total, count: NAT ← 0;
FOR n: NAT IN[cc0..cc1] DO total ← total+c[n]; count ← count+1; ENDLOOP;
RETURN[total/count];
};
Commander.Register["Blend", Blend, "\nBlend <REAL> <Cmap> <Cmap> [-s: show] [-o <file>]."];
Commander.Register["Blends", Blends, "\nBlend [Cmap] . . . [Cmap]."];
}.