;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;;
;;; 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 (gnu build svg)
  #:use-module (rsvg)
  #:use-module (cairo)
  #:use-module (srfi srfi-11)
  #:export (svg->png))

(define* (downscaled-surface surface
                             #:key
                             source-width source-height
                             width height)
  "Return a new rendering context where SURFACE is scaled to WIDTH x HEIGHT."
  (let ((cr (cairo-create (cairo-image-surface-create 'argb32
                                                      width height))))
    (cairo-scale cr (/ width source-width) (/ height source-height))
    (cairo-set-source-surface cr surface 0 0)
    (cairo-pattern-set-filter (cairo-get-source cr) 'best)
    (cairo-rectangle cr 0 0 source-width source-height)
    (cairo-fill cr)
    cr))

(define* (svg->png in-svg out-png
                   #:key width height)
  "Render the file at IN-SVG as a PNG file in OUT-PNG.  When WIDTH and HEIGHT
are provided, use them as the dimensions of OUT-PNG; otherwise preserve the
dimensions of IN-SVG."
  (define svg
    (rsvg-handle-new-from-file in-svg))

  (let-values (((origin-width origin-height em ex)
                (rsvg-handle-get-dimensions svg)))
    (let* ((surf (cairo-image-surface-create 'argb32
                                             origin-width origin-height))
           (cr   (cairo-create surf)))
      (rsvg-handle-render-cairo svg cr)
      (cairo-surface-flush surf)
      (let ((cr (if (and width height
                         (not (= width origin-width))
                         (not (= height origin-height)))
                    (downscaled-surface surf
                                        #:source-width origin-width
                                        #:source-height origin-height
                                        #:width width
                                        #:height height)
                    cr)))
        (cairo-surface-write-to-png (cairo-get-target cr) out-png)))))

;;; svg.scm ends here
lass='msg-tooltip'>Fixes &lt;https://bugs.gnu.org/34279&gt;.
Reported by Claes Wallin (韋嘉誠) &lt;clacke@lysator.liu.se&gt;.

* etc/guix-install.sh: Change shebang to #!/bin/sh and add 'if'
statement to spawn Bash if needed.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-12-13 18:44:40 +0100'>2018-12-13</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=1fc90e89f01f6fc372ef9d58826a23d861df24a7'>guix-install.sh: Use pool.sks-keyservers.net.</a><span class='msg-avail'>...<span class='msg-tooltip'>"pgp.mit.edu" has been unavailable for some time.

* etc/guix-install.sh (chk_require): Change key server to
pool.sks-keyservers.net.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-12-05 16:26:55 +0100'>2018-12-05</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=4a0b87f0ec5b6c2dcf82b372dd20ca7ea6acdd9c'>guix-install.sh: Use the "ci.guix.info.pub" file name for clarity.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/guix-install.sh (sys_authorize_build_farms): Use the
"ci.guix.info.pub" file name rather "berlin.guixsd.org.pub".
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-11-23 15:42:01 +0100'>2018-11-23</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=e9926f80c6553fde50ce1fcfd38d6370f841efd2'>build: Binary tarball now populates the "current-guix" profile.</a><span class='msg-avail'>...<span class='msg-tooltip'>* Makefile.am (guix-binary.%.tar.xz): Pass
'--profile-name=current-guix'.  Remove glibc and glibc-utf8-locales.
* doc/guix.texi (Binary Installation): Update accordingly.
* etc/guix-install.sh
* etc/guix-install.sh (sys_create_store, sys_enable_guix_daemon)
(sys_authorize_build_farms): Likewise.
* etc/guix-publish.conf.in, etc/guix-publish.service.in,
etc/guix-daemon.conf.in, etc/guix-daemon.service.in: Update file names
accordingly.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-10-14 23:48:49 +0200'>2018-10-14</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=2510bd87562bfee9d82348f1c08dd78ccea12dd1'>guix-install.sh: Recognize armhf-linux.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/guix-install.sh (chk_sys_arch): Add "armv7l" case.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-05-19 22:47:07 +0200'>2018-05-19</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=593fe736674fadedd961c499e5758fa9c96a57aa'>guix-install.sh: Fix chk_require exiting without warning.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/guix-install.sh (chk_require): Because of the set -e option, Bash was
exiting when the command `command -v "$c" &amp;&gt;/dev/null' was running on its
own. Instead, we now test the command and accumulate warning messages in a
single statement by chaining the command with a logical OR.

Signed-off-by: Ludovic Courtès &lt;ludo@gnu.org&gt;
</span></span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2018-03-29 07:03:37 +0200'>2018-03-29</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=3cd4447f5639f45b7d833f6fb2adce11ea15ba1d'>guix-install.sh: Explicitly set root's home directory.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/guix-install.sh (ROOT_HOME): New variable.
  (sys_create_store, sys_enable_guix_daemon, sys_authorize_build_farms):
  Use ROOT_HOME instead of ~root or the HOME environment variable.
* doc/guix.texi (Binary Installation): Instead of assuming that ~ and
  $HOME refer to root's directory simply because commands are being run
  as root, explicilty refer to it via ~root.

Fixes: &lt;https://bugs.gnu.org/30728&gt;
</span></span></td><td>Chris Marusich</td></tr>
<tr><td><span title='2018-02-21 22:14:39 +0200'>2018-02-21</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=ea6b1baec7515ec941f35c186ab314ec1c844250'>etc: guix-install.sh: Add aarch64-linux support.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/guix-install.sh (chk_sys_arch): Add aarch64 case.
</span></span></td><td>Efraim Flashner</td></tr>
<tr><td><span title='2018-01-30 03:48:04 +0100'>2018-01-30</span></td><td><a href='/guix/commit/etc/guix-install.sh?id=6f4e8693e7b0c5d830eafa8a69c3559390f13369'>etc: Add installation script.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/guix-install.sh: New file.
* Makefile.am (EXTRA_DIST): Add it.
* doc/guix.texi (Binary Installation): Mention it.

Co-authored-by: sharlatan &lt;sharlatanus@gmail.com&gt;
</span></span></td><td>Ricardo Wurmus</td></tr>