diff --git a/Chart-simple.cabal b/Chart-simple.cabal new file mode 100644 --- /dev/null +++ b/Chart-simple.cabal @@ -0,0 +1,34 @@ +Name: Chart-simple +Version: 1.2 +License: BSD3 +License-file: LICENSE +Copyright: Tim Docker, 2006-2010 +Author: Tim Docker +Maintainer: Tim Docker +Homepage: https://github.com/timbod7/haskell-chart/wiki +Synopsis: A wrapper for the chart library to assist with basic plots +Description: A wrapper for the chart library to assist with basic plots +Category: Graphics +Cabal-Version: >= 1.6 +Build-Type: Simple + +library + Build-depends: base >= 3 && < 5 + , old-locale + , time, mtl, array + , data-default-class < 0.1 + , cairo >= 0.9.11 + , colour >= 2.2.1 && < 2.4 + , colour >= 2.2.1 + , gtk >= 0.9.11 + , Chart >= 1.2 && < 1.3 + , Chart-cairo >= 1.2 && < 1.3 + , Chart-gtk >= 1.2 && < 1.3 + + Exposed-modules: + Graphics.Rendering.Chart.Simple, + Graphics.Rendering.Chart.Simple.Internal + +source-repository head + type: git + location: https://github.com/timbod7/haskell-chart diff --git a/Graphics/Rendering/Chart/Simple.hs b/Graphics/Rendering/Chart/Simple.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Chart/Simple.hs @@ -0,0 +1,44 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Chart.Simple +-- Copyright : (c) David Roundy 2007 +-- License : BSD-style (see chart/COPYRIGHT) +-- +-- An even simpler framework for creating 2D charts in Haskell. +-- +-- The basic idea is to make it as easy to plot as octave, which means that +-- you provide no more information than you wish to provide. We provide +-- four plotting functions, which differ only in their output. One +-- produces a "Layout1" that you can customize using other +-- Graphics.Rendering.Chart functions. The other three produce their +-- output directly. All three accept the same input and produce the same plots. +-- +-- The plot functions accept a variable number of arguments. You must +-- provide a [Double] which defines the points on the x axis, which must +-- precede any of the "y" values. The y values may either be [Double] or +-- functions. After any given y value, you can give either Strings or +-- PlotKinds describing how you'd like that y printed. +-- +-- Examples: +-- +-- > -- this plotters +-- > import Graphics.Rendering.Chart.Simple +-- > -- rendering instances from 'chart-cairo' package +-- > import Graphics.Rendering.Chart.Backend.Cairo +-- +-- > main = do +-- > plotPDF "foo.pdf" [0 :: Double, 0.1..10] sin "- " cos ". " cos "o" +-- +-- > plotPS "foo.ps" [0 :: Double, 0.1..10] (sin . exp) "- " (sin . exp) "o-" +----------------------------------------------------------------------------- +module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords, + plotPDF, plotPS, + plotLayout, plotPNG, LayoutDDD, + layoutDddToRenderable + , PlotPDFType(..) + , PlotPSType(..) + , PlotPNGType(..) + , uplot + ) where + +import Graphics.Rendering.Chart.Simple.Internal diff --git a/Graphics/Rendering/Chart/Simple/Internal.hs b/Graphics/Rendering/Chart/Simple/Internal.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Chart/Simple/Internal.hs @@ -0,0 +1,298 @@ + +module Graphics.Rendering.Chart.Simple.Internal where + +import Data.Maybe ( catMaybes ) +import Data.Colour +import Data.Colour.Names +import Data.Default.Class + +import Graphics.Rendering.Chart +import Graphics.Rendering.Chart.Utils +import Graphics.Rendering.Chart.Backend.Cairo +import Graphics.Rendering.Chart.Gtk + +styleColor :: Int -> AlphaColour Double +styleColor ind = colorSequence !! ind + where colorSequence = cycle $ map opaque [ blue, red, green, yellow + , cyan, magenta, black ] + +styleSymbol :: Int -> PlotKind +styleSymbol ind = symbolSequence !! ind + where symbolSequence = cycle [ Ex, HollowCircle, Square, Diamond + , Triangle, DownTriangle, Plus, Star + , FilledCircle ] + +iplot :: (PlotValue x, PlotValue y) => [InternalPlot x y] -> Layout x y +iplot foobar = def { + _layout_plots = concat $ zipWith toplot (ip foobar) [0..] + } + where + ip (xs@(IPX _ _):xyss) = map (\ys -> (xs,ys)) yss ++ ip rest + where yss = takeWhile isIPY xyss + rest = dropWhile isIPY xyss + ip (_:xyss) = ip xyss + ip [] = [] + isIPY (IPY _ _) = True + isIPY _ = False + toplot (IPX xs _, IPY ys yks) ind = plots + where + vs = zip xs ys + plots = case catMaybes $ map plotas yks of + [] -> [ toPlot $ def + { _plot_lines_title = name yks, + _plot_lines_values = [vs], + _plot_lines_style = solidLine 1 (styleColor ind) + } ] + xs -> xs + plotas Solid = Just $ toPlot $ def + { _plot_lines_title = name yks, + _plot_lines_values = [vs], + _plot_lines_style = solidLine 1 (styleColor ind) } + plotas Dashed = Just $ toPlot $ def + { _plot_lines_title = name yks, + _plot_lines_values = [vs], + _plot_lines_style = dashedLine 1 [10,10] + (styleColor ind) } + plotas Dotted = Just $ toPlot $ def + { _plot_lines_title = name yks, + _plot_lines_values = [vs], + _plot_lines_style = dashedLine 1 [1,11] + (styleColor ind) } + plotas FilledCircle = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = filledCircles 4 + (styleColor ind) } + plotas HollowCircle = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = hollowCircles 5 1 + (styleColor ind) } + plotas Triangle = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = hollowPolygon 7 1 3 False + (styleColor ind) } + plotas DownTriangle = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = hollowPolygon 7 1 3 True + (styleColor ind) } + plotas Square = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = hollowPolygon 7 1 4 False + (styleColor ind) } + plotas Diamond = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = hollowPolygon 7 1 4 True + (styleColor ind) } + plotas Plus = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = plusses 7 1 (styleColor ind) } + plotas Ex = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = exes 7 1 (styleColor ind) } + plotas Star = Just $ toPlot $ def + { _plot_points_title = name yks, + _plot_points_values = vs, + _plot_points_style = stars 7 1 (styleColor ind) } + plotas Symbols = plotas (styleSymbol ind) + plotas _ = Nothing + +name :: [PlotKind] -> String +name (Name s:_) = s +name (_:ks) = name ks +name [] = "" + +str2k :: String -> [PlotKind] +str2k "" = [] +str2k ". " = [Dotted] +str2k s@('?':_) = str2khelper s Symbols +str2k s@('@':_) = str2khelper s FilledCircle +str2k s@('#':_) = str2khelper s Square +str2k s@('v':_) = str2khelper s DownTriangle +str2k s@('^':_) = str2khelper s Triangle +str2k s@('o':_) = str2khelper s HollowCircle +str2k s@('+':_) = str2khelper s Plus +str2k s@('x':_) = str2khelper s Ex +str2k s@('*':_) = str2khelper s Star +str2k s@('.':_) = str2khelper s LittleDot +str2k "- " = [Dashed] +str2k "-" = [Solid] +str2k n = [Name n] + +str2khelper :: String -> PlotKind -> [PlotKind] +str2khelper s@(_:r) x = case str2k r of + [] -> [x] + [Name _] -> [Name s] + xs -> x:xs + +-- | Type to define a few simple properties of each plot. +data PlotKind = Name String | FilledCircle | HollowCircle + | Triangle | DownTriangle | Square | Diamond + | Plus | Ex | Star | Symbols + | LittleDot | Dashed | Dotted | Solid + deriving ( Eq, Show, Ord ) +data InternalPlot x y = IPY [y] [PlotKind] | IPX [x] [PlotKind] + +newtype LayoutDDD = LayoutDDD { plotLayout :: Layout Double Double } + +layoutDddToRenderable :: LayoutDDD -> Renderable (LayoutPick Double Double Double) +layoutDddToRenderable = layoutToRenderable . plotLayout + +instance ToRenderable LayoutDDD where + toRenderable = setPickFn nullPickFn . toRenderable + +uplot :: [UPlot] -> LayoutDDD +uplot us = LayoutDDD $ iplot $ nameDoubles $ evalfuncs us + where + nameDoubles :: [UPlot] -> [InternalPlot Double Double] + nameDoubles (X xs: uus) = case grabName uus of + (ks,uus') -> IPX (filter isValidNumber xs) ks + : nameDoubles uus' + nameDoubles (UDoubles xs:uus)= case grabName uus of + (ks,uus') -> IPY (filter isValidNumber xs) ks + : nameDoubles uus' + nameDoubles (_:uus) = nameDoubles uus + nameDoubles [] = [] + evalfuncs :: [UPlot] -> [UPlot] + evalfuncs (UDoubles xs:uus) = X xs : map ef (takeWhile (not.isX) uus) + ++ evalfuncs (dropWhile (not.isX) uus) + where ef (UFunction f) = UDoubles (map f xs) + ef u = u + evalfuncs (X xs:uus) = X xs : map ef (takeWhile (not.isX) uus) + ++ evalfuncs (dropWhile (not.isX) uus) + where ef (UFunction f) = UDoubles (map f xs) + ef u = u + evalfuncs (u:uus) = u : evalfuncs uus + evalfuncs [] = [] + grabName :: [UPlot] -> ([PlotKind],[UPlot]) + grabName (UString n:uus) = case grabName uus of + (ks,uus') -> (str2k n++ks,uus') + grabName (UKind ks:uus) = case grabName uus of + (ks',uus') -> (ks++ks',uus') + grabName uus = ([],uus) + isX (X _) = True + isX _ = False + +-- | The main plotting function. The idea behind PlotType is shamelessly +-- copied from Text.Printf (and is not exported). All you need to know is +-- that your arguments need to be in class PlotArg. And PlotArg consists +-- of functions and [Double] and String and PlotKind or [PlotKind]. + +plot :: PlotType a => a +plot = pl [] +class PlotType t where + pl :: [UPlot] -> t +instance (PlotArg a, PlotType r) => PlotType (a -> r) where + pl args = \ a -> pl (toUPlot a ++ args) +instance PlotType LayoutDDD where + pl args = uplot (reverse args) + +-- | Save a plot as a PDF file. + +plotPDF :: PlotPDFType a => String -> a +plotPDF fn = pld fn [] +class PlotPDFType t where + pld :: FilePath -> [UPlot] -> t +instance (PlotArg a, PlotPDFType r) => PlotPDFType (a -> r) where + pld fn args = \ a -> pld fn (toUPlot a ++ args) + +-- | Save a plot as a postscript file. + +plotPS :: PlotPSType a => String -> a +plotPS fn = pls fn [] +class PlotPSType t where + pls :: FilePath -> [UPlot] -> t +instance (PlotArg a, PlotPSType r) => PlotPSType (a -> r) where + pls fn args = \ a -> pls fn (toUPlot a ++ args) + +-- | Save a plot as a png file. +plotPNG :: PlotPNGType a => String -> a +plotPNG fn = plp fn [] + +class PlotPNGType t where + plp :: FilePath -> [UPlot] -> t +instance (PlotArg a, PlotPNGType r) => PlotPNGType (a -> r) where + plp fn args = \ a -> plp fn (toUPlot a ++ args) + +data UPlot = UString String | UDoubles [Double] | UFunction (Double -> Double) + | UKind [PlotKind] | X [Double] + +xcoords :: [Double] -> UPlot +xcoords = X + +class PlotArg a where + toUPlot :: a -> [UPlot] + +instance IsPlot p => PlotArg [p] where + toUPlot = toUPlot' + +instance (Real a, Real b, Fractional a, Fractional b) => PlotArg (a -> b) where + toUPlot x = [UFunction (realToFrac . x . realToFrac)] + +instance (Real a, Real b, Fractional a, Fractional b) => IsPlot (a -> b) where + toUPlot' = reverse . concatMap f + where f x = [UFunction (realToFrac . x . realToFrac)] + +instance PlotArg UPlot where + toUPlot = (:[]) + +instance PlotArg PlotKind where + toUPlot = (:[]) . UKind . (:[]) + + +class IsPlot c where + toUPlot' :: [c] -> [UPlot] + +instance IsPlot PlotKind where + toUPlot' = (:[]) . UKind + +instance IsPlot Double where + toUPlot' = (:[]) . UDoubles + +instance IsPlot Char where + toUPlot' = (:[]) . UString + +instance IsPlot p => IsPlot [p] where + toUPlot' = reverse . concatMap toUPlot' + +instance (IsPlot p, IsPlot q, IsPlot r) => IsPlot (p,q,r) where + toUPlot' = reverse . concatMap f + where f (p,q,r) = toUPlot' [p] ++ toUPlot' [q] ++ toUPlot' [r] + +instance (IsPlot p, IsPlot q) => IsPlot (p,q) where + toUPlot' = reverse . concatMap f + where f (p,q) = toUPlot' [p] ++ toUPlot' [q] + +instance PlotPDFType (IO a) where + pld fn args = do + renderableToFile def{_fo_format=PDF,_fo_size=(640,480)} (layoutDddToRenderable $ uplot (reverse args)) fn + return undefined + +instance PlotPSType (IO a) where + pls fn args = do + renderableToFile def{_fo_format=PS,_fo_size=(640,480)} (layoutDddToRenderable $ uplot (reverse args)) fn + return undefined + +instance PlotPNGType (IO a) where + plp fn args = do + renderableToFile def{_fo_format=PNG,_fo_size=(640,480)} (layoutDddToRenderable $ uplot (reverse args)) fn + return undefined + +-- | Display a plot on the screen. + +plotWindow :: PlotWindowType a => a +plotWindow = plw [] +class PlotWindowType t where + plw :: [UPlot] -> t +instance (PlotArg a, PlotWindowType r) => PlotWindowType (a -> r) where + plw args = \ a -> plw (toUPlot a ++ args) +instance PlotWindowType (IO a) where + plw args = do + renderableToWindow (layoutDddToRenderable $ uplot (reverse args)) 640 480 + return undefined diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2006, Tim Docker + +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. + + * The names of contributors may not 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain