1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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 (guix build minetest-build-system)
#:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
#:use-module (ice-9 regex)
#:use-module (ice-9 exceptions)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module ((guix build copy-build-system) #:prefix copy:)
#:export (%standard-phases
mod-install-plan minimise-png read-mod-name check))
;; (guix build copy-build-system) does not export 'install'.
(define copy:install
(assoc-ref copy:%standard-phases 'install))
(define (mod-install-plan mod-name)
`(("." ,(string-append "share/minetest/mods/" mod-name)
;; Only install files that will actually be used at run time.
;; This can save a little disk space.
;;
;; See <https://github.com/minetest/minetest/blob/master/doc/lua_api.txt>
;; for an incomple list of files that can be found in mods.
#:include ("mod.conf" "modpack.conf" "settingtypes.txt" "depends.txt"
"description.txt" "config.txt" "_config.txt")
#:include-regexp (".lua$" ".png$" ".ogg$" ".obj$" ".b3d$" ".tr$"
".mts$"))))
(define* (guess-mod-name #:key inputs #:allow-other-keys)
"Try to determine the name of the mod or modpack that is being built.
If it is unknown, make an educated guess."
;; Minetest doesn't care about the directory names in "share/minetest/mods"
;; so there is no technical problem if the directory names don't match
;; the mod names. The directory can appear in the GUI if the modpack
;; doesn't have the 'name' set though, so try to make a guess.
(define (guess)
(let* ((source (assoc-ref inputs "source"))
;; Don't retain a reference to the store.
(file-name (strip-store-file-name source))
;; The "minetest-" prefix is not informative, so strip it.
(file-name (if (string-prefix? "minetest-" file-name)
(substring file-name (string-length "minetest-"))
file-name))
;; Strip "-checkout" suffixes of git checkouts.
(file-name (if (string-suffix? "-checkout" file-name)
(substring file-name
0
(- (string-length file-name)
(string-length "-checkout")))
file-name))
(first-dot (string-index file-name #\.))
;; If the source code is in an archive (.tar.gz, .zip, ...),
;; strip the extension.
(file-name (if first-dot
(substring file-name 0 first-dot)
file-name)))
(format (current-error-port)
"warning: the modpack ~a did not set 'name' in 'modpack.conf'~%"
file-name)
file-name))
(cond ((file-exists? "mod.conf")
;; Mods must have 'name' set in "mod.conf", so don't guess.
(read-mod-name "mod.conf"))
((file-exists? "modpack.conf")
;; While it is recommended to have 'name' set in 'modpack.conf',
;; it is optional, so guess a name if necessary.
(read-mod-name "modpack.conf" guess))
(#t (guess))))
(define* (install #:key inputs #:allow-other-keys #:rest arguments)
(apply copy:install
#:install-plan (mod-install-plan (apply guess-mod-name arguments))
arguments))
(define %png-magic-bytes
;; Magic bytes of PNG images, see ‘5.2 PNG signatures’ in
;; ‘Portable Network Graphics (PNG) Specification (Second Edition)’
;; on <https://www.w3.org/TR/PNG/>.
#vu8(137 80 78 71 13 10 26 10))
(define png-file?
((@@ (guix build utils) file-header-match) %png-magic-bytes))
(define* (minimise-png #:key inputs native-inputs #:allow-other-keys)
"Minimise PNG images found in the working directory."
(define optipng (which "optipng"))
(define (optimise image)
(format #t "Optimising ~a~%" image)
(make-file-writable (dirname image))
(make-file-writable image)
(define old-size (stat:size (stat image)))
;; The mod "technic" has a file "technic_music_player_top.png" that
;; actually is a JPEG file, see
;; <https://github.com/minetest-mods/technic/issues/590>.
(if (png-file? image)
(invoke optipng "-o4" "-quiet" image)
(format #t "warning: skipping ~a because it's not actually a PNG image~%"
image))
(define new-size (stat:size (stat image)))
(values old-size new-size))
(define files (find-files "." ".png$"))
(let loop ((total-old-size 0)
(total-new-size 0)
(images (find-files "." ".png$")))
(cond ((pair? images)
(receive (old-size new-size)
(optimise (car images))
(loop (+ total-old-size old-size)
(+ total-new-size new-size)
(cdr images))))
((= total-old-size 0)
(format #t "There were no PNG images to minimise."))
(#t
(format #t "Minimisation reduced size of images by ~,2f% (~,2f MiB to ~,2f MiB)~%"
(* 100.0 (- 1 (/ total-new-size total-old-size)))
(/ total-old-size (expt 1024 2))
(/ total-new-size (expt 1024 2)))))))
(define name-regexp (make-regexp "^name[ ]*=(.+)$"))
(define* (read-mod-name mod.conf #:optional not-found)
"Read the name of a mod from MOD.CONF. If MOD.CONF
does not have a name field and NOT-FOUND is #false, raise an
error. If NOT-FOUND is TRUE, call NOT-FOUND instead."
(call-with-input-file mod.conf
(lambda (port)
(let loop ()
(define line (read-line port))
(if (eof-object? line)
(if not-found
(not-found)
(error "~a does not have a 'name' field" mod.conf))
(let ((match (regexp-exec name-regexp line)))
(if (regexp-match? match)
(string-trim-both (match:substring match 1) #\ )
(loop))))))))
(define* (check #:key outputs tests? #:allow-other-keys)
"Test whether the mod loads. The mod must first be installed first."
(define (all-mod-names directories)
(append-map
(lambda (directory)
(map read-mod-name (find-files directory "mod.conf")))
directories))
(when tests?
(mkdir "guix_testworld")
;; Add the mod to the mod search path, such that Minetest can find it.
(setenv "MINETEST_MOD_PATH"
(list->search-path-as-string
(cons
(string-append (assoc-ref outputs "out") "/share/minetest/mods")
(search-path-as-string->list
(or (getenv "MINETEST_MOD_PATH") "")))
":"))
(with-directory-excursion "guix_testworld"
(setenv "HOME" (getcwd))
;; Create a world in which all mods are loaded.
(call-with-output-file "world.mt"
(lambda (port)
(display
"gameid = minetest
world_name = guix_testworld
backend = sqlite3
player_backend = sqlite3
auth_backend = sqlite3
" port)
(for-each
(lambda (mod)
(format port "load_mod_~a = true~%" mod))
(all-mod-names (search-path-as-string->list
(getenv "MINETEST_MOD_PATH"))))))
(receive (port pid)
((@@ (guix build utils) open-pipe-with-stderr)
"xvfb-run" "--" "minetest" "--info" "--world" "." "--go")
(format #t "Started Minetest with all mods loaded for testing~%")
;; Scan the output for error messages.
;; When the player has joined the server, stop minetest.
(define (error? line)
(and (string? line)
(string-contains line ": ERROR[")))
(define (stop? line)
(and (string? line)
(string-contains line "ACTION[Server]: singleplayer [127.0.0.1] joins game.")))
(let loop ((has-errors? #f))
(match `(,(read-line port) ,has-errors?)
(((? error? line) _)
(display line)
(newline)
(loop #t))
(((? stop?) #f)
(kill pid SIGINT)
(close-port port)
(waitpid pid))
(((? eof-object?) #f)
(error "minetest didn't start"))
(((or (? stop?) (? eof-object?)) #t)
(error "minetest raised an error"))
(((? string? line) has-error?)
(display line)
(newline)
(loop has-error?))))))))
(define %standard-phases
(modify-phases gnu:%standard-phases
(delete 'bootstrap)
(delete 'configure)
(add-before 'build 'minimise-png minimise-png)
(delete 'build)
(delete 'check)
(replace 'install install)
;; The 'check' phase requires the mod to be installed,
;; so move the 'check' phase after the 'install' phase.
(add-after 'install 'check check)))
;;; minetest-build-system.scm ends here
|
