{- Haskell binding (GreenCard) to libsndfile-1.0.9 -}
{- by David Ogborn, 2004 -}

module Sndfile where

import StdDIS
import Addr
import Bits

%C #include "sndfile.h"

%enum SfFormat (Eq,Show) Int [SF_FORMAT_WAV, SF_FORMAT_AIFF, SF_FORMAT_AU, SF_FORMAT_RAW, SF_FORMAT_PAF, SF_FORMAT_SVX, SF_FORMAT_NIST, SF_FORMAT_VOC, SF_FORMAT_IRCAM, SF_FORMAT_W64, SF_FORMAT_MAT4, SF_FORMAT_MAT5, SF_FORMAT_PVF, SF_FORMAT_XI, SF_FORMAT_HTK, SF_FORMAT_SDS, SF_FORMAT_AVR, SF_FORMAT_WAVEX]

%enum SfEncoding (Eq,Show) Int [SF_FORMAT_PCM_S8, SF_FORMAT_PCM_16, SF_FORMAT_PCM_24, SF_FORMAT_PCM_32, SF_FORMAT_PCM_U8, SF_FORMAT_FLOAT, SF_FORMAT_DOUBLE, SF_FORMAT_ULAW, SF_FORMAT_ALAW, SF_FORMAT_IMA_ADPCM, SF_FORMAT_MS_ADPCM, SF_FORMAT_GSM610, SF_FORMAT_VOX_ADPCM, SF_FORMAT_G721_32, SF_FORMAT_G723_24, SF_FORMAT_G723_40, SF_FORMAT_DWVW_12, SF_FORMAT_DWVW_16, SF_FORMAT_DWVW_24, SF_FORMAT_DWVW_N, SF_FORMAT_DPCM_8, SF_FORMAT_DPCM_16]

%enum SfEndianness (Eq,Show) Int [SF_ENDIAN_FILE, SF_ENDIAN_LITTLE, SF_ENDIAN_BIG, SF_ENDIAN_CPU, SF_FORMAT_SUBMASK, SF_FORMAT_TYPEMASK, SF_FORMAT_ENDMASK]

%enum SfCommand (Eq,Show) Int [SFC_GET_LIB_VERSION, SFC_GET_LOG_INFO, SFC_GET_NORM_DOUBLE, SFC_GET_NORM_FLOAT, SFC_SET_NORM_DOUBLE, SFC_SET_NORM_FLOAT, SFC_GET_SIMPLE_FORMAT_COUNT, SFC_GET_SIMPLE_FORMAT, SFC_GET_FORMAT_INFO, SFC_GET_FORMAT_MAJOR_COUNT, SFC_GET_FORMAT_MAJOR, SFC_GET_FORMAT_SUBTYPE_COUNT, SFC_GET_FORMAT_SUBTYPE, SFC_CALC_SIGNAL_MAX, SFC_CALC_NORM_SIGNAL_MAX, SFC_CALC_MAX_ALL_CHANNELS, SFC_CALC_NORM_MAX_ALL_CHANNELS, SFC_SET_ADD_PEAK_CHUNK, SFC_UPDATE_HEADER_NOW, SFC_SET_UPDATE_HEADER_AUTO, SFC_FILE_TRUNCATE, SFC_SET_RAW_START_OFFSET, SFC_SET_DITHER_ON_WRITE, SFC_SET_DITHER_ON_READ, SFC_GET_DITHER_INFO_COUNT, SFC_GET_DITHER_INFO, SFC_GET_EMBED_FILE_INFO, SFC_SET_CLIPPING, SFC_GET_CLIPPING, SFC_GET_INSTRUMENT, SFC_SET_INSTRUMENT, SFC_TEST_IEEE_FLOAT_REPLACE]

%enum SfStringType (Eq,Show) Int [SF_STR_TITLE, SF_STR_COPYRIGHT, SF_STR_SOFTWARE, SF_STR_ARTIST, SF_STR_COMMENT, SF_STR_DATE]

%enum SfMode (Eq,Show) Int [SFM_READ, SFM_WRITE, SFM_RDWR]

%enum SfError (Eq,Show) Int [SF_ERR_NO_ERROR, SF_ERR_UNRECOGNISED_FORMAT, SF_ERR_SYSTEM]

type SndFile = Addr
%dis sndFile x = addr x

{- The code that follows is our attempt to marshall Int64s between Haskell and C. -}
{- Note: In its present form this is not cross-platform. -}

marshall_intpairinternal :: Int64 -> (Int,Int)
marshall_intpairinternal i = (least,most)
 where least = fromIntegral(i .&. (65536*65536-1))::Int
       most = fromIntegral(shiftR i 32)::Int

unmarshall_intpairinternal :: (Int,Int) -> Int64
unmarshall_intpairinternal (least,most) = (fromIntegral(least)::Int64) .|. (shiftL (fromIntegral(most)::Int64) 32)

%C struct BIGINT {int least,most;};

%dis bigint t = declare {struct BIGINT} t in <marshall_intpairinternal/unmarshall_intpairinternal> (int {%t.least},int {%t.most})

%dis int64 i = declare {__int64} i in (bigint {(*((struct BIGINT*)(&%i)))})

{- END OF INT64 MARSHALLING CODE -}

type SfCountT = Int64
%dis sfCountT x = int64 x

data SfInfo = SfInfo SfCountT Int Int Int Int Int
%dis sfInfo info =
% declare {SF_INFO} info in
% SfInfo (sfCountT {%info.frames}) (int {%info.samplerate}) (int {%info.channels})
% (int {%info.format}) (int {%info.sections}) (int {%info.seekable})

{- Accessors for SfInfo -}

getFrames :: SfInfo -> SfCountT
getFrames (SfInfo f _ _ _ _ _) = f

getSampleRate :: SfInfo -> Int
getSampleRate (SfInfo _ s _ _ _ _) = s

getChannels :: SfInfo -> Int
getChannels (SfInfo _ _ c _ _ _) = c


data SfFormatInfo = SfFormatInfo Int String String
%dis sfFormatInfo info =
% declare {struct SF_FORMAT_INFO} info in
% SfFormatInfo (int {%info.format}) (string {%info.name}) (string {%info.extension})

%enum SfDither (Eq,Show) Int [SFD_DEFAULT_LEVEL, SFD_CUSTOM_LEVEL, SFD_NO_DITHER, SFD_WHITE, SFD_TRIANGULAR_PDF]

data SfDitherInfo = SfDitherInfo Int Double String
%dis sfDitherInfo info =
% declare {struct SF_DITHER_INFO} info in
% SfDitherInfo (int {%info.type}) (double {%info.level}) (string {%info.name})

{- warning: bound type sf_count_t to Int... -}
data SfEmbedFileInfo = SfEmbedFileInfo Int Int
%dis sfEmbedFileInfo info =
% declare {struct SF_EMBED_FILE_INFO} info in
% SfEmbedFileInfo (int {%info.offset}) (int {%info.length})
 
data SfInstrument = SfInstrument Int Int SustainReleaseMode Int Int SustainReleaseMode Int Int
%dis sfInstrument x =
% declare {struct SF_INSTRUMENT} x in SfInstrument (int {%x.basenote}) (int {%x.gain}) (int {%x.sustain_mode})
% (int {%x.sustain_start}) (int {%x.sustain_end}) (int {%x.release_mode}) (int {%x.release_start})
% (int {%x.release_end})

%enum SustainReleaseMode (Eq,Show) Int [SF_LOOP_NONE,SF_LOOP_FORWARD,SF_LOOP_BACKWARD]


{- Functions from libsndfile, in the order that they appear in sndfile.h -}
{- Note 1: sf_open_fd (opening a sound file from a file descriptor) has been omitted. -}
{- Note 2: sf_perror and sf_error_str, which are both deprecated, have been omitted. -}

%fun sf_open :: String -> SfMode -> SfInfo -> IO (SndFile,SfInfo)
%call (string p) (sfMode m) (sfInfo s)
%code r=sf_open(p,m,&s);
%result (sndFile r,sfInfo {s})

%fun sf_error :: SndFile -> Int
%fun sf_strerror :: SndFile -> String
%fun sf_error_number :: Int -> String

%fun sf_command :: SndFile -> SfCommand -> Addr -> Int -> IO Int

%fun sf_format_check :: SfInfo -> Bool
%code res1=sf_format_check(&arg1);

{- Seek within the waveform data chunk of the SNDFILE. sf_seek () uses
** the same values for whence (SEEK_SET, SEEK_CUR and SEEK_END) as
** stdio.h function fseek (). -}
%fun sf_seek :: SndFile -> SfCountT -> Int -> IO SfCountT
%code res1=sf_seek(arg1,arg2,arg3);

%fun sf_set_string :: SndFile -> SfStringType -> String -> IO Int
{- returns non-zero on error -}
%fun sf_get_string :: SndFile -> SfStringType -> String

%fun sf_read_raw :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_read_raw(arg1,arg2,arg3)

%fun sf_write_raw :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_write_raw(arg1,arg2,arg3)

%fun sf_readf_short :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_readf_short(arg1,arg2,arg3)

%fun sf_writef_short :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_writef_short(arg1,arg2,arg3)

%fun sf_readf_int :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_readf_int(arg1,arg2,arg3)

%fun sf_writef_int :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_writef_int(arg1,arg2,arg3)

%fun sf_readf_float :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_readf_float(arg1,arg2,arg3)

%fun sf_writef_float :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_writef_float(arg1,arg2,arg3)

%fun sf_readf_double :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_readf_double(arg1,arg2,arg3)

%fun sf_writef_double :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_writef_double(arg1,arg2,arg3)

%fun sf_read_short :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_read_short(arg1,arg2,arg3)

%fun sf_write_short :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_write_short(arg1,arg2,arg3)

%fun sf_read_int :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_read_int(arg1,arg2,arg3)

%fun sf_write_int :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_write_int(arg1,arg2,arg3)

%fun sf_read_float :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_read_float(arg1,arg2,arg3)

%fun sf_write_float :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_write_float(arg1,arg2,arg3)

%fun sf_read_double :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_read_double(arg1,arg2,arg3)

%fun sf_write_double :: SndFile -> Addr -> SfCountT -> IO SfCountT
%code res1=sf_write_double(arg1,arg2,arg3)


%fun sf_close :: SndFile -> IO Int


{- New functions added by us -}

sfFrames :: String -> SfCountT
sfFrames path = unsafePerformIO (
  do r <- sf_open path SFM_READ (SfInfo 0 0 0 0 0 0)
     let x = getFrames (snd r)
     sf_close (fst r)
     return x)

sfSampleRate :: String -> Int
sfSampleRate path = unsafePerformIO (
  do r <- sf_open path SFM_READ (SfInfo 0 0 0 0 0 0)
     let x = getSampleRate (snd r)
     sf_close (fst r)
     return x)

sfChannels :: String -> Int
sfChannels path = unsafePerformIO (
  do r <- sf_open path SFM_READ (SfInfo 0 0 0 0 0 0)
     let x = getChannels (snd r)
     sf_close (fst r)
     return x)