[bug#74723] [PATCH 07/19] gnu: Add stk.

[Sughosha via Guix-patches via <guix-patches@gnu.org>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=y, Size: 8304 bytes --]

* gnu/packages/music.scm (stk): New variable.
* gnu/packages/patches/stk-5.0.1-typo.patch: New file.
* gnu/local.mk: Register the patch file.

Change-Id: Iaa2e30506b00c9636b79fe47ee69455c1919c83b
---
 gnu/local.mk                              |   1 +
 gnu/packages/music.scm                    | 120 +++++++++++++++++++++-
 gnu/packages/patches/stk-5.0.1-typo.patch |   8 ++
 3 files changed, 128 insertions(+), 1 deletion(-)
 create mode 100644 gnu/packages/patches/stk-5.0.1-typo.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index c89fd88282..45e7382bf9 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1951,6 +1951,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/sioyek-fix-build.patch			\
   %D%/packages/patches/smalltalk-multiplication-overflow.patch	\
   %D%/packages/patches/sqlite-hurd.patch			\
+  %D%/packages/patches/stk-5.0.1-typo.patch			\
   %D%/packages/patches/strace-readlink-tests.patch		\
   %D%/packages/patches/sunxi-tools-remove-sys-io.patch	\
   %D%/packages/patches/p11-kit-hurd.patch			\
diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm
index 871e3e0e1e..de6ef7e7f6 100644
--- a/gnu/packages/music.scm
+++ b/gnu/packages/music.scm
@@ -45,7 +45,7 @@
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Thomas Albers Raviola <thomas@thomaslabs.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
-;;; Copyright © 2022, 2023 Sughosha <sughosha@disroot.org>
+;;; Copyright © 2022, 2023, 2024 Sughosha <sughosha@disroot.org>
 ;;; Copyright © 2022 Remco van 't Veer <remco@remworks.net>
 ;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -1793,6 +1793,124 @@ (define-public music21
     ;; Software is dual-licensed.
     (license (list license:bsd-3 license:lgpl3+))))
 
+(define-public stk
+  (package
+    (name "stk")
+    (version "5.0.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "https://ccrma.stanford.edu/software/stk/"
+                                  "release/stk-" version ".tar.gz"))
+              (sha256
+               (base32
+                "1151cpapg8vc8g2sldkgsj6psksyfkxb77cdrg5am2xvlfp5zhxg"))
+              (patches
+               (search-patches "stk-5.0.1-typo.patch"))
+              (modules '((guix build utils)))
+              (snippet
+               '(begin
+                  ;; Fix commands.
+                  (substitute* (find-files "." "Makefile\\.in")
+                    (("/bin/") ""))))))
+    (build-system gnu-build-system)
+    (arguments
+     (list #:tests? #f ;no tests
+           #:configure-flags
+           #~(list (string-append "RAWWAVE_PATH=" #$output
+                                  "/share/stk/rawwaves/"))
+           #:phases
+           #~(modify-phases %standard-phases
+               (add-after 'unpack 'fix-paths
+                 (lambda _
+                   (with-directory-excursion "projects"
+                     (for-each (lambda (file)
+                                 (substitute* (string-drop-right file 4)
+                                   (("wish") (which "wish"))
+                                   (("< tcl") (string-append "< " #$output:gui
+                                                             "/share/stk/tcl"))
+                                   (("\\./") (string-append #$output "/bin/"))))
+                      (find-files "." "\\.bat$"))
+                     (substitute* (find-files "share/stk/tcl" "\\.tcl$")
+                       (("tcl/bitmaps")
+                        (string-append #$output:gui "/share/stk/tcl/bitmaps")))
+                     (substitute* (find-files "." "\\.cpp$")
+                       (("\\.\\./\\.\\./rawwaves")
+                        (string-append #$output "/share/stk/rawwaves"))
+                       (("\"rawwaves")
+                        (string-append "\"" #$output "/share/stk/rawwaves"))))))
+               (add-after 'install 'install-data
+                 (lambda _
+                   (let* ((bin (string-append #$output "/bin"))
+                          (data (string-append #$output "/share/stk"))
+                          (rawwaves (string-append data "/rawwaves"))
+                          (scores (string-append data "/scores"))
+                          (gui (string-append #$output:gui "/bin"))
+                          (tcl (string-append #$output:gui "/share/stk/tcl")))
+                     (mkdir-p data)
+                     ;; Install rawwaves.
+                     (copy-recursively "rawwaves" rawwaves)
+                     ;; Install projects.
+                     (with-directory-excursion "projects"
+                       ;; Install project binaries.
+                       (for-each (lambda (file)
+                                   (install-file file bin))
+                        (list "demo/stk-demo"
+                              "effects/effects"
+                              "examples/audioprobe"
+                              "examples/bethree"
+                              "examples/controlbee"
+                              "examples/crtsine"
+                              "examples/duplex"
+                              "examples/foursine"
+                              "examples/grains"
+                              "examples/inetIn"
+                              "examples/inetOut"
+                              "examples/midiprobe"
+                              "examples/play"
+                              "examples/playsmf"
+                              "examples/record"
+                              "examples/rtsine"
+                              "examples/sine"
+                              "examples/sineosc"
+                              "examples/threebees"
+                              "eguitar/eguitar"
+                              "ragamatic/ragamat"))
+                       ;; Install project rawwaves.
+                       (for-each (lambda (dir)
+                                   (copy-recursively dir rawwaves))
+                        (list "examples/rawwaves"
+                              "ragamatic/rawwaves"))
+                       ;; Install project scores.
+                       (for-each (lambda (dir)
+                                   (copy-recursively dir scores))
+                        (list "demo/scores"
+                              "eguitar/scores"
+                              "examples/scores"))
+                       ;; Install GUI scripts.
+                       (for-each (lambda (file)
+                                   (install-file (string-drop-right file 4) gui))
+                        (find-files "." "\\.bat"))
+                       ;; Install TCL files
+                       (for-each (lambda (dir)
+                                   (copy-recursively dir tcl))
+                        (list "demo/tcl"
+                              "effects/tcl"
+                              "eguitar/tcl"
+                              "ragamatic/tcl")))))))))
+    (outputs
+     '("out" "gui"))
+    (inputs
+     (list alsa-lib jack-2 tk))
+    (home-page "https://ccrma.stanford.edu/software/stk/")
+    (synopsis "Audio signal processing and algorithmic synthesis classes")
+    (description
+     "Synthesis ToolKit in C++ (STK) is a set of audio signal processing and
+algorithmic synthesis classes written in C++.
+
+This package also provides its demo project, examples, ElectricGuitar,
+RagaMatic and Effects.")
+    (license (license:non-copyleft "file:///LICENSE"))))
+
 (define-public abjad
   (package
     (name "abjad")
diff --git a/gnu/packages/patches/stk-5.0.1-typo.patch b/gnu/packages/patches/stk-5.0.1-typo.patch
new file mode 100644
index 0000000000..b4160dcdc6
--- /dev/null
+++ b/gnu/packages/patches/stk-5.0.1-typo.patch
@@ -0,0 +1,8 @@
+This patch fixes typo.
+
+diff -ruN stk-5.0.1-a/projects/eguitar/ElectricGuitar stk-5.0.1-b/projects/eguitar/ElectricGuitar
+--- stk-5.0.1-a/projects/eguitar/ElectricGuitar	2024-11-30 15:07:14.267988301 +0530
++++ stk-5.0.1-b/projects/eguitar/ElectricGuitar	2024-11-30 15:05:40.951986213 +0530
+@@ -1 +1 @@
+-wish < tcl/Eguitar.tcl | ./eguitar -or -ip
++wish < tcl/EGuitar.tcl | ./eguitar -or -ip
-- 
2.46.0