{-# LANGUAGE RecordWildCards #-}
module SDR.RTLSDRStream (
RTLSDRParams(..),
defaultRTLSDRParams,
setRTLSDRParams,
sdrStream,
sdrStreamFromDevice
) where
import Control.Monad
import Control.Monad.Trans.Except
import Data.Word
import Data.Int
import Foreign.ForeignPtr
import Foreign.C.Types
import Control.Concurrent hiding (yield)
import Foreign.Marshal.Utils
import qualified Data.Vector.Storable as VS
import Pipes
import Pipes.Concurrent
import RTLSDR
data RTLSDRParams = RTLSDRParams {
centerFreq :: Word32,
sampleRate :: Word32,
freqCorrection :: Int32,
tunerGain :: Maybe Int32
}
defaultRTLSDRParams :: Word32
-> Word32
-> RTLSDRParams
defaultRTLSDRParams freq sampleRate = RTLSDRParams freq sampleRate 0 Nothing
setRTLSDRParams :: RTLSDR
-> RTLSDRParams
-> IO ()
setRTLSDRParams dev RTLSDRParams{..} = do
setCenterFreq dev centerFreq
setSampleRate dev sampleRate
setFreqCorrection dev freqCorrection
case tunerGain of
Nothing -> setTunerGainMode dev False
Just g -> setTunerGainMode dev True >> setTunerGain dev g
return ()
sdrStream :: RTLSDRParams
-> Word32
-> Word32
-> ExceptT String IO (Producer (VS.Vector CUChar) IO ())
sdrStream params bufNum bufLen = do
lift $ putStrLn "Initializing RTLSDR device..."
dev' <- lift $ open 0
dev <- maybe (throwE "Failed to open device") return dev'
lift $ do
t <- getTunerType dev
putStrLn $ "Found a: " ++ show t
setRTLSDRParams dev params
sdrStreamFromDevice dev bufNum bufLen
sdrStreamFromDevice :: RTLSDR
-> Word32
-> Word32
-> IO (Producer (VS.Vector CUChar) IO ())
sdrStreamFromDevice dev bufNum bufLen = do
resetBuffer dev
(output, input) <- spawn unbounded
forkOS $ void $ readAsync dev bufNum bufLen $ \dat num -> void $ do
let numBytes = fromIntegral $ bufNum * bufLen
fp <- mallocForeignPtrArray numBytes
withForeignPtr fp $ \fpp -> moveBytes fpp dat numBytes
let v = VS.unsafeFromForeignPtr0 fp numBytes
atomically (send output v)
return $ fromInput input