;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; 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 . (define-module (gnu services pm) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (gnu packages admin) #:use-module (gnu packages linux) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:export (tlp-service-type tlp-configuration thermald-configuration thermald-service-type)) (define (uglify-field-name field-name) (let ((str (symbol->string field-name))) (string-join (string-split (string-upcase (if (string-suffix? "?" str) (substring str 0 (1- (string-length str))) str)) #\-) "_"))) (define (serialize-field field-name val) (format #t "~a=~a\n" (uglify-field-name field-name) val)) (define (serialize-boolean field-name val) (serialize-field field-name (if val "1" "0"))) (define-maybe boolean) (define (serialize-string field-name val) (serialize-field field-name val)) (define-maybe string) (d
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2019, 2020, 2021, 2024 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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 packages axoloti)
  #:use-module (guix gexp)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system ant)
  #:use-module (gnu packages)
  #:use-module (gnu packages base)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages cross-base)
  #:use-module (gnu packages embedded)
  #:use-module (gnu packages flashing-tools)
  #:use-module (gnu packages java)
  #:use-module (gnu packages java-graphics)
  #:use-module (gnu packages java-xml)
  #:use-module (gnu packages libusb)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages textutils)
  #:use-module (gnu packages version-control))

;; XXX The patch does not apply to libusb 1.0.24.
;; See https://github.com/axoloti/axoloti/issues/464
(define libusb-for-axoloti
  (package
    (inherit libusb)
    (version "1.0.23")
    (source
     (origin
      (method url-fetch)
      (uri (string-append "https://github.com/libusb/libusb/"
                          "releases/download/v" version
                          "/libusb-" version ".tar.bz2"))
      (sha256
       (base32 "13dd2a9x290d1q8nb1lqiaf36grcvns5ripk5k2xm0lajmpc04fv"))
      (patches (list (search-patch "libusb-for-axoloti.patch")))))))

(define dfu-util-for-axoloti
  (package (inherit dfu-util)
    (name "axoloti-dfu-util")
    (version "0.8")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "http://dfu-util.sourceforge.net/releases/"
                           "dfu-util-" version ".tar.gz"))
       (sha256
        (base32
         "0n7h08avlzin04j93m6hkq9id6hxjiiix7ff9gc2n89aw6dxxjsm"))))
    (inputs
     `(("libusb" ,libusb-for-axoloti)))))

(define-public axoloti-runtime
  (package
    (name "axoloti-runtime")
    (version "1.0.12-2")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/axoloti/axoloti")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
        (base32 "1qffis277wshldr3i939b0r2x3a2mlr53samxqmr2nk1sfm2b4w9"))
       (modules '((guix build utils)))
       ;; Remove pre-built Java binaries.
       (snippet
        '(delete-file-recursively "lib/"))))
    (build-system gnu-build-system)
    (arguments
     (list
      #:tests? #f ; no check target
      #:modules '((guix build gnu-build-system)
                  (guix build utils)
                  (srfi srfi-1)
                  (srfi srfi-26)
                  (ice-9 match)
                  (ice-9 regex))
      #:phases
      #~(modify-phases %standard-phases
          (add-after 'unpack 'patch-paths
            (lambda* (#:key inputs #:allow-other-keys)
              ;; prepare ChibiOS
              (invoke "unzip" "-o" (assoc-ref inputs "chibios"))
              (invoke "mv" "ChibiOS_2.6.9" "chibios")
              (with-directory-excursion "chibios/ext"
                (invoke "unzip" "-o" "fatfs-0.9-patched.zip"))

              ;; Remove source of non-determinism in ChibiOS
              (substitute* "chibios/os/various/shell.c"
                (("#ifdef __DATE__") "#if 0"))

              ;; Patch shell paths
              (substitute* '("src/main/java/qcmds/QCmdCompileFirmware.java"
                             "src/main/java/qcmds/QCmdCompilePatch.java"
                             "src/main/java/qcmds/QCmdFlashDFU.java")
                (("/bin/sh") (which "sh")))

              ;; Override cross compiler base name
              (substitute* "firmware/Makefile.patch"
                (("arm-none-eabi-(gcc|g\\+\\+|objcopy|objdump)" tool)
                 (which tool)))

              ;; XXX: for some reason the whitespace substitution does not
              ;; work, so we disable it.
              (substitute* "firmware/Makefile.patch"
                (("^BDIR=.*") "BDIR=${axoloti_home}/build\n"))

              ;; Hardcode full path to compiler tools
              (substitute* '("firmware/Makefile"
                             "firmware/flasher/Makefile"
                             "firmware/mounter/Makefile")
                (("TRGT =.*")
                 (string-append "TRGT = "
                                (assoc-ref inputs "cross-toolchain")
                                "/bin/arm-none-eabi-\n")))

              ;; Hardcode path to "make"
              (substitute* '("firmware/compile_firmware_linux.sh"
                             "firmware/compile_patch_linux.sh")
                (("make") (which "make")))

              ;; Hardcode path to "dfu-util"
              (substitute* "platform_linux/upload_fw_dfu.sh"
                (("-f \"\\$\\{platformdir\\}/bin/dfu-util\"") "-z \"\"")
                (("\\./dfu-util") (which "dfu-util")))))
          (delete 'configure)
          (replace 'build
            ;; Build Axoloti firmware with cross-compiler
            (lambda _
              (with-directory-excursion "platform_linux"
                (invoke "sh" "compile_firmware.sh"))))
          (replace 'install
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((share (string-append #$output "/share/axoloti/"))
                     (doc   (string-append share "doc"))
                     (dir   (getcwd))
                     (pats  '("/doc/[^/]+$"
                              "/patches/[^/]+/[^/]+$"
                              "/objects/[^/]+/[^/]+$"
                              "/firmware/.+"
                              "/chibios/[^/]+$"
                              "/chibios/boards/ST_STM32F4_DISCOVERY/[^/]+$"
                              "/chibios/(ext|os|docs)/.+"
                              "/CMSIS/[^/]+/[^/]+$"
                              "/patch/[^/]+/[^/]+$"
                              "/[^/]+\\.txt$"))
                     (pattern (string-append
                               "(" (string-join
                                    (map (cut string-append dir <>)
                                         pats)
                                    "|") ")"))
                     (files   (find-files dir
                                          (lambda (file stat)
                                            (and (eq? 'regular (stat:type stat))
                                                 (string-match pattern file))))))
                (for-each (lambda (file)
                            (install-file file
                                          (string-append
                                           share
                                           (regexp-substitute
                                            #f
                                            (string-match dir (dirname file))
                                            'pre  'post))))
                          files)))))))
    (inputs
     `(("chibios"
        ,(origin
           (method url-fetch)
           (uri "mirror://sourceforge/chibios/ChibiOS%20GPL3/Version%202.6.9/ChibiOS_2.6.9.zip")
           (sha256
            (base32
             "0lb5s8pkj80mqhsy47mmq0lqk34s2a2m3xagzihalvabwd0frhlj"))))
       ;; for compiling patches
       ("make" ,gnu-make)
       ;; for compiling firmware
       ("cross-toolchain" ,(make-arm-none-eabi-nano-toolchain-4.9))
       ;; for uploading compiled patches and firmware
       ("dfu-util" ,dfu-util-for-axoloti)))
    (native-inputs
     (list unzip))
    (home-page "http://www.axoloti.com/")
    (synopsis "Audio development environment for the Axoloti core board")
    (description
     "The Axoloti patcher offers a “patcher” environment similar to Pure Data
for sketching digital audio algorithms.  The patches run on a standalone
powerful microcontroller board: Axoloti Core.  This package provides the
runtime.")
    (license license:gpl3+)))

(define-public axoloti-patcher
  (package (inherit axoloti-runtime)
    (name "axoloti-patcher")
    (version (package-version axoloti-runtime))
    (arguments
     (list
      #:tests? #f ; no check target
      #:modules '((guix build gnu-build-system)
                  ((guix build ant-build-system) #:prefix ant:)
                  (guix build utils)
                  (srfi srfi-1)
                  (srfi srfi-26)
                  (ice-9 match)
                  (ice-9 regex)
                  (sxml simple)
                  (sxml xpath)
                  (sxml transform))
      #:imported-modules `((guix build ant-build-system)
                           ,@%default-gnu-imported-modules)
       #:phases
       #~(modify-phases %standard-phases
           (delete 'configure)
           (replace 'build
             (lambda* (#:key inputs #:allow-other-keys)
               (setenv "JAVA_HOME" (assoc-ref inputs "icedtea"))
               ;; We want to use our own jar files instead of the pre-built
               ;; stuff in lib.  So we replace the zipfileset tags in the
               ;; build.xml with new ones that reference our jars.
               (let* ((build.xml (with-input-from-file "build.xml"
                                   (lambda _
                                     (xml->sxml #:trim-whitespace? #t))))
                      (jars      (append-map (match-lambda
                                               (((? (cut string-prefix? "java-" <>)
                                                    label) . directory)
                                                (find-files directory "\\.jar$"))
                                               (_ '()))
                                             inputs))
                      (classpath (string-join jars ":"))
                      (fileset   (map (lambda (jar)
                                        `(zipfileset (@ (excludes "META-INF/*.SF")
                                                        (src ,jar))))
                                      jars)))
                 (call-with-output-file "build.xml"
                   (lambda (port)
                     (sxml->xml
                      (pre-post-order
                       build.xml
                       `( ;; Remove all zipfileset tags f