module SDR.Plot (
plotLine,
plotLineAxes,
plotWaterfall,
plotFill,
plotFillAxes,
zeroAxes,
centeredAxes
) where
import Control.Monad.Trans.Except
import qualified Data.Vector.Storable as VS
import Graphics.Rendering.OpenGL
import Graphics.Rendering.Cairo
import Pipes
import Data.Colour.Names
import Graphics.Rendering.Pango
import Graphics.DynamicGraph.Line
import Graphics.DynamicGraph.Waterfall
import Graphics.DynamicGraph.FillLine
import Graphics.DynamicGraph.Axis
import Graphics.DynamicGraph.RenderCairo
import Graphics.DynamicGraph.Window
plotLine :: Int
-> Int
-> Int
-> Int
-> ExceptT String IO (Consumer (VS.Vector GLfloat) IO ())
plotLine width height samples resolution = window width height $ fmap pipeify $ renderLine samples resolution
plotLineAxes :: Int
-> Int
-> Int
-> Int
-> Render ()
-> ExceptT String IO (Consumer (VS.Vector GLfloat) IO ())
plotLineAxes width height samples xResolution rm = window width height $ do
renderFunc <- renderLine samples xResolution
renderAxisFunc <- renderCairo rm width height
return $ for cat $ \dat -> lift $ do
blend $= Disabled
viewport $= (Position 50 50, Size (fromIntegral width - 100) (fromIntegral height - 100))
renderFunc dat
blend $= Enabled
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
viewport $= (Position 0 0, Size (fromIntegral width) (fromIntegral height))
renderAxisFunc
plotWaterfall :: Int
-> Int
-> Int
-> Int
-> [GLfloat]
-> ExceptT String IO (Consumer (VS.Vector GLfloat) IO ())
plotWaterfall windowWidth windowHeight width height colorMap = window windowWidth windowHeight $ renderWaterfall width height colorMap
plotFill :: Int
-> Int
-> Int
-> [GLfloat]
-> ExceptT String IO (Consumer (VS.Vector GLfloat) IO ())
plotFill width height samples colorMap = window width height $ fmap pipeify $ renderFilledLine samples colorMap
plotFillAxes :: Int
-> Int
-> Int
-> [GLfloat]
-> Render ()
-> ExceptT String IO (Consumer (VS.Vector GLfloat) IO ())
plotFillAxes width height samples colorMap rm = window width height $ do
renderFunc <- renderFilledLine samples colorMap
renderAxisFunc <- renderCairo rm width height
return $ for cat $ \dat -> lift $ do
viewport $= (Position 50 50, Size (fromIntegral width - 100) (fromIntegral height - 100))
renderFunc dat
blend $= Enabled
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
viewport $= (Position 0 0, Size (fromIntegral width) (fromIntegral height))
renderAxisFunc
zeroAxes :: Int
-> Int
-> Double
-> Double
-> Render ()
zeroAxes width height bandwidth interval = do
blankCanvasAlpha black 0 (fromIntegral width) (fromIntegral height)
let xSeparation = (interval / bandwidth) * (fromIntegral width - 100)
ySeparation = 0.2 * (fromIntegral height - 100)
xCoords = takeWhile (< (fromIntegral width - 50)) $ iterate (+ xSeparation) 50
yCoords = takeWhile (> 50) $ iterate (\x -> x - ySeparation) (fromIntegral height - 50)
ctx <- liftIO $ cairoCreateContext Nothing
xAxisLabels ctx white (map (\n -> show n ++ " KHz" ) (takeWhile (< bandwidth) $ iterate (+ interval) 0)) xCoords (fromIntegral height - 50)
drawAxes (fromIntegral width) (fromIntegral height) 50 50 50 50 white 2
xAxisGrid gray 1 [] 50 (fromIntegral height - 50) xCoords
yAxisGrid gray 1 [4, 2] 50 (fromIntegral width - 50) yCoords
centeredAxes :: Int
-> Int
-> Double
-> Double
-> Double
-> Render ()
centeredAxes width height cFreq bandwidth interval = do
blankCanvasAlpha black 0 (fromIntegral width) (fromIntegral height)
let xSeparation = (interval / bandwidth) * (fromIntegral width - 100)
firstXLabel = fromIntegral (ceiling ((cFreq - (bandwidth / 2)) / interval)) * interval
fract x = x - fromIntegral (floor x)
xOffset = fract ((cFreq - (bandwidth / 2)) / interval) * xSeparation
ySeparation = 0.2 * (fromIntegral height - 100)
xCoords = takeWhile (< (fromIntegral width - 50)) $ iterate (+ xSeparation) (50 + xOffset)
yCoords = takeWhile (> 50) $ iterate (\x -> x - ySeparation) (fromIntegral height - 50)
ctx <- liftIO $ cairoCreateContext Nothing
xAxisLabels ctx white (map (\n -> show n ++ " MHZ") (takeWhile (< (cFreq + bandwidth / 2)) $ iterate (+ interval) firstXLabel)) xCoords (fromIntegral height - 50)
drawAxes (fromIntegral width) (fromIntegral height) 50 50 50 50 white 2
xAxisGrid gray 1 [] 50 (fromIntegral height - 50) xCoords
yAxisGrid gray 1 [4, 2] 50 (fromIntegral width - 50) yCoords