CtViewerImpl:
CEDAR
MONITOR
IMPORTS BasicTime, CtBasic, CtMap, Imager, ImagerBackdoor, InputFocus, IO, KeyNames, MessageWindow, SafeStorage, SF, TIPUser, UserInputOps, ViewerAbort, ViewerOps, ViewersWorld, ViewersWorldInstance
EXPORTS CtViewer
Types and Viewer Data Access
IntegerPair: TYPE ~ CtBasic.IntegerPair;
SampleMaps: TYPE ~ CtBasic.SampleMaps;
Cmap: TYPE ~ CtMap.Cmap;
Mouse: TYPE ~ CtViewer.Mouse;
MouseProc: TYPE ~ CtViewer.MouseProc;
PollProc: TYPE ~ CtViewer.PollProc;
Origin: TYPE ~ CtViewer.Origin;
ViewerProc: TYPE ~ CtViewer.ViewerProc;
Context: TYPE ~ Imager.Context;
Vec: TYPE ~ ImagerSample.Vec;
ROPE: TYPE ~ Rope.ROPE;
Box: TYPE ~ SF.Box;
Viewer: TYPE ~ ViewerClasses.Viewer;
ViewerClass:
TYPE ~ ViewerClasses.ViewerClass;
currentViewer:
PUBLIC Viewer ¬
NIL;
CtData: TYPE ~ REF CtDataRep;
CtDataRep:
TYPE ~
RECORD [
notify: BOOL ¬ TRUE,
lastAffect: Box ¬ [[0, 0], [0, 0]],
buffer: SampleMaps ¬ NIL,
save: SampleMaps ¬ NIL,
bb: BoundingBox ¬ NIL,
mouseRegistry: MouseList ¬ NIL,
cmap: Cmap ¬ NIL,
action: ViewerProc ¬ NIL,
size: Vec ¬ [0, 0],
clientData: REF ANY ¬ NIL
];
BoundingBoxProc:
TYPE ~ CtViewer.BoundingBoxProc;
BoundingBoxPick:
TYPE
~
RECORD [
x0, x1, y0, y1: BOOL ¬ FALSE,
one, all: BOOL ¬ FALSE,
origin: IntegerPair ¬ [0, 0]
];
BoundingBox: TYPE ~ REF BoundingBoxRep;
BoundingBoxRep:
TYPE ~
RECORD [
active: BOOL ¬ FALSE,
busy: BOOL ¬ FALSE,
pick: BoundingBoxPick ¬ [],
mouseState: CtViewer.MouseState ¬ up, -- current mouse status
mousePos: IntegerPair ¬ [0, 0], -- current mouse position
x0, y0, x1, y1: INTEGER ¬ 0, -- box location
old, new: Box ¬ [[0, 0], [0, 0]], -- previous, current bounding boxes
action: BoundingBoxProc ¬ NIL,
clientData: REF ANY ¬ NIL,
save: ViewerClass ¬ NIL, -- for arrested viewers
count: INTEGER ¬ 0 -- limited # mouse events till done
];
MouseData: TYPE ~ RECORD [mouse: MouseProc, clientData: REF ANY, origin: Origin];
MouseList:
TYPE ~
LIST
OF MouseData;
GetData:
PROC [viewer: Viewer]
RETURNS [ctData: CtData] ~ {
Guarranteed non-nil return. viewer.data reserved for the viewer maker.
N.B.
CtData is local; the NARROW fails for new versions of CtViewerImpl that access a pre-existing ColorTrix viewer. Destroy old ColorTrix viewers if a new CtViewerImpl is run.
IF (ctData ¬
NARROW[ViewerOps.FetchProp[viewer, $CtData]]) =
NIL
THEN {
ctData ¬ NEW[CtDataRep];
ctData.bb ¬ NEW[BoundingBoxRep];
ctData.size ¬ -- [viewer.cw, viewer.ch] -- [0, 0]; -- buffer entire viewer upon opening
ViewerOps.AddProp[viewer, $CtData, ctData];
};
};
Viewer Image Operations
ArrestViewer:
PROC [viewer: Viewer]
RETURNS [save: ViewerClass ¬
NIL] ~ {
IF viewer.class # ctClass
THEN {
viewer.class ¬ NEW[ViewerClasses.ViewerClassRec ¬ (save ¬ viewer.class)];
viewer.class ¬ ctClass; -- kablam!
viewer.tipTable ¬ ctClass.tipTable; -- also needed
};
};
ReleaseViewer:
PROC [viewer: Viewer, save: ViewerClass] ~ {
IF save # NIL THEN {viewer.class ¬ save; viewer.tipTable ¬ save.tipTable};
};
DoWithViewer:
PUBLIC
PROC [
viewer: Viewer,
action: ViewerProc,
clientData: REF ANY ¬ NIL]
~ {
IF viewer #
NIL
AND
NOT viewer.iconic
THEN {
AssignAction: PROC ~ {ctData.action ¬ action};
save: ViewerClass ¬ ArrestViewer[viewer];
clear, unsafe: BOOL ¬ FALSE;
ctData: CtData ¬ GetData[viewer]; -- only one per viewer
AssignAction[ ! SafeStorage.UnsafeProcAssignment => {unsafe ¬ TRUE; CONTINUE}];
IF unsafe THEN TRUSTED {ctData.action ¬ action};
ctData.clientData ¬ clientData;
IF viewer.iconic THEN {clear ← TRUE; ViewerOps.OpenIcon[viewer]};
ViewerOps.PaintViewer[viewer, client, clear, $DoWithViewer];
IF unsafe THEN ctData.action ¬ NIL;
ReleaseViewer[viewer, save];
};
};
DoWithNamedViewer:
PUBLIC
PROC [
name: ROPE ¬ "ColorTrix",
action: ViewerProc,
clientData: REF ANY ¬ NIL,
column: ViewerClasses.Column ¬ left,
openHeight: NAT ¬ 300,
paint, top, closeOthers: BOOL ¬ FALSE]
RETURNS [viewer: Viewer]
~ {
viewer ¬ GetViewer[name, column, openHeight, paint, top, closeOthers];
DoWithViewer[viewer, action, clientData];
};
GetViewer:
PUBLIC
PROC [
name: ROPE,
column: ViewerClasses.Column ¬ left,
openHeight: NAT ¬ 300,
paint, top, closeOthers: BOOL ¬ FALSE]
RETURNS [v: Viewer] ~ {
IF (v ¬ ViewerOps.FindViewer[name]) =
NIL
THEN v ¬ ViewerOps.CreateViewer[
$CtViewer, [name: name, column: column, openHeight: openHeight+13]];
IF v.iconic AND paint THEN ViewerOps.OpenIcon[v, closeOthers, NOT top, paint];
};
Buffering
Union:
PROC [box1, box2: Box]
RETURNS [u: Box] ~ {
u ¬ [SF.Min[box1.min, box2.min], SF.Max[box1.max, box2.max]];
};
GetBuffer:
PUBLIC PROC [viewer: Viewer]
RETURNS [SampleMaps] ~ {
RETURN[GetData[viewer].buffer];
};
GetSave:
PUBLIC
PROC
[viewer:
Viewer]
RETURNS
[s:
SampleMaps]
~
{s
¬
GetData[viewer].save};
PutSave:
PUBLIC
PROC [viewer: Viewer, save: SampleMaps] ~ {
GetData[viewer].save ¬ save; -- apparently not needed
};
CopyMaps:
PROC [maps: SampleMaps, box: Box]
RETURNS [s: SampleMaps] ~ {
x, y, w, h: INTEGER;
{
ENABLE
UNCAUGHT =>
GOTO Bad;
[x, y, w, h] ¬ CtBasic.XYWHFromBox[box];
s ¬ CtBasic.CopyOfMaps[maps, x, y, w, h];
EXITS Bad =>
MessageWindow.Append[
IO.PutFLR[
"BAD CopyMaps: %g, %g, %g, %g (maps: %g, %g, %g, %g)",
LIST[
IO.int[x], IO.int[y], IO.int[w], IO.int[h],
IO.int[maps.x], IO.int[maps.y], IO.int[maps.w], IO.int[maps.h]]], TRUE];
};
};
MakeMaps:
PROC [bpp:
NAT, b: Box]
RETURNS [s: SampleMaps] ~ {
s ¬ CtBasic.CreateMaps[bpp, b.min.f, b.min.s, b.max.f-b.min.f, b.max.s-b.min.s];
};
ProperBox:
PROC [in: Box]
RETURNS [Box] ~ {
IF in.min.f > in.max.f THEN {i: INTEGER ¬ in.min.f; in.min.f ¬ in.max.f; in.max.f ¬ i};
IF in.min.s > in.max.s THEN {i: INTEGER ¬ in.min.s; in.min.s ¬ in.max.s; in.max.s ¬ i};
RETURN[in];
};
PutBuffer:
PUBLIC
PROC [viewer: Viewer, maps: SampleMaps, affectedRegion: Box] ~ {
ctData: CtData;
IF
SF.Nonempty[affectedRegion]
AND (ctData ¬ GetData[viewer]) #
NIL
THEN {
affectedRegion ¬ SF.Intersect[ProperBox[affectedRegion], maps.box];
IF ctData.buffer =
NIL
THEN ctData.buffer ¬ MakeMaps[maps.bpp, affectedRegion]
ELSE
IF
SF.Intersect[ctData.buffer.box, affectedRegion] # affectedRegion
THEN {
-- grow
tmp: SampleMaps ¬ MakeMaps[maps.bpp, Union[affectedRegion, ctData.buffer.box]];
CtBasic.CopyMaps[ctData.buffer, tmp];
CtBasic.ReleaseDescriptors[ctData.buffer];
ctData.buffer ¬ tmp;
};
ctData.save ¬ CopyMaps[ctData.buffer, affectedRegion];
CtBasic.CopyClippedMaps[maps, ctData.buffer, affectedRegion, affectedRegion];
};
};
Paint
Debug:
PUBLIC
PROC [set:
BOOL] ~ {debug ¬ set};
Paint: ViewerClasses.PaintProc ~ {
ViewerAbortAction:
PROC ~ {
ENABLE
UNCAUGHT =>
IF debug
THEN ERROR
ELSE {Blink["unknown error"]; GOTO Bad};
SampleMapsAction:
PROC [maps: SampleMaps] ~ {
UnBuffer:
PROC ~ {
IF ctData.buffer # NIL THEN CtBasic.CopyMaps[ctData.buffer, maps];
};
ClientAction:
PROC ~ {
ENABLE UNWIND => GOTO Abort;
IF ctData.action #
NIL
THEN {
ctData.lastAffect ¬ maps.box;
ctData.lastAffect
¬
ctData.action[self,
maps,
context, ctData.clientData
! ABORTED => {Blink["aborted"]; GOTO Abort}].affectedRegion;
somehow the aborted proc doesn't seem to truly exit
e.g., if it's an entry proc, then a subsequent invocation will result in deadlock.
PutBuffer[self, maps, ctData.lastAffect]; -- commit to previous action
};
EXITS Abort => NULL; -- this should accommodate entry procs
};
SELECT whatChanged
FROM
NIL => IF self.cw # ctData.size.s OR self.ch # ctData.size.f
THEN { -- this was a nice idea, but too many related problems
ctData.size ¬ [self.cw, self.ch];
PutBuffer[self, maps, maps.box]; -- store entire viewer for subsequent undo
ClientAction[];
}
ELSE UnBuffer[];
$DoWithViewer => ClientAction[];
ENDCASE => UnBuffer[];
};
IF whatChanged # $BoundingBox
THEN CtBasic.DoWithSampleMapsFromContext[context, SampleMapsAction];
IF whatChanged # $DoWithViewer
THEN BoundingBoxDraw[context, whatChanged, ctData.bb];
EXITS Bad => NULL;
};
ctData: CtData ¬ GetData[self];
ViewerAbort.CallWithAbortEnabled[self, ViewerAbortAction];
};
xorStipple: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 122645B, xor:
TRUE];
OrderBox:
PUBLIC PROC [box: Box]
RETURNS [Box] ~ {
RETURN[[SF.Min[box.min, box.max], SF.Max[box.min, box.max]]];
};
XOR:
PUBLIC PROC [context: Context, box: Box] ~ {
size: Vec ¬ SF.Size[box];
IF size.f = 0 AND size.s = 0 THEN RETURN;
Imager.SetColor[context, xorStipple];
Imager.MaskRectangle[context, [box.min.f-3.0, box.min.s-3.0, 3.0, size.s+6.0]]; -- left
Imager.MaskRectangle[context, [box.max.f, box.min.s-3.0, 3.0, size.s+6.0]]; -- right
Imager.MaskRectangle[context, [box.min.f, box.min.s-3.0, size.f, 3.0]]; -- top
Imager.MaskRectangle[context, [box.min.f, box.max.s, size.f, 3.0]]; -- bottom
};
Mouse Access
viewersWorld: ViewersWorldRefType.Ref ¬ ViewersWorldInstance.GetWorld[];
capH: INTEGER ¬ 14; -- height of viewer caption
userInput: UserInputOps.Handle ¬ ViewersWorld.GetInputHandle[viewersWorld];
leftShift: KeyTypes.KeySym ¬ KeyNames.KeySymFromName["LeftShift"];
rightShift: KeyTypes.KeySym ¬ KeyNames.KeySymFromName["RighShift"];
control: KeyTypes.KeySym ¬ KeyNames.KeySymFromName["LeftControl"];
leftMouse: KeyTypes.KeySym ¬ KeyNames.KeySymFromName["LeftMouse"];
middleMouse: KeyTypes.KeySym ¬ KeyNames.KeySymFromName["MiddleMouse"];
rightMouse: KeyTypes.KeySym ¬ KeyNames.KeySymFromName["RightMouse"];
GetMousePos:
PUBLIC
PROC [viewer: Viewer, origin: Origin ¬ upperLeft]
RETURNS [pos: IntegerPair]
~ {
[pos.x, pos.y] ¬ ViewersWorld.GetMousePosition[viewersWorld];
pos.x ¬ pos.x-viewer.wx;
pos.y ¬ IF origin = upperLeft THEN viewer.wy+viewer.wh-capH-pos.y ELSE pos.y-viewer.wy;
};
KeyDown:
PUBLIC
PROC [key: KeyTypes.KeySym]
RETURNS [b:
BOOL] ~ {
RETURN[UserInputOps.GetLatestKeySymState[userInput, key] = down];
};
MouseAllUp:
PUBLIC
PROC
RETURNS [
BOOL] ~ {
RETURN[
NOT KeyDown[leftMouse]
AND
NOT KeyDown[middleMouse] AND
NOT KeyDown[rightMouse]];
};
MouseInViewer:
PUBLIC PROC [viewer: Viewer]
RETURNS [
BOOL] ~ {
pos: IntegerPair ¬ GetMousePos[viewer];
RETURN[pos.x IN [0..viewer.ww] AND pos.y IN [0..viewer.wh]];
};
ChangeOrigin:
PUBLIC
PROC [pos: IntegerPair, viewer: Viewer, old, new: Origin]
RETURNS [IntegerPair]
~ {
RETURN[IF new = old THEN pos ELSE [pos.x, viewer.wh-pos.y]];
};
DoWhileMouseDown:
PUBLIC
PROC [
viewer: Viewer,
action: PollProc,
origin: Origin ¬ upperLeft]
~ {
ctData: CtData ¬ GetData[viewer];
ctData.notify ¬ FALSE;
DO
pos: IntegerPair ¬ GetMousePos[viewer, origin];
IF pos.x
NOT
IN [0..viewer.ww]
OR
pos.y NOT IN [0..viewer.wh] OR
MouseAllUp[] OR
(action #
NIL
AND
NOT action[pos])
THEN EXIT;
ENDLOOP;
ctData.notify ¬ TRUE;
};
Mouse Registration
GetMouseRegistry:
PROC
[v:
Viewer]
RETURNS
[MouseList]
~
{
RETURN[GetData[v].mouseRegistry];
};
RegisterMouse:
PUBLIC
PROC
[
viewer: Viewer,
mouse: MouseProc,
clientData: REF ANY ¬ NIL,
origin: Origin ¬ upperLeft]
~ {
c: CtData ¬ GetData[viewer];
m: MouseData ¬ [mouse, clientData, origin];
UnregisterMouse[viewer, mouse];
c.mouseRegistry ¬ IF c.mouseRegistry # NIL THEN CONS[m, c.mouseRegistry] ELSE LIST[m];
};
UnregisterMouse:
PUBLIC PROC [viewer: Viewer, mouse: MouseProc] ~ {
c: CtData ¬ GetData[viewer];
list, prev: MouseList ¬ c.mouseRegistry;
FOR l: MouseList ¬ list, l.rest
WHILE l #
NIL
DO
IF l.first.mouse = mouse
THEN {
IF l = list THEN c.mouseRegistry ¬ l.rest ELSE prev.rest ¬ l.rest;
EXIT;
};
prev ¬ l;
ENDLOOP;
};
Bounding Box
EnableBoundingBox:
PUBLIC ENTRY PROC [
viewer: Viewer,
action: BoundingBoxProc ¬ NIL,
clientData: REF ANY ¬ NIL]
~ {
IF viewer #
NIL
THEN {
b: BoundingBox ¬ GetData[viewer].bb;
b.action ¬ action;
b.clientData ¬ clientData;
b.active ¬ TRUE;
b.save ¬ ArrestViewer[viewer];
Following lines so box can be adjusted given mouse held even if no prior mouse down:
b.x0 ¬ b.x1 ¬ b.y0 ¬ b.y1 ¬ 0;
b.mousePos ¬ GetMousePos[viewer, lowerLeft]; -- probably irrelevant
b.pick.x0 ¬ b.pick.x1 ¬ b.pick.y0 ¬ b.pick.y1 ¬ b.pick.one ¬ b.pick.all ¬ FALSE;
};
};
DisableBoundingBox:
PUBLIC ENTRY PROC [viewer: Viewer]
RETURNS [result: Box] ~ {
IF viewer #
NIL
AND viewer.class.notify = Notify
THEN {
b: BoundingBox ¬ GetData[viewer].bb;
size: Vec ¬ SF.Size[b.new];
b.active ¬ FALSE;
result ¬ CtBasic.BoxFromRectangle[[b.new.min.f, viewer.ch-b.new.max.s, size.f, size.s]];
b.x0 ¬ b.x1 ¬ b.y0 ¬ b.y1 ¬ 0;
ViewerOps.PaintViewer[viewer, client, FALSE, $BoundingBox];
ReleaseViewer[viewer, b.save];
};
};
GetBoundingBox:
PUBLIC
PROC [
viewer: Viewer,
start: Vec,
context: Context ¬ NIL,
origin: Origin ¬ lowerLeft]
RETURNS [b: Box]
~ {
Action: ViewerProc ~ {
save: ATOM ¬ maps[0].type;
Inner[CtBasic.ContextFromSampleMaps[maps, TRUE]];
maps[0].type ¬ save;
};
Inner:
PROC [context: Context] ~ {
Poll: PollProc ~ {
pos.y
¬
IF origin
=
upperLeft
THEN viewer.wy+viewer.wh-capH-pos.y
ELSE pos.y-viewer.wy;
pos.y ¬ viewer.wh-pos.y; -- context origin is at lower left (viewer at upper left)
IF b.max # [pos.y, pos.x]
THEN {
XOR[context, b];
b ¬ OrderBox[[start, [pos.y, pos.x]]];
XOR[context, b];
};
};
DoWhileMouseDown[viewer, Poll, origin];
XOR[context, b ¬ OrderBox[b]];
};
b ¬ [start, start];
IF context #
NIL
THEN [] ¬ Inner[context]
ELSE DoWithViewer[viewer, Action];
IF origin = upperLeft THEN {b.min.s ¬ viewer.wh-b.min.s; b.max.s ¬ viewer.wh-b.max.s};
b ¬ OrderBox[b];
};
InitBoundingBox:
PROC [b: BoundingBox] ~ {
wOver4, hOver4: NAT;
b.pick.x0 ¬ b.pick.x1 ¬ b.pick.y0 ¬ b.pick.y1 ¬ b.pick.one ¬ b.pick.all ¬ FALSE;
IF b.x0 > b.x1 THEN {t: NAT ¬ b.x0; b.x0 ¬ b.x1; b.x1 ¬ t};
IF b.y0 > b.y1 THEN {t: NAT ¬ b.y0; b.y0 ¬ b.y1; b.y1 ¬ t};
wOver4 ¬ (b.x1-b.x0)/4;
hOver4 ¬ (b.y1-b.y0)/4;
IF b.x0 = 0
AND b.x1 = 0
AND b.y0 = 0
AND b.y1 = 0
THEN {
b.x0 ¬ b.x1 ¬ b.mousePos.x;
b.y0 ¬ b.y1 ¬ b.mousePos.y;
b.pick.x1 ¬ b.pick.y1 ¬ TRUE;
}
ELSE {
SELECT b.mousePos.x
FROM
< b.x0+wOver4 => b.pick.x0 ¬ TRUE;
> b.x1-wOver4 => b.pick.x1 ¬ TRUE;
ENDCASE => b.pick.one ¬ TRUE;
SELECT b.mousePos.y
FROM
< b.y0+hOver4 => b.pick.y0 ¬ TRUE;
> b.y1-hOver4 => b.pick.y1 ¬ TRUE;
ENDCASE =>
IF b.pick.one
THEN {
b.pick.all ¬ TRUE;
b.pick.origin ¬ b.mousePos;
};
};
};
BoundingBoxDraw:
PROC [c: Context, whatChanged:
REF, b: BoundingBox] ~ {
IF b.active
THEN
SELECT b.mouseState
FROM
down => InitBoundingBox[b];
held =>
IF b.pick.all
THEN {
dx: INTEGER ¬ b.mousePos.x-b.pick.origin.x;
dy: INTEGER ¬ b.mousePos.y-b.pick.origin.y;
b.x0 ¬ b.x0+dx;
b.x1 ¬ b.x1+dx;
b.y0 ¬ b.y0+dy;
b.y1 ¬ b.y1+dy;
b.pick.origin ¬ b.mousePos;
}
ELSE {
IF b.pick.x0
THEN b.x0 ¬ b.mousePos.x
ELSE IF b.pick.x1 THEN b.x1 ¬ b.mousePos.x;
IF b.pick.y0
THEN b.y0 ¬ b.mousePos.y
ELSE IF b.pick.y1 THEN b.y1 ¬ b.mousePos.y;
};
ENDCASE => IF (b.count ¬ b.count+1) > 25 THEN b.active ¬ FALSE; -- escape valve
IF b.action # NIL AND NOT b.action[b.new, b.clientData] THEN b.active ¬ FALSE;
IF whatChanged # NIL THEN XOR[c, b.old];
IF
NOT b.active
THEN b.new.max ¬ b.new.min
ELSE XOR[c, b.new ¬ OrderBox[[[b.y0, b.x0], [b.y1, b.x1]]]];
b.old ¬ b.new;
b.busy ¬ FALSE;
};