[bug#41163] [PATCH] gnu: grub: Allow a PNG image and replace (aspect-ratio) with (resolution).

[Stefan <stefan-guix@vodafonemail.de>]

* gnu/bootloaders/grub.scm (<grub-image>)[resolution]: Replacement of the
'aspect-ratio' field.
(<grub-theme>)[image]: Replacement of the 'images' field.
(svg->png): Remove default-values for 'width' and 'height' and only do the
conversion with them, if the suffix of the file is actually ".svg".

Using image formats different to SVG was not possible.

For a <grub-image> to be chosen, the 'aspect-ratio' of it had to be 4/3, as the
resolution of any image was defaulting to 1024 x 768.

There was no code yet to determine the proper boot-resolution, to make any use
of a list of images with different aspect-ratios.

It seems to be a better solution to only define a single image with any format,
and use a given resolution only for the conversion from a SVG file.

Moving the default values from '%background-image' and '%default-theme' into
<grub-image> and <grub-theme> makes a customisation easier without (inherit)
and allows to deprecate %background-image' and '%default-theme'.
---
 gnu/bootloader/grub.scm | 74 +++++++++++++++++++----------------------
 gnu/system.scm          |  1 +
 2 files changed, 36 insertions(+), 39 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 67736724a7..c70c3e260d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -40,12 +40,12 @@
   #:use-module (srfi srfi-2)
   #:export (grub-image
             grub-image?
-            grub-image-aspect-ratio
+            grub-image-resolution
             grub-image-file
 
             grub-theme
             grub-theme?
-            grub-theme-images
+            grub-theme-image
             grub-theme-color-normal
             grub-theme-color-highlight
 
@@ -82,34 +82,28 @@ denoting a file name."
 (define-record-type* <grub-image>
   grub-image make-grub-image
   grub-image?
-  (aspect-ratio    grub-image-aspect-ratio        ;rational number
-                   (default 4/3))
-  (file            grub-image-file))              ;file-valued gexp (SVG)
+  (resolution grub-image-resolution
+              (default '(1024 . 768)))
+  (file       grub-image-file
+              (default (file-append %artwork-repository
+                                    "/grub/GuixSD-fully-black-4-3.svg"))))
 
 (define-record-type* <grub-theme>
+  ;; Default theme contributed by Felipe López.
   grub-theme make-grub-theme
   grub-theme?
-  (images          grub-theme-images
-                   (default '()))                 ;list of <grub-image>
+  (image           grub-theme-image
+                   (default (grub-image)))
   (color-normal    grub-theme-color-normal
-                   (default '((fg . cyan) (bg . blue))))
+                   (default '((fg . light-gray) (bg . black))))
   (color-highlight grub-theme-color-highlight
-                   (default '((fg . white) (bg . blue))))
+                   (default '((fg . yellow) (bg . black))))
   (gfxmode         grub-gfxmode
                    (default '("auto"))))          ;list of string
 
-(define %background-image
-  (grub-image
-   (aspect-ratio 4/3)
-   (file (file-append %artwork-repository
-                      "/grub/GuixSD-fully-black-4-3.svg"))))
+(define %background-image (grub-image))
 
-(define %default-theme
-  ;; Default theme contributed by Felipe López.
-  (grub-theme
-   (images (list %background-image))
-   (color-highlight '((fg . yellow) (bg . black)))
-   (color-normal    '((fg . light-gray) (bg . black))))) ;XXX: #x303030
+(define %default-theme (grub-theme))
 
 ^L
 ;;;
@@ -117,32 +111,34 @@ denoting a file name."
 ;;;
 
 (define (bootloader-theme config)
-  "Return user defined theme in CONFIG if defined or %default-theme
+  "Return user defined theme in CONFIG if defined or a default theme
 otherwise."
-  (or (bootloader-configuration-theme config) %default-theme))
+  (or (bootloader-configuration-theme config) (grub-theme)))
 
 (define* (svg->png svg #:key width height)
-  "Build a PNG of HEIGHT x WIDTH from SVG."
+  "Build a PNG of HEIGHT x WIDTH from SVG if its file suffix is \".svg\".
+Otherwise the picture in SVG is just copied."
   (computed-file "grub-image.png"
                  (with-imported-modules '((gnu build svg))
                    (with-extensions (list guile-rsvg guile-cairo)
-                     #~(begin
-                         (use-modules (gnu build svg))
-                         (svg->png #+svg #$output
-                                   #:width #$width
-                                   #:height #$height))))))
-
-(define* (grub-background-image config #:key (width 1024) (height 768))
-  "Return the GRUB background image defined in CONFIG with a ratio of
-WIDTH/HEIGHT, or #f if none was found."
-  (let* ((ratio (/ width height))
-         (image (find (lambda (image)
-                        (= (grub-image-aspect-ratio image) ratio))
-                      (grub-theme-images
-                       (bootloader-theme config)))))
+                     #~(if (string-suffix? ".svg" #+svg)
+                           (begin
+                             (use-modules (gnu build svg))
+                             (svg->png #+svg #$output
+                                       #:width #$width
+                                       #:height #$height))
+                           (copy-file #+svg #$output))))))
+
+(define* (grub-background-image config)
+  "Return the GRUB background image defined in CONFIG or #f if none was found.
+If the suffix of the image file is \".svg\", then it is converted into a PNG
+file with the resolution provided in CONFIG."
+  (let* ((image (grub-theme-image (bootloader-theme config))))
     (and image
-         (svg->png (grub-image-file image)
-                   #:width width #:height height))))
+         (let ((resolution (grub-image-resolution image)))
+           (svg->png (grub-image-file image)
+                     #:width (car resolution)
+                     #:height (cdr resolution))))))
 
 (define* (eye-candy config store-device store-mount-point
                     #:key port)
-- 
2.26.0