From mboxrd@z Thu Jan 1 00:00:00 1970 From: Mark H Weaver Subject: [PATCH] system: grub: Use librsvg to convert SVG to PNG Date: Fri, 02 Sep 2016 04:02:46 -0400 Message-ID: <87lgzaloex.fsf@netris.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:47798) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bfjRT-0001Sb-Ta for guix-devel@gnu.org; Fri, 02 Sep 2016 04:03:20 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bfjRO-0003Ts-Kv for guix-devel@gnu.org; Fri, 02 Sep 2016 04:03:14 -0400 Received: from world.peace.net ([50.252.239.5]:41525) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bfjRO-0003Tb-F2 for guix-devel@gnu.org; Fri, 02 Sep 2016 04:03:10 -0400 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org --=-=-= Content-Type: text/plain Hello Guix, The attached patch eliminates the use of 'inkscape' and 'imagemagick' to convert our grub background image from SVG to PNG. The job is now done using 'librsvg' [1] via Guile's dynamic FFI. I was unable to perform the needed scaling using the 'rsvg-convert' program, so I had to use librsvg directly. As a side benefit, the resulting image quality should be superior when scaling is performed, because scaling is now effectively done in the vector representation during rendering, whereas previously it was done in the raster representation as a separate step. What do you think? Mark [1] Note that in the past, 'librsvg' was unable to properly convert our SVG file, but that problem seems to be fixed. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-system-grub-Use-librsvg-to-convert-SVG-to-PNG.patch Content-Transfer-Encoding: quoted-printable Content-Description: [PATCH] system: grub: Use librsvg to convert SVG to PNG >From a50f358b083cff4d156cd7116fee516952fc9bcf Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 2 Sep 2016 02:26:43 -0400 Subject: [PATCH] system: grub: Use librsvg to convert SVG to PNG. * guix/build/svg.scm: New file. * Makefile.am (MODULES): Add it. * gnu/system/grub.scm (svg->png): Add 'width' and 'height' arguments. Reimplement using (guix build svg). Drop references to 'inkscape' and 'imagemagick'. (resize-image): Remove. (grub-background-image): Adapt to the incorporation of scaling into 'svg->png'. --- Makefile.am | 1 + gnu/system/grub.scm | 34 +++++++---------- guix/build/svg.scm | 108 ++++++++++++++++++++++++++++++++++++++++++++++++= ++++ 3 files changed, 122 insertions(+), 21 deletions(-) create mode 100644 guix/build/svg.scm diff --git a/Makefile.am b/Makefile.am index 79abd6b..f5ceeb6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -101,6 +101,7 @@ MODULES =3D \ guix/build/pull.scm \ guix/build/rpath.scm \ guix/build/cvs.scm \ + guix/build/svg.scm \ guix/build/svn.scm \ guix/build/syscalls.scm \ guix/build/gremlin.scm \ diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 45b46ca..e61dbcf 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2013, 2014, 2015, 2016 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2016 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,8 +28,7 @@ #:use-module (gnu artwork) #:use-module (gnu system file-systems) #:autoload (gnu packages grub) (grub) - #:autoload (gnu packages inkscape) (inkscape) - #:autoload (gnu packages imagemagick) (imagemagick) + #:autoload (gnu packages gnome) (librsvg) #:autoload (gnu packages compression) (gzip) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -121,25 +121,18 @@ ;;; Background image & themes. ;;; =20 -(define (svg->png svg) - "Build a PNG from SVG." +(define* (svg->png svg #:optional width height) + "Build a PNG of size WIDTH and HEIGHT from SVG. If omitted, WIDTH and +HEIGHT default to the natural image size." ;; Don't use #:local-build? so that it's substitutable. (gexp->derivation "grub-image.png" - #~(zero? - (system* (string-append #$inkscape "/bin/inkscape") - "--without-gui" - (string-append "--export-png=3D" #$output) - #$svg)))) - -(define (resize-image image width height) - "Resize IMAGE to WIDTHxHEIGHT." - ;; Don't use #:local-build? so that it's substitutable. - (let ((size (string-append (number->string width) - "x" (number->string height)))) - (gexp->derivation "grub-image.resized.png" - #~(zero? - (system* (string-append #$imagemagick "/bin/conve= rt") - "-resize" #$size #$image #$output))))) + #~(begin + (use-modules (guix build svg)) + (svg->png #$svg #$output + #:width #$width + #:height #$height + #:librsvg #$librsvg)) + #:modules '((guix build svg)))) =20 (define* (grub-background-image config #:key (width 1024) (height 768)) "Return the GRUB background image defined in CONFIG with a ratio of @@ -149,8 +142,7 @@ WIDTH/HEIGHT, or #f if none was found." (=3D (grub-image-aspect-ratio image) ratio)) (grub-theme-images (grub-configuration-theme config)= )))) (if image - (mlet %store-monad ((png (svg->png (grub-image-file image)))) - (resize-image png width height)) + (svg->png (grub-image-file image) width height) (with-monad %store-monad (return #f))))) =20 diff --git a/guix/build/svg.scm b/guix/build/svg.scm new file mode 100644 index 0000000..610734b --- /dev/null +++ b/guix/build/svg.scm @@ -0,0 +1,108 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2016 Mark H Weaver +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix build svg) + #:use-module (ice-9 match) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:export (svg->png)) + +(define (null-check! message) + (match-lambda + ((? null-pointer?) + (error message)) + (pointer pointer))) + +(define (int-bool-check! message) + (match-lambda + (0 (error message)) + (_ #t))) + +(define CAIRO_STATUS_SUCCESS 0) +(define (cairo-status-check! message) + (lambda (status) + (or (=3D status CAIRO_STATUS_SUCCESS) + (error message status)))) + +(define* (svg->png svg png #:key width height librsvg) + "Build a PNG of size WIDTH and HEIGHT from SVG using LIBRSVG. +If omitted, WIDTH and HEIGHT default to the natural image size." + + (define library + (dynamic-link (if librsvg + (string-append librsvg "/lib/librsvg-2.so") + "librsvg-2.so"))) + + (define (c-function return-type name arg-types) + (pointer->procedure return-type (dynamic-func name library) arg-types)) + + (define rsvg-handle-new-from-file + (compose (null-check! "rsvg-handle-new-from-file failed") + (c-function '* "rsvg_handle_new_from_file" '(* *)) + (lambda (name) + (values (string->pointer name) + (make-c-struct '(*) (list %null-pointer)))))) + + (define rsvg-handle-get-dimensions + (let ((get-dimensions* + (c-function void "rsvg_handle_get_dimensions" '(* *))) + (type (list int int double double))) + (lambda (handle) + (let ((dimensions (make-c-struct type '(0 0 0 0)))) + (get-dimensions* handle dimensions) + (parse-c-struct dimensions type))))) + + (define rsvg-handle-render-cairo + (compose (int-bool-check! "rsvg-handle-render-cairo failed") + (c-function int "rsvg_handle_render_cairo" '(* *)))) + + (define g-object-unref + (c-function void "g_object_unref" '(*))) + + (define CAIRO_FORMAT_ARGB32 0) + (define cairo-image-surface-create + (compose (null-check! "cairo-image-surface-create failed") + (c-function '* "cairo_image_surface_create" + (list int int int)))) + (define cairo-create (compose (null-check! "cairo-create failed") + (c-function '* "cairo_create" '(*)))) + (define cairo-scale (c-function void "cairo_scale" (list '* double doubl= e))) + (define cairo-destroy (c-function void "cairo_destroy" '(*))) + (define cairo-surface-destroy (c-function void "cairo_surface_destroy" '= (*))) + + (define cairo-surface-write-to-png + (compose (cairo-status-check! "cairo-surface-write-to-png failed") + (c-function int "cairo_surface_write_to_png" '(* *)) + (lambda (surface name) + (values surface (string->pointer name))))) + + (let ((rsvg-handle (rsvg-handle-new-from-file svg))) + (match (rsvg-handle-get-dimensions rsvg-handle) + ((natural-width natural-height . _) + (let* ((width (or width natural-width)) + (height (or height natural-height)) + (surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 + width height)) + (cr (cairo-create surface))) + (cairo-scale cr (/ width natural-width) (/ height natural-height)) + (rsvg-handle-render-cairo rsvg-handle cr) + (g-object-unref rsvg-handle) + (cairo-surface-write-to-png surface png) + (cairo-destroy cr) + (cairo-surface-destroy surface) + #t))))) --=20 2.9.3 --=-=-=--