In the beginning there was darkness

.envrc

@@ -0,0 +1,2 @@
+export NIXPKGS_ALLOW_BROKEN=1
+use nix

.gitignore

@@ -0,0 +1,7 @@
+*~
+*.so
+*.o
+*.import.scm
+*.sh
+*.link
+menu

bios-install

@@ -0,0 +1,33 @@
+#!/bin/sh
+
+# Global variables
+BASEURL="https://github.com/Abdess/retroarch_system/raw/refs/heads/libretro"
+TARGETDIR="${HOME}/.var/app/org.libretro.RetroArch/config/retroarch/system"
+
+# Sega CD
+SEGACDPREFIX="Sega%20-%20Mega%20CD%20-%20Sega%20CD"
+SEGACDFILES="bios_CD_E.bin bios_CD_J.bin bios_CD_U.bin"
+
+for FILE in $SEGACDFILES
+do
+    curl -L "${BASEURL}/${SEGACDPREFIX}/${FILE}" -o "${TARGETDIR}/${FILE}"
+done
+
+# Sega Saturn
+SEGASATURNPREFIX="Sega%20-%20Saturn"
+SEGASATURNFILES="mpr-17933.bin saturn_bios.bin sega_101.bin"
+
+for FILE in $SEGASATURNFILES
+do
+    curl -L "${BASEURL}/${SEGASATURNPREFIX}/${FILE}" -o "${TARGETDIR}/${FILE}"
+done
+
+# Sega Dreamcast
+DREAMCASTPREFIX="Sega%20-%20Dreamcast"
+DREAMCASTFILES="dc_boot.bin dc_flash.bin naomi_boot.bin"
+
+for FILE in $DREAMCASTFILES
+do
+    mkdir -p "${TARGETDIR}/dc"
+    curl -L "${BASEURL}/${DREAMCASTPREFIX}/${FILE}" -o "${TARGETDIR}/dc/${FILE}"
+done

menu-impl.scm

@@ -0,0 +1,213 @@
+(import (scheme)
+        (chicken base)
+        (chicken format)
+        (chicken irregex)
+        (chicken keyword)
+        (chicken process)
+        (chicken process-context)
+        (srfi 18)
+        (srfi 69)
+        (toml)
+        (prefix sdl2 "sdl2:")
+        (prefix sdl2-image "img:")
+        (prefix sdl2-ttf "ttf:"))
+
+(change-directory
+ (irregex-match-substring (irregex-search '(: bos (* any) #\/) (executable-pathname))))
+
+;;; Configuration Handling
+
+(define tomldata (table-from-file "menu.toml"))
+
+(define launcher-entries
+  (let* ((launcher (toml-table tomldata "launcher"))
+         (entries (toml-array launcher "entry"))
+         (max-index (- (toml-count-entries entries) 1)))
+    (let accumulate ((index 0))
+      (if (< index max-index)
+          (cons (toml-table entries index)
+                (accumulate (+ index 1)))
+          (list (toml-table entries index))))))
+
+;;; Data Loading
+
+(define (load-image-texture renderer imgpath)
+  (sdl2:create-texture-from-surface renderer (img:load imgpath)))
+
+(define (load-resources! renderer)
+  (map (lambda (entry)
+         (let ((id (string->keyword (toml-string entry "id")))
+               (image (toml-string entry "image")))
+           (hash-table-set! texstore id
+                            (load-image-texture renderer image))))
+       launcher-entries)
+  (hash-table-set! texstore #:background
+                   (load-image-texture renderer "media/images/background.png"))
+  (hash-table-set! texstore #:square
+                   (load-image-texture renderer "media/images/square.png"))
+
+  (hash-table-set! fontstore #:fira-propo
+                   (ttf:open-font "media/fonts/FiraCodeNerdFontPropo-Bold.ttf" 24)))
+
+(define texstore (make-hash-table))
+(define fontstore (make-hash-table))
+(define debugtext "Initialized and ready.")
+
+(define (render-debugtext renderer)
+  (let ((font (hash-table-ref fontstore #:fira-propo)))
+    (let-values (((tw th) (ttf:size-text font debugtext)))
+      (let ((rect (sdl2:make-rect 0 0 tw th)))
+        (sdl2:render-copy! renderer
+                           (sdl2:create-texture-from-surface
+                            renderer
+                            (ttf:render-text-solid font debugtext (sdl2:make-colour)))
+                           rect rect)))))
+
+(define active-controllers '())
+
+(define active-button-id 0)
+(define button-bg-x 100)
+(define button-bg-y 100)
+(define button-mv-tickbuffer 0)
+(define pixels-per-tick 1)
+
+(define (button-coordinates index)
+  (values (+ 300 (* (modulo index 4) 350))
+          (+ 300 (* (floor (/ index 4)) 350))))
+
+(define (move-button-bg!)
+  (let-values (((target-x target-y) (button-coordinates active-button-id)))
+    (let ((ticks (- (sdl2:get-ticks) button-mv-tickbuffer)))
+      (set! button-mv-tickbuffer (sdl2:get-ticks))
+      (cond ((< button-bg-x target-x)
+             (set! button-bg-x (min (+ button-bg-x (* pixels-per-tick ticks))
+                                    target-x)))
+            ((> button-bg-x target-x)
+             (set! button-bg-x (max (- button-bg-x (* pixels-per-tick ticks))
+                                    target-x)))
+            (else #t))
+      (cond ((< button-bg-y target-y)
+             (set! button-bg-y (min (+ button-bg-y (* pixels-per-tick ticks))
+                                    target-y)))
+            ((> button-bg-y target-y)
+             (set! button-bg-y (max (- button-bg-y (* pixels-per-tick ticks))
+                                    target-y)))
+            (else #t)))))
+
+(define (render-square renderer x y rgb)
+  (let* ((square (hash-table-ref texstore #:square))
+         (srcrect (sdl2:make-rect 0 0 300 300))
+         (destrect (sdl2:make-rect x y 300 300)))
+    (sdl2:texture-colour-mod-set! square rgb)
+    (sdl2:render-copy! renderer square srcrect destrect)))
+
+(define (render-launcher-button renderer index)
+  (let-values (((button-x button-y) (button-coordinates index)))
+    (let* ((entry (list-ref launcher-entries index))
+           (id (string->keyword (toml-string entry "id")))
+           (icon (hash-table-ref texstore id))
+           (srcrect (sdl2:make-rect 0 0 300 300))
+           (destrect (sdl2:make-rect (+ 20 button-x) (+ 20 button-y) 260 260)))
+      (sdl2:render-copy! renderer icon srcrect destrect))))
+
+(define (render-launcher-buttons renderer)
+  (let loop ((index 0))
+    (render-launcher-button renderer index)
+    (when (< index (- (length launcher-entries) 1))
+      (loop (+ index 1)))))
+
+(define (render-button-bgs renderer active-x active-y)
+  (let loop ((index 0))
+    (let-values (((button-x button-y) (button-coordinates index)))
+      (render-square renderer button-x button-y '(200 200 200)))
+    (when (< index (- (length launcher-entries) 1))
+      (loop (+ index 1))))
+  (render-square renderer active-x active-y '(100 100 100)))
+
+(define (render-main-menu renderer ww wh)
+  (let ((texture (hash-table-ref texstore #:background))
+        (srcrec (sdl2:make-rect 0 0 1920 1080))
+        (dstrec (sdl2:make-rect 0 0 ww wh)))
+    (sdl2:render-clear! renderer)
+    (sdl2:render-copy! renderer texture srcrec dstrec)
+    (render-debugtext renderer)
+    (render-button-bgs renderer button-bg-x button-bg-y)
+    (render-launcher-buttons renderer)
+    (sdl2:render-present! renderer)))
+
+(define (change-active-button delta)
+  (cond ((and (> delta 0) (< active-button-id 3))
+         (set! active-button-id (+ active-button-id delta)))
+        ((and (< delta 0) (> active-button-id 0))
+         (set! active-button-id (+ active-button-id delta)))))
+
+(define (trigger-action! window)
+  (set! active-controllers '())
+  (sdl2:quit-subsystem! '(events))
+  (process-wait (process-run (toml-string (list-ref launcher-entries active-button-id) "command")))
+  (sdl2:init-subsystem! '(events))
+  (sdl2:pump-events!)
+  (sdl2:flush-events!)
+  (sdl2:window-fullscreen-set! window 'fullscreen-desktop))
+
+(define (handle-event ev window renderer ww wh exit-main-loop!)
+  (case (sdl2:event-type ev)
+    ((window) (render-main-menu renderer ww wh))
+    ((quit) (exit-main-loop! #t))
+    ((controller-device-added) (begin (set! debugtext
+                                        (format "Event: Controller ~A added"
+                                                (sdl2:controller-device-event-which ev)))
+                                      (set! active-controllers
+                                        (cons (sdl2:game-controller-open!
+                                               (sdl2:controller-device-event-which ev))
+                                              active-controllers))))
+    ((controller-device-removed) (set! debugtext "Event: Controller removed"))
+    ((controller-axis-motion) (begin
+                                (case (sdl2:controller-axis-event-axis ev)
+                                  ((left-x) (cond ((< 0 (sdl2:controller-axis-event-value ev))
+                                                   (change-active-button 1))
+                                                  ((> 0 (sdl2:controller-axis-event-value ev))
+                                                   (change-active-button -1))
+                                                  (else #t))))
+                                (set! debugtext (format "Event: Axis ~A moved by ~A, active button is ~A"
+                                                        (sdl2:controller-axis-event-axis ev)
+                                                        (sdl2:controller-axis-event-value ev)
+                                                        active-button-id))))
+    ((controller-button-down) (begin
+                                (case (sdl2:controller-button-event-button ev)
+                                  ((a) (trigger-action! window)))
+                                (set! debugtext (format "Controller button: ~A"
+                                                        (sdl2:controller-button-event-button ev)))))
+    ((key-down) (set! debugtext "Event: Key down"))
+    ((key-up) (set! debugtext "Event: Key up"))
+    (else #f)))
+
+(define (thread-delay! ms)
+  (thread-sleep! (* ms 0.001)))
+
+(define (mainloop window renderer)
+  (let-values (((ww wh) (sdl2:window-size window)))
+    (let ((sdl2-event (sdl2:make-event)))
+      (call-with-current-continuation
+       (lambda (exit-main-loop!)
+         (let inner-loop ()
+           (render-main-menu renderer ww wh)
+           (move-button-bg!)
+           (let ((event (sdl2:wait-event-timeout! 50 sdl2-event thread-delay!)))
+             (when event (handle-event event window renderer ww wh exit-main-loop!)))
+           (inner-loop)))))))
+
+(define (main #!optional args)
+  (sdl2:set-main-ready!)
+  (sdl2:init! '(everything))
+  (ttf:init!)
+  (sdl2:set-hint! 'render-scale-quality "best")
+  (let* ((window (sdl2:create-window! "Media Center" 'undefined 'undefined 1920 1080
+                                      '(shown allow-high-dpi fullscreen-desktop)))
+         (renderer (sdl2:create-renderer! window -1 '(accelerated target-texture))))
+    (load-resources! renderer)
+    (on-exit sdl2:quit!)
+    (thread-join!
+     (thread-start!
+      (lambda ()
+        (mainloop window renderer))))))

menu.led.scm

@@ -0,0 +1,19 @@
+(module (menu led)
+    (enable-led
+     disable-led)
+  (import (scheme)
+          (chicken base)
+          (chicken process))
+
+  ;; Investigate: there are the kernel modules ledtrig_timer and ledtrig_heartbeat.
+  ;; The latter, when `echo heartbeat` to `trigger`, does what one would expect.
+  
+  (define (enable-led colour)
+    (process-run (string-append "echo 255 | sudo tee /sys/class/leds/"
+                                (symbol->string colour)
+                                "_led/brightness")))
+
+  (define (disable-led colour)
+    (process-run (string-append "echo 0 | sudo tee /sys/class/leds/"
+                                (symbol->string colour)
+                                "_led/brightness"))))

menu.scm

@@ -0,0 +1,6 @@
+(module (menu)
+    ()
+  (import (scheme)
+          (chicken base))
+  (include-relative "./menu-impl.scm")
+  (main))

menu.toml

@@ -0,0 +1,21 @@
+[launcher]
+
+[[launcher.entry]]
+id = "kodi"
+image = "media/images/kodi.png"
+command = "flatpak run tv.kodi.Kodi"
+
+[[launcher.entry]]
+id = "retroarch"
+image = "media/images/retroarch.png"
+command = "flatpak run org.libretro.RetroArch"
+
+[[launcher.entry]]
+id = "update"
+image = "media/images/update.png"
+command = "./prepare-update"
+
+[[launcher.entry]]
+id = "power-off"
+image = "media/images/power-off.png"
+command = "sudo shutdown now"

prepare-update

@@ -0,0 +1,3 @@
+#!/bin/sh
+git pull
+./update

setup-arch

@@ -0,0 +1,46 @@
+#!/bin/sh
+yes j | sudo pacman -Syu chicken sdl2 sdl2_ttf sdl2_image flatpak vim vulkan-panfrost
+
+sudo systemctl enable bluetooth
+blueman-tray &
+
+sudo mkdir -p /etc/systemd/dnssd
+cat << EOF > kodi.dnssd
+[Service]
+Name=%H
+Type=_http._tcp
+SubType=_kodi
+Port=8080
+EOF
+sudo mv kodi.dnssd /etc/systemd/dnssd/
+sudo systemctl restart systemd-resolved.service
+
+for FPAK in tv.kodi.Kodi org.libretro.RetroArch
+do
+    flatpak install -y $FPAK
+done
+
+cat <<EOF > led_off.sh
+#!/bin/sh
+echo none | sudo tee /sys/class/leds/blue_led/trigger
+echo none | sudo tee /sys/class/leds/green_led/trigger
+EOF
+chmod +x led_off.sh
+
+cat <<EOF > "${HOME}/.config/autostart/led_off.desktop"
+[Desktop Entry]
+Type=Application
+Exec=${HOME}/led_off.sh
+X-GNOME-Autostart-enabled=true
+EOF
+
+cat <<EOF > "${HOME}/.config/autostart/menu.desktop"
+[Desktop Entry]
+Type=Application
+Exec=${HOME}/ecmenu/menu
+X-GNOME-Autostart-enabled=true
+EOF
+
+git clone https://forgejo.lyrion.ch/zilti/ecmenu.git
+cd ecmenu
+./update

setup-armbian

@@ -0,0 +1,61 @@
+#!/bin/sh
+sudo apt update
+sudo apt upgrade -y
+sudo apt install -y chicken-bin libchicken-dev libchicken11 \
+     libsdl2-dev libsdl2-image-dev libsdl2-ttf-dev \
+     flatpak xdg-desktop-portal vim unclutter
+
+sudo systemctl enable bluetooth
+blueman-tray &
+
+sudo mkdir -p /etc/systemd/dnssd
+cat << EOF > kodi.dnssd
+[Service]
+Name=%H
+Type=_http._tcp
+SubType=_kodi
+Port=8080
+EOF
+sudo mv kodi.dnssd /etc/systemd/dnssd/
+sudo systemctl restart systemd-resolved.service
+
+flatpak remote-add --if-not-exists flathub https://dl.flathub.org/repo/flathub.flatpakrepo
+for FPAK in tv.kodi.Kodi org.libretro.RetroArch
+do
+    flatpak install -y $FPAK
+done
+
+cat <<EOF > led_off.sh
+#!/bin/sh
+echo none | sudo tee /sys/class/leds/blue_led/trigger
+echo none | sudo tee /sys/class/leds/green_led/trigger
+EOF
+chmod +x led_off.sh
+
+cat <<EOF > "${HOME}/.config/autostart/led_off.desktop"
+[Desktop Entry]
+Type=Application
+Name=led_off
+Exec=${HOME}/led_off.sh
+X-GNOME-Autostart-enabled=true
+EOF
+
+cat <<EOF > "${HOME}/.config/autostart/menu.desktop"
+[Desktop Entry]
+Type=Application
+Name=menu
+Exec=${HOME}/ecmenu/menu
+X-GNOME-Autostart-enabled=true
+EOF
+
+cat <<EOF > "${HOME}/.config/autostart/unclutter.desktop"
+[Desktop Entry]
+Type=Application
+Name=unclutter
+Exec=unclutter
+X-GNOME-Autostart-enabled=true
+EOF
+
+git clone https://forgejo.lyrion.ch/zilti/ecmenu.git
+cd ecmenu
+./update

shell.nix

@@ -0,0 +1,23 @@
+with import <nixpkgs> {
+};
+mkShell {
+  packages = with pkgs; [
+    chicken
+    rlwrap
+    SDL2
+    SDL2_image
+    SDL2_ttf
+  ]
+  ++ (with pkgs.chickenPackages_5.chickenEggs; [
+    apropos
+    chicken-doc
+    csm
+    srfi-1
+    srfi-18
+    lsp-server
+    sdl2
+    sdl2-ttf
+    sdl2-image
+    toml
+  ]);
+}

update

@@ -0,0 +1,27 @@
+#!/usr/bin/env bash
+if [ "$(which pacman)" ]
+then
+    yes j | sudo pacman -Syu
+    CSC=chicken-csc
+else
+    sudo apt -y update
+    sudo apt -y upgrade
+    CSC=csc
+fi
+flatpak update -y
+sudo chicken-install -s lay
+sudo lay -j 8 sdl2 sdl2-ttf sdl2-image srfi-18 srfi-69 toml csm
+#${CSC} -o menu -gui ./menu.scm
+csm -program menu
+# Core Updates
+cd /tmp
+curl -L https://github.com/zilti/retroarch-cores/archive/refs/heads/master.tar.gz | tar -xzf -
+cd retroarch-cores-master/aarch64
+for FILE in $(find .)
+do
+    unzip $FILE -do ~/.var/app/org.libretro.RetroArch/config/retroarch/cores
+done
+cd /tmp
+rm -rf retroarch-cores-master
+# The End
+sudo shutdown -r now