summaryrefslogtreecommitdiff
path: root/src/corelib
diff options
context:
space:
mode:
authorgraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2008-03-21 23:21:00 +0000
committergraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2008-03-21 23:21:00 +0000
commit66b5a5ab7249eff995f9927d8172f62081979437 (patch)
tree626c35b5bb447a9a2d371c588cfa80765992bcc9 /src/corelib
parentad532a0858d4e362b96f543a2c1ffe4f47b5da05 (diff)
downloadfpGUI-66b5a5ab7249eff995f9927d8172f62081979437.tar.xz
* new method in Canvas class called ClipLine() which clips the coordinates
of a line based on a given clipping rectangle. This doesn't not use the Canvas's internal ClipRegion. It uses the well known Cohen-Sutherland line clipping algorithm, and performance is very good. * new method in Canvas class called DrawLineClipped() which uses the ClipLine method. * Converted some C headers for the Motif Window Manager hints support under X11. * Introduced a new Window Attribute type called waBorderless. This allows use create borderless windows that can handle keyboard input. Currently borderless windows are only implemented in X11. It past 01:15 here and I need sleep, so will tackle GDI support on Monday. * Extended some of the types to be used for the new Style/Theme Manager. * Fixed a bug where TfpgForm.OnClose event did not fire when you call .Close method.
Diffstat (limited to 'src/corelib')
-rw-r--r--src/corelib/gfxbase.pas99
-rw-r--r--src/corelib/x11/fpgfx_package.pas7
-rw-r--r--src/corelib/x11/gfx_x11.pas68
3 files changed, 169 insertions, 5 deletions
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 5129fbb3..427cd07e 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -24,7 +24,7 @@ type
TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup);
- TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos, waStayOnTop, waFullScreen);
+ TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos, waStayOnTop, waFullScreen, waBorderless);
TWindowAttributes = set of TWindowAttribute;
TMouseCursor = (mcDefault, mcArrow, mcCross, mcIBeam, mcSizeEW, mcSizeNS,
@@ -267,6 +267,8 @@ type
procedure DrawRectangle(x, y, w, h: TfpgCoord); overload;
procedure DrawRectangle(r: TfpgRect); overload;
procedure DrawLine(x1, y1, x2, y2: TfpgCoord);
+ procedure DrawLineClipped(var x1, y1, x2, y2: TfpgCoord; const AClipRect: TfpgRect);
+ procedure ClipLine(var x1, y1, x2, y2: TfpgCoord; const AClipRect: TfpgRect; out FallsOutsideRegion: Boolean);
procedure DrawImage(x, y: TfpgCoord; img: TfpgImageBase);
procedure DrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer);
procedure DrawArc(x, y, w, h: TfpgCoord; a1, a2: double);
@@ -1000,6 +1002,101 @@ begin
DoDrawLine(x1, y1, x2, y2);
end;
+procedure TfpgCanvasBase.DrawLineClipped(var x1, y1, x2, y2: TfpgCoord;
+ const AClipRect: TfpgRect);
+var
+ OutOfRegion: boolean;
+begin
+ ClipLine(X1, Y1, X2, Y2, AClipRect, OutOfRegion);
+ if not OutOfRegion then
+ DrawLine(X1, Y1, X2, Y2); { Draw the new line! }
+end;
+
+{ DrawLineClipped - This procedure clips a line to the AClipRect boundaries and
+ then calls the DrawLine procedure with the clipped coordinates. If the line
+ lies completely outside of the clip boundary, then the Line routine is not
+ called. This procedure uses the well known Cohen-Sutherland line clipping
+ algorithm to clip each coordinate.
+
+ Use this if you did not what to change the Canvas.ClipRegion for some reason.
+ For a detailed explanation see:
+ http://www.nondot.org/~sabre/graphpro/line6.html }
+procedure TfpgCanvasBase.ClipLine(var x1, y1, x2, y2: TfpgCoord;
+ const AClipRect: TfpgRect; out FallsOutsideRegion: Boolean);
+CONST
+ CodeBottom = 1; CodeTop = 2; { BitFields for output codes }
+ CodeLeft = 4; CodeRight = 8;
+
+ FUNCTION CompOutCode(X, Y : INTEGER) : integer; { Nested function }
+ VAR Code : integer;
+ BEGIN
+ Code := 0;
+ IF Y > AClipRect.Bottom THEN Code := CodeBottom
+ ELSE IF Y < AClipRect.Top THEN Code := CodeTop;
+ IF X > AClipRect.Right THEN Code := Code+CodeRight
+ ELSE IF X < AClipRect.Left THEN Code := Code+CodeLeft;
+ Result := Code;
+ END;
+
+VAR
+ OutCode0, { The code of the first endpoint }
+ OutCode1, { The code of the second endpoint }
+ OutCodeOut : integer;
+ X, Y : INTEGER;
+BEGIN
+ FallsOutsideRegion := False;
+ OutCode0 := CompOutCode(X1, Y1); { Compute the original codes }
+ OutCode1 := CompOutCode(X2, Y2);
+
+ WHILE (OutCode0 <> 0) OR (OutCode1 <> 0) DO { While not Trivially Accepted }
+ BEGIN
+ IF (OutCode0 AND OutCode1) <> 0 THEN { Trivial Reject }
+ begin
+ FallsOutsideRegion := True;
+ Exit; //==>
+ end
+ ELSE
+ BEGIN { Failed both tests, so calculate the line segment to clip }
+ IF OutCode0 > 0 THEN
+ OutCodeOut := OutCode0 { Clip the first point }
+ ELSE
+ OutCodeOut := OutCode1; { Clip the last point }
+
+ IF (OutCodeOut AND CodeBottom) = CodeBottom THEN
+ BEGIN { Clip the line to the bottom of the viewport }
+ Y := AClipRect.Bottom;
+ X := X1+LONGINT(X2-X1)*LONGINT(Y-Y1) DIV (Y2 - Y1);
+ END
+ ELSE IF (OutCodeOut AND CodeTop) = CodeTop THEN
+ BEGIN { Clip the line to the top of the viewport }
+ Y := AClipRect.Top;
+ X := X1+LONGINT(X2-X1)*LONGINT(Y-Y1) DIV (Y2 - Y1);
+ END
+ ELSE IF (OutCodeOut AND CodeRight) = CodeRight THEN
+ BEGIN { Clip the line to the right edge of the viewport }
+ X := AClipRect.Right;
+ Y := Y1+LONGINT(Y2-Y1)*LONGINT(X-X1) DIV (X2-X1);
+ END
+ ELSE IF (OutCodeOut AND CodeLeft) = CodeLeft THEN
+ BEGIN { Clip the line to the left edge of the viewport }
+ X := AClipRect.Left;
+ Y := Y1+LONGINT(Y2-Y1)*LONGINT(X-X1) DIV (X2-X1);
+ END;
+
+ IF (OutCodeOut = OutCode0) THEN { Modify the first coordinate }
+ BEGIN
+ X1 := X; Y1 := Y; { Update temporary variables }
+ OutCode0 := CompOutCode(X1, Y1); { Recalculate the OutCode }
+ END
+ ELSE { Modify the second coordinate }
+ BEGIN
+ X2 := X; Y2 := Y; { Update temporary variables }
+ OutCode1 := CompOutCode(X2, Y2); { Recalculate the OutCode }
+ END;
+ END;
+ END; { while }
+end;
+
procedure TfpgCanvasBase.DrawImage(x, y: TfpgCoord; img: TfpgImageBase);
begin
if img = nil then
diff --git a/src/corelib/x11/fpgfx_package.pas b/src/corelib/x11/fpgfx_package.pas
index d7813dee..ea32e8cc 100644
--- a/src/corelib/x11/fpgfx_package.pas
+++ b/src/corelib/x11/fpgfx_package.pas
@@ -8,10 +8,9 @@ interface
uses
x11_xft, x11_keyconv, gfxbase, gfx_x11, fpgfx, gfx_stdimages, gfx_imgfmt_bmp,
- gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams,
- gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline,
- gfx_imagelist, gfx_constants, gfx_pofiles, gfx_translations,
- gfx_stringhashlist;
+ gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams, gfx_utils,
+ gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline, gfx_imagelist,
+ gfx_constants, gfx_pofiles, gfx_translations, gfx_stringhashlist;
implementation
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index 49b58825..7fea5804 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -12,6 +12,7 @@ uses
X,
Xlib,
XUtil,
+ ctypes,
x11_xft,
_netlayer,
gfxbase,
@@ -50,6 +51,45 @@ type
end;
PXdbeSwapInfo = ^TXdbeSwapInfo;
+ // MWM support
+ TMWMHints = record
+ flags: culong;
+ functions: culong;
+ decorations: culong;
+ input_mode: longint;
+ status: culong;
+ end;
+
+
+const
+// Motif window hints
+ MWM_HINTS_FUNCTIONS = 1 shl 0;
+ MWM_HINTS_DECORATIONS = 1 shl 1;
+ MWM_HINTS_INPUT_MODE = 1 shl 2;
+ MWM_HINTS_STATUS = 1 shl 3;
+// bit definitions for MwmHints.functions */
+ MWM_FUNC_ALL = 1 shl 0;
+ MWM_FUNC_RESIZE = 1 shl 1;
+ MWM_FUNC_MOVE = 1 shl 2;
+ MWM_FUNC_MINIMIZE = 1 shl 3;
+ MWM_FUNC_MAXIMIZE = 1 shl 4;
+ MWM_FUNC_CLOSE = 1 shl 5;
+// bit definitions for MwmHints.decorations */
+ MWM_DECOR_ALL = 1 shl 0;
+ MWM_DECOR_BORDER = 1 shl 1;
+ MWM_DECOR_RESIZEH = 1 shl 2;
+ MWM_DECOR_TITLE = 1 shl 3;
+ MWM_DECOR_MENU = 1 shl 4;
+ MWM_DECOR_MINIMIZE = 1 shl 5;
+ MWM_DECOR_MAXIMIZE = 1 shl 6;
+// bit definitions for MwmHints.inputMode */
+ MWM_INPUT_MODELESS = 0;
+ MWM_INPUT_PRIMARY_APPLICATION_MODAL = 1;
+ MWM_INPUT_SYSTEM_MODAL = 2;
+ MWM_INPUT_FULL_APPLICATION_MODAL = 3;
+ PROP_MWM_HINTS_ELEMENTS = 5;
+
+type
TXWindowStateFlag = (xwsfMapped);
TXWindowStateFlags = set of TXWindowStateFlag;
@@ -1266,6 +1306,9 @@ var
IconPixmap: TPixmap;
WMHints: PXWMHints;
+
+ prop: TAtom;
+ mwmhints: TMWMHints;
begin
if HandleIsValid then
Exit; //==>
@@ -1370,6 +1413,31 @@ begin
// we have a Splash screen
fpgApplication.netlayer.WindowSetType(FWinHandle, [nwtSplash]);
+ // process Borderless forms
+ if (FWindowType = wtWindow) and (waBorderless in FWindowAttributes) then
+ begin
+ prop := X.None;
+ prop := XInternAtom(xapplication.display, '_MOTIF_WM_INFO', longbool(0));
+ if prop = X.None then
+ begin
+ writeln('Window Manager does not support MWM hints. Bypassing window manager control for borderless window.');
+ // Set Override Redirect here!
+ mwmhints.flags := 0;
+ end
+ else
+ begin
+ mwmhints.flags := MWM_HINTS_DECORATIONS;
+ mwmhints.decorations := 0;
+
+ if xapplication.xia_motif_wm_hints <> X.None then
+ begin
+
+ prop := xapplication.xia_motif_wm_hints;
+ XChangeProperty(xapplication.display, FWinHandle, prop, prop, 32, PropModeReplace, @mwmhints, PROP_MWM_HINTS_ELEMENTS);
+ end;
+ end;
+ end;
+
{ TODO : We could optimise this for non-focusable widgets }
XSelectInput(xapplication.Display, wh, KeyPressMask or KeyReleaseMask or
ButtonPressMask or ButtonReleaseMask or