03/05: website: Randomize which screenshots to show.

[Florian Pelz]

pelzflorian pushed a commit to branch master
in repository guix-artwork.

commit 750374bf9c391057d31a8e9d2ee88f3e409f9f75
Author: Florian Pelz <address@hidden>
Date:   Sat Oct 26 12:50:28 2019 +0200

    website: Randomize which screenshots to show.
    
    Suggested by sirgazil <address@hidden>.
    
    * website/apps/aux/lists.scm (take-random): New procedure.
    * website/apps/media/templates/components.scm (screenshots-box):
    Show only the selected number of screenshots, default 6.
    * website/apps/media/templates/screenshots-overview.scm
    (screenshots-overview-t): Show all screenshots in overview.
---
 website/apps/aux/lists.scm                          | 21 ++++++++++++++++++++-
 website/apps/media/templates/components.scm         | 10 ++++++----
 .../apps/media/templates/screenshots-overview.scm   |  2 +-
 3 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/website/apps/aux/lists.scm b/website/apps/aux/lists.scm
index cf4bb15..4207fe9 100644
--- a/website/apps/aux/lists.scm
+++ b/website/apps/aux/lists.scm
@@ -1,14 +1,17 @@
 ;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <address@hidden>
 ;;; Initially written by sirgazil who waves all
 ;;; copyright interest on this file.
 
 (define-module (apps aux lists)
   #:use-module (apps aux numbers)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-27)
   #:export (list-group
            list-slice
            rest
-           separate))
+            separate
+            take-random))
 
 
 (define (list-group los limit)
@@ -49,3 +52,19 @@
        (else
         (cons (first los)
               (cons separator (separate (rest los) separator))))))
+
+(define (take-random list n)
+  "Return a list containing N elements from LIST, if possible, chosen
+randomly and evenly distributed.  If LIST has less than N elements,
+the result is a permutation of LIST."
+  (let loop ((list list)
+             (n n)
+             (len (length list)))
+    (if (<= (min n len) 0)
+        '()
+        (let ((r (random-integer len)))
+          (cons (list-ref list r)
+                (loop (append (take list r)
+                              (drop list (1+ r)))
+                      (- len 1)
+                      (- n 1)))))))
diff --git a/website/apps/media/templates/components.scm 
b/website/apps/media/templates/components.scm
index 08544b8..6bd7b1f 100644
--- a/website/apps/media/templates/components.scm
+++ b/website/apps/media/templates/components.scm
@@ -6,6 +6,7 @@
 ;;; This module defines HTML parts related to media.
 
 (define-module (apps media templates components)
+  #:use-module (apps aux lists)
   #:use-module (apps aux web)
   #:use-module (apps base utils)
   #:use-module (apps media types)
@@ -35,12 +36,13 @@
     (p ,(screenshot-caption shot) (span (@ (class "hidden")) "."))))
 
 
-(define* (screenshots-box screenshots #:key shadow)
-  "Return SHTML for a box displaying all SCREENSHOTS.  If SHADOW is
-true, a shadow is displayed at the top."
+(define* (screenshots-box screenshots #:optional (n 6) #:key shadow)
+  "Return SHTML for a box displaying up to N many SCREENSHOTS randomly
+chosen at build time.  If SHADOW is true, a shadow is displayed at the
+top."
   `(div
     (@ (class ,(string-join `("screenshots-box"
                               ,@(if shadow
                                     '("top-shadow-bg")
                                     '())))))
-    ,@(map screenshot->shtml screenshots)))
+    ,@(map screenshot->shtml (take-random screenshots n))))
diff --git a/website/apps/media/templates/screenshots-overview.scm 
b/website/apps/media/templates/screenshots-overview.scm
index 5858048..7605705 100644
--- a/website/apps/media/templates/screenshots-overview.scm
+++ b/website/apps/media/templates/screenshots-overview.scm
@@ -27,4 +27,4 @@
    `(main
      (section
       (@ (class "light-text centered-text noise-bg"))
-      ,(screenshots-box screenshots #:shadow #t)))))
+      ,(screenshots-box screenshots (length screenshots) #:shadow #t)))))