From bc42b58608698321969a51640dec45762de269ad Mon Sep 17 00:00:00 2001 From: David Pirotte Date: Fri, 10 Mar 2023 23:33:35 -0300 Subject: [PATCH 3/3] New context->cairo-pointer cairo-pointer->context interfaces Note: cairo-pointer->context was first written by Daniel Llorens, then fixed by Dale Smith who also wrote context->cairo-pointer. I merely prepared and sent the patch, I wrote the test. Special thanks to both, as cairo-pointer->context is added on my demand, to make guile-cairo usable with G-Golf. * guile-cairo/guile-cairo.c (context->cairo-pointer, cairo-pointer->context): New procedures. * tests/unit-tests/context-pointer.scm: New file, testing the new procedures. * tests/unit-tests/Makefile.am: Updated for the above. --- guile-cairo/guile-cairo.c | 20 +++++++++++++++++-- tests/unit-tests/Makefile.am | 6 ++++-- tests/unit-tests/context-pointer.scm | 29 ++++++++++++++++++++++++++++ 3 files changed, 51 insertions(+), 4 deletions(-) create mode 100644 tests/unit-tests/context-pointer.scm diff --git a/guile-cairo/guile-cairo.c b/guile-cairo/guile-cairo.c index b298fc8..8d8c0b7 100644 --- a/guile-cairo/guile-cairo.c +++ b/guile-cairo/guile-cairo.c @@ -1,6 +1,10 @@ /* guile-cairo * Copyright (C) 2007, 2011, 2012, 2014, 2018, 2020 Andy Wingo - * + * Copyright (C) 2023 Daniel Llorens + * Copyright (C) 2023 Dale Smith + + David Pirotte + * guile-cairo.c: Cairo for Guile * * This library is free software; you can redistribute it and/or modify @@ -3522,7 +3526,19 @@ cairo_svg_version_to_string (cairo_svg_version_t version); #endif /* CAIRO_HAS_SVG_SURFACE */ - +SCM_DEFINE_PUBLIC (scm_context2cairo_pointer, "context->cairo-pointer", 1, 0, 0, + (SCM scr), + "") +{ + return scm_from_pointer (scm_to_cairo (scr), NULL); +} + +SCM_DEFINE_PUBLIC (scm_cairo_pointer2context, "cairo-pointer->context", 1, 0, 0, + (SCM scr), + "") +{ + return scm_from_cairo ((cairo_t *) scm_to_pointer (scr)); +} void scm_init_cairo (void) diff --git a/tests/unit-tests/Makefile.am b/tests/unit-tests/Makefile.am index c13443d..9bf2316 100644 --- a/tests/unit-tests/Makefile.am +++ b/tests/unit-tests/Makefile.am @@ -1,5 +1,6 @@ # guile-cairo # Copyright (C) 2007,2011 Andy Wingo +# Copyright (C) 2023 David Pirotte # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as @@ -16,8 +17,9 @@ # . TESTS= \ - api-stability.scm \ - version.scm + api-stability.scm \ + version.scm \ + context-pointer.scm TESTS_ENVIRONMENT=\ API_FILE=$(srcdir)/cairo.api $(top_builddir)/env guile -s diff --git a/tests/unit-tests/context-pointer.scm b/tests/unit-tests/context-pointer.scm new file mode 100644 index 0000000..c746e58 --- /dev/null +++ b/tests/unit-tests/context-pointer.scm @@ -0,0 +1,29 @@ +;; guile-cairo unit test +;; Copyright (C) 2023 David Pirotte + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or (at +;; your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(use-modules (unit-test) + (oop goops) + (cairo)) + +(define-class ()) + +(define-method (test-context-pointer (self )) + (let* ((cs (cairo-image-surface-create 'argb32 140 100)) + (cr (cairo-create cs))) + (assert (context->cairo-pointer cr)) + (assert (cairo-pointer->context (context->cairo-pointer cr))))) + +(exit-with-summary (run-all-defined-test-cases)) -- 2.39.2