rts-sounds.c
1 //! @file rts-sounds.c
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2024 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! SOUND routines.
25
26 #include "a68g.h"
27 #include "a68g-genie.h"
28 #include "a68g-prelude.h"
29
30 // Implementation of SOUND values.
31
32 #define MAX_BYTES 4
33
34 #if (__BYTE_ORDER == __LITTLE_ENDIAN)
35 #define A68_LITTLE_ENDIAN A68_TRUE
36 #define A68_BIG_ENDIAN A68_FALSE
37 #elif (__BYTE_ORDER == __BIG_ENDIAN)
38 #define A68_LITTLE_ENDIAN A68_FALSE
39 #define A68_BIG_ENDIAN A68_TRUE
40 #else
41 #error "undefined endianness"
42 #endif
43
44 // From public Microsoft RIFF documentation.
45
46 #define WAVE_FORMAT_UNKNOWN (0x0000)
47 #define WAVE_FORMAT_PCM (0x0001)
48 #define WAVE_FORMAT_ADPCM (0x0002)
49 #define WAVE_FORMAT_IEEE_FLOAT (0x0003)
50 #define WAVE_FORMAT_IBM_FORMAT_CVSD (0x0005)
51 #define WAVE_FORMAT_ALAW (0x0006)
52 #define WAVE_FORMAT_MULAW (0x0007)
53 #define WAVE_FORMAT_OKI_ADPCM (0x0010)
54 #define WAVE_FORMAT_DVI_ADPCM (0x0011)
55 #define WAVE_FORMAT_MEDIASPACE_ADPCM (0x0012)
56 #define WAVE_FORMAT_SIERRA_ADPCM (0x0013)
57 #define WAVE_FORMAT_G723_ADPCM (0X0014)
58 #define WAVE_FORMAT_DIGISTD (0x0015)
59 #define WAVE_FORMAT_DIGIFIX (0x0016)
60 #define WAVE_FORMAT_YAMAHA_ADPCM (0x0020)
61 #define WAVE_FORMAT_SONARC (0x0021)
62 #define WAVE_FORMAT_DSPGROUP_TRUESPEECH (0x0022)
63 #define WAVE_FORMAT_ECHOSCI1 (0x0023)
64 #define WAVE_FORMAT_AUDIOFILE_AF36 (0x0024)
65 #define WAVE_FORMAT_APTX (0x0025)
66 #define WAVE_FORMAT_AUDIOFILE_AF10 (0x0026)
67 #define WAVE_FORMAT_DOLBY_AC2 (0x0030)
68 #define WAVE_FORMAT_GSM610 (0x0031)
69 #define WAVE_FORMAT_ANTEX_ADPCME (0x0033)
70 #define WAVE_FORMAT_CONTROL_RES_VQLPC (0x0034)
71 #define WAVE_FORMAT_DIGIREAL (0x0035)
72 #define WAVE_FORMAT_DIGIADPCM (0x0036)
73 #define WAVE_FORMAT_CONTROL_RES_CR10 (0x0037)
74 #define WAVE_FORMAT_NMS_VBXADPCM (0x0038)
75 #define WAVE_FORMAT_ROCKWELL_ADPCM (0x003b)
76 #define WAVE_FORMAT_ROCKWELL_DIGITALK (0x003c)
77 #define WAVE_FORMAT_G721_ADPCM (0x0040)
78 #define WAVE_FORMAT_G728_CELP (0x0041)
79 #define WAVE_FORMAT_MPEG (0x0050)
80 #define WAVE_FORMAT_MPEGLAYER3 (0x0055)
81 #define WAVE_FORMAT_G726_ADPCM (0x0064)
82 #define WAVE_FORMAT_G722_ADPCM (0x0065)
83 #define WAVE_FORMAT_IBM_FORMAT_MULAW (0x0101)
84 #define WAVE_FORMAT_IBM_FORMAT_ALAW (0x0102)
85 #define WAVE_FORMAT_IBM_FORMAT_ADPCM (0x0103)
86 #define WAVE_FORMAT_CREATIVE_ADPCM (0x0200)
87 #define WAVE_FORMAT_FM_TOWNS_SND (0x0300)
88 #define WAVE_FORMAT_OLIGSM (0x1000)
89 #define WAVE_FORMAT_OLIADPCM (0x1001)
90 #define WAVE_FORMAT_OLICELP (0x1002)
91 #define WAVE_FORMAT_OLISBC (0x1003)
92 #define WAVE_FORMAT_OLIOPR (0x1004)
93 #define WAVE_FORMAT_EXTENSIBLE (0xfffe)
94
95 static unt pow256[] = { 1, 256, 65536, 16777216 };
96
97 //! @brief Test bits per sample.
98
99 void test_bits_per_sample (NODE_T * p, unt bps)
100 {
101 if (bps <= 0 || bps > 24) {
102 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "unsupported number of bits per sample");
103 exit_genie (p, A68_RUNTIME_ERROR);
104 }
105 }
106
107 //! @brief Code string into big-endian unt.
108
109 unt code_string (NODE_T * p, char *s, int n)
110 {
111 if (n > MAX_BYTES) {
112 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "too long word length");
113 exit_genie (p, A68_RUNTIME_ERROR);
114 }
115 unt v = 0; int m = n - 1;
116 for (int k = 0; k < n; k++, m--) {
117 v += ((unt) s[k]) * pow256[m];
118 } return v;
119 }
120
121 //! @brief Code unt into string.
122
123 char *code_unt (NODE_T * p, unt n)
124 {
125 static char text[MAX_BYTES + 1];
126 (void) p;
127 for (int k = 0; k < MAX_BYTES; k++) {
128 char ch = (char) (n % 0x100);
129 if (ch == NULL_CHAR) {
130 ch = BLANK_CHAR;
131 } else if (ch < BLANK_CHAR) {
132 ch = '?';
133 }
134 text[MAX_BYTES - k - 1] = ch;
135 n >>= 8;
136 }
137 text[MAX_BYTES] = NULL_CHAR;
138 return text;
139 }
140
141 //! @brief WAVE format category
142
143 char *format_category (unt n)
144 {
145 switch (n) {
146 case WAVE_FORMAT_UNKNOWN: {
147 return "WAVE_FORMAT_UNKNOWN";
148 }
149 case WAVE_FORMAT_PCM: {
150 return "WAVE_FORMAT_PCM ";
151 }
152 case WAVE_FORMAT_ADPCM: {
153 return "WAVE_FORMAT_ADPCM";
154 }
155 case WAVE_FORMAT_IEEE_FLOAT: {
156 return "WAVE_FORMAT_IEEE_FLOAT";
157 }
158 case WAVE_FORMAT_IBM_FORMAT_CVSD: {
159 return "WAVE_FORMAT_IBM_FORMAT_CVSD";
160 }
161 case WAVE_FORMAT_ALAW: {
162 return "WAVE_FORMAT_ALAW";
163 }
164 case WAVE_FORMAT_MULAW: {
165 return "WAVE_FORMAT_MULAW";
166 }
167 case WAVE_FORMAT_OKI_ADPCM: {
168 return "WAVE_FORMAT_OKI_ADPCM";
169 }
170 case WAVE_FORMAT_DVI_ADPCM: {
171 return "WAVE_FORMAT_DVI_ADPCM";
172 }
173 case WAVE_FORMAT_MEDIASPACE_ADPCM: {
174 return "WAVE_FORMAT_MEDIASPACE_ADPCM";
175 }
176 case WAVE_FORMAT_SIERRA_ADPCM: {
177 return "WAVE_FORMAT_SIERRA_ADPCM";
178 }
179 case WAVE_FORMAT_G723_ADPCM: {
180 return "WAVE_FORMAT_G723_ADPCM";
181 }
182 case WAVE_FORMAT_DIGISTD: {
183 return "WAVE_FORMAT_DIGISTD";
184 }
185 case WAVE_FORMAT_DIGIFIX: {
186 return "WAVE_FORMAT_DIGIFIX";
187 }
188 case WAVE_FORMAT_YAMAHA_ADPCM: {
189 return "WAVE_FORMAT_YAMAHA_ADPCM";
190 }
191 case WAVE_FORMAT_SONARC: {
192 return "WAVE_FORMAT_SONARC";
193 }
194 case WAVE_FORMAT_DSPGROUP_TRUESPEECH: {
195 return "WAVE_FORMAT_DSPGROUP_TRUESPEECH";
196 }
197 case WAVE_FORMAT_ECHOSCI1: {
198 return "WAVE_FORMAT_ECHOSCI1";
199 }
200 case WAVE_FORMAT_AUDIOFILE_AF36: {
201 return "WAVE_FORMAT_AUDIOFILE_AF36";
202 }
203 case WAVE_FORMAT_APTX: {
204 return "WAVE_FORMAT_APTX";
205 }
206 case WAVE_FORMAT_AUDIOFILE_AF10: {
207 return "WAVE_FORMAT_AUDIOFILE_AF10";
208 }
209 case WAVE_FORMAT_DOLBY_AC2: {
210 return "WAVE_FORMAT_DOLBY_AC2";
211 }
212 case WAVE_FORMAT_GSM610: {
213 return "WAVE_FORMAT_GSM610 ";
214 }
215 case WAVE_FORMAT_ANTEX_ADPCME: {
216 return "WAVE_FORMAT_ANTEX_ADPCME";
217 }
218 case WAVE_FORMAT_CONTROL_RES_VQLPC: {
219 return "WAVE_FORMAT_CONTROL_RES_VQLPC";
220 }
221 case WAVE_FORMAT_DIGIREAL: {
222 return "WAVE_FORMAT_DIGIREAL";
223 }
224 case WAVE_FORMAT_DIGIADPCM: {
225 return "WAVE_FORMAT_DIGIADPCM";
226 }
227 case WAVE_FORMAT_CONTROL_RES_CR10: {
228 return "WAVE_FORMAT_CONTROL_RES_CR10";
229 }
230 case WAVE_FORMAT_NMS_VBXADPCM: {
231 return "WAVE_FORMAT_NMS_VBXADPCM";
232 }
233 case WAVE_FORMAT_ROCKWELL_ADPCM: {
234 return "WAVE_FORMAT_ROCKWELL_ADPCM";
235 }
236 case WAVE_FORMAT_ROCKWELL_DIGITALK: {
237 return "WAVE_FORMAT_ROCKWELL_DIGITALK";
238 }
239 case WAVE_FORMAT_G721_ADPCM: {
240 return "WAVE_FORMAT_G721_ADPCM";
241 }
242 case WAVE_FORMAT_G728_CELP: {
243 return "WAVE_FORMAT_G728_CELP";
244 }
245 case WAVE_FORMAT_MPEG: {
246 return "WAVE_FORMAT_MPEG";
247 }
248 case WAVE_FORMAT_MPEGLAYER3: {
249 return "WAVE_FORMAT_MPEGLAYER3";
250 }
251 case WAVE_FORMAT_G726_ADPCM: {
252 return "WAVE_FORMAT_G726_ADPCM";
253 }
254 case WAVE_FORMAT_G722_ADPCM: {
255 return "WAVE_FORMAT_G722_ADPCM";
256 }
257 case WAVE_FORMAT_IBM_FORMAT_MULAW: {
258 return "WAVE_FORMAT_IBM_FORMAT_MULAW";
259 }
260 case WAVE_FORMAT_IBM_FORMAT_ALAW: {
261 return "WAVE_FORMAT_IBM_FORMAT_ALAW";
262 }
263 case WAVE_FORMAT_IBM_FORMAT_ADPCM: {
264 return "WAVE_FORMAT_IBM_FORMAT_ADPCM";
265 }
266 case WAVE_FORMAT_CREATIVE_ADPCM: {
267 return "WAVE_FORMAT_CREATIVE_ADPCM";
268 }
269 case WAVE_FORMAT_FM_TOWNS_SND: {
270 return "WAVE_FORMAT_FM_TOWNS_SND";
271 }
272 case WAVE_FORMAT_OLIGSM: {
273 return "WAVE_FORMAT_OLIGSM";
274 }
275 case WAVE_FORMAT_OLIADPCM: {
276 return "WAVE_FORMAT_OLIADPCM";
277 }
278 case WAVE_FORMAT_OLICELP: {
279 return "WAVE_FORMAT_OLICELP";
280 }
281 case WAVE_FORMAT_OLISBC: {
282 return "WAVE_FORMAT_OLISBC";
283 }
284 case WAVE_FORMAT_OLIOPR: {
285 return "WAVE_FORMAT_OLIOPR";
286 }
287 case WAVE_FORMAT_EXTENSIBLE: {
288 return "WAVE_FORMAT_EXTENSIBLE";
289 }
290 default: {
291 return "other";
292 }
293 }
294 }
295
296 //! @brief Read RIFF item.
297
298 unt read_riff_item (NODE_T * p, FILE_T fd, int n, BOOL_T little)
299 {
300 unt v, z;
301 int k, m, r;
302 if (n > MAX_BYTES) {
303 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "too long word length");
304 exit_genie (p, A68_RUNTIME_ERROR);
305 }
306 if (little) {
307 for (k = 0, m = 0, v = 0; k < n; k++, m++) {
308 z = 0;
309 errno = 0;
310 r = (int) io_read (fd, &z, (size_t) 1);
311 if (r != 1 || errno != 0) {
312 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while reading file");
313 exit_genie (p, A68_RUNTIME_ERROR);
314 }
315 v += z * pow256[m];
316 }
317 } else {
318 for (k = 0, m = n - 1, v = 0; k < n; k++, m--) {
319 z = 0;
320 errno = 0;
321 r = (int) io_read (fd, &z, (size_t) 1);
322 if (r != 1 || errno != 0) {
323 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while reading file");
324 exit_genie (p, A68_RUNTIME_ERROR);
325 }
326 v += z * pow256[m];
327 }
328 }
329 return v;
330 }
331
332 //! @brief Read sound from file.
333
334 void read_sound (NODE_T * p, A68_REF ref_file, A68_SOUND * w)
335 {
336 A68_FILE *f = FILE_DEREF (&ref_file);
337 int r;
338 unt fmt_cat;
339 unt blockalign, byterate, chunksize, subchunk2size, z;
340 BOOL_T data_read = A68_FALSE;
341 if (read_riff_item (p, FD (f), 4, A68_BIG_ENDIAN) != code_string (p, "RIFF", 4)) {
342 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "file format is not RIFF");
343 exit_genie (p, A68_RUNTIME_ERROR);
344 }
345 chunksize = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
346 if ((z = read_riff_item (p, FD (f), 4, A68_BIG_ENDIAN)) != code_string (p, "WAVE", 4)) {
347 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL_STRING, M_SOUND, "file format is not \"WAVE\" but", code_unt (p, z));
348 exit_genie (p, A68_RUNTIME_ERROR);
349 }
350 // Now read chunks.
351 while (data_read == A68_FALSE) {
352 z = read_riff_item (p, FD (f), 4, A68_BIG_ENDIAN);
353 if (z == code_string (p, "fmt ", 4)) {
354 // Read fmt chunk.
355 z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
356 int skip = (int) z - 0x10; // Bytes to skip in extended wave format
357 fmt_cat = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
358 if (fmt_cat != WAVE_FORMAT_PCM) {
359 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL_STRING, M_SOUND, "category is not WAVE_FORMAT_PCM but", format_category (fmt_cat));
360 exit_genie (p, A68_RUNTIME_ERROR);
361 }
362 NUM_CHANNELS (w) = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
363 SAMPLE_RATE (w) = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
364 byterate = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
365 blockalign = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
366 BITS_PER_SAMPLE (w) = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
367 test_bits_per_sample (p, BITS_PER_SAMPLE (w));
368 for (int k = 0; k < skip; k++) {
369 z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
370 }
371 } else if (z == code_string (p, "LIST", 4)) {
372 // Skip a LIST chunk.
373 z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
374 int skip = (int) z;
375 for (int k = 0; k < skip; k++) {
376 z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
377 }
378 } else if (z == code_string (p, "cue ", 4)) {
379 // Skip a cue chunk.
380 z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
381 int skip = (int) z;
382 for (int k = 0; k < skip; k++) {
383 z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
384 }
385 } else if (z == code_string (p, "fact", 4)) {
386 // Skip a fact chunk.
387 z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
388 int skip = (int) z;
389 for (int k = 0; k < skip; k++) {
390 z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
391 }
392 } else if (z == code_string (p, "data", 4)) {
393 // Read data chunk.
394 subchunk2size = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
395 NUM_SAMPLES (w) = subchunk2size / NUM_CHANNELS (w) / (unt) A68_SOUND_BYTES (w);
396 DATA (w) = heap_generator (p, M_SOUND_DATA, (int) subchunk2size);
397 r = (int) io_read (FD (f), ADDRESS (&(DATA (w))), subchunk2size);
398 if (r != (int) subchunk2size) {
399 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "cannot read all of the data");
400 exit_genie (p, A68_RUNTIME_ERROR);
401 }
402 data_read = A68_TRUE;
403 } else {
404 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL_STRING, M_SOUND, "chunk is", code_unt (p, z));
405 exit_genie (p, A68_RUNTIME_ERROR);
406 }
407 }
408 (void) z;
409 (void) blockalign;
410 (void) byterate;
411 (void) chunksize;
412 (void) subchunk2size;
413 STATUS (w) = INIT_MASK;
414 }
415
416 //! @brief Write RIFF item.
417
418 void write_riff_item (NODE_T * p, FILE_T fd, unt z, int n, BOOL_T little)
419 {
420 unt char y[MAX_BYTES];
421 if (n > MAX_BYTES) {
422 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "too long word length");
423 exit_genie (p, A68_RUNTIME_ERROR);
424 }
425 for (int k = 0; k < n; k++) {
426 y[k] = (unt char) (z & 0xff);
427 z >>= 8;
428 }
429 if (little) {
430 for (int k = 0; k < n; k++) {
431 ASSERT (io_write (fd, &(y[k]), 1) != -1);
432 }
433 } else {
434 for (int k = n - 1; k >= 0; k--) {
435 int r = (int) io_write (fd, &(y[k]), 1);
436 if (r != 1) {
437 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while writing file");
438 exit_genie (p, A68_RUNTIME_ERROR);
439 }
440 }
441 }
442 }
443
444 //! @brief Write sound to file.
445
446 void write_sound (NODE_T * p, A68_REF ref_file, A68_SOUND * w)
447 {
448 A68_FILE *f = FILE_DEREF (&ref_file);
449 int r;
450 unt blockalign = NUM_CHANNELS (w) * (unt) (A68_SOUND_BYTES (w));
451 unt byterate = SAMPLE_RATE (w) * blockalign;
452 unt subchunk2size = NUM_SAMPLES (w) * blockalign;
453 unt chunksize = 4 + (8 + 16) + (8 + subchunk2size);
454 write_riff_item (p, FD (f), code_string (p, "RIFF", 4), 4, A68_BIG_ENDIAN);
455 write_riff_item (p, FD (f), chunksize, 4, A68_LITTLE_ENDIAN);
456 write_riff_item (p, FD (f), code_string (p, "WAVE", 4), 4, A68_BIG_ENDIAN);
457 write_riff_item (p, FD (f), code_string (p, "fmt ", 4), 4, A68_BIG_ENDIAN);
458 write_riff_item (p, FD (f), 16, 4, A68_LITTLE_ENDIAN);
459 write_riff_item (p, FD (f), 1, 2, A68_LITTLE_ENDIAN);
460 write_riff_item (p, FD (f), NUM_CHANNELS (w), 2, A68_LITTLE_ENDIAN);
461 write_riff_item (p, FD (f), SAMPLE_RATE (w), 4, A68_LITTLE_ENDIAN);
462 write_riff_item (p, FD (f), byterate, 4, A68_LITTLE_ENDIAN);
463 write_riff_item (p, FD (f), blockalign, 2, A68_LITTLE_ENDIAN);
464 write_riff_item (p, FD (f), BITS_PER_SAMPLE (w), 2, A68_LITTLE_ENDIAN);
465 write_riff_item (p, FD (f), code_string (p, "data", 4), 4, A68_BIG_ENDIAN);
466 write_riff_item (p, FD (f), subchunk2size, 4, A68_LITTLE_ENDIAN);
467 if (IS_NIL (DATA (w))) {
468 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sound has no data");
469 exit_genie (p, A68_RUNTIME_ERROR);
470 }
471 r = (int) io_write (FD (f), ADDRESS (&(DATA (w))), subchunk2size);
472 if (r != (int) subchunk2size) {
473 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while writing file");
474 exit_genie (p, A68_RUNTIME_ERROR);
475 }
476 }
477
478 //! @brief PROC new sound = (INT bits, INT sample rate, INT channels, INT samples) SOUND
479
480 void genie_new_sound (NODE_T * p)
481 {
482 A68_INT num_channels, sample_rate, bits_per_sample, num_samples;
483 A68_SOUND w;
484 POP_OBJECT (p, &num_samples, A68_INT);
485 POP_OBJECT (p, &num_channels, A68_INT);
486 POP_OBJECT (p, &sample_rate, A68_INT);
487 POP_OBJECT (p, &bits_per_sample, A68_INT);
488 NUM_SAMPLES (&w) = (unt) (VALUE (&num_samples));
489 NUM_CHANNELS (&w) = (unt) (VALUE (&num_channels));
490 SAMPLE_RATE (&w) = (unt) (VALUE (&sample_rate));
491 BITS_PER_SAMPLE (&w) = (unt) (VALUE (&bits_per_sample));
492 test_bits_per_sample (p, BITS_PER_SAMPLE (&w));
493 DATA_SIZE (&w) = (unt) A68_SOUND_DATA_SIZE (&w);
494 DATA (&w) = heap_generator (p, M_SOUND_DATA, (int) DATA_SIZE (&w) * sizeof (unt));
495 STATUS (&w) = INIT_MASK;
496 PUSH_OBJECT (p, w, A68_SOUND);
497 }
498
499 //! @brief PROC get sound = (SOUND w, INT channel, sample) INT
500
501 void genie_get_sound (NODE_T * p)
502 {
503 A68_INT channel, sample;
504 A68_SOUND w;
505 int addr, k, n, z, m;
506 BYTE_T *d;
507 POP_OBJECT (p, &sample, A68_INT);
508 POP_OBJECT (p, &channel, A68_INT);
509 POP_OBJECT (p, &w, A68_SOUND);
510 if (!(VALUE (&channel) >= 1 && VALUE (&channel) <= (int) NUM_CHANNELS (&w))) {
511 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "channel index out of range");
512 exit_genie (p, A68_RUNTIME_ERROR);
513 }
514 if (!(VALUE (&sample) >= 1 && VALUE (&sample) <= (int) NUM_SAMPLES (&w))) {
515 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sample index out of range");
516 exit_genie (p, A68_RUNTIME_ERROR);
517 }
518 if (IS_NIL (DATA (&w))) {
519 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sound has no data");
520 exit_genie (p, A68_RUNTIME_ERROR);
521 }
522 n = A68_SOUND_BYTES (&w);
523 addr = ((VALUE (&sample) - 1) * (int) (NUM_CHANNELS (&w)) + (VALUE (&channel) - 1)) * n;
524 ABEND (addr < 0 || addr >= (int) DATA_SIZE (&w), ERROR_INTERNAL_CONSISTENCY, __func__);
525 d = &(ADDRESS (&(DATA (&w)))[addr]);
526 // Convert from little-endian, irrespective from the platform we work on.
527 for (k = 0, z = 0, m = 0; k < n; k++) {
528 z += ((int) (d[k]) * (int) (pow256[k]));
529 m = k;
530 }
531 PUSH_VALUE (p, (d[m] & 0x80 ? (n == 4 ? z : z - (int) pow256[m + 1]) : z), A68_INT);
532 }
533
534 //! @brief PROC set sound = (SOUND w, INT channel, sample, value) VOID
535
536 void genie_set_sound (NODE_T * p)
537 {
538 A68_INT channel, sample, value;
539 int addr, k, n, z;
540 BYTE_T *d;
541 A68_SOUND w;
542 POP_OBJECT (p, &value, A68_INT);
543 POP_OBJECT (p, &sample, A68_INT);
544 POP_OBJECT (p, &channel, A68_INT);
545 POP_OBJECT (p, &w, A68_SOUND);
546 if (!(VALUE (&channel) >= 1 && VALUE (&channel) <= (int) NUM_CHANNELS (&w))) {
547 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "channel index out of range");
548 exit_genie (p, A68_RUNTIME_ERROR);
549 }
550 if (!(VALUE (&sample) >= 1 && VALUE (&sample) <= (int) NUM_SAMPLES (&w))) {
551 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sample index out of range");
552 exit_genie (p, A68_RUNTIME_ERROR);
553 }
554 if (IS_NIL (DATA (&w))) {
555 diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sound has no data");
556 exit_genie (p, A68_RUNTIME_ERROR);
557 }
558 n = A68_SOUND_BYTES (&w);
559 addr = ((VALUE (&sample) - 1) * (int) (NUM_CHANNELS (&w)) + (VALUE (&channel) - 1)) * n;
560 ABEND (addr < 0 || addr >= (int) DATA_SIZE (&w), ERROR_INTERNAL_CONSISTENCY, __func__);
561 d = &(ADDRESS (&(DATA (&w)))[addr]);
562 // Convert to little-endian.
563 for (k = 0, z = VALUE (&value); k < n; k++) {
564 d[k] = (BYTE_T) (z & 0xff);
565 z >>= 8;
566 }
567 }
568
569 //! @brief OP SOUND = (SOUND) INT
570
571 void genie_sound_samples (NODE_T * p)
572 {
573 A68_SOUND w;
574 POP_OBJECT (p, &w, A68_SOUND);
575 PUSH_VALUE (p, (int) (NUM_SAMPLES (&w)), A68_INT);
576 }
577
578 //! @brief OP RATE = (SOUND) INT
579
580 void genie_sound_rate (NODE_T * p)
581 {
582 A68_SOUND w;
583 POP_OBJECT (p, &w, A68_SOUND);
584 PUSH_VALUE (p, (int) (SAMPLE_RATE (&w)), A68_INT);
585 }
586
587 //! @brief OP CHANNELS = (SOUND) INT
588
589 void genie_sound_channels (NODE_T * p)
590 {
591 A68_SOUND w;
592 POP_OBJECT (p, &w, A68_SOUND);
593 PUSH_VALUE (p, (int) (NUM_CHANNELS (&w)), A68_INT);
594 }
595
596 //! @brief OP RESOLUTION = (SOUND) INT
597
598 void genie_sound_resolution (NODE_T * p)
599 {
600 A68_SOUND w;
601 POP_OBJECT (p, &w, A68_SOUND);
602 PUSH_VALUE (p, (int) (BITS_PER_SAMPLE (&w)), A68_INT);
603 }
