[graphic-forms-cvs] r269 - trunk/src/uitoolkit/system

[junrue at common-lisp.net]

Author: junrue
Date: Tue Sep 26 16:54:18 2006
New Revision: 269

Modified:
   trunk/src/uitoolkit/system/datastructs.lisp
   trunk/src/uitoolkit/system/system-constants.lisp
   trunk/src/uitoolkit/system/system-types.lisp
Log:
added foreign type translators for the RECT and POINT foreign types

Modified: trunk/src/uitoolkit/system/datastructs.lisp
==============================================================================
--- trunk/src/uitoolkit/system/datastructs.lisp	(original)
+++ trunk/src/uitoolkit/system/datastructs.lisp	Tue Sep 26 16:54:18 2006
@@ -58,15 +58,38 @@
   (declare (ignore param))
   (cffi:foreign-free ptr))
 
+(defmethod cffi:free-translated-object (ptr (name (eql 'rect-pointer)) param)
+  (declare (ignore param))
+  (cffi:foreign-free ptr))
+
 (defmethod cffi:translate-from-foreign (ptr (name (eql 'point-pointer)))
-  (if (null-pointer-p ptr)
+  (if (cffi:null-pointer-p ptr)
     (make-point)
     (cffi:with-foreign-slots ((x y) ptr point)
       (make-point :x x :y y))))
 
+(defmethod cffi:translate-from-foreign (ptr (name (eql 'rect-pointer)))
+  (if (cffi:null-pointer-p ptr)
+    (make-rectangle)
+    (cffi:with-foreign-slots ((left top right bottom) ptr rect)
+      (let ((pnt (make-point :x left :y top))
+            (size (make-size :width (- right left) :height (- bottom top))))
+        (make-rectangle :location pnt :size size)))))
+
 (defmethod cffi:translate-to-foreign ((lisp-pnt point) (name (eql 'point-pointer)))
   (let ((ptr (cffi:foreign-alloc 'point)))
     (cffi:with-foreign-slots ((x y) ptr point)
       (setf x (point-x lisp-pnt)
             y (point-y lisp-pnt)))
     ptr))
+
+(defmethod cffi:translate-to-foreign ((lisp-rect rectangle) (name (eql 'rect-pointer)))
+  (let ((ptr (cffi:foreign-alloc 'rect))
+        (pnt (location lisp-rect))
+        (size (size lisp-rect)))
+    (cffi:with-foreign-slots ((left top right bottom) ptr rect)
+      (setf left   (gfs:point-x pnt)
+            top    (gfs:point-y pnt)
+            right  (+ (gfs:point-x pnt) (gfs:size-width size))
+            bottom (+ (gfs:point-y pnt) (gfs:size-height size))))
+    ptr))

Modified: trunk/src/uitoolkit/system/system-constants.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-constants.lisp	(original)
+++ trunk/src/uitoolkit/system/system-constants.lisp	Tue Sep 26 16:54:18 2006
@@ -1277,6 +1277,15 @@
 (defconstant +ws-ex-composited+        #x02000000)
 (defconstant +ws-ex-noactivate+        #x08000000)
 
+(defconstant +wvr-aligntop+                #x0010)
+(defconstant +wvr-alignleft+               #x0020)
+(defconstant +wvr-alignbottom+             #x0040)
+(defconstant +wvr-alignright+              #x0080)
+(defconstant +wvr-hredraw+                 #x0100)
+(defconstant +wvr-vredraw+                 #x0200)
+(defconstant +wvr-redraw+                  #x0300)
+(defconstant +wvr-validrects+              #x0400)
+
 (defconstant +white-brush+                      0)
 (defconstant +ltgray-brush+                     1)
 (defconstant +gray-brush+                       2)

Modified: trunk/src/uitoolkit/system/system-types.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-types.lisp	(original)
+++ trunk/src/uitoolkit/system/system-types.lisp	Tue Sep 26 16:54:18 2006
@@ -287,6 +287,8 @@
   (incupdate BOOL)
   (reserved BYTE :count 32))
 
+(defctype rect-pointer :pointer)
+
 (defcstruct rect
   (left LONG)
   (top LONG)
@@ -300,6 +302,12 @@
   (flags DWORD)
   (device TCHAR :count 32)) ; CCHDEVICENAME
 
+(defcstruct nccalcsize_params
+  (clientnewrect  rect)
+  (destvalidrect  rect)
+  (srcvalidrect   rect)
+  (lppos          LPTR))
+
 (defcstruct openfilename
   (ofnsize DWORD)
   (ofnhwnd HANDLE)
@@ -383,6 +391,15 @@
   (cywinborders UINT)
   (wintype ATOM)
   (version WORD))
+
+(defcstruct windowpos
+  (hwnd      HANDLE)
+  (hwndafter HANDLE)
+  (x         INT)
+  (y         INT)
+  (cx        INT)
+  (cy        INT)
+  (flags    UINT))
   
 (defcstruct wndclassex
   (cbsize UINT)