Host/Mod/Mechanisms.odc

MODULE HostMechanisms;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT COM,
		USER32, WinOle, WinApi, OleData, 
		Services, Ports, Stores, Models, Sequencers, Views, Controllers, Properties,
		Dialog, Mechanisms, Containers, Documents, Windows,
		HostPorts;


	CONST
		handleSize = Ports.point * 11 DIV 2;
		clipMiddleHandle = handleSize DIV 2 + 2 * Ports.point;
		infiniteMiddleHandle = 48 * Ports.point;
		targetBorderSize = 2;

		outside = 0; left = 1; top = 2; right = 3; bottom = 4;

		pick = -1; escape = -2;
		both = 31; iclick = 30;
		
		fixed = 31;	(* controller option *)


	TYPE
		IDropSource = POINTER TO RECORD (WinOle.IDropSource)
			key: SET
		END;
		
		IDropTarget = POINTER TO RECORD (WinOle.IDropTarget)
			win: Windows.Window;
			wnd: WinApi.HWND;
			x, y: INTEGER;
			key, effect: SET;
			source: Views.Frame;
			srcX, srcY: INTEGER;
			type: Stores.TypeName;
			isSingle: BOOLEAN;
			w, h, rx, ry: INTEGER;
		END;
		
		Hook = POINTER TO RECORD (Mechanisms.Hook) END;
		
	
	VAR
		sourceFrame: Views.Frame;	(* source of drag & drop *)
		sourceX, sourceY: INTEGER;
		targetFrame: Views.Frame;	(* target of drag & drop *)
		targetX, targetY: INTEGER;
		dropView: Views.View;	(* view to drop *)
		isSingleton: BOOLEAN;
		dropW, dropH: INTEGER;
		relX, relY: INTEGER;
		
	
	(** focus borders **)

	PROCEDURE Fixed (host: Views.Frame; v: Views.View): BOOLEAN;
		VAR sp: Properties.ResizePref; c: Containers.Controller;
	BEGIN
		c := host.view(Containers.View).ThisController();
		IF c.opts * {Containers.noCaret, Documents.pageWidth..Documents.winHeight, fixed} # {} THEN
			RETURN TRUE
		END;
		sp.fixed := FALSE; Views.HandlePropMsg(v, sp); RETURN sp.fixed
	END Fixed;

	PROCEDURE PaintFocusBorder (f: Views.Frame; focus: Views.View; l, t, r, b: INTEGER);
		VAR u, s,  w, h,  mx, my,  l0, t0, r0, b0: INTEGER;
		
		PROCEDURE PaintHandle (x, y: INTEGER; l, t, r, b: BOOLEAN);
		BEGIN
			IF l THEN f.DrawRect(x - u, y, x, y + s, Ports.fill, Ports.background) END;
			IF t THEN f.DrawRect(x, y - u, x + s, y, Ports.fill, Ports.background) END;
			IF r THEN f.DrawRect(x + s, y, x + s + u, y + s, Ports.fill, Ports.background) END;
			IF b THEN f.DrawRect(x, y + s, x + s, y + s + u, Ports.fill, Ports.background) END;
			f.DrawRect(x, y, x + s, y + s, Ports.fill, Ports.defaultColor)
		END PaintHandle;
		
	BEGIN
		f.rider.GetRect(l0, t0, r0, b0);
		s := (handleSize - f.dot) DIV f.unit;
		f.rider.SetRect(l0 - s, t0 - s, r0 + s, b0 + s);
		u := f.dot; s := s * f.unit;
		w := r - l; h := b - t;
		f.DrawRect(l, t - s, r, t, Ports.fill, Ports.background);
		f.DrawRect(l, b, r, b + s, Ports.fill, Ports.background);
		f.DrawRect(l - s, t - s, l, b + s, Ports.fill, Ports.background);
		f.DrawRect(r, t - s, r + s, b + s, Ports.fill, Ports.background);
		DEC(s, u);
		f.MarkRect(l, t - s, r, t, Ports.fill, HostPorts.focusPat, Ports.show);
		f.MarkRect(l, b, r, b + s, Ports.fill, HostPorts.focusPat, Ports.show);
		f.MarkRect(l - s, t - s, l, b + s, Ports.fill, HostPorts.focusPat, Ports.show);
		f.MarkRect(r, t - s, r + s, b + s, Ports.fill, HostPorts.focusPat, Ports.show);
		IF ~Fixed(f, focus) THEN
			PaintHandle(l - s, t - s, FALSE, FALSE, TRUE, TRUE);
			PaintHandle(r, t - s, TRUE, FALSE, FALSE, TRUE);
			PaintHandle(l - s, b, FALSE, TRUE, TRUE, FALSE);
			PaintHandle(r, b, TRUE, TRUE, FALSE, FALSE);
			IF w > 2 * clipMiddleHandle THEN
				mx := (l + r - s) DIV 2;
				PaintHandle(mx, t - s, TRUE, FALSE, TRUE, FALSE);
				PaintHandle(mx, b, TRUE, FALSE, TRUE, FALSE)
			END;
			IF h > 2 * clipMiddleHandle THEN
				my := (t + b - s) DIV 2;
				PaintHandle(l - s, my, FALSE, TRUE, FALSE, TRUE);
				PaintHandle(r, my, FALSE, TRUE, FALSE, TRUE)
			END
		END;
		f.DrawRect(l - u, t - u, r + u, b + u, u, Ports.defaultColor);
		f.rider.SetRect(l0, t0, r0, b0)
	END PaintFocusBorder;

	PROCEDURE (hook: Hook) FocusBorderCursor* (f: Views.Frame; view: Views.View; l, t, r, b: INTEGER;
									x, y: INTEGER): INTEGER;
		VAR s, u, w, h, mx, my: INTEGER; cursor: INTEGER;
		
		PROCEDURE CheckHandle (x0, y0: INTEGER; c: INTEGER);
		BEGIN
			IF (x >= x0 - u) & (x <= x0 + s) & (y >= y0 - u) & (y <= y0 + s) THEN
				cursor := c
			END
		END CheckHandle;
		
	BEGIN
		u := f.dot; s := handleSize - 2 * u;
		IF (x < l - s) OR (x > r + s) OR (y < t - s) OR (y > b + s) THEN
			cursor := Mechanisms.outside
		ELSE
			cursor := Mechanisms.inside
		END;
		w := r - l; h := b - t;
		IF ~Fixed(f, view) THEN
			CheckHandle(l - s, t - s, HostPorts.resizeLCursor);
			CheckHandle(r, t - s, HostPorts.resizeRCursor);
			CheckHandle(l - s, b, HostPorts.resizeRCursor);
			CheckHandle(r, b, HostPorts.resizeLCursor);
			IF w > 2 * clipMiddleHandle THEN
				mx := (l + r - s) DIV 2;
				CheckHandle(mx, t - s, HostPorts.resizeVCursor);
				CheckHandle(mx, b, HostPorts.resizeVCursor)
			END;
			IF h > 2 * clipMiddleHandle THEN
				my := (t + b - s) DIV 2;
				CheckHandle(l - s, my, HostPorts.resizeHCursor);
				CheckHandle(r, my, HostPorts.resizeHCursor)
			END
		END;
		RETURN cursor
	END FocusBorderCursor;

	PROCEDURE RestoreBorderArea (f: Views.Frame; l, t, r, b: INTEGER);
	(* restore area under destructive border mark *)
		VAR g: Views.RootFrame; res, s, dx, dy: INTEGER;
	BEGIN
		g := Views.RootOf(f);
		dx := f.gx - g.gx; dy := f.gy - g.gy;
		s := (handleSize - f.dot) DIV f.unit * f.unit;
		INC(l, dx); INC(t, dy); INC(r, dx); INC(b, dy);
(*
		Views.UpdateRoot(g, l - s, t - s, r + s, b + s, FALSE);
*)
		Views.ValidateRoot(g);
		Views.RestoreRoot(g, l - s, t - s, r + s, b + s);
(*
		Views.RestoreRoot(g, l - s, t - s, r + s, t);
		Views.RestoreRoot(g, l - s, t, l, b);
		Views.RestoreRoot(g, r, t, r + s, b);
		Views.RestoreRoot(g, l - s, b, r + s, b + s)
*)
	END RestoreBorderArea;
	
	PROCEDURE (hook: Hook) MarkFocusBorder* (
		host: Views.Frame; focus: Views.View; l, t, r, b: INTEGER; show: BOOLEAN
	);
	BEGIN
		IF focus # NIL THEN
			IF show THEN
				PaintFocusBorder(host, focus, l, t, r, b)
			ELSE
				RestoreBorderArea(host, l, t, r, b)
			END
		END
	END MarkFocusBorder;
	

	(** selection borders **)

	PROCEDURE PaintSelBorder (f: Views.Frame; view: Views.View; l, t, r, b: INTEGER);
		VAR res, u, d, w, h,  mx, my: INTEGER; sizeable: BOOLEAN; l0, t0, r0, b0: INTEGER;
		
		PROCEDURE PaintHandle (x, y: INTEGER);
			VAR s: INTEGER; ci, co: Ports.Color;
		BEGIN
			DEC(x, d); DEC(y, d); s := d * 2 + u;
			IF sizeable THEN ci := HostPorts.selBackground; co := HostPorts.selTextCol
			ELSE ci := HostPorts.selTextCol; co := HostPorts.selBackground
			END;
			f.DrawRect(x, y, x + s, y + s, Ports.fill, co);
			INC(x, u); INC(y, u); DEC(s, 2 * u);
			f.DrawRect(x, y, x + s, y + s, Ports.fill, ci);
(*			
			f.DrawRect(x, y, x + s, y + s, Ports.fill, ci);
			f.DrawRect(x, y, x + s, y + s, 0, co)
*)
		END PaintHandle;
		
	BEGIN
		d := (handleSize - f.dot) DIV f.unit DIV 2;
		f.rider.GetRect(l0, t0, r0, b0);
		f.rider.SetRect(l0 - d - 1, t0 - d - 1, r0 + d + 1, b0 + d + 1);
		d := d * f.unit; u := f.dot;
		w := r - l; h := b - t; sizeable := ~Fixed(f, view);
		DEC(l, u); DEC(t, u);
(*
		f.SaveRect(l - d, t - d, r + u + d, b + u + d, res);
*)
		f.DrawRect(l, t, r + u, b + u, u, HostPorts.selBackground);
		IF f.front THEN
			IF (w > clipMiddleHandle) & (h > clipMiddleHandle) THEN
				PaintHandle(l, t);
				PaintHandle(r, t);
				PaintHandle(l, b);
				PaintHandle(r, b);
				IF w > 2 * clipMiddleHandle THEN
					mx := (l + r) DIV 2;
					PaintHandle(mx, t);
					PaintHandle(mx, b)
				END;
				IF h > 2 * clipMiddleHandle THEN
					my := (t + b) DIV 2;
					PaintHandle(l, my);
					PaintHandle(r, my)
				END
			ELSIF sizeable THEN
				PaintHandle(r, b)
			END
		END;
		f.rider.SetRect(l0, t0, r0, b0)
	END PaintSelBorder;

	PROCEDURE (hook: Hook) SelBorderCursor* (f: Views.Frame; view: Views.View; l, t, r, b: INTEGER;
									x, y: INTEGER): INTEGER;
		VAR d, u, w, h, mx, my: INTEGER; cursor: INTEGER;
		
		PROCEDURE CheckHandle (x0, y0: INTEGER; c: INTEGER);
		BEGIN
			IF (x >= x0 - d) & (x <= x0 + d) & (y >= y0 - d) & (y <= y0 + d) THEN
				cursor := c
			END
		END CheckHandle;
		
	BEGIN
		IF (x < l) OR (x > r) OR (y < t) OR (y > b) THEN cursor := Mechanisms.outside
		ELSE cursor := Mechanisms.inside
		END;
		IF (view # NIL) & ~Fixed(f, view) THEN
			d := (handleSize - f.dot) DIV f.unit DIV 2 * f.unit;
			w := r - l; h := b - t; u := f.dot;
			DEC(l, u); DEC(t, u);
			IF (w > clipMiddleHandle) & (h > clipMiddleHandle) THEN
				CheckHandle(l, t, HostPorts.resizeLCursor);
				CheckHandle(r, t, HostPorts.resizeRCursor);
				CheckHandle(l, b, HostPorts.resizeRCursor);
				CheckHandle(r, b, HostPorts.resizeLCursor);
				IF w > 2 * clipMiddleHandle THEN
					mx := (l + r) DIV 2;
					CheckHandle(mx, t, HostPorts.resizeVCursor);
					CheckHandle(mx, b, HostPorts.resizeVCursor)
				END;
				IF h > 2 * clipMiddleHandle THEN
					my := (t + b) DIV 2;
					CheckHandle(l, my, HostPorts.resizeHCursor);
					CheckHandle(r, my, HostPorts.resizeHCursor)
				END
			ELSE
				CheckHandle(r, b, HostPorts.resizeLCursor)
			END
		END;
		RETURN cursor
	END SelBorderCursor;

	PROCEDURE RestoreViewArea (f: Views.Frame; l, t, r, b: INTEGER);
	(* restore area under destructive selection mark *)
		VAR g: Views.RootFrame; res, d, u, dx, dy: INTEGER;
	BEGIN
(*
		d := (handleSize - f.dot) DIV f.unit DIV 2 * f.unit + f.dot;
		f.RestoreRect(l - d, t - d, r + d, b + d, TRUE)
*)
		g := Views.RootOf(f);
		dx := f.gx - g.gx; dy := f.gy - g.gy;
		d := (handleSize - f.dot) DIV f.unit DIV 2 * f.unit + f.dot;
		INC(l, dx); INC(t, dy); INC(r, dx); INC(b, dy);
		Views.ValidateRoot(g);
		Views.RestoreRoot(g, l - d, t - d, r + d, b + d)
	END RestoreViewArea;

	PROCEDURE (hook: Hook) MarkSingletonBorder* (
		host: Views.Frame; view: Views.View; l, t, r, b: INTEGER; show: BOOLEAN
	);
	BEGIN
		IF view # NIL THEN
			IF show THEN
				PaintSelBorder(host, view, l, t, r, b)
			ELSE
				RestoreViewArea(host, l, t, r, b)
			END
		END
(*		
		IF view # NIL THEN InvertSelBorder(host, view, l, t, r, b, show) END
*)
	END MarkSingletonBorder;


(*
	PROCEDURE MarkBorder* (host: Ports.Frame; view: Stores.Store; l, t, r, b: INTEGER);
		VAR s: INTEGER;
	BEGIN
		IF view # NIL THEN 
			s := markBorderSize * host.dot;
			host.MarkRect(l - s, t - s, r + s, b + s, s, Ports.dim50, Ports.show)
		END
	END MarkBorder;
*)

	PROCEDURE (hook: Hook) TrackToResize* (host: Views.Frame; view: Views.View;
										minW, maxW, minH, maxH: INTEGER;
										VAR l, t, r, b: INTEGER; VAR op: INTEGER;
										VAR x, y: INTEGER; VAR buttons: SET);
		VAR area: SET; isDown: BOOLEAN; c: INTEGER; m: SET; p: Properties.SizePref;
			x1, y1,  dx, dy,  dl, dt, dr, db,  l0, t0, r0, b0,  l1, t1, r1, b1,  w, h,  dw, dh: INTEGER;
	BEGIN
		l0 := l; t0 := t; r0 := r; b0 := b;  dl := 0; dt := 0; dr := 0; db := 0;
		x1 := (l + r) DIV 2; y1 := (t + b) DIV 2;
		IF (r - l <= 2 * clipMiddleHandle) OR (ABS(x - x1) > handleSize DIV 2) THEN
			IF x < x1 THEN dl := 1 ELSE dr := 1 END
		END;
		IF (b - t <= 2 * clipMiddleHandle) OR (ABS(y - y1) > handleSize DIV 2) THEN
			IF y < y1 THEN dt := 1 ELSE db := 1 END
		END;
		IF (Controllers.extend IN buttons) & (dl # dr) THEN dl := 1; dr := 1 END;
		IF (Controllers.extend IN buttons) & (dt # db) THEN dt := 1; db := 1 END;
		host.MarkRect(l, t, r, b, 0, Ports.dim50, Ports.show);
		REPEAT
			host.Input(x1, y1, m, isDown);
			IF x1 < host.l THEN x1 := host.l ELSIF x1 > host.r THEN x1 := host.r END;
			IF y1 < host.t THEN y1 := host.t ELSIF y1 > host.b THEN y1 := host.b END;
			dx := x1 - x; dy := y1 - y;
			l1 := l0 + dl * dx; t1 := t0 + dt * dy; r1 := r0 + dr * dx; b1 := b0 + db * dy;
			w := r1 - l1; h := b1 - t1;
			IF (w > 0) & (h > 0) THEN
				p.fixedH := (dl = 0) & (dr = 0); p.fixedW := (dt = 0) & (db = 0);
				p.w := w; p.h := h; Views.HandlePropMsg(view, p); w := p.w; h := p.h;
				IF w < minW THEN w := minW ELSIF w > maxW THEN w := maxW END;
				IF h < minH THEN h := minH ELSIF h > maxH THEN h := maxH END;
				dw := w - (r1 - l1); dh := h - (b1 - t1);
				DEC(l1, dl * dw); DEC(t1, dt * dh);
				IF (dl + dr = 0) & (dw # 0) THEN INC(r1, dw) ELSE INC(r1, dr * dw) END;
				IF (dt + db = 0) & (dh # 0) THEN INC(b1, dh) ELSE INC(b1, db * dh) END;
				IF (l1 # l) OR (t1 # t) OR (r1 # r) OR (b1 # b) THEN
					host.MarkRect(l, t, r, b, 0, Ports.dim50, Ports.hide);
					l := l1; t := t1; r := r1; b := b1;
					host.MarkRect(l, t, r, b, 0, Ports.dim50, Ports.show)
				END
			END
		UNTIL ~isDown;
		host.MarkRect(l, t, r, b, 0, Ports.dim50, Ports.hide);
		x := x1; y := y1; buttons := {};
		IF (l # l0) OR (t # t0) OR (r # r0) OR (b # b0) THEN op := Mechanisms.resize
		ELSE op := Mechanisms.cancelResize
		END
	END TrackToResize;

	
	(* IDropSource *)
	
	PROCEDURE (this: IDropSource) QueryContinueDrag (
		escapePressed: WinApi.BOOL; keyState: SET
	): COM.RESULT;
	BEGIN
		IF this.key = {} THEN
			this.key := keyState * (WinApi.MK_LBUTTON + WinApi.MK_MBUTTON + WinApi.MK_RBUTTON)
		END;
		IF escapePressed # 0 THEN RETURN WinApi.DRAGDROP_S_CANCEL
		ELSIF keyState * this.key = {} THEN RETURN WinApi.DRAGDROP_S_DROP
		ELSE RETURN WinApi.S_OK
		END
	END QueryContinueDrag;
	
	PROCEDURE (this: IDropSource) GiveFeedback (effect: SET): COM.RESULT;
	BEGIN
		RETURN WinApi.DRAGDROP_S_USEDEFAULTCURSORS
	END GiveFeedback;
	

	(* IDropTarget *)

	PROCEDURE InstallDropTarget* (wnd: WinApi.HWND; win: Windows.Window);
		VAR drop: IDropTarget; res: COM.RESULT;
	BEGIN
		NEW(drop); drop.win := win; drop.wnd := wnd;
		res := WinOle.RegisterDragDrop(wnd, drop);
	END InstallDropTarget;
	
	PROCEDURE RemoveDropTarget* (wnd: WinApi.HWND);
		VAR res: COM.RESULT;
	BEGIN
		res := WinOle.RevokeDragDrop(wnd);
	END RemoveDropTarget;
	
	PROCEDURE PollDrop (d: IDropTarget; show: BOOLEAN);
		VAR msg: Controllers.PollDropMsg; w, h: INTEGER;
	BEGIN
		(* x, y in port coordinates of w *)
		d.win.port.GetSize(w, h);
		msg.x := d.x * d.win.port.unit;
		msg.y := d.y * d.win.port.unit;
		(* msg.x, msg.y in coordinates of target root frame *)
		msg.source := d.source; msg.sourceX := d.srcX; msg.sourceY := d.srcY;
		msg.mark := Controllers.mark; msg.show := show;
		msg.type := d.type; msg.isSingle := d.isSingle;
		msg.w := d.w; msg.h := d.h; msg.rx := d.rx; msg.ry := d.ry;
		msg.dest := NIL;
		d.win.ForwardCtrlMsg(msg);
		(* msg.x, msg.y in coordinates of target frame *)
		targetFrame := msg.dest; targetX := msg.x; targetY := msg.y
	END PollDrop;

	PROCEDURE Drop (d: IDropTarget; v: Views.View; w, h: INTEGER; isSingle: BOOLEAN);
		VAR msg: Controllers.DropMsg; pw, ph: INTEGER;
	BEGIN
		(* x, y in port coordinates of w *)
		d.win.port.GetSize(pw, ph);
		msg.x := d.x * d.win.port.unit;
		msg.y := d.y * d.win.port.unit;
		(* msg.x, msg.y in coordinates of target root frame *)
		msg.source := d.source; msg.sourceX := d.srcX; msg.sourceY := d.srcY;
		msg.view := v; msg.isSingle := isSingle;
		msg.w := w; msg.h := h; msg.rx := d.rx; msg.ry := d.ry;
		d.win.ForwardCtrlMsg(msg)
	END Drop;

	PROCEDURE AppendMenu (menu: USER32.Handle; id: INTEGER; name: Dialog.String);
		VAR res: INTEGER; sn: ARRAY 256 OF SHORTCHAR;
	BEGIN
		Dialog.MapString(name, name); sn := SHORT(name$);
		res := USER32.AppendMenuA(menu, {}, id, sn);
	END AppendMenu;

	PROCEDURE ShowPopup (f: Views.Frame; x, y: INTEGER; VAR effect: SET);
		VAR menu: USER32.Handle; res: INTEGER;
			wnd: USER32.Handle; msg: USER32.Message; pt: USER32.Point;
	BEGIN
		menu := USER32.CreatePopupMenu();
		AppendMenu(menu, 32000, "#Host:MoveHere");
		AppendMenu(menu, 32001, "#Host:CopyHere");
		AppendMenu(menu, 32002, "#Host:LinkHere");
		IF effect * WinOle.DROPEFFECT_MOVE = {} THEN
			res := USER32.EnableMenuItem(menu, 32000, {USER32.MFGrayed})
		END;
		IF effect * WinOle.DROPEFFECT_COPY = {} THEN
			res := USER32.EnableMenuItem(menu, 32001, {USER32.MFGrayed})
		END;
		IF effect * WinOle.DROPEFFECT_LINK = {} THEN
			res := USER32.EnableMenuItem(menu, 32002, {USER32.MFGrayed})
		END;
		res := USER32.AppendMenuA(menu, {USER32.MFSeparator}, 0, NIL);
		AppendMenu(menu, 32003, "#System:Cancel");
		wnd := f.rider(HostPorts.Rider).port.wnd;
		pt.x := (x + f.gx) DIV f.unit; pt.y := (y + f.gy) DIV f.unit;
		res := USER32.ClientToScreen(wnd, pt);
		res := USER32.TrackPopupMenu(menu, {1}, pt.x, pt.y, 0, wnd, NIL);
		res := USER32.DestroyMenu(menu);
		effect := WinOle.DROPEFFECT_NONE;
		IF USER32.PeekMessageA(msg, wnd, USER32.WMCommand, USER32.WMCommand, 1) # 0 THEN
			IF msg.wParam = 32000 THEN effect := WinOle.DROPEFFECT_MOVE
			ELSIF msg.wParam = 32001 THEN effect := WinOle.DROPEFFECT_COPY
			ELSIF msg.wParam = 32002 THEN effect := WinOle.DROPEFFECT_LINK
			END
		END
	END ShowPopup;
	
	PROCEDURE Effect (mask, keyState: SET): SET;
		VAR effect: SET;
	BEGIN
		IF (mask * WinOle.DROPEFFECT_LINK # {})
			& (((WinApi.MK_SHIFT + WinApi.MK_CONTROL) - keyState = {})
				OR (mask * (WinOle.DROPEFFECT_MOVE + WinOle.DROPEFFECT_COPY) = {})) THEN
					effect := WinOle.DROPEFFECT_LINK
		ELSIF (mask * WinOle.DROPEFFECT_COPY # {})
			& ((keyState * WinApi.MK_CONTROL # {})
				OR ((WinApi.MK_LBUTTON + WinApi.MK_RBUTTON) - keyState = {})
				OR (mask * WinOle.DROPEFFECT_MOVE = {})) THEN effect := WinOle.DROPEFFECT_COPY
		ELSIF mask * WinOle.DROPEFFECT_MOVE # {} THEN effect := WinOle.DROPEFFECT_MOVE
		ELSE effect := WinOle.DROPEFFECT_NONE
		END;
		RETURN effect
	END Effect;
	
	PROCEDURE (this: IDropTarget) DragEnter (dataObj: WinOle.IDataObject; keyState: SET; pt: WinApi.POINT;
																VAR effect: SET): COM.RESULT;
		VAR res, w, h, x, y: INTEGER; s: BOOLEAN;
	BEGIN
		IF sourceFrame # NIL THEN
			this.source := sourceFrame;
			this.srcX := sourceX; this.srcY := sourceY;
			Services.GetTypeName(dropView, this.type);
			this.isSingle := isSingleton;
			this.w := dropW; this.h := dropH;
			this.rx := relX; this.ry := relY
		ELSE
			OleData.GetDataType(dataObj, this.type, this.w, this.h, this.rx, this.ry, this.isSingle);
			this.source := NIL
		END;
		IF (this.type # "") & (this.win # NIL) THEN
			res := WinApi.ScreenToClient(this.wnd, pt);
			this.x := pt.x; this.y := pt.y; this.key := keyState;
			PollDrop(this, Controllers.show)
		END;
		IF (this.type # "") & (this.win = NIL) OR (targetFrame # NIL) THEN
			effect := Effect(effect, keyState)
		ELSE effect := WinOle.DROPEFFECT_NONE
		END;
		 this.effect := effect;
		RETURN WinApi.S_OK
	END DragEnter;
	
	PROCEDURE (this: IDropTarget) DragOver (keyState: SET; pt: WinApi.POINT; VAR effect: SET): COM.RESULT;
		VAR res: INTEGER;
	BEGIN
		IF (this.type # "") & (this.win # NIL) THEN
			res := WinApi.ScreenToClient(this.wnd, pt);
			IF (pt.x # this.x) OR (pt.y # this.y) THEN
				PollDrop(this, Controllers.hide);
				this.x := pt.x; this.y := pt.y;
				PollDrop(this, Controllers.show)
			END
		END;
		IF (this.type # "") & (this.win = NIL) OR (targetFrame # NIL) THEN
			effect := Effect(effect, keyState);
		ELSE effect := WinOle.DROPEFFECT_NONE
		END;
		this.effect := effect;
		RETURN WinApi.S_OK
	END DragOver;
	
	PROCEDURE (this: IDropTarget) DragLeave (): COM.RESULT;
	BEGIN
		IF (this.type # "") & (this.win # NIL) THEN
			PollDrop(this, Controllers.hide);
		END;
		targetFrame := NIL; this.source := NIL;
		RETURN WinApi.S_OK
	END DragLeave;
	
	PROCEDURE (this: IDropTarget) Drop (dataObj: WinOle.IDataObject; keyState: SET; pt: WinApi.POINT;
														VAR effect: SET): COM.RESULT;
		VAR res, w, h: INTEGER; v: Views.View; s: BOOLEAN;
			c: Containers.Controller; q: ANYPTR; m: Containers.Model; p: Properties.BoundsPref;
	BEGIN
		IF this.effect # WinOle.DROPEFFECT_NONE THEN
			IF this.win # NIL THEN
				res := WinApi.ScreenToClient(this.wnd, pt);
				PollDrop(this, Controllers.hide);
				IF targetFrame # NIL THEN
					Windows.dir.Select(this.win, Windows.eager);
					IF WinApi.MK_LBUTTON * this.key = {} THEN	(* nonstandard drag *)
						ShowPopup(targetFrame, targetX, targetY, effect)
					ELSE effect := this.effect
					END;
					IF (effect # WinOle.DROPEFFECT_NONE) & (sourceFrame = NIL) THEN
						IF Services.Is(targetFrame.view, "TextViews.View") THEN
							OleData.GetTextDataView(dataObj, v, w, h, s)
						ELSE
							OleData.GetDataView(dataObj, "", v, w, h, s)
						END;
						IF v # NIL THEN Drop(this, v, w, h, s)
						ELSE effect := WinOle.DROPEFFECT_NONE
						END
					END
				ELSE effect := WinOle.DROPEFFECT_NONE
				END
			ELSE	(* drop to new window *)
				effect := this.effect;
				IF sourceFrame # NIL THEN
					w := dropW; h := dropH;
					IF isSingleton THEN
						v := Views.CopyOf(dropView, Views.deep)
					ELSE
						c := dropView(Containers.View).ThisController();
						m := c.SelectionCopy();
						v := Views.CopyWithNewModel(dropView, m);
						p.w := w; p.h := h; Views.HandlePropMsg(v, p); w := p.w; h := p.h
					END
				ELSE OleData.GetDataView(dataObj, "", v, w, h, s)
				END;
				IF v # NIL THEN Views.OpenView(Documents.dir.New(v, w, h));
				Views.BeginModification(Views.notUndoable, v);
				Views.EndModification(Views.notUndoable, v)
				ELSE effect := WinOle.DROPEFFECT_NONE
				END
			END
		ELSE effect := WinOle.DROPEFFECT_NONE
		END;
		RETURN WinApi.S_OK
	END Drop;
	
	
	(* drag & drop *)

	PROCEDURE (hook: Hook) TrackToDrop* (f: Views.Frame; view: Views.View;
									isSingle: BOOLEAN; w, h, rx, ry: INTEGER;
									VAR dest: Views.Frame; VAR destX, destY: INTEGER; VAR op: INTEGER;
									VAR x, y: INTEGER; VAR buttons: SET);
		VAR res: COM.RESULT; mask, mode: SET; p: HostPorts.Port; pt: WinApi.POINT;
			dsrc: IDropSource; data: WinOle.IDataObject;
	BEGIN
		sourceFrame := f; sourceX := x; sourceY := y;
		dropView := view; isSingleton := isSingle;
		dropW := w; dropH := h; relX := rx; relY := ry;
		data := OleData.ViewDropData(view, w, h, rx, ry, isSingle, ~isSingle);
		NEW(dsrc); dsrc.key := {};
		mask := WinOle.DROPEFFECT_COPY;
		IF op # Mechanisms.copy THEN mask := mask + WinOle.DROPEFFECT_MOVE END;
		res := WinOle.DoDragDrop(data, dsrc, mask, mode);
		op := Mechanisms.cancelDrop;
		IF res = WinApi.DRAGDROP_S_DROP THEN
			IF mode * WinOle.DROPEFFECT_MOVE # {} THEN op := Mechanisms.move
			ELSIF mode * WinOle.DROPEFFECT_COPY # {} THEN op := Mechanisms.copy
			END
		END;
		IF targetFrame # NIL THEN	(* reconstruct final mouse coordinates in f *)
			p := targetFrame.rider(HostPorts.Rider).port;
			pt.x := (targetX + targetFrame.gx) DIV p.unit;
			pt.y := (targetY + targetFrame.gy) DIV p.unit;
			res := WinApi.ClientToScreen(p.wnd, pt);
			p := f.rider(HostPorts.Rider).port;
			res := WinApi.ScreenToClient(p.wnd, pt);
			x := pt.x * p.unit - f.gx;
			y := pt.y * p.unit - f.gy
		END;
		dest := targetFrame; destX := targetX; destY := targetY;
		sourceFrame := NIL; targetFrame := NIL; dropView := NIL
	END TrackToDrop;

	PROCEDURE PickMode (f, dest: Views.Frame; x, y: INTEGER): INTEGER;
		VAR mode, cursor: INTEGER;
	BEGIN
		IF USER32.GetAsyncKeyState(1BH) < 0 THEN mode := escape; cursor := Ports.arrowCursor
(*
		ELSIF Home(f, x, y) THEN mode := Mechanisms.cancelPick; cursor := Ports.arrowCursor
*)
		ELSIF dest = NIL THEN mode := Mechanisms.cancelPick; cursor := HostPorts.stopCursor
		ELSE
			cursor := HostPorts.pickCursor;
			IF Services.SameType(dest.view, f.view) THEN
				mode := Mechanisms.pick
			ELSE mode := Mechanisms.pickForeign
			END
		END;
		f.SetCursor(cursor);
		RETURN mode
	END PickMode;

	PROCEDURE (hook: Hook) TrackToPick* (f: Views.Frame;
									VAR dest: Views.Frame; VAR destX, destY: INTEGER; VAR op: INTEGER;
									VAR x, y: INTEGER; VAR buttons: SET);
		VAR d, d0: Views.Frame;
			dx, dy,  x0, y0,  x1, y1: INTEGER; isDown: BOOLEAN; m: SET;
	BEGIN
		x0 := x; y0 := y;
		Properties.PollPick(x, y, f, x0, y0, Properties.mark, Properties.show, dest, destX, destY);
		(* MarkTarget(dest, dest # f); *)
		op := PickMode(f, dest, x, y);
		REPEAT
			(* CheckWindow(TRUE); *)
			f.Input(x1, y1, m, isDown);
			IF (x1 # x) OR (y1 # y) THEN
				Properties.PollPick(x1, y1, f, x0, y0, Properties.noMark, Properties.show, d, dx, dy);
				IF (d # dest) OR (dx # destX) OR (dy # destY) THEN
					d0 := dest;
					(* MarkTarget(dest, (dest # f) & (d # d0)); *)
					Properties.PollPick(x, y, f, x0, y0, Properties.mark, Properties.hide, dest, destX, destY);
					x := x1; y := y1;
					Properties.PollPick(x, y, f, x0, y0, Properties.mark, Properties.show, d, dx, dy);
					dest := d; destX := dx; destY := dy;
					(* MarkTarget(dest, (dest # f) (* ~home *) & (d # d0)); *)
				ELSE
					Properties.PollPick(x, y, f, x0, y0, Properties.mark, Properties.hide, d, dx, dy);
					x := x1; y := y1;
					Properties.PollPick(x, y, f, x0, y0, Properties.mark, Properties.show, d, dx, dy)
				END
			END;
			op := PickMode(f, dest, x, y)
		UNTIL ~isDown OR (op = escape);
		Properties.PollPick(x, y, f, x0, y0, Properties.mark, Properties.hide, d, dx, dy);
		IF op = escape THEN
			REPEAT f.Input(x, y, m, isDown) UNTIL ~isDown;
			op := Mechanisms.cancelPick
		END;
		(* MarkTarget(dest, dest # f); *)
		(* CheckWindow(FALSE) *)
		buttons := {}
	END TrackToPick;


	PROCEDURE (hook: Hook) PopUpAndSelect* (f: Views.Frame;
										n, this: INTEGER;
										string: ARRAY OF ARRAY OF CHAR;
										enabled, checked: ARRAY OF BOOLEAN;
										VAR i: INTEGER;
										VAR x, y: INTEGER; VAR buttons: SET);
		VAR res, j: INTEGER; menu, wnd: USER32.Handle; pt: USER32.Point;
			t: ARRAY 256 OF CHAR; st: ARRAY 256 OF SHORTCHAR; s: SET;
	BEGIN
		ASSERT(0 < n, 20); ASSERT(n <= LEN(string), 21);
		ASSERT(LEN(enabled) = LEN(string), 22);
		ASSERT(LEN(checked) = LEN(string), 23);
		
		ASSERT(wnd # 0, 100);
		menu := USER32.CreatePopupMenu(); j := 0;
		WHILE j < n DO
			IF string[j] = "-" THEN
				res := USER32.AppendMenuA(menu, {USER32.MFSeparator}, 0, NIL)
			ELSE
				Dialog.MapString(string[j], t); st := SHORT(t$);
				res := USER32.AppendMenuA(menu, {}, 32000 + j, st);
				IF ~enabled[j] THEN
					res := USER32.EnableMenuItem(menu, 32000 + j, {USER32.MFGrayed})
				ELSIF checked[j] THEN
					res := USER32.CheckMenuItem(menu, 32000 + j, {USER32.MFChecked})
				END
			END;
			INC(j)
		END;
		pt.x := (x + f.gx) DIV f.unit; pt.y := (y + f.gy) DIV f.unit;
		res := USER32.ClientToScreen(wnd, pt);
		s := {1, 2};	(* track right, center align *)
		res := USER32.TrackPopupMenu(menu, s, pt.x, pt.y + 2, 0, wnd, NIL);
		res := USER32.DestroyMenu(menu);
	END PopUpAndSelect;


	PROCEDURE Init*;
		VAR h: Hook;
	BEGIN
		(* Sequencers.MarkBorder := MarkBorder; *)
		NEW(h); Mechanisms.SetHook(h);
	END Init;

BEGIN
	Init
END HostMechanisms.