R/read_vol_header.R

In barefootbiology/heyexr: Import, Transform and Visualize Optical Coherence Tomography Volumes in R

#' Read the VOL header
#'
#' Read the header information from a Heidelberg Spectralis VOL file.
#' Function assumes the header begins at byte 0. Due to limitation in R,
#' this function does not currently parse date and time information correctly.
#'
#' @param vol_con a connection to the VOL file
#' @param tz Timezone for dates in header.
#'
#' @return a list containing the header from the VOL file
#'
#' @importFrom magrittr %>%
#' @importFrom lubridate ymd tz
read_vol_header <- function(vol_con, tz = "UTC") {

    # Originally, I built this function on the code from Open_Heyex_Raw.java
    # which was bundled with the heyex plugin for ImageJ. I have since verified
    # the code using the documentation for the Spectralis Special Function:
    # Exporting Raw Data document (revision 4.0-1E, Noveber 2008, Art. No.
    # 97 175-002).

    # Create a container for the header information
    header <- list()

    # Read each value from the VOL file
    header$version      <- readBin(vol_con, character(), endian = "little")

    if(is.na(header$version) || (nchar(header$version) == 0)) {
        stop("Version information in header is missing.")
    }

    header$size_x       <- readBin(vol_con, integer(), endian = "little")
    header$num_bscans   <- readBin(vol_con, integer(), endian = "little")
    header$size_z       <- readBin(vol_con, integer(), endian = "little")
    header$scale_x      <- readBin(vol_con, double(), endian = "little")
    header$distance     <- readBin(vol_con, double(), endian = "little")
    header$scale_z      <- readBin(vol_con, double(), endian = "little")
    header$size_x_slo   <- readBin(vol_con, integer(), endian = "little")
    header$size_y_slo   <- readBin(vol_con, integer(), endian = "little")
    header$scale_x_slo  <- readBin(vol_con, double(), endian = "little")
    header$scale_y_slo  <- readBin(vol_con, double(), endian = "little")
    header$field_size_slo   <- readBin(vol_con, integer(), endian = "little")
    header$scan_focus       <- readBin(vol_con, double(), endian = "little")
    header$scan_position    <- readBin(vol_con, character(), size = 1, n = 2, endian = "little")[1]

    # By default, the 'exam_time' is set of the local system timezone.
    header$exam_time        <- readBin(vol_con, "raw", endian = "little",  n = 8,
                                       signed = FALSE) %>%
        raw_to_datetime()

    lubridate::tz(header$exam_time) <- tz

    # From: https://stat.ethz.ch/R-manual/R-devel/library/base/html/DateTimeClasses.html
    # "Class "POSIXct" represents the (signed) number of seconds
    # since the beginning of 1970 (in the UTC time zone) as a numeric vector."
    # That means that R's reference is the same as Java's.

    header$scan_pattern     <- readBin(vol_con, integer(), endian = "little")
    header$bscan_hdr_size  <- readBin(vol_con, integer(), endian = "little")

    header$id               <- readBin(vol_con, "raw", endian = "little",
                                       size = 1, n = 16) %>%
        rawToChar()

    header$reference_id     <- readBin(vol_con, "raw", endian = "little",
                                       size = 1, n = 16) %>%
        rawToChar()

    header$pid              <- readBin(vol_con, integer(), endian = "little")
    header$patient_id       <- readBin(vol_con, "raw", endian = "little",
                                       size = 1, n = 21) %>%
        rawToChar() # , size = 21

    header$padding          <- readBin(vol_con, "raw", endian = "little",
                                       n = 3) %>%
        paste0(collapse = "")

    # day_offset       <- 25569
    dob              <- readBin(vol_con, double(), endian = "little", size = 8)
    header$dob <- as.POSIXct(dob * (60 * 60 * 24), origin = "1899-12-30", tz = tz)

    header$vid      <- readBin(vol_con, integer(), endian = "little")
    header$visit_id     <- readBin(vol_con, "raw", endian = "little", size = 1, n = 24) %>%
        rawToChar()

    visit_date      <- readBin(vol_con, double(), endian = "little")
    header$visit_date <- as.POSIXct(visit_date * (60 * 60 * 24), origin = "1899-12-30", tz = tz)

    # NOTE: We're discarding this data, as Heidelberg isn't storing anything of
    #       interest in this.
    spare <- readBin(vol_con, "raw", endian = "little", size = 1, n = 1840)

    # Return the header. The file connection is automatically updated.
    header
}