From 0b3066420f72ecf15b65406bd417768450bfcac7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 19 Aug 2015 17:26:02 -0400 Subject: [PATCH] system: grub: Convert grub background using rsvg-convert, not inkscape. * gnu/system/grub.scm (svg->png): Accept additional arguments 'width' and 'height'. Reimplement using rsvg-convert and emacs instead of inkscape. (resize-image): Remove. (grub-background-image): Remove 'resize-image' step. Pass 'width' and 'height' to 'svg->png'. --- gnu/system/grub.scm | 57 +++++++++++++++++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index e49b6db..fe7400a 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 Ludovic Courtès +;;; Copyright © 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,8 +27,8 @@ #:use-module (guix download) #:use-module (gnu artwork) #:autoload (gnu packages grub) (grub) - #:autoload (gnu packages inkscape) (inkscape) - #:autoload (gnu packages imagemagick) (imagemagick) + #:autoload (gnu packages emacs) (emacs) + #:autoload (gnu packages gnome) (librsvg) #:autoload (gnu packages compression) (gzip) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -119,25 +120,40 @@ ;;; Background image & themes. ;;; -(define (svg->png svg) +(define (svg->png svg width height) "Build a PNG from SVG." ;; 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))))) + (let ((width (number->string width)) + (height (number->string height))) + (gexp->derivation + "grub-image.png" + #~(begin + (use-modules (guix build emacs-utils)) + (let ((image-file "/tmp/image.svg")) + ;; The SVG images in the guix-artwork repository contain a bottom + ;; "Background" layer containing a checkerboard pattern. Here we + ;; remove that layer. + (copy-file #$svg image-file) + (chmod image-file #o644) + (parameterize ((%emacs (string-append #$emacs "/bin/emacs"))) + (emacs-batch-edit-file image-file + '(progn (goto-char (point-min)) + (when (re-search-forward "inkscape:label=\"Background\"" + nil nil) + (nxml-backward-up-element) + (set-mark (point)) + (nxml-forward-element) + (kill-region (mark) (point)) + (basic-save-buffer))))) + (zero? + (system* (string-append #$librsvg "/bin/rsvg-convert") + "--width" #$width + "--height" #$height + "--background-color" "black" + "--format" "png" + "--output" #$output + image-file)))) + #:modules '((guix build emacs-utils))))) (define* (grub-background-image config #:key (width 640) (height 480)) "Return the GRUB background image defined in CONFIG with a ratio of @@ -147,8 +163,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))))) -- 2.5.0