module SDR.Plot (
plotLine,
plotLineAxes,
plotWaterfall,
--plotWaterfallAxes,
plotFill,
plotFillAxes,
zeroAxes,
centeredAxes
) where
import Control.Monad.Trans.Either
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
-> EitherT 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 ()
-> EitherT 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]
-> EitherT 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]
-> EitherT 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 ()
-> EitherT 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