MODULE WMWindowManager;
IMPORT
Modules, KernelLog, Plugins, Locks, Strings,
Messages := WMMessages, Graphics := WMGraphics, Raster, Rectangles := WMRectangles;
CONST
FlagFrame* = 0;
FlagClose* = 1;
FlagMinimize* = 2;
FlagStayOnTop* = 3;
FlagNonDispatched* = 4;
FlagNoFocus* = 5;
FlagDecorWindow* = 6;
FlagStayOnBottom* = 7;
FlagNavigation* = 8;
FlagHidden* = 9;
FlagNoResizing* = 10;
FlagNoPointer*=11;
SizeMinHeight = 3;
SizeMinWidth = 3;
Ok* = 0;
Error* = 1;
NotSupported* = 2;
X0 = 30;
Y0 = 80;
TYPE
Rectangle = Rectangles.Rectangle;
String = Strings.String;
Message = Messages.Message;
RealRect* = RECORD l*, t*, r*, b* : REAL END;
PointerInfo* = OBJECT
VAR hotX*, hotY* : LONGINT; img* : Graphics.Image;
END PointerInfo;
WindowStyle* = OBJECT
VAR
useBitmaps* : BOOLEAN;
baCol*, biCol* : LONGINT;
basw*, bisw* : LONGINT;
th*, bh*, lw*, rw* : LONGINT;
taa*, tab*, tac*, tia*, tib*, tic*,
laa*, lab*, lac*, lia*, lib*, lic*,
raa*, rab*, rac*, ria*, rib*, ric*,
baa*, bab*, bac*, bia*, bib*, bic* : Graphics.Image;
ca*, ci*, closeHover*,
ma*, mi*, minimizeHover* : Graphics.Image;
minimizeOffset* : LONGINT;
atextX*, atextY*, atextColor*, itextX*, itextY*, itextColor* : LONGINT;
bgColor*, fgColor*, selectCol*, desktopColor* : Graphics.Color;
topFocusThreshold*, topThreshold*, bottomFocusThreshold*, bottomThreshold*,
leftFocusThreshold*, leftThreshold*, rightFocusThreshold*, rightThreshold* : LONGINT;
PROCEDURE &Init*;
BEGIN
useBitmaps := FALSE;
baCol := 0FFFFH; biCol := 0FF40H;
basw := 4; bisw := 3;
th := 20; bh := 3; lw := 3; rw := 3;
taa := NIL; tab := NIL; tac := NIL; tia := NIL; tib := NIL; tic := NIL;
laa := NIL; lab := NIL; lac := NIL; lia := NIL; lib := NIL; lic := NIL;
raa := NIL; rab := NIL; rac := NIL; ria := NIL; rib := NIL; ric := NIL;
baa := NIL; bab := NIL; bac := NIL; bia := NIL; bib := NIL; bic := NIL;
ca := Graphics.LoadImage("ZeroSkin.zip://aclose.png", TRUE);
ci := Graphics.LoadImage("ZeroSkin.zip://iclose.png", TRUE);
closeHover := NIL;
ma := NIL; mi := NIL; minimizeHover := NIL;
minimizeOffset := 0;
atextX := 5; atextY := 15; atextColor := LONGINT(0FFFF00FFH);
itextX := 5; itextY := 15; itextColor := 04444FFH;
bgColor := LONGINT(08080FFFFH);
fgColor := 0000000FFH;
selectCol := 0FFFFH;
desktopColor := LONGINT(08080FFFFH);
topFocusThreshold := 0; topThreshold := 0;
bottomFocusThreshold := 0; bottomThreshold := 0;
leftFocusThreshold := 0; leftThreshold := 0;
rightFocusThreshold := 0; rightThreshold := 0;
END Init;
PROCEDURE Initialize*;
BEGIN
IF useBitmaps THEN
IF tab # NIL THEN th := tab.height END;
IF bab # NIL THEN bh := bab.height END;
IF lab # NIL THEN lw := lab.width END;
IF rab # NIL THEN rw := rab.width END;
END
END Initialize;
END WindowStyle;
DragInfo* = OBJECT
VAR
data*, sender* : ANY;
onAccept*, onReject* : Messages.CompCommand;
offsetX*, offsetY*: LONGINT;
END DragInfo;
DecorList* = OBJECT
VAR next* : DecorList;
w* : Window;
END DecorList;
MessagePreviewProc* = PROCEDURE (VAR msg : Message; VAR discard : BOOLEAN);
MessagePreviewList* = OBJECT
VAR proc*: MessagePreviewProc;
next*:MessagePreviewList;
END MessagePreviewList;
DocumentInfo* = RECORD
id* : LONGINT;
name* : ARRAY 32 OF CHAR;
fullname* : ARRAY 256 OF CHAR;
modified*, hasFocus* : BOOLEAN;
END;
VisualComponentInfo* = RECORD
width*, height* : LONGINT;
generator* : PROCEDURE {DELEGATE} () : ANY;
END;
WindowInfo* = RECORD
openDocuments* : ARRAY 16 OF DocumentInfo;
handleDocumentInfo* : PROCEDURE {DELEGATE} (CONST info : DocumentInfo; new : BOOLEAN; VAR res : LONGINT);
vc* : VisualComponentInfo;
END;
WindowInfoPtr = POINTER TO WindowInfo;
Window* = OBJECT
VAR
id- : LONGINT;
timestamp- : LONGINT;
bounds* : Rectangle;
initialBounds* : Rectangle;
normalBounds* : Rectangle;
manager* : WindowManager;
sequencer* : Messages.MsgSequencer;
prev*, next* : Window;
title : String;
info* : WindowInfoPtr;
master* : Window;
view* : ViewPort;
decor* : DecorList;
flags* : SET;
icon* : Graphics.Image;
topW*, bottomW*, leftW*, rightW* : Window;
useAlpha* : BOOLEAN;
isVisible* : BOOLEAN;
pointerInfo- : PointerInfo;
acceptDrag : BOOLEAN;
reduceQuality- : BOOLEAN;
PROCEDURE &Init*(w, h : LONGINT; alpha : BOOLEAN);
BEGIN
id := GetId();
timestamp := 0;
bounds := Graphics.MakeRectangle(0, 0, w, h);
initialBounds := bounds;
normalBounds := bounds;
manager := NIL; sequencer := NIL;
prev := NIL; next := NIL;
title := NIL;
info := NIL;
master := NIL; decor := NIL;
view := NIL;
flags := {};
icon := NIL;
topW := NIL; bottomW := NIL; leftW := NIL; rightW := NIL;
useAlpha := alpha;
isVisible := TRUE;
pointerInfo := NIL;
acceptDrag := FALSE;
reduceQuality := FALSE;
END Init;
PROCEDURE IsCallFromSequencer*() : BOOLEAN;
BEGIN
RETURN (sequencer # NIL) & (sequencer.IsCallFromSequencer())
END IsCallFromSequencer;
PROCEDURE GetManager*() : WindowManager;
BEGIN
RETURN manager
END GetManager;
PROCEDURE SetTitle*(title : String);
BEGIN
IF manager # NIL THEN manager.SetWindowTitle(SELF, title) ELSE SELF.title := title END
END SetTitle;
PROCEDURE GetTitle*() : String;
BEGIN
IF manager # NIL THEN RETURN manager.GetWindowTitle(SELF) ELSE RETURN title END
END GetTitle;
PROCEDURE SetIcon*(icon : Graphics.Image);
BEGIN
IF (manager # NIL) THEN manager.SetWindowIcon(SELF, icon); ELSE SELF.icon := icon; END;
END SetIcon;
PROCEDURE GetHeight*() : LONGINT;
BEGIN
RETURN bounds.b - bounds.t
END GetHeight;
PROCEDURE GetWidth*() : LONGINT;
BEGIN
RETURN bounds.r - bounds.l
END GetWidth;
PROCEDURE SetInfo*(CONST info : WindowInfo);
BEGIN
IF (manager # NIL) THEN
manager.SetWindowInfo(SELF, info);
ELSE
IF (SELF.info = NIL) THEN NEW(SELF.info); END;
SELF.info^ := info;
END;
END SetInfo;
PROCEDURE GetInfo*(VAR info : WindowInfo) : BOOLEAN;
VAR infoPtr : WindowInfoPtr;
BEGIN
IF (manager # NIL) THEN
RETURN manager.GetWindowInfo(SELF, info);
ELSE
infoPtr := SELF.info;
IF (infoPtr # NIL) THEN
info := infoPtr^;
END;
RETURN (infoPtr # NIL);
END;
END GetInfo;
PROCEDURE Resizing*(VAR width, height : LONGINT);
BEGIN
IF FlagNoResizing IN flags THEN
width := GetWidth(); height := GetHeight();
ELSIF width < SizeMinWidth THEN
width := GetWidth();
ELSIF height < SizeMinHeight THEN
height := GetHeight();
END
END Resizing;
PROCEDURE Resized*(width, height : LONGINT);
END Resized;
PROCEDURE Invalidate*(rect : Rectangle);
BEGIN
Rectangles.MoveRel(rect, bounds.l, bounds.t);
Rectangles.ClipRect(rect, bounds);
IF manager # NIL THEN manager.AddVisibleDirty(SELF, rect) END
END Invalidate;
PROCEDURE PointerDown*(x, y : LONGINT; keys : SET);
END PointerDown;
PROCEDURE PointerMove*(x, y : LONGINT; keys : SET);
END PointerMove;
PROCEDURE WheelMove*(dz : LONGINT);
END WheelMove;
PROCEDURE PointerUp*(x, y : LONGINT; keys : SET);
END PointerUp;
PROCEDURE PointerLeave*;
END PointerLeave;
PROCEDURE DragOver*(x, y: LONGINT; dragInfo : DragInfo);
END DragOver;
PROCEDURE DragDropped*(x, y: LONGINT; dragInfo : DragInfo);
END DragDropped;
PROCEDURE ConfirmDrag*(accept : BOOLEAN; dragInfo : DragInfo);
BEGIN
IF dragInfo # NIL THEN
IF accept THEN
IF dragInfo.onAccept # NIL THEN dragInfo.onAccept(SELF, dragInfo) END
ELSE
IF dragInfo.onReject # NIL THEN dragInfo.onReject(SELF, dragInfo) END
END
END
END ConfirmDrag;
PROCEDURE StartDrag*(sender, data : ANY; img : Graphics.Image; offsetX, offsetY: LONGINT; onAccept, onReject : Messages.CompCommand) : BOOLEAN;
BEGIN
RETURN manager.StartDrag(SELF, sender, data, img, offsetX, offsetY, onAccept, onReject)
END StartDrag;
PROCEDURE KeyEvent*(ucs : LONGINT; flags : SET; keysym : LONGINT);
END KeyEvent;
PROCEDURE FocusGot*;
END FocusGot;
PROCEDURE FocusLost*;
END FocusLost;
PROCEDURE StyleChanged*;
END StyleChanged;
PROCEDURE CanClose*() : BOOLEAN;
BEGIN
RETURN TRUE
END CanClose;
PROCEDURE Close*;
BEGIN
IF manager # NIL THEN manager.Remove(SELF) END;
END Close;
PROCEDURE IsHit*(x, y : LONGINT) : BOOLEAN;
BEGIN
RETURN TRUE
END IsHit;
PROCEDURE SetPointerInfo*(pi : PointerInfo);
BEGIN
IF FlagNoPointer IN flags THEN pi := pointerNull END;
IF pi # pointerInfo THEN
pointerInfo := pi;
IF manager # NIL THEN manager.CheckPointerImage END;
END
END SetPointerInfo;
PROCEDURE Handle*(VAR m : Message);
BEGIN
IF m.msgType = Messages.MsgKey THEN
KeyEvent(m.x, m.flags, m.y)
ELSIF m.msgType = Messages.MsgPointer THEN
IF m.msgSubType = Messages.MsgSubPointerMove THEN
IF (m.dz # 0) THEN WheelMove(m.dz) END;
PointerMove(m.x, m.y, m.flags)
ELSIF m.msgSubType = Messages.MsgSubPointerDown THEN PointerDown(m.x, m.y, m.flags)
ELSIF m.msgSubType = Messages.MsgSubPointerUp THEN PointerUp(m.x, m.y, m.flags)
ELSIF m.msgSubType = Messages.MsgSubPointerLeave THEN PointerLeave
END
ELSIF m.msgType = Messages.MsgDrag THEN
IF m.msgSubType = Messages.MsgDragOver THEN
IF (m.ext # NIL) THEN
DragOver(m.x, m.y, m.ext(DragInfo))
END
ELSIF m.msgSubType = Messages.MsgDragDropped THEN
IF (m.ext # NIL) THEN
DragDropped(m.x, m.y, m.ext(DragInfo))
END
END
ELSIF m.msgType = Messages.MsgClose THEN Close
ELSIF m.msgType = Messages.MsgFocus THEN
IF m.msgSubType = Messages.MsgSubFocusGot THEN FocusGot
ELSIF m.msgSubType = Messages.MsgSubFocusLost THEN FocusLost
END
ELSIF m.msgType = Messages.MsgStyleChanged THEN StyleChanged
ELSIF m.msgType = Messages.MsgResized THEN Resized(m.x, m.y)
END;
END Handle;
PROCEDURE Draw*(canvas : Graphics.Canvas; w, h, q : LONGINT);
END Draw;
PROCEDURE HintReduceQuality*(reduce : BOOLEAN);
BEGIN
IF reduce # reduceQuality THEN
reduceQuality := reduce;
IF ~reduceQuality THEN
IF manager # NIL THEN manager.AddVisibleDirty(SELF, bounds) END
END
END
END HintReduceQuality;
END Window;
BufferWindow* = OBJECT(Window)
VAR
img* : Graphics.Image;
canvas* : Graphics.BufferCanvas;
pointerThreshold* : LONGINT;
PROCEDURE &Init*(w, h : LONGINT; alpha : BOOLEAN);
BEGIN
Init^(w, h, alpha);
NEW(img);
IF alpha THEN Raster.Create(img, w, h, Raster.BGRA8888) ELSE Raster.Create(img, w, h, format) END;
NEW(canvas, img);
END Init;
PROCEDURE IsHit(x, y : LONGINT) : BOOLEAN;
VAR w, h : LONGINT; fx, fy : REAL;
BEGIN
w := GetWidth(); h := GetHeight();
IF (w > 0) & (h > 0) & ((w # img.width) OR (h # img.height)) THEN
fx := img.width / w; fy := img.height / h;
RETURN Graphics.IsBitmapHit(ENTIER(x * fx), ENTIER(y * fy), pointerThreshold, img)
ELSE RETURN Graphics.IsBitmapHit(x, y, pointerThreshold, img)
END
END IsHit;
PROCEDURE Draw*(canvas : Graphics.Canvas; w, h, q : LONGINT);
BEGIN
IF reduceQuality THEN q := 0 END;
IF img # NIL THEN
IF (w = img.width) & (h = img.height) THEN
IF useAlpha THEN canvas.DrawImage(0, 0, img, Graphics.ModeSrcOverDst)
ELSE canvas.DrawImage(0, 0, img, Graphics.ModeCopy)
END
ELSE
IF useAlpha THEN
canvas.ScaleImage(img, Rectangles.MakeRect(0, 0, img.width, img.height),
Rectangles.MakeRect(0, 0, w, h), Graphics.ModeSrcOverDst, q)
ELSE
canvas.ScaleImage(img, Rectangles.MakeRect(0, 0, img.width, img.height),
Rectangles.MakeRect(0, 0, w, h), Graphics.ModeCopy, q)
END
END
END;
INC(timestamp);
END Draw;
PROCEDURE Invalidate*(rect : Rectangle);
VAR w, h : LONGINT; fx, fy : REAL;
BEGIN
w := GetWidth(); h := GetHeight();
IF (w > 0) & (h > 0) & ((w # img.width) OR (h # img.height)) THEN
fx := w / img.width; fy := h / img.height;
rect.l := ENTIER(rect.l * fx); rect.t := ENTIER(rect.t * fy);
rect.r := ENTIER(rect.r * fx + 0.5); rect.b := ENTIER(rect.b * fy + 0.5)
END;
Invalidate^(rect)
END Invalidate;
PROCEDURE Handle*(VAR m : Message);
VAR w, h : LONGINT; fx, fy : REAL;
BEGIN
w := GetWidth(); h := GetHeight();
IF (w > 0) & (h > 0) & ((w # img.width) OR (h # img.height)) & (m.msgType = Messages.MsgPointer) THEN
fx := img.width / w; fy := img.height / h; m.x := ENTIER(m.x * fx); m.y := ENTIER(m.y * fy)
END;
Handle^(m)
END Handle;
END BufferWindow;
DoubleBufferWindow* = OBJECT(BufferWindow)
VAR
visibleCanvas : Graphics.BufferCanvas;
backImg* : Graphics.Image;
swapping, drawing : BOOLEAN;
PROCEDURE &Init*(w, h: LONGINT; alpha : BOOLEAN);
BEGIN
Init^(w, h, alpha);
NEW(backImg); Raster.Create(backImg, w, h, img.fmt);
visibleCanvas := canvas; NEW(canvas, backImg);
END Init;
PROCEDURE ReInit*(w, h : LONGINT);
BEGIN {EXCLUSIVE}
AWAIT(~drawing);
IF useAlpha THEN
Raster.Create(img, w, h, Raster.BGRA8888);
Raster.Create(backImg, w, h, Raster.BGRA8888)
ELSE
Raster.Create(img, w, h, format);
Raster.Create(backImg, w, h, format)
END;
NEW(visibleCanvas, img); NEW(canvas, backImg)
END ReInit;
PROCEDURE Draw*(canvas : Graphics.Canvas; w, h, q : LONGINT);
BEGIN
BEGIN{EXCLUSIVE}
AWAIT(~swapping); drawing := TRUE;
END;
IF reduceQuality THEN q := 0 END;
IF img # NIL THEN
IF (w = img.width) & (h = img.height) THEN
IF useAlpha THEN canvas.DrawImage(0, 0, img, Graphics.ModeSrcOverDst)
ELSE canvas.DrawImage(0, 0, img, Graphics.ModeCopy)
END
ELSE
IF useAlpha THEN
canvas.ScaleImage(img, Rectangles.MakeRect(0, 0, img.width, img.height),
Rectangles.MakeRect(0, 0, w, h), Graphics.ModeSrcOverDst, q)
ELSE
canvas.ScaleImage(img, Rectangles.MakeRect(0, 0, img.width, img.height),
Rectangles.MakeRect(0, 0, w, h), Graphics.ModeCopy, q)
END
END
END;
BEGIN{EXCLUSIVE}
drawing := FALSE;
END;
INC(timestamp);
END Draw;
PROCEDURE CopyRect*(rect : Rectangle);
BEGIN {EXCLUSIVE}
swapping := TRUE;
AWAIT(~drawing);
visibleCanvas.SetClipRect(rect);
visibleCanvas.DrawImage(0, 0, backImg, Graphics.ModeCopy);
visibleCanvas.SetClipRect(visibleCanvas.limits);
swapping := FALSE
END CopyRect;
PROCEDURE Swap*;
VAR tmp : Graphics.Image; tmpc : Graphics.BufferCanvas;
BEGIN {EXCLUSIVE}
swapping := TRUE;
AWAIT(~drawing);
tmp := img; img := backImg; backImg := tmp;
tmpc := canvas; canvas := visibleCanvas; visibleCanvas := tmpc;
swapping := FALSE
END Swap;
END DoubleBufferWindow;
ViewPort* = OBJECT (Plugins.Plugin)
VAR
next* : ViewPort;
manager* : WindowManager;
range* : RealRect;
width0*, height0* : LONGINT;
PROCEDURE Update*(r : Rectangle; top : Window);
END Update;
PROCEDURE Refresh*(top : Window);
END Refresh;
PROCEDURE SetRange*(x, y, w, h : REAL; showTransition : BOOLEAN);
END SetRange;
PROCEDURE GetKeyState*(VAR state : SET);
END GetKeyState;
END ViewPort;
Decorator* = PROCEDURE {DELEGATE} (w : Window);
WindowManager* = OBJECT(Plugins.Plugin)
VAR
pointerNull*, pointerStandard*, pointerMove*, pointerText*, pointerCrosshair*,
pointerLeftRight*, pointerUpDown*, pointerULDR*, pointerURDL*, pointerLink* : PointerInfo;
decorate* : Decorator;
viewRegistry- : Plugins.Registry;
sequencer- : Messages.MsgSequencer;
lock- : Locks.RWLock;
messagePreviewList : MessagePreviewList;
style : WindowStyle;
PROCEDURE &Init*;
BEGIN
NEW(pointerNull);
InitCursors;
decorate := NIL;
NEW(viewRegistry, "View#", "Views Port Window Manager");
NEW(sequencer, Handle); lock := sequencer.lock;
messagePreviewList := NIL;
NEW(style);
END Init;
PROCEDURE InitCursors;
BEGIN
LoadCursor("ZeroSkin.zip://arrow.png", 0, 0, pointerStandard);
LoadCursor("ZeroSkin.zip://move.png", 15, 15, pointerMove);
LoadCursor("ZeroSkin.zip://text.png", 13, 12, pointerText);
LoadCursor("ZeroSkin.zip://crosshair.png", 13, 12, pointerCrosshair);
LoadCursor("ZeroSkin.zip://leftright.png", 13, 12, pointerLeftRight);
LoadCursor("ZeroSkin.zip://updown.png", 13, 12, pointerUpDown);
LoadCursor("ZeroSkin.zip://uldr.png", 13, 12, pointerULDR);
LoadCursor("ZeroSkin.zip://urdl.png", 13, 12, pointerURDL);
LoadCursor("ZeroSkin.zip://hand.png", 6, 0, pointerLink);
END InitCursors;
PROCEDURE ZeroSkin*;
BEGIN
lock.AcquireWrite;
style.Init;
SetStyle(style);
InitCursors;
lock.ReleaseWrite
END ZeroSkin;
PROCEDURE ShutDown*;
BEGIN
ASSERT(lock.HasWriteLock());
Plugins.main.Remove(viewRegistry)
END ShutDown;
PROCEDURE Add*(l, t : LONGINT; item : Window; flags:SET);
END Add;
PROCEDURE Remove*(item : Window);
END Remove;
PROCEDURE SetWindowPos*(vs : Window; x, y : LONGINT);
END SetWindowPos;
PROCEDURE SetWindowSize*(vs : Window; VAR width, height : LONGINT);
END SetWindowSize;
PROCEDURE AddDirty*(VAR rect:Rectangle);
END AddDirty;
PROCEDURE AddVisibleDirty*(w : Window; rect : Rectangle);
END AddVisibleDirty;
PROCEDURE SetFocus*(w : Window);
END SetFocus;
PROCEDURE AddDecorWindow*(to, decor : Window);
VAR dl : DecorList;
BEGIN
lock.AcquireWrite;
INCL(decor.flags, FlagDecorWindow);
INCL(decor.flags, FlagHidden);
decor.master := to;
NEW(dl); dl.w := decor; dl.next := to.decor; to.decor := dl;
lock.ReleaseWrite
END AddDecorWindow;
PROCEDURE RemoveDecorWindow*(w, from : Window);
VAR dl : DecorList;
BEGIN
lock.AcquireWrite;
IF (from.decor # NIL) & (from.decor.w = w) THEN from.decor := from.decor.next
ELSE
dl := from.decor;
WHILE (dl.next # NIL) & (dl.next.w # w) DO dl := dl.next END;
IF dl.next # NIL THEN dl.next := dl.next.next END
END;
lock.ReleaseWrite
END RemoveDecorWindow;
PROCEDURE SetStyle*(x : WindowStyle);
VAR m : Message;
BEGIN
ASSERT(style # NIL);
style := x; m.msgType := Messages.MsgStyleChanged; m.ext := style;
Broadcast(m)
END SetStyle;
PROCEDURE GetStyle*() : WindowStyle;
BEGIN
ASSERT(style # NIL);
RETURN style
END GetStyle;
PROCEDURE ToFront*(w : Window);
END ToFront;
PROCEDURE ToBack*(w : Window);
END ToBack;
PROCEDURE SetIsVisible*(w : Window; isVisible : BOOLEAN);
VAR d : DecorList;
BEGIN
ASSERT(w # NIL);
lock.AcquireWrite;
IF (w.isVisible # isVisible) THEN
w.isVisible := isVisible;
IF (w.leftW # NIL) THEN w.leftW.isVisible := isVisible; END;
IF (w.rightW # NIL) THEN w.rightW.isVisible := isVisible; END;
IF (w.topW # NIL) THEN w.topW.isVisible := isVisible; END;
IF (w.bottomW # NIL) THEN w.bottomW.isVisible := isVisible; END;
AddDirty(w.bounds);
IF (w.decor # NIL) THEN
d := w.decor;
WHILE (d # NIL) & (d.w # NIL) DO
AddDirty(d.w.bounds);
d := d.next;
END;
END;
IncOTimestamp;
END;
lock.ReleaseWrite;
END SetIsVisible;
PROCEDURE SetWindowIcon*(w : Window; icon : Graphics.Image);
VAR tw : Window;
BEGIN
ASSERT(w # NIL);
lock.AcquireWrite;
w.icon := icon;
tw := w.topW;
IF tw # NIL THEN AddVisibleDirty(tw, tw.bounds) END;
lock.ReleaseWrite;
IncOTimestamp;
END SetWindowIcon;
PROCEDURE GetPositionOwner*(x, y : LONGINT) : Window;
END GetPositionOwner;
PROCEDURE GetFocusOwner*() : Window;
END GetFocusOwner;
PROCEDURE SetWindowTitle*(w : Window; title : String);
VAR tw : Window;
BEGIN
lock.AcquireWrite;
w.title := title;
tw := w.topW;
IF tw # NIL THEN AddVisibleDirty(tw, tw.bounds) END;
lock.ReleaseWrite;
IncWTimestamp;
END SetWindowTitle;
PROCEDURE GetWindowTitle*(w : Window) : String;
BEGIN
RETURN w.title
END GetWindowTitle;
PROCEDURE SetWindowInfo*(w : Window; CONST info : WindowInfo);
BEGIN
ASSERT(w # NIL);
lock.AcquireWrite;
IF (w.info = NIL) THEN NEW(w.info); END;
w.info^ := info;
lock.ReleaseWrite;
IncOTimestamp;
END SetWindowInfo;
PROCEDURE GetWindowInfo*(w : Window; VAR info : WindowInfo) : BOOLEAN;
VAR infoPtr : WindowInfoPtr;
BEGIN
ASSERT(w # NIL);
lock.AcquireRead;
infoPtr := w.info;
IF (infoPtr # NIL) THEN
info := infoPtr^;
END;
lock.ReleaseRead;
RETURN (infoPtr # NIL);
END GetWindowInfo;
PROCEDURE SetWindowFlag*(w : Window; flag : LONGINT; value : BOOLEAN);
BEGIN
ASSERT(w # NIL);
ASSERT((flag = FlagFrame) OR (flag = FlagStayOnTop) OR (flag = FlagStayOnBottom) OR (flag = FlagHidden));
END SetWindowFlag;
PROCEDURE SetAcceptDrag*(w : Window; accept : BOOLEAN);
BEGIN
lock.AcquireWrite;
w.acceptDrag := accept;
lock.ReleaseWrite
END SetAcceptDrag;
PROCEDURE StartDrag*(w : Window; sender, data : ANY; img : Graphics.Image; offsetX, offsetY: LONGINT; onAccept, onReject : Messages.CompCommand) : BOOLEAN;
END StartDrag;
PROCEDURE TransferPointer*( to : Window) : BOOLEAN;
END TransferPointer;
PROCEDURE CheckPointerImage*;
END CheckPointerImage;
PROCEDURE AddView*(v : ViewPort);
END AddView;
PROCEDURE RefreshView*(v : ViewPort);
END RefreshView;
PROCEDURE RemoveView*(v : ViewPort);
END RemoveView;
PROCEDURE Broadcast*(VAR m : Message);
END Broadcast;
PROCEDURE SendMessage*(dest : Window; VAR m : Message) : BOOLEAN;
BEGIN
IF dest.sequencer # NIL THEN RETURN dest.sequencer.Add(m)
ELSE dest.Handle(m); RETURN TRUE
END
END SendMessage;
PROCEDURE InstallMessagePreview*(x : MessagePreviewProc);
VAR mpl : MessagePreviewList;
BEGIN
lock.AcquireWrite;
NEW(mpl); mpl.next := messagePreviewList; mpl.proc := x; messagePreviewList := mpl;
lock.ReleaseWrite
END InstallMessagePreview;
PROCEDURE RemoveMessagePreview*(x : MessagePreviewProc);
VAR cur : MessagePreviewList;
BEGIN
lock.AcquireWrite;
IF (messagePreviewList # NIL) & (messagePreviewList.proc = x) THEN messagePreviewList := messagePreviewList.next
ELSE
cur := messagePreviewList;
WHILE cur # NIL DO
IF (cur.next # NIL) & (cur.next.proc = x) THEN cur.next := cur.next.next; lock.ReleaseWrite; RETURN
ELSE cur := cur.next END
END
END;
lock.ReleaseWrite
END RemoveMessagePreview;
PROCEDURE PreviewMessage*(VAR m : Message; VAR discard : BOOLEAN);
VAR mpl : MessagePreviewList;
BEGIN
ASSERT(lock.HasReadLock());
discard := FALSE;
mpl := messagePreviewList;
WHILE (mpl # NIL) & ~discard DO mpl.proc(m, discard); mpl := mpl.next END;
END PreviewMessage;
PROCEDURE GetFirst*() : Window;
END GetFirst;
PROCEDURE GetNext*(x : Window) : Window;
END GetNext;
PROCEDURE GetPrev*(x : Window) : Window;
END GetPrev;
PROCEDURE ReplaceBackground*(w : Window) : Window;
END ReplaceBackground;
PROCEDURE GetPopulatedArea*(VAR r : Rectangle);
END GetPopulatedArea;
PROCEDURE HandleInternal*(VAR msg : Messages.Message);
BEGIN
ASSERT(sequencer.IsCallFromSequencer())
END HandleInternal;
PROCEDURE Handle*(VAR msg : Messages.Message);
VAR discard : BOOLEAN;
BEGIN
IF sequencer.IsCallFromSequencer() THEN
PreviewMessage(msg, discard);
IF ~discard THEN HandleInternal(msg) END
ELSE
IF ~sequencer.Add(msg) THEN
KernelLog.String("A message sent to the WM could not be handled "); KernelLog.Ln
END
END
END Handle;
END WindowManager;
VAR
registry- : Plugins.Registry;
pointerNull: PointerInfo;
wTimestamp- : LONGINT;
oTimestamp- : LONGINT;
x1, y1 : LONGINT;
format* : Raster.Format;
nextId : LONGINT;
PROCEDURE GetId() : LONGINT;
BEGIN {EXCLUSIVE}
INC(nextId);
RETURN nextId;
END GetId;
PROCEDURE IncWTimestamp*;
BEGIN {EXCLUSIVE}
INC(wTimestamp);
END IncWTimestamp;
PROCEDURE IncOTimestamp*;
BEGIN {EXCLUSIVE}
INC(oTimestamp);
END IncOTimestamp;
PROCEDURE AwaitChange*(wTs, oTs : LONGINT);
BEGIN {EXCLUSIVE}
AWAIT((wTimestamp # wTs) OR (oTimestamp # oTs));
END AwaitChange;
PROCEDURE ClearInfo*(VAR info : WindowInfo);
VAR i : LONGINT;
BEGIN
FOR i := 0 TO LEN(info.openDocuments)-1 DO
info.openDocuments[i].id := 0;
info.openDocuments[i].name := "";
info.openDocuments[i].fullname := "";
info.openDocuments[i].modified := FALSE;
info.openDocuments[i].hasFocus := FALSE;
END;
info.handleDocumentInfo := NIL;
info.vc.width := 0;
info.vc.height := 0;
info.vc.generator := NIL;
END ClearInfo;
PROCEDURE NewString*(CONST x : ARRAY OF CHAR) : String;
VAR t : String;
BEGIN
NEW(t, LEN(x)); COPY(x, t^); RETURN t
END NewString;
PROCEDURE LoadCursor*(CONST name : ARRAY OF CHAR; hx, hy : LONGINT; VAR pi : PointerInfo);
BEGIN
IF pi = NIL THEN NEW(pi) END;
pi.img := Graphics.LoadImage(name, TRUE); pi.hotX := hx; pi.hotY := hy;
IF pi.img = NIL THEN KernelLog.String("Picture not loaded : "); KernelLog.String(name); KernelLog.Ln END
END LoadCursor;
PROCEDURE GetDefaultManager*() : WindowManager;
VAR p : Plugins.Plugin;
BEGIN
p := registry.Await("");
RETURN p(WindowManager)
END GetDefaultManager;
PROCEDURE GetDefaultView*() : ViewPort;
VAR p : Plugins.Plugin; m : WindowManager;
BEGIN
m := GetDefaultManager();
p := m.viewRegistry.Await("");
RETURN p(ViewPort)
END GetDefaultView;
PROCEDURE ResetNextPosition*;
BEGIN {EXCLUSIVE}
x1 := 0; y1 := 0;
END ResetNextPosition;
PROCEDURE GetNextPosition*(window : Window; manager : WindowManager; view : ViewPort; VAR dx, dy : LONGINT);
VAR style : WindowStyle; x, y : LONGINT;
BEGIN {EXCLUSIVE}
ASSERT((window # NIL) & (manager # NIL) & (view # NIL));
style := manager.GetStyle();
x := style.lw; y := style.th;
dx := x + X0 + x1; dy := y + Y0 + y1;
INC(x1, x); INC(y1, y);
IF (x1 > ENTIER(0.3 * view.width0)) OR (y1 > ENTIER(0.3 * view.height0)) THEN
x1 := 0; y1 := 0;
END;
END GetNextPosition;
PROCEDURE DefaultAddWindow*(w : Window);
VAR manager : WindowManager; view : ViewPort; dy, dx : LONGINT;
BEGIN
manager := GetDefaultManager();
view := GetDefaultView();
GetNextPosition(w, manager, view, dx, dy);
manager.Add(ENTIER(view.range.l) + dx, ENTIER(view.range.t) + dy, w, {FlagFrame, FlagClose, FlagMinimize});
manager.SetFocus(w)
END DefaultAddWindow;
PROCEDURE AddWindow*(w : Window; dx, dy : LONGINT);
VAR manager : WindowManager; view : ViewPort;
BEGIN
manager := GetDefaultManager();
view := GetDefaultView();
manager.Add(ENTIER(view.range.l) + dx, ENTIER(view.range.t) + dy, w, {FlagFrame, FlagClose, FlagMinimize})
END AddWindow;
PROCEDURE ExtAddWindow*(w : Window; dx, dy : LONGINT; flags : SET);
VAR manager : WindowManager; view : ViewPort;
BEGIN
manager := GetDefaultManager();
view := GetDefaultView();
manager.Add(ENTIER(view.range.l) + dx, ENTIER(view.range.t) + dy, w, flags)
END ExtAddWindow;
PROCEDURE ExtAddViewBoundWindow*(w : Window; dx, dy : LONGINT; view : ViewPort; flags : SET);
VAR manager : WindowManager;
BEGIN
flags := flags + {FlagNavigation};
manager := GetDefaultManager();
manager.Add(dx, dy, w, flags);
END ExtAddViewBoundWindow;
PROCEDURE DefaultBringToView*(w : Window; toFront : BOOLEAN);
VAR manager : WindowManager; view : ViewPort; dy, dx : LONGINT;
BEGIN
manager := GetDefaultManager();
view := GetDefaultView();
GetNextPosition(w, manager, view, dx, dy);
manager.SetWindowPos(w, ENTIER(view.range.l) + dx, ENTIER(view.range.t) + dy);
manager.SetFocus(w);
IF toFront THEN manager.ToFront(w) END
END DefaultBringToView;
PROCEDURE CleanUp;
BEGIN
Plugins.main.Remove(registry)
END CleanUp;
BEGIN
Modules.InstallTermHandler(CleanUp);
NEW(registry, "WM#", "Window Managers");
nextId := 0; x1 := 0; y1 := 0;
wTimestamp := 0; oTimestamp := 0;
format := Raster.BGRA8888;
NEW(pointerNull);
END WMWindowManager.