;;; 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
/guix/commit/gnu/packages/simulation.scm?id=1e6ddceb8318d413745ca1c9d91fde01b1e0364b'>gnu: Use HTTPS package home pages wherever possible.</a><span class='msg-avail'>...</span></td><td>Tobias Geerinckx-Rice</td></tr>
<tr><td><span title='2023-02-12 08:45:36 +0100'>2023-02-12</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=015777f4c5094d20c2697c633dfe52ff966052a1'>gnu: Add esmini.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2023-02-12 08:45:35 +0100'>2023-02-12</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=4a42167c3cb39645d07cb1a25b4e4e75247b4322'>gnu: Add python-open-simulation-interface.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2023-02-12 08:45:35 +0100'>2023-02-12</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=efee3dd7a175c2e068178cc0b48479a03775c23d'>gnu: Add open-simulation-interface.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2023-01-08 16:29:56 +0100'>2023-01-08</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=e55bc944a94134f7ff2a4ab4a0e8b9a5ac9d46d1'>gnu: Add python-commonroad-route-planner.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2023-01-08 16:29:56 +0100'>2023-01-08</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=86136b4f76e3950124563aea5173a3f78847c3c2'>gnu: Add python-commonroad-io.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2023-01-08 16:27:59 +0100'>2023-01-08</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=59a8de6bad856ee012cd6bc8aaf4d929a6c8e619'>gnu: Add python-commonroad-vehicle-models.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2022-10-27 19:43:07 +0200'>2022-10-27</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=e05e2a7a75fb7994df48423ecebb7bf1a6ea8177'>gnu: python-pygmsh: Use pyproject-build-system.</a><span class='msg-avail'>...</span></td><td>Marius Bakke</td></tr>
<tr><td><span title='2022-10-24 20:31:34 +0200'>2022-10-24</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=8663be6da7f13a8eeea71dc1f493f7adc5b7672a'>gnu: Add sumo.</a><span class='msg-avail'>...</span></td><td>Liliana Marie Prikler</td></tr>
<tr><td><span title='2022-09-15 20:15:56 -0400'>2022-09-15</span></td><td><a href='/guix/commit/gnu/packages/simulation.scm?id=b736af1824acb941919ee671ff5a8a67fa735406'>gnu: catch-framework2: Rename variable to catch2.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>