DIRECTORY
AIS USING [FRef, OpenFile, Raster, ReadRaster, CloseFile],
AISViewer,
FS USING [ExpandName],
Imager USING [Context, DoSaveAll, ConcatT, Rectangle, SetColor, MaskStrokeTrajectory, SetSampledColor, MaskBox],
ImagerBackdoor USING [GetBounds, invert],
ImagerColorOperator USING [ColorOperator, GrayLinearColorModel],
ImagerPath USING [Trajectory, MoveTo, LineTo],
ImagerPixelArray USING [PixelArray, FromAIS],
ImagerTransformation USING [Scale],
Real USING [RoundC],
Rope USING [ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerRec, ViewerClassRec, InitProc, NotifyProc],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass];
AISViewerImpl:
CEDAR
MONITOR
IMPORTS AIS, FS, Imager, ImagerBackdoor, ImagerColorOperator, ImagerPath, ImagerPixelArray, ImagerTransformation, Real, TIPUser, ViewerOps
EXPORTS AISViewer
= BEGIN OPEN AISViewer;
ROPE: TYPE ~ Rope.ROPE;
ColorOp: TYPE ~ ATOM;
State: TYPE = REF StateRecord;
StateRecord:
TYPE =
RECORD [
op: ImagerColorOperator.ColorOperator,
pa: ImagerPixelArray.PixelArray,
scans, pixels: NAT ← 0,
scale: REAL ← 1.0,
xStart, yStart: REAL ← 0,
trajectory: ImagerPath.Trajectory,
dragInProgress: BOOL ← FALSE,
trajectoryActive: BOOL ← FALSE,
allowSubWindow: BOOL ← FALSE,
prevDragX, prevDragY: REAL ← 0,
xStop, yStop: REAL ← 0,
clientData: REF ANY ← NIL,
progressProc: ProgressProc ← NIL,
rpProc: RPProc ← NIL,
active: BOOL ← FALSE,
drawing: BOOL ← FALSE
];
ArgSpec: TYPE = REF ArgSpecRec;
ArgSpecRec: TYPE = RECORD [proc: CallBackProc];
CallBackProc: TYPE = PROC[context: Imager.Context, argSpec: ArgSpec];
ProgressProc: TYPE =
PROC [scanStart, pixelStart, scans, pixels: CARDINAL, clientData: REF ANY ← NIL];
RPProc: TYPE =
PROC [scanStart, pixelStart, scans, pixels: REAL, clientData: REF ANY ← NIL];
CreateAISViewer:
PUBLIC
PROC
[info: ViewerClasses.ViewerRec ← [], paint:
BOOL ←
TRUE]
RETURNS [new: ViewerClasses.Viewer] =
BEGIN
IF info.name = NIL THEN info.name ← "AIS Viewer";
info.scrollable ← FALSE;
new ← ViewerOps.CreateViewer[
flavor: $AISViewer,
info: info];
IF paint THEN ViewerOps.PaintViewer[viewer: new, hint: all];
END;
DisplayAIS:
PUBLIC
PROC [v: ViewerClasses.Viewer,
fileName: Rope.
ROPE ←
NIL, wDir:
ROPE ←
NIL,
allowSubWindow:
BOOL ←
FALSE, progressProc: ProgressProc ←
NIL, rpProc: RPProc ←
NIL,
clientData:
REF
ANY ←
NIL, paint:
BOOL ←
TRUE] =
BEGIN
fn: ROPE ← FS.ExpandName[fileName, wDir].fullFName;
state: State ← NARROW [v.data];
state.clientData ← clientData;
state.progressProc ← progressProc;
state.rpProc ← rpProc;
state.allowSubWindow ← allowSubWindow;
IF fileName #
NIL
THEN
BEGIN
state.pa← ImagerPixelArray.FromAIS[fn];
state.op← ImagerColorOperator.GrayLinearColorModel[sWhite~255, sBlack~0];
[state.scans, state.pixels] ← GetDimensions[fn];
state.active ← TRUE;
IF progressProc # NIL THEN progressProc [0, 0, state.scans, state.pixels, clientData];
IF rpProc # NIL THEN rpProc [0, 0, state.scans, state.pixels, clientData];
END
ELSE state.active ← FALSE;
IF paint THEN ViewerOps.PaintViewer[v, client];
END;
GetCurrentSubWindow:
PUBLIC
PROC [v: ViewerClasses.Viewer]
RETURNS [scanStart, pixelStart, scans, pixels:
CARDINAL, clientData:
REF
ANY ←
NIL] =
BEGIN
Returns the current size and location of the subwindow.
state: State ← NARROW[v.data];
IF NOT state.allowSubWindow THEN RETURN[0, 0, 0, 0, state.clientData];
[scanStart, pixelStart, scans, pixels] ← ComputeAISBox[state];
RETURN [scanStart, pixelStart, scans, pixels, state.clientData];
END;
RegisterAISViewer:
PUBLIC
PROC [tipTable: Rope.
ROPE ←
NIL] =
BEGIN
AISViewerClass: ViewerClasses.ViewerClass;
IF tipTable = NIL THEN tipTable ← "AISViewer.tip";
AISViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← [
paint: Paint,
notify: Notify,
tipTable: TIPUser.InstantiateNewTIPTable[tipTable],
init: Init
]];
ViewerOps.RegisterViewerClass[$AISViewer, AISViewerClass];
END;
Init: ViewerClasses.InitProc =
BEGIN
--
PROC [self: Viewer] ;
self.data ← NEW[StateRecord];
END;
Paint : ViewerClasses.PaintProc
=
BEGIN
PROC [self: Viewer, context: Imager.Context, whatChanged: REF, clear: BOOL]
RETURNS [quit: BOOL ← FALSE];
state: State ← NARROW[self.data];
state.drawing ← TRUE;
IF whatChanged =
NIL
THEN
BEGIN
CallClient:
PROC ~
BEGIN
IF state.active
THEN
BEGIN
viewBox: Imager.Rectangle ← ImagerBackdoor.GetBounds[context];
sx, sy: REAL ← 1.0;
IF state.scans # 0 THEN sy ← (viewBox.h * 1.0) / state.scans;
IF state.pixels # 0 THEN sx ← (viewBox.w * 1.0) / state.pixels;
state.scale ← MIN [sx, sy];
Imager.ConcatT[context, ImagerTransformation.Scale[state.scale]];
Imager.SetSampledColor[context: context, m: ImagerTransformation.Scale[1.0],
pa: state.pa, colorOperator: state.op];
Imager.MaskBox[context, [0,0, state.pixels, state.scans]];
state.trajectoryActive ← FALSE;
END;
END;
Imager.DoSaveAll[context, CallClient];
END
ELSE
BEGIN
CallClient:
PROC ~
BEGIN
argSpec: ArgSpec ← NARROW[whatChanged];
argSpec.proc[context, argSpec];
END;
Imager.DoSaveAll[context, CallClient];
END;
state.drawing ← FALSE;
END;
Notify: ViewerClasses.NotifyProc =
BEGIN
PROC [self: Viewer, input: LIST OF REF ANY]
-- Tokens arrive from the TIP processor and are used to set up state variables and control
-- feed-back. Every token list arriving from tip is expected to start with mouse coords
SetXY:
PROC =
TRUSTED
BEGIN
TranslateMouse: CallBackProc ~ TRUSTED {x← xy.mouseX; y← xy.mouseY};
ViewerOps.PaintViewer[viewer: self, hint: client, clearClient:
FALSE,
whatChanged: NEW[ArgSpecRec ← [proc: TranslateMouse]]];
END;
XorBox:
PROC ~
TRUSTED
BEGIN
XorBoxCtxt: CallBackProc ~
TRUSTED BEGIN
Imager.SetColor[context, ImagerBackdoor.invert];
Imager.MaskStrokeTrajectory[context, state.trajectory];
END;
ViewerOps.PaintViewer[viewer: self, hint: client, clearClient:
FALSE,
whatChanged: NEW[ArgSpecRec ← [proc: XorBoxCtxt]]];
END;
NotInImage:
PROC
RETURNS [
BOOL] =
BEGIN
SetXY[];
IF x > (state.pixels * state.scale) THEN RETURN [TRUE];
IF y > (state.scans * state.scale) THEN RETURN [TRUE];
RETURN [FALSE];
END;
state: State ← NARROW[self.data];
x, y: REAL ← 0;
xy: TIPUser.TIPScreenCoords ← NARROW [input.first];
IF state.drawing THEN RETURN;
IF NOT state.allowSubWindow THEN RETURN;
IF NotInImage[] THEN RETURN;
-- parse the list of command tokens following the mouse pos
FOR input ← input.rest, input.rest
WHILE input #
NIL
DO
SELECT input.first
FROM
$Down =>
BEGIN
IF state.trajectoryActive THEN XorBox[]; -- get rid of previous box
state.trajectoryActive ← FALSE;
SetXY[]; -- Get position at down stroke
state.xStart ← x;
state.yStart ← y;
state.prevDragX ← x; state.prevDragY ← y; -- remember where feedback was drawn
state.dragInProgress ← TRUE;
IF state.progressProc #
NIL
THEN
BEGIN
scanStart, pixelStart, scans, pixels: CARDINAL;
[scanStart, pixelStart, scans, pixels] ← ComputeAISBox[state];
state.progressProc[scanStart, pixelStart, scans, pixels, state.clientData];
END;
IF state.rpProc #
NIL
THEN
BEGIN
scanStart, pixelStart, scans, pixels: REAL;
[scanStart, pixelStart, scans, pixels] ← ComputeRealAISBox[state];
state.rpProc[scanStart, pixelStart, scans, pixels, state.clientData];
END;
END;
$Move, $Release =>
BEGIN
IF NOT state.dragInProgress THEN RETURN [];
IF state.trajectoryActive THEN XorBox[]; -- get rid of previous box
SetXY[]; -- load x,y with user coords of mouse
state.trajectory ← ImagerPath.MoveTo[[state.xStart, state.yStart]];
state.trajectory ← ImagerPath.LineTo[state.trajectory, [state.xStart, y]];
state.trajectory ← ImagerPath.LineTo[state.trajectory, [x, y]];
state.trajectory ← ImagerPath.LineTo[state.trajectory, [x, state.yStart]];
state.trajectory ← ImagerPath.LineTo[state.trajectory, [state.xStart, state.yStart]];
state.trajectoryActive ← TRUE;
XorBox[]; -- draw new box
state.prevDragX ← x; state.prevDragY ← y; -- remember where feedback was drawn
IF state.progressProc #
NIL
THEN
BEGIN
scanStart, pixelStart, scans, pixels: CARDINAL;
[scanStart, pixelStart, scans, pixels] ← ComputeAISBox[state];
state.progressProc[scanStart, pixelStart, scans, pixels, state.clientData];
END;
IF state.rpProc #
NIL
THEN
BEGIN
scanStart, pixelStart, scans, pixels: REAL;
[scanStart, pixelStart, scans, pixels] ← ComputeRealAISBox[state];
state.rpProc[scanStart, pixelStart, scans, pixels, state.clientData];
END;
IF input.first = $Release
THEN
BEGIN
state.xStop ← x; state.yStop ← y;
state.dragInProgress ← FALSE;
END;
END;
ENDCASE => ERROR;
ENDLOOP;
END;
Internal Procs
GetDimensions:
PROC [f: Rope.
ROPE]
RETURNS [scans, pixels:
NAT] =
BEGIN
-- return the dimensions of an AIS file
fd: AIS.FRef ← AIS.OpenFile[name: f];
r: AIS.Raster ← AIS.ReadRaster[fd];
AIS.CloseFile[fd];
RETURN [r.scanCount, r.scanLength];
END;
ComputeAISBox:
PROC [state: State]
RETURNS [scanStart, pixelStart, scans, pixels:
CARDINAL] =
BEGIN
y: REAL ← (state.scans * 1.0) - (state.prevDragY/state.scale);
yStart: REAL ← (state.scans * 1.0) - (state.yStart/state.scale);
x: REAL ← state.prevDragX/state.scale;
xStart: REAL ← state.xStart/state.scale;
IF y < yStart
THEN {scanStart ← Real.RoundC[y]; scans ← Real.RoundC[yStart] - scanStart}
ELSE {scanStart ← Real.RoundC[yStart]; scans ← Real.RoundC[y] - scanStart};
IF x < xStart
THEN {pixelStart ← Real.RoundC[x]; pixels ← Real.RoundC[xStart] - pixelStart}
ELSE {pixelStart ← Real.RoundC[xStart]; pixels ← Real.RoundC[x] - pixelStart};
END;
ComputeRealAISBox:
PROC [state: State]
RETURNS [scanStart, pixelStart, scans, pixels:
REAL] =
BEGIN
y: REAL ← (state.scans * 1.0) - (state.prevDragY/state.scale);
yStart: REAL ← (state.scans * 1.0) - (state.yStart/state.scale);
x: REAL ← state.prevDragX/state.scale;
xStart: REAL ← state.xStart/state.scale;
IF y < yStart
THEN {scanStart ← y; scans ← yStart - scanStart}
ELSE {scanStart ← yStart; scans ← y - scanStart};
IF x < xStart
THEN {pixelStart ← x; pixels ← xStart - pixelStart}
ELSE {pixelStart ← xStart; pixels ← x - pixelStart};
END;
RegisterAISViewer[];
END.