[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>): Remove this record and replace it
by ...
(<grub-theme>)[image]: ... this field with the default from %background-image,
(<grub-theme>)[resolution]: ... this field with the defaults from 'width' and
'height' of 'grub-background-image'.
(<grub-theme>)[images]: Remove this field.
(svg->png): Use 'copy-file' instead of 'svg->png', if the suffix of the image
file is not ".svg".
(grub-background-image): Remove the arguments 'width' and 'height'.
(grub-theme-image): Add function.
(grub-theme-resolution): Add function.
(grub-theme-gfxmode): Add function.
(grub-image): Remove function.
(grub-image?): Remove function.
(grub-image-aspect-ratio): Remove function.
(grub-image-file): Remove function.
(grub-theme-images): Remove function.
(%default-theme): Remove variable.
(%background-image): Remove variable.

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 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. This also
makes the use of a special <grub-image> record unnecessary.

Moving the default values from '%background-image' and '%default-theme' into
<grub-theme> makes a customisation easier without (inherit) and allows to remove
the undocumented variables %background-image' and '%default-theme'.
---
 gnu/bootloader/grub.scm | 93 ++++++++++++++++-------------------------
 1 file changed, 37 insertions(+), 56 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 3f61b4a963..fb2e4cc00d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -37,19 +37,13 @@
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
-  #:export (grub-image
-            grub-image?
-            grub-image-aspect-ratio
-            grub-image-file
-
-            grub-theme
+  #:export (grub-theme
             grub-theme?
-            grub-theme-images
+            grub-theme-image
+            grub-theme-resolution
             grub-theme-color-normal
             grub-theme-color-highlight
-
-            %background-image
-            %default-theme
+            grub-theme-gfxmode
 
             grub-bootloader
             grub-efi-bootloader
@@ -77,70 +71,57 @@ denoting a file name."
                  file))))
     (#f file)))
 
-(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)
-
 (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 (file-append %artwork-repository
+                                         "/grub/GuixSD-fully-black-4-3.svg")))
+  (resolution      grub-theme-resolution
+                   (default '(1024 . 768)))
   (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))))
-  (gfxmode         grub-gfxmode
+                   (default '((fg . yellow) (bg . black))))
+  (gfxmode         grub-theme-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 %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
-
 ^L
 ;;;
 ;;; Background image & themes.
 ;;;
 
 (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)))))
-    (and image
-         (svg->png (grub-image-file image)
-                   #:width width #:height height))))
+                     #~(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* ((theme (bootloader-theme config))
+          (image (grub-theme-image theme)))
+     (and image
+          (match (grub-theme-resolution theme)
+            (((? number? width) . (? number? height))
+             (svg->png image #:width width #:height height))
+            (_ #f)))))
 
 (define* (eye-candy config store-device store-mount-point
                     #:key system port)
@@ -153,7 +134,7 @@ system string---e.g., \"x86_64-linux\"."
   (define setup-gfxterm-body
     (let ((gfxmode
            (or (and-let* ((theme (bootloader-configuration-theme config))
-                          (gfxmode (grub-gfxmode theme)))
+                          (gfxmode (grub-theme-gfxmode theme)))
                  (string-join gfxmode ";"))
                "auto")))
 
-- 
2.26.0