X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/f9364484c7530f9d371b4b37b796720b5e84012b..3b688fe895de03b38fff2b8c36f0c01a17b320db:/cairo/cairo.lisp diff --git a/cairo/cairo.lisp b/cairo/cairo.lisp index 266484f..0e91ef1 100644 --- a/cairo/cairo.lisp +++ b/cairo/cairo.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: cairo.lisp,v 1.4 2006/02/08 22:19:44 espen Exp $ +;; $Id: cairo.lisp,v 1.5 2006/02/09 22:30:39 espen Exp $ (in-package "CAIRO") @@ -631,11 +631,8 @@ (defbinding %scaled-font-create () pointer (ctm matrix) (options font-options)) -(defmethod initialize-instance ((scaled-font scaled-font) &key font-face font-matrix cmt options) - (setf - (foreign-location scaled-font) - (%scaled-font-create font-face font-matrix cmt options)) - (call-next-method)) +(defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options) + (%scaled-font-create font-face font-matrix cmt options)) @@ -659,10 +656,9 @@ (defbinding font-options-status () status (defbinding %font-options-create () pointer) -(defmethod initialize-instance ((font-options font-options) &rest initargs) +(defmethod allocate-foreign ((font-options font-options) &rest initargs) (declare (ignore initargs)) - (setf (foreign-location font-options) (%font-options-create)) - (call-next-method)) + (%font-options-create)) (defbinding font-options-merge () nil (options1 font-options :return) @@ -735,18 +731,15 @@ (defun surface-mark-dirty (surface &optional x y width height) ;; Image Surface ;; Should data be automatically freed when the surface is GCed? -(defmethod initialize-instance ((surface image-surface) - &key width height stride format data) - (setf - (foreign-location surface) - (if (not data) - (%image-surface-create format width height) - (%image-surface-create-for-data data format width height - (or - stride - (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8)))))) - (ceiling (* width element-size))))))) - (call-next-method)) +(defmethod allocate-foreign ((surface image-surface) + &key width height stride format data) + (if (not data) + (%image-surface-create format width height) + (%image-surface-create-for-data data format width height + (or + stride + (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8)))))) + (ceiling (* width element-size))))))) (defbinding %image-surface-create () image-surface