diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Marco Zocca (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Marco Zocca nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# plot-light + +[![Build Status](https://travis-ci.org/ocramz/plot-light.png)](https://travis-ci.org/ocramz/plot-light) + +A lightweight plotting library, exporting to SVG diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/plot-light.cabal b/plot-light.cabal new file mode 100644 --- /dev/null +++ b/plot-light.cabal @@ -0,0 +1,58 @@ +name: plot-light +version: 0.1.0.0 +synopsis: A lightweight plotting library, exporting to SVG +-- description: +homepage: https://github.com/ocramz/plot-light +license: BSD3 +license-file: LICENSE +author: Marco Zocca +maintainer: zocca marco gmail +copyright: 2017 Marco Zocca +category: Graphics +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 +tested-with: GHC == 8.0.2 + +library + default-language: Haskell2010 + ghc-options: -Wall + hs-source-dirs: src + exposed-modules: Lib + Graphics.Rendering.Plot.Light + Graphics.Rendering.Plot.Light.Internal + Graphics.Rendering.Plot.Light.IO.Text + Graphics.Rendering.Plot.Light.PlotTypes.Heatmap + Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries + build-depends: base >= 4.7 && < 5 + , time + , vector + , attoparsec + , scientific + , text + , colour + , palette + , blaze-svg + +-- executable plot-light +-- default-language: Haskell2010 +-- ghc-options: -threaded -rtsopts -with-rtsopts=-N +-- hs-source-dirs: app +-- main-is: Main.hs +-- build-depends: base +-- , plot-light + +test-suite spec + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , plot-light + , hspec + , QuickCheck + +source-repository head + type: git + location: https://github.com/ocramz/plot-light diff --git a/src/Graphics/Rendering/Plot/Light.hs b/src/Graphics/Rendering/Plot/Light.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Plot/Light.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module Graphics.Rendering.Plot.Light where + +-- import Data.Foldable +import qualified Data.Text as T +import qualified Data.Vector as V + +import Text.Blaze.Svg +import Text.Blaze.Svg11 ((!), mkPath, rotate, translate, l, m) +import qualified Text.Blaze.Svg11 as S +import qualified Text.Blaze.Svg11.Attributes as A +import Text.Blaze.Svg.Renderer.String (renderSvg) + +import qualified Data.Colour as C +import qualified Data.Colour.Names as C +import qualified Data.Colour.SRGB as C + +-- data BoundingBox a = BBox { _x0 :: a, _y0 :: a, _width :: a, _height :: a} deriving (Eq, Show) + + + + + + + + + + + diff --git a/src/Graphics/Rendering/Plot/Light/IO/Text.hs b/src/Graphics/Rendering/Plot/Light/IO/Text.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Plot/Light/IO/Text.hs @@ -0,0 +1,29 @@ +module Graphics.Rendering.Plot.Light.IO.Text where + + +import Data.Text +import qualified Data.Attoparsec.Text as A +import qualified Data.Attoparsec.Internal.Types as AP (Parser) +import Data.Scientific + + + + +-- row = many' decimal + +space, comma :: A.Parser Char +space = A.char ' ' +comma = A.char ',' + +-- rowNums :: A.Parser Scientific +rowNums :: AP.Parser Text s -> AP.Parser Text [Scientific] +rowNums = A.sepBy A.scientific + +rowNumSpace :: AP.Parser Text [Scientific] +rowNumSpace = rowNums space + + + +-- | parse a grid of numbers, separated by `sep` +gridNum :: AP.Parser Text s -> AP.Parser Text [[Scientific]] +gridNum sep = A.sepBy (rowNums sep) A.endOfLine diff --git a/src/Graphics/Rendering/Plot/Light/Internal.hs b/src/Graphics/Rendering/Plot/Light/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Plot/Light/Internal.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE OverloadedStrings #-} +module Graphics.Rendering.Plot.Light.Internal where + + +import Control.Arrow ((&&&), (***)) + +-- import Data.Foldable +import qualified Data.Text as T +-- import qualified Data.Vector as V + +import Text.Blaze.Svg +import Text.Blaze.Svg11 -- ((!), mkPath, rotate, translate, l, m) +import qualified Text.Blaze.Svg11 as S +import qualified Text.Blaze.Svg11.Attributes as A +import Text.Blaze.Svg.Renderer.String (renderSvg) + +import qualified Data.Colour as C +import qualified Data.Colour.Names as C +import qualified Data.Colour.SRGB as C + + + +data FigureData a d = + FigData { + _width :: a + , _height :: a + , _xmin :: a + , _xmax :: a + , _ymin :: a + , _ymax :: a + , _figData :: d + } + + +-- | A LabeledPoint carries the information of where a point should be plotted, what label should it carry (e.g. for labelling the axes) and its function value +data LabeledPoint c l a = + LabeledPoint { _coord :: c, _label :: l, _value :: a } + +data P1 a = P1 a +data P2 a = P2 a a + + + +-- axis f1 figd = undefined +-- where +-- d = f1 <$> _figData figd -- pick out data +-- numd = length d +-- mm = maximum d +-- m = minimum d + + +-- | Given a point `x` in a range [x1min, x1max], map it by affine transformation onto the interval [x2min, x2max] +affine :: Fractional t => t -> t -> t -> t -> t -> t +affine x2min x2max x1min x1max x = (x - x1min)*d2/d1 + x2min where + d1 = x1max - x1min + d2 = x2max - x2min + + + +-- | Header for a Figure +figure :: FigureData Int d -> Svg -> Svg +figure fd = + S.docTypeSvg + ! A.version "1.1" + ! A.width (vi $ _width fd) + ! A.height (vi $ _height fd) + ! A.viewbox (vis [_xmin fd, _ymin fd, _xmax fd, _ymax fd]) + + +-- | A filled rectangle, centered at (x0, y0) +rectCentered + :: Double -> Double -> Double -> Double -> C.Colour Double -> Svg +rectCentered x0 y0 wid hei col = S.g ! A.transform (translate x0c y0c) $ + S.rect ! A.width (vd wid) ! A.height (vd hei) ! A.fill (colourAttr col) where + x0c = x0 - (wid / 2) + y0c = y0 - (hei / 2) + +-- centeredAt x0 y0 = S.g ! A.transform (translate x0 y0) + + + +-- * Helpers + +-- Render a Colour from `colour` into a `blaze` Attribute +colourAttr :: C.Colour Double -> S.AttributeValue +colourAttr = S.toValue . C.sRGB24show + +-- ** Conversion from primitive numerical types to AttributeValue +vi :: Int -> S.AttributeValue +vi = S.toValue + +-- | For use e.g. in `viewbox` +vis :: [Int] -> S.AttributeValue +vis = S.toValue . unwords . map show + +vd :: Double -> S.AttributeValue +vd = S.toValue + + + + + +-- + +-- main :: IO () +-- main = do +-- let a = renderSvg svgDoc +-- putStrLn a + +-- svgDoc :: S.Svg +-- svgDoc = S.docTypeSvg ! A.version "1.1" ! A.width "150" ! A.height "100" ! A.viewbox "0 0 3 2" $ do +-- S.g ! A.transform makeTransform $ do +-- -- S.rect ! A.width "1" ! A.height "2" ! A.fill "#008d46" +-- -- S.rect ! A.width "1" ! A.height "2" ! A.fill "#ffffff" +-- S.rect ! A.width "1" ! A.height "2" ! A.fill "#d2232c" +-- -- S.path ! A.d makePath + +-- makePath :: S.AttributeValue +-- makePath = mkPath $ do +-- l 2 3 +-- m 4 5 + +-- makeTransform :: S.AttributeValue +-- makeTransform = translate 1 1 -- rotate 50 diff --git a/src/Graphics/Rendering/Plot/Light/PlotTypes/Heatmap.hs b/src/Graphics/Rendering/Plot/Light/PlotTypes/Heatmap.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Plot/Light/PlotTypes/Heatmap.hs @@ -0,0 +1,8 @@ +module Graphics.Rendering.Plot.Light.PlotTypes.Heatmap where + + +import Graphics.Rendering.Plot.Light.Internal + + + + diff --git a/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs b/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs @@ -0,0 +1,70 @@ +module Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries where + +import GHC.Real +import Data.Fixed (Pico) +import Data.Time +import qualified Data.Text as T + +import Graphics.Rendering.Plot.Light.Internal + +-- | An instant, defined by date (Day) and TimeOfDay +data Tick = Tick Day TimeOfDay + deriving (Eq, Show, Ord) + +-- | Create a Tick from valid (year, month, day, hour, minute, second) +mkTick :: Integer -> Int -> Int -> Int -> Int -> Pico -> Maybe Tick +mkTick yy mm dd hr mi se = do + tim <- makeTimeOfDayValid hr mi se + let d = fromGregorian yy mm dd + return $ Tick d tim + + +-- | Map a Tick onto the rationals +fromTick :: Tick -> Rational +fromTick (Tick d t) = fromIntegral (toModifiedJulianDay d) + timeOfDayToDayFraction t + +-- | A point in a time series +data TsPoint a = + Tsp { + _tick :: Tick, + _val :: a + } deriving (Eq, Show) + + +-- | Transform the time coordinate of a timeseries point +mapToViewbox :: FigureData (Ratio Integer) d + -> Tick -- | Lower bound + -> Tick -- | Upper bound + -> TsPoint a -- | A point in the timeseries + -> LabeledPoint (Ratio Integer) Tick a +mapToViewbox fd tmin tmax p = LabeledPoint t' (_tick p) (_val p) + where + t' = toViewboxRange fd tmin tmax p + + +toViewboxRange :: + FigureData Rational d -> Tick -> Tick -> TsPoint a -> Rational +toViewboxRange fd tmin tmax p = + affine (_xmin fd) (_xmax fd) (fromTick tmin) (fromTick tmax) (fromTick $ _tick p) + + + + +-- SVG with text + +-- +-- +-- +-- Example text01 - 'Hello, out there' in blue + +-- +-- Hello, out there +-- + +-- +-- +-- diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,1 @@ +module Lib where diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}