<<>>
<<CtWarpCommandsImpl.mesa>>
<<Copyright Ó 1988, 1992 by Xerox Corporation.  All rights reserved.>>
<<Bloomenthal, September 6, 1992 4:51 pm PDT>>
<<Heckbert, June 2, 1988 3:54:09 pm PDT>>

DIRECTORY Buttons, CtBasic, CtDispatch, CtMisc, CtMod, CtViewer, Commander, G2dContour, G2dBasic, ImagerSample, IO, MessageWindow, 
Process, Real, Rope, RuntimeError, TypeScript, ViewerClasses, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools;

CtWarpCommandsImpl: CEDAR PROGRAM
IMPORTS Buttons, CtBasic, CtDispatch, CtMisc, CtMod, CtViewer, G2dContour, G2dBasic, ImagerSample, IO, MessageWindow, Process, 
Real, RuntimeError, TypeScript, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools

~ BEGIN
<<Imported Types>>
IntegerPair:        TYPE ~ CtBasic.IntegerPair;
PixelArray:        TYPE ~ CtBasic.PixelArray;
SampleMaps:        TYPE ~ CtBasic.SampleMaps;
CtProc:            TYPE ~ CtDispatch.CtProc;
PairSequence:    TYPE ~ G2dBasic.PairSequence;
ROPE:                TYPE ~ Rope.ROPE;
Viewer:            TYPE ~ ViewerClasses.Viewer;
ViewerClassRec:    TYPE ~ ViewerClasses.ViewerClassRec;
<<PerspWarp Command>>
Persp:     TYPE ~ REF PerspRep;
PerspRep:    TYPE ~ RECORD [
parent:            Viewer Ź NIL,                            -- parent viewer
image:            Viewer Ź NIL,                            -- the viewer to warp
button:            CtViewer.MouseButton Ź left,
box:                ImagerSample.Box Ź [[0, 0], [0, 0]],    -- texture box
texture:            PixelArray Ź NIL,                        -- array of chosen texture
smooth:            BOOL Ź FALSE,                            -- anti-alias or not?
index:                NAT Ź 0,                                    -- index to warp quadilateral points
points:            ARRAY [0..4) OF IntegerPair            -- warp quadrilateral
];

ctPerspWarpUsage: ROPE ~ "Ct PerspWarp: Warp a window into a quadrilateral.";

CtPerspWarp: CtProc ~ {
v: Viewer Ź ViewerOps.FindViewer["Ct PerspWarp"];
d: Persp Ź IF v = NIL THEN NEW[PerspRep] ELSE NARROW[v.data];
d.image Ź viewer;
IF v = NIL THEN TRUSTED {Process.Detach[FORK MakePersper[d]]};
affect Ź [[0, 0], [0, 0]];
CtViewer.RegisterMouse[viewer, PerspMouse, d];
};

MakePersper: PROC [d: Persp] ~ { 
d.parent Ź MakeViewer["Ct PerspWarp", $CtPerspWarp, 51, d];
ViewerTools.SetContents[ViewerTools.MakeNewTextViewer[
info: [scrollable: FALSE, parent: d.parent, border: FALSE, wx: 7, wy: 0, ww: 400, wh: 16]],
"Left: pick texture, Middle: warp points, Right: restart"];
Buttons.SetDisplayStyle[Buttons.Create[
[parent: d.parent, name: "Warp-On ", wx: 3, wy: 20],  PerspWarpTog, d], $WhiteOnBlack];
Buttons.SetDisplayStyle[Buttons.Create[
[parent: d.parent, name: "Smooth-Off ", wx: 70, wy: 20],  SmoothTog, d], $BlackOnWhite];
};

PerspWarpTog: Buttons.ButtonProc ~ {
d: Persp Ź NARROW[clientData];
CtMisc.ButtonToggle[parent];
IF CtMisc.ButtonOn[parent]
THEN CtViewer.RegisterMouse[d.image, PerspMouse, d]
ELSE CtViewer.UnregisterMouse[d.image, PerspMouse];
};

SmoothTog: Buttons.ButtonProc ~ {
d: Persp Ź NARROW[clientData];
CtMisc.ButtonToggle[parent];
d.smooth Ź CtMisc.ButtonOn[parent]
};

PerspMouse: CtViewer.MouseProc ~ {
d: Persp Ź NARROW[clientData];
IF mouse.state # down THEN RETURN;
IF (d.button Ź mouse.button) = left
THEN d.box Ź CtViewer.GetBoundingBox[viewer, [mouse.pos.y, mouse.pos.x]];
CtViewer.DoWithViewer[viewer, DoPersp, d];
};

DoPersp: CtViewer.ViewerProc ~ {
d: Persp Ź NARROW[clientData];
CtViewer.DoWhileMouseDown[viewer, NIL];
SELECT d.button FROM
left =>
d.texture Ź CtBasic.PixelArrayFromSampleMap[ImagerSample.Clip[maps[0].map, d.box]];
middle => {
d.points[d.index] Ź CtViewer.GetMousePos[viewer];
IF (d.index Ź (d.index+1) MOD 4) = 0 THEN
[] Ź CtMod.PerspWarp[d.texture, maps, d.smooth, d.points];
};
ENDCASE => CtBasic.TransferPixelArrayToMap[d.texture, maps[0].map];
};

PerspWarpDestroy: ViewerClasses.DestroyProc ~ {
CtViewer.UnregisterMouse[NARROW[self.data, Persp].image, PerspMouse];
};
<<CoonsWarp Command>>
CoonsControl:    TYPE ~ CtMod.CoonsControl;

Coons:                TYPE ~ REF CoonsRep;
CoonsRep:        TYPE ~ RECORD [                       -- info for Coons mouse and warp procs
flag:                        ATOM Ź NIL,
mouse:                    CtViewer.Mouse Ź [],
cmd:                        Commander.Handle Ź NIL,    -- Commander handle
control:                    REF CoonsControl Ź NIL,    -- control during warping
r, g, b, bw:                PixelArray,                    -- source picture (8 or 24 bpp)
ind:                        [0..4] Ź 0,                    -- which curve are we editing? [0..4)
curves:                    ARRAY [0..4) OF PairSequence,    -- the four outline curves
image:                    Viewer Ź NIL,                -- the viewer to warp
parent:                    Viewer Ź NIL,                -- the parent viewer
text:                        Viewer Ź NIL,                -- log's viewer, for feedback
filterButton:                Viewer Ź NIL,                -- button for filter mode
lifeButton:                Viewer Ź NIL,                -- to put CoonsWarp to sleep or wake up
awake:                    BOOL Ź TRUE,                -- awake or asleep?
s:                            IO.STREAM Ź NIL            -- log's output stream
];

ctCoonsWarpUsage: ROPE ~ "Ct CoonsWarp: Warp an outlined area into a rectangle.";

CtCoonsWarp: CtProc ~ {
v: Viewer Ź ViewerOps.FindViewer["Ct CoonsWarp"];
d: Coons Ź IF v = NIL THEN NEW[CoonsRep] ELSE NARROW[v.data];
affect Ź [[0, 0], [0, 0]];
d.cmd Ź cmd;
d.image Ź viewer;
IF v = NIL THEN TRUSTED {Process.Detach[FORK MakeCoonser[d]]};
IF maps.bpp = 24
THEN {
d.r Ź CtBasic.PixelArrayFromSampleMap[maps[0].map];
d.g Ź CtBasic.PixelArrayFromSampleMap[maps[1].map];
d.b Ź CtBasic.PixelArrayFromSampleMap[maps[2].map];
}
ELSE d.bw Ź CtBasic.PixelArrayFromSampleMap[maps[0].map];
CtViewer.RegisterMouse[viewer, CoonsMouse, d];
};

MakeCoonser: PROC [d: Coons] ~ {
d.parent Ź MakeViewer["Ct CoonsWarp", $CtCoonsWarp, 120, d];
d.text Ź TypeScript.Create[
[parent: d.parent, border: FALSE, wx: 0, wy: 0, ww: ViewerSpecs.openRightWidth, wh: 85]];
d.s Ź ViewerIO.CreateViewerStreams[NIL, d.text].out;
Buttons.SetDisplayStyle[d.lifeButton Ź Buttons.Create[
[parent: d.parent, name: "AWAKE ", wx: 3, wy: 90], CoonsAwakeTog, d], $WhiteOnBlack];
[] Ź Buttons.Create[[parent: d.parent, name: "Abort", wx: 50, wy: 90], CoonsAbort, d,,,, TRUE];
[] Ź Buttons.Create[[parent: d.parent, name: "Restart", wx: 95, wy: 90], CoonsRestart, d];
[] Ź Buttons.Create[[parent: d.parent, name: "Smooth", wx: 145, wy: 90], CoonsSmooth, d];
d.filterButton Ź Buttons.Create[
[parent: d.parent, name: "Filter: point", wx: 240, wy: 90], CoonsFilter, d];
IO.PutRope[d.s, "\nPlease wait . . . "];
FOR i: INT IN [0..4) DO d.curves[i] Ź NEW[G2dBasic.PairSequenceRep[64]]; ENDLOOP; -- grow?
d.control Ź NEW[CoonsControl];
IO.PutRope[d.s, "\nSTART DRAWING:  L: draw outline, M: warp, R: restore original\n\n"];
};

CoonsSmooth: Buttons.ButtonProc ~ {
d: Coons Ź NARROW[clientData];
CoonsCurvesDraw[d, $Undraw];
FOR j: NAT IN [1..10] DO
FOR i: NAT IN [0..4) DO [] Ź G2dContour.SmoothPairs[d.curves[i], d.curves[i]]; ENDLOOP;
ENDLOOP;
CoonsCurvesDraw[d, $Draw];
};

CoonsRestart: Buttons.ButtonProc ~ {NARROW[clientData, Coons].ind Ź 0};

CoonsAbort: Buttons.ButtonProc ~ {NARROW[clientData, Coons].control.abort Ź TRUE};

CoonsAwakeTog: Buttons.ButtonProc ~ {
d: Coons Ź NARROW[clientData];
Buttons.ReLabel[d.lifeButton, IF d.awake Ź NOT d.awake THEN "AWAKE" ELSE "ASLEEP"];
Buttons.SetDisplayStyle[d.lifeButton, IF d.awake THEN $WhiteOnBlack ELSE $BlackOnWhite];
IF d.awake
THEN CtViewer.RegisterMouse[d.image, CoonsMouse, d]
ELSE CtViewer.UnregisterMouse[d.image, CoonsMouse];
};

CoonsFilter: Buttons.ButtonProc ~ {
d: Coons Ź NARROW[clientData];
d.control.filter Ź IF d.control.filter = point THEN box ELSE point;
Buttons.ReLabel[d.filterButton, IF d.control.filter = point THEN "Filter: point" ELSE "Filter: box"];
};

CoonsWarpDestroy: ViewerClasses.DestroyProc ~ {
d: Coons Ź NARROW[self.data];
d.s Ź d.cmd.out;
d.control.abort Ź TRUE;
CtViewer.UnregisterMouse[d.image, CoonsMouse];
};

CoonsCurvesDrawAction: CtViewer.ViewerProc ~ {
d: Coons Ź NARROW[clientData];
FOR c: NAT IN [0..4) DO
FOR i: NAT IN [0..d.curves[c].length) DO
CoonsDotDraw[d, maps, Real.Fix[d.curves[c][i].x], Real.Fix[d.curves[c][i].y], d.flag];
ENDLOOP;
ENDLOOP;
};

CoonsCurvesDraw: PROC [d: Coons, flag: ATOM] ~ {
d.flag Ź flag;
CtViewer.DoWithViewer[d.image, CoonsCurvesDrawAction, d];
};

CoonsDotDraw: PROC [d: Coons, maps: SampleMaps, x, y: NAT, flag: ATOM] ~ {
x0: NAT Ź x-1;
x1: NAT Ź x+1;
y0: NAT Ź y-1;
y1: NAT Ź y+1;
SELECT flag FROM
$Draw => SELECT maps.bpp FROM
8 => ImagerSample.Fill[maps[0].map, [[y0, x0], [y1, x1]], 255];
24 => CtBasic.PutRGBBox[maps, x0, y0, x1, y1, [255, 255, 255]];
ENDCASE;
$Undraw => SELECT maps.bpp FROM
8 => CtBasic.PixelArrayBoxToMap[d.bw, maps[0].map, x0, y0, x1, y1];
24 => {
CtBasic.PixelArrayBoxToMap[d.r, maps[0].map, x0, y0, x1, y1];
CtBasic.PixelArrayBoxToMap[d.g, maps[1].map, x0, y0, x1, y1];
CtBasic.PixelArrayBoxToMap[d.b, maps[2].map, x0, y0, x1, y1];
};
ENDCASE;
ENDCASE;
};

CoonsMouseAction: CtViewer.ViewerProc ~ {
d: Coons Ź NARROW[clientData];
SELECT d.mouse.button FROM
middle => {    --  warp
d.control.abort Ź FALSE;
IF d.ind # 0
THEN Blink["Four boundary curves needed"]
ELSE {
CtMod.CoonsWarp[d.r, d.g, d.b, d.curves, maps, d.control];
IO.PutRope[d.s, " done!\n"];
};
};
right =>        -- restore original image
SELECT maps.bpp FROM
8 => CtBasic.TransferPixelArrayToMap[d.bw, maps[0].map];
24 => {
CtBasic.TransferPixelArrayToMap[d.r, maps[0].map];
CtBasic.TransferPixelArrayToMap[d.g, maps[1].map];
CtBasic.TransferPixelArrayToMap[d.b, maps[2].map];
};
ENDCASE;
left => {        -- add point(s)
AddPoint: PROC [pos: IntegerPair] ~ {
d.curves[d.ind] Ź G2dBasic.AddToPairSequence[d.curves[d.ind], [pos.x, pos.y]
! RuntimeError.BoundsFault => GOTO Bad];     -- record the point in curve array
CoonsDotDraw[d, maps, pos.x, pos.y, $Draw];    -- draw dots on screen
EXITS Bad => {
Blink[IO.PutFR["Curve %g length exceeded at %g points",
IO.int[d.ind], IO.int[d.curves[d.ind].length]]];
d.curves[d.ind].length Ź 0;                        -- best can do: restart curve
};
};
Poll: CtViewer.PollProc ~ {AddPoint[pos]};
CtViewer.UnregisterMouse[viewer, CoonsMouse];
IO.PutF1[d.s, "curve %g: ", IO.int[d.ind]];          -- assume just had a mouse-down
d.curves[d.ind].length Ź 0;
AddPoint[d.mouse.pos];
CtViewer.DoWhileMouseDown[viewer, Poll];
IO.PutF1[d.s, "%g pts, ", IO.int[d.curves[d.ind].length]];
IF d.curves[d.ind].length < 2
THEN {
Blink[IO.PutFR["Too few points (%g), redraw curve %g",
IO.int[d.curves[d.ind].length], IO.int[d.ind]]];
d.curves[d.ind].length Ź 0;                        -- best can do: restart curve
IO.PutF1[d.s, "curve %g: ", IO.int[d.ind]];
}
ELSE d.ind Ź (d.ind+1) MOD 4;
CtViewer.RegisterMouse[viewer, CoonsMouse, d];
};
ENDCASE;
};

CoonsMouse: CtViewer.MouseProc ~ {
d: Coons Ź NARROW[clientData];
d.mouse Ź mouse;
CtViewer.DoWithViewer[viewer, CoonsMouseAction, d];
};
<<Support Code>>
MakeViewer: PROC [name: ROPE, flavor: ATOM, openHeight: NAT, data: REF ANY]
RETURNS [viewer: Viewer]
~ {
viewer Ź ViewerOps.CreateViewer[
flavor: flavor,
info: [openHeight: openHeight, name: name, data: data, scrollable: FALSE, column: right, iconic: TRUE]];
ViewerOps.OpenIcon[viewer];
};

Blink: PROC [rope: ROPE] ~ {
MessageWindow.Append[rope, TRUE];
MessageWindow.Blink[];
};
<<Start Code>>
ViewerOps.RegisterViewerClass[
$CtPerspWarp, NEW[ViewerClassRec Ź [destroy: PerspWarpDestroy]]];

ViewerOps.RegisterViewerClass[
$CtCoonsWarp, NEW[ViewerClassRec Ź [destroy: CoonsWarpDestroy]]];

CtDispatch.RegisterCtOp["Warp:",            NIL,                NIL];
CtDispatch.RegisterCtOp["PerspWarp",    CtPerspWarp,    ctPerspWarpUsage];
CtDispatch.RegisterCtOp["CoonsWarp",    CtCoonsWarp,    ctCoonsWarpUsage];

END.