[PATCH] system: grub: Use librsvg to convert SVG to PNG

[PATCH] system: grub: Use librsvg to convert SVG to PNG

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 733 bytes --]

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.


[-- Attachment #2: [PATCH] system: grub: Use librsvg to convert SVG to PNG --]
[-- Type: text/x-patch, Size: 8797 bytes --]

From a50f358b083cff4d156cd7116fee516952fc9bcf Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
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 =					\
   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 © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; 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.
 ;;;
 
-(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=" #$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/convert")
-                                  "-resize" #$size #$image #$output)))))
+                    #~(begin
+                        (use-modules (guix build svg))
+                        (svg->png #$svg #$output
+                                  #:width #$width
+                                  #:height #$height
+                                  #:librsvg #$librsvg))
+                    #:modules '((guix build svg))))
 
 (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."
                         (= (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)))))
 
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 © 2016 Mark H Weaver <mhw@netris.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 (= 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 double)))
+  (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)))))
-- 
2.9.3

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Ludovic Courtès]

Hi Mark!

Mark H Weaver <mhw@netris.org> skribis:

> 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?

I think it’s excellent.  :-)
> From a50f358b083cff4d156cd7116fee516952fc9bcf Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> 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'.

[...]

> +(define-module (guix build svg)
> +  #:use-module (ice-9 match)
> +  #:use-module (system foreign)
> +  #:use-module (rnrs bytevectors)
> +  #:export (svg->png))

Is there are reason for not using guile-rsvg and guile-cairo?  Otherwise
I think it would be preferable (they’d need to be autoloaded so that
‘make’ doesn’t fail when they’re missing, but that’s OK.)

I found an example that Andy had posted:

  https://lists.gnu.org/archive/html/guix-devel/2015-08/msg00753.html

Thank you!

Ludo’.

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Vincent Legoll]

Hello,

> 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.
> [...]
> What do you think?

This is very good, reducing the bare-bones system configuration even if
keeping the default grub theme.

I'll test it later

-- 
Vincent Legoll

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Vincent Legoll]

Hello,

> This is very good, reducing the bare-bones system configuration even if
> keeping the default grub theme.
>
> I'll test it later

I think it works OK, tested it like that:

changed root's .config/guix/latest to point to a current guix git checkout
+ your patch, modified my /etc/config.scm to comment out the grub theme:

  (bootloader (grub-configuration (device "/dev/vda")
;;                                  (theme (grub-theme))
))

ran guix system reconfigure /etc/config.scm && guix gc

and now I can't see inkscape in /gnu/store any more...

This is probably not the best way to test, but I think it is still conclusive

Thanks

-- 
Vincent Legoll

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Vincent Legoll]

And I also now tested back the other way, if I guix pull (so the patch is
not in effect anymore) now I get inkscape (& al.) back into the store...

-- 
Vincent Legoll

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Leo Famulari]

On Fri, Sep 02, 2016 at 04:02:46AM -0400, Mark H Weaver wrote:
> From a50f358b083cff4d156cd7116fee516952fc9bcf Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> 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'.

This works as expected for me on x86_64.

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Ludovic Courtès]

Hi!

ludo@gnu.org (Ludovic Courtès) skribis:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> 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?
>
> I think it’s excellent.  :-)
>> From a50f358b083cff4d156cd7116fee516952fc9bcf Mon Sep 17 00:00:00 2001
>> From: Mark H Weaver <mhw@netris.org>
>> 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'.
>
> [...]
>
>> +(define-module (guix build svg)
>> +  #:use-module (ice-9 match)
>> +  #:use-module (system foreign)
>> +  #:use-module (rnrs bytevectors)
>> +  #:export (svg->png))
>
> Is there are reason for not using guile-rsvg and guile-cairo?  Otherwise
> I think it would be preferable (they’d need to be autoloaded so that
> ‘make’ doesn’t fail when they’re missing, but that’s OK.)
>
> I found an example that Andy had posted:
>
>   https://lists.gnu.org/archive/html/guix-devel/2015-08/msg00753.html

I hacked this a little bit a pushed as
ffde82c9ecf99524220e463055f4f18c8c9e7a81.

Ludo’.

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Leo Famulari]

On Tue, Oct 25, 2016 at 01:24:15AM +0200, Ludovic Courtès wrote:
> > Is there are reason for not using guile-rsvg and guile-cairo?  Otherwise
> > I think it would be preferable (they’d need to be autoloaded so that
> > ‘make’ doesn’t fail when they’re missing, but that’s OK.)
> >
> > I found an example that Andy had posted:
> >
> >   https://lists.gnu.org/archive/html/guix-devel/2015-08/msg00753.html
> 
> I hacked this a little bit a pushed as
> ffde82c9ecf99524220e463055f4f18c8c9e7a81.

A welcome change! But I think it needs a little more time in the
kitchen:

$ guix pull

Starting download of /tmp/guix-file.osf6YF
From http://git.savannah.gnu.org/cgit/guix.git/snapshot/master.tar.gz...
 ….tar.gz                                   980KiB/s 00:11 | 10.6MiB transferred
unpacking '/gnu/store/7b9v738y69s6ngca555c0962kr530z5a-guix-latest.tar.gz'...
The following derivation will be built:
   /gnu/store/3nl8yxfalzirgv69vyb5v98fvzkc878q-guix-latest.drv
building path(s) `/gnu/store/vyq66l6l7pnrk5nh848ddfrpl33myhzc-guix-latest'
copying and compiling to '/gnu/store/vyq66l6l7pnrk5nh848ddfrpl33myhzc-guix-latest'...
loading...	 23.2% of 538 filesrandom seed for tests: 1477353926
loading...	 26.0% of 538 filesBacktrace:
In ice-9/boot-9.scm:
 157: 19 [catch #t #<catch-closure 8c9580> ...]
In unknown file:
   ?: 18 [apply-smob/1 #<catch-closure 8c9580>]
In ice-9/boot-9.scm:
  63: 17 [call-with-prompt prompt0 ...]
In ice-9/eval.scm:
 432: 16 [eval # #]
In ice-9/boot-9.scm:
2401: 15 [save-module-excursion #<procedure 8e6800 at ice-9/boot-9.scm:4045:3 ()>]
4050: 14 [#<procedure 8e6800 at ice-9/boot-9.scm:4045:3 ()>]
1724: 13 [%start-stack load-stack #<procedure 8f9600 at ice-9/boot-9.scm:4041:10 ()>]
1729: 12 [#<procedure 8fc9c0 ()>]
In unknown file:
   ?: 11 [primitive-load "/gnu/store/3hq5mb2nd5cc5byp3i7sc7j4l422y2q2-guix-latest-builder"]
In ./guix/build/pull.scm:
  57: 10 [build-guix "/gnu/store/vyq66l6l7pnrk5nh848ddfrpl33myhzc-guix-latest" ...]
 123: 9 [#<procedure b57280 at ./guix/build/pull.scm:57:2 ()>]
In ice-9/boot-9.scm:
2864: 8 [resolve-interface (gnu build svg) #:select ...]
2789: 7 [#<procedure 84d300 at ice-9/boot-9.scm:2777:4 (name #:optional autoload version #:key ensure)> # ...]
3065: 6 [try-module-autoload (gnu build svg) #f]
2401: 5 [save-module-excursion #<procedure beb9c0 at ice-9/boot-9.scm:3066:17 ()>]
3085: 4 [#<procedure beb9c0 at ice-9/boot-9.scm:3066:17 ()>]
In unknown file:
   ?: 3 [primitive-load-path "gnu/build/svg" ...]
In ice-9/eval.scm:
 387: 2 [eval # ()]
In ice-9/boot-9.scm:
2867: 1 [resolve-interface (rsvg) #:select ...]
In unknown file:
   ?: 0 [scm-error misc-error #f "~A ~S" ("no code for module" (rsvg)) #f]

ERROR: In procedure scm-error:
ERROR: no code for module (rsvg)
builder for `/gnu/store/3nl8yxfalzirgv69vyb5v98fvzkc878q-guix-latest.drv' failed with exit code 1
guix pull: error: build failed: build of `/gnu/store/3nl8yxfalzirgv69vyb5v98fvzkc878q-guix-latest.drv' failed

Re: [PATCH] system: grub: Use librsvg to convert SVG to PNG

[Ludovic Courtès]

Leo Famulari <leo@famulari.name> skribis:

> On Tue, Oct 25, 2016 at 01:24:15AM +0200, Ludovic Courtès wrote:
>> > Is there are reason for not using guile-rsvg and guile-cairo?  Otherwise
>> > I think it would be preferable (they’d need to be autoloaded so that
>> > ‘make’ doesn’t fail when they’re missing, but that’s OK.)
>> >
>> > I found an example that Andy had posted:
>> >
>> >   https://lists.gnu.org/archive/html/guix-devel/2015-08/msg00753.html
>> 
>> I hacked this a little bit a pushed as
>> ffde82c9ecf99524220e463055f4f18c8c9e7a81.
>
> A welcome change! But I think it needs a little more time in the
> kitchen:
>
> $ guix pull

[...]

> In unknown file:
>    ?: 0 [scm-error misc-error #f "~A ~S" ("no code for module" (rsvg)) #f]
>
> ERROR: In procedure scm-error:
> ERROR: no code for module (rsvg)

Indeed it wasn’t fully cooked.  ;-)  I see your message just now, but
others reported it on IRC and it got fixed in
8ce84bf1f5705f5280e8bf8f150ec2e859b045ee.

Ludo’.