fixed bug in iff reader

.github/workflows/rhub.yaml

@@ -23,9 +23,6 @@ on:
         description: 'Unique ID. You can leave this empty now.'
         type: string
 
-env:
-  THIS_IS_RHUB: yes
-
 jobs:
 
   setup:

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ProTrackR2
 Title: Manipulate and Play 'ProTracker' Modules
-Version: 0.0.6.0011
+Version: 0.0.6.0012
 Authors@R: c(
     person("Pepijn", "de Vries", role = c("aut", "cre"),
     email = "pepijn.devries@outlook.com",

NEWS.md

@@ -1,4 +1,4 @@
-ProTrackR2 v0.0.6.0011
+ProTrackR2 v0.0.6.0012
 -------------
 
  * Implemented `as_pt2cell()` and `as_pt2celllist()`

R/pattern.R

@@ -16,7 +16,8 @@ pt2_pattern <- function(mod, i, ...) {
   structure(
     list(mod = mod, i = as.integer(i)),
     class = "pt2pat"
-  )
+  ) |>
+    as.raw.pt2pat(compact = TRUE)
 }
 
 #' Create a new ProTracker pattern

R/samples.R

@@ -18,7 +18,8 @@ pt2_sample <- function(mod, i, ...) {
   structure(
     list(mod = mod, i = as.integer(i)),
     class = "pt2samp"
-  )
+  ) |>
+    as.raw()
 }
 
 #' @rdname mod_info

data-raw/DATASET.R

@@ -19,10 +19,11 @@ if (!requireNamespace("ProTrackR")) {
     dur2 <- c(dur2, as.numeric(endtime - starttime, "secs"))
   }
   mean(dur1)/mean(dur2)
-  ProTrackR2::pt2_write_sample(mod2$samples[[1]], "data-raw/test-sample.wav")
-  ProTrackR2::pt2_write_sample(mod2$samples[[1]], "data-raw/test-sample.iff")
   if (requireNamespace("av")) {
-    samp <- av::read_audio_bin("data-raw/test-sample.wav")
-    av::av_audio_convert("data-raw/test-sample.wav", "data-raw/test-sample.aiff")
+    tempsmp <- tempfile(fileext = ".wav")
+    pt2_write_sample(mod2$samples[[1]], tempsmp)
+    samp <- av::read_audio_bin(tempsmp)
+    av::av_audio_convert(
+      tempsmp, "data-raw/test-sample.aiff", format = "u8")
   }
 }

src/samp_io.cpp

@@ -54,13 +54,17 @@ raws sample_file_format_(SEXP input, std::string file_type) {
 
   if (file_type == "IFF") {
     // IFF file size
-    // FORM + 8SVX + VHDR + 20 + NAME + namelen + ANNO + ProTrackR2 + BODY + samplelen
-    uint32_t file_size = 16 * 4 + 8 + 20 + 10 + sampleLength + (sampleLength & 1);
+    // FORM + 8SVX + VHDR + 20 + (NAME + namelen) + ANNO + ProTrackR2 + BODY + samplelen
+    // 6 chunk headers of which 5 have also length 6 * 4 + 5 * 4
+    // VHDR always has 20 bytes
+    // ANNO always has 10 bytes
+    // NAME and BODY have variable length
+    uint32_t file_size = 6 * 4 + 5 * 4 + 20 + 10 + sampleLength + (sampleLength & 1);
     if (namelen > 0) {
-      file_size += 16 + (namelen + (namelen&1));
+      file_size += (namelen + (namelen&1));
     }
 
-    int32_t align = ((uint32_t)(file_size/4))*4;
+    int32_t align = ((uint32_t)(file_size/2))*2;
 
     writable::raws output((R_xlen_t)align);
     uint8_t * buffer = (uint8_t *)RAW(as_sexp(output));

tests/testthat/test_io.R

@@ -1,6 +1,9 @@
 mod     <- pt2_read_mod(pt2_demo())
 sample  <- pt2_sample(mod, 0L)
-smpfile <- tempfile(fileext = ".raw")
+smpfile_raw <- tempfile(fileext = ".raw")
+smpfile_iff <- tempfile(fileext = ".iff")
+smpfile_wav <- tempfile(fileext = ".wav")
+smpfile_aiff <- "https://github.com/pepijn-devries/ProTrackR2/blob/master/data-raw/test-sample.aiff"
 
 test_that("Writing a mod works", {
   expect_no_error({
@@ -10,12 +13,17 @@ test_that("Writing a mod works", {
 
 test_that("Writing raw samples will warn user", {
   expect_warning({
-    pt2_write_sample(sample, smpfile)
+    pt2_write_sample(sample, smpfile_raw)
+    pt2_write_sample(sample, smpfile_iff)
+    pt2_write_sample(sample, smpfile_wav)
   })
 })
 
 test_that("Reading sample works", {
   expect_no_error({
-    pt2_read_sample(smpfile)
+    samp_raw <- pt2_read_sample(smpfile_raw)
+    samp_iff <- pt2_read_sample(smpfile_iff)
+    samp_wav <- pt2_read_sample(smpfile_wav)
+    samp_aiff <- pt2_read_sample(smpfile_aiff)
   })
 })

tests/testthat/test_render.R

@@ -1,7 +1,8 @@
 mod <- pt2_read_mod(pt2_demo())
 
 test_that("Module renders as expected", {
-  skip_if(Sys.getenv("THIS_IS_RHUB") == "yes", "Skip this test on RHUB as the `av` package leaks memory")
+  skip_if(grepl("valgrind", Sys.getenv("CHECK_ARGS", ""), ignore.case = TRUE),
+   "Skip this test on RHUB as the `av` package leaks memory")
   skip_on_cran()
   skip_if_not_installed("av")
   snap <- "intro.mp3"