packages feed

diagrams 0.2.1.2 → 0.2.1.3

raw patch · 13 files changed

+358/−4 lines, 13 filesdep ~cairo

Dependency ranges changed: cairo

Files

CHANGES view
@@ -1,3 +1,14 @@+Version 0.2.1.3: May 30, 2010++  * update cairo version range to allow 0.11+  * include example files in distribution tarball++Version 0.2.1.2: March 18, 2010++  * widen some dependency version ranges to include new releases that+    still work.+  * remove some redundant imports.+ Version 0.2.1.1: September 25, 2009    * builds with colour-2.3.1, so update allowable version range
diagrams.cabal view
@@ -1,5 +1,5 @@ Name:                diagrams-Version:             0.2.1.2+Version:             0.2.1.3 Stability:           experimental Description:         An embedded domain-specific language (EDSL) for                       creating simple diagrams, built on top of the Cairo@@ -8,12 +8,12 @@ Synopsis:            An EDSL for creating simple diagrams License:             BSD3 License-file:        LICENSE-Extra-source-files:  README,CHANGES+Extra-source-files:  README,CHANGES,example/*.hs Author:              Brent Yorgey Maintainer:          byorgey@gmail.com Category:            Graphics Build-type:          Simple-Cabal-version:       >= 1.2+Cabal-version:       >= 1.6 Tested-with:         GHC==6.12.1, GHC==6.10.4  flag testing@@ -26,7 +26,7 @@     ghc-options: -Werror   Build-Depends:     base >= 2 && < 5, mtl >= 1.0 && < 1.2,                      containers >= 0.2 && < 0.4,-                     cairo >= 0.9 && < 0.11, colour >= 2.2.1 && < 2.4+                     cairo >= 0.9 && < 0.12, colour >= 2.2.1 && < 2.4   Exposed-Modules:   Graphics.Rendering.Diagrams,                      Graphics.Rendering.Diagrams.Types,                      Graphics.Rendering.Diagrams.Paths,
+ example/CloudPacker.hs view
@@ -0,0 +1,63 @@+module CloudPacker (diagram) where++-- Cobbled together from snippets and ideas by Chris Done+-- http://github.com/chrisdone/wordcloud/++import Control.Arrow ((&&&), (***), first)+import Control.Monad (liftM)+import Data.Char (isLetter, toLower)+import Data.List (init, sortBy, foldl')+import Data.Maybe (listToMaybe)+import Data.Ord (comparing)+import qualified Data.Map as M++import Graphics.Rendering.Diagrams+import Graphics.Rendering.Diagrams.Engine (sizeAndPos)++type Point = (Int,Int)+type Size = Point+type Rect = (Point,Point)++-- Arrange the text boxes on the page, starting with the+-- largest and placing each one in the first gap available.+diagram :: [Diagram] -> Diagram+diagram = arrange . uncurry zip . (f &&& id)+    where f = map toPoint . foldl addToLayout [] . map size++arrange :: [(Point,Diagram)] -> Diagram+arrange = positionA left top . map (first (fromIntegral *** fromIntegral))++addToLayout :: [Rect] -> Size -> [Rect]+addToLayout [] sz = let (w,h) = sz in [toRect (-w`div`2,-h`div`2) sz]+addToLayout rs sz = maybe rs (\p -> rs ++ [toRect p sz]) $ listToMaybe $ bestfits sz rs++bestfits :: Size -> [Rect] -> [Point]+bestfits sz rs = concatMap (\r -> aroundRect sz r rs) rs++aroundRect :: Size -> Rect -> [Rect] -> [Point]+aroundRect sz r rs = filter valid (potentials sz r)+    where valid pt = not (any (overlaps (toRect pt sz)) rs)++toRect :: Point -> Size -> Rect+toRect (x,y) (w,h) = ((x,y),(x+w,y+h))+toPoint :: Rect -> Point+toPoint = fst++-- Produces candidates in anti-clockwise order.+potentials :: Size -> Rect -> [Point]+potentials (w,h) ((x1,y1),(x2,y2)) = concat [leftside,rightside,bottomside,topside]+    where leftside = init $ map ((,) x) [y..y2]+          rightside = init $ map ((,) x2) [y2,y2-1..y]+          bottomside = init $ map (flip (,) y2) [x..x2]+          topside = init $ map (flip (,) y) [x2,x2-1..x]+          (x,y) = (x1 - w, y1 - h)++overlaps :: Rect -> Rect -> Bool+overlaps r1 r2 = r1 `overlapX` r2 && r1 `overlapY` r2+overlapX :: Rect -> Rect -> Bool+overlapX ((x1,_),(x1',_)) ((x2,_),(x2',_)) = if x1 < x2 then x1' > x2 else x2' > x1+overlapY :: Rect -> Rect -> Bool+overlapY ((_,y1),(_,y1')) ((_,y2),(_,y2')) = if y1 < y2 then y1' > y2 else y2' > y1++size :: Diagram -> Size+size = (ceiling *** ceiling) . fst . sizeAndPos
+ example/alignment.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE ParallelListComp #-}+module Main where++import Graphics.Rendering.Diagrams+import Data.Colour.SRGB.Linear++colors = [ rgb r 0 0.5 | r <- [0.2, 0.4 .. 1.0] ]++circles = [ fc c $ circle r | c <- colors | r <- [5,4..1] ]++alignments = [ [ (ha,va) | ha <- [left, hcenter, right] ]+                         | va <- [top,  vcenter, bottom] ]++dia = vsep 2 .+      map (hsep 2) .+      map (map (\(h,v) -> unionA h v circles)) $+      alignments++main = do renderAs PNG "alignment.png" (Width 500) dia
+ example/dragon.hs view
@@ -0,0 +1,29 @@+{- Heighway dragon.  See http://en.wikipedia.org/wiki/Dragon_curve. -}+module Main where++import Graphics.Rendering.Diagrams+import Control.Monad.State+import Data.Maybe++dragonStr :: Int -> String+dragonStr 0 = "FX"+dragonStr n = concatMap rules $ dragonStr (n-1)+  where rules 'X' = "X+YF+"+        rules 'Y' = "-FX-Y"+        rules c = [c]++strToPath :: String -> Path+strToPath s = pathFromVectors . catMaybes $ evalState c (0,-1)+  where c        = mapM exec s+        exec 'F' = Just `fmap` get+        exec '-' = modify left >> return Nothing+        exec '+' = modify right >> return Nothing+        exec _   = return Nothing+        left (x,y)  = (-y,x)+        right (x,y) = (y,-x)++dragon :: Int -> Diagram+dragon = lc red . curved 0.8 . strToPath . dragonStr++main = renderAs PNG "dragon.png" (Height 500) (dragon 14)+
+ example/ferrers.hs view
@@ -0,0 +1,26 @@+module Main where++import Graphics.Rendering.Diagrams+import Graphics.Rendering.Diagrams.Engine+import Graphics.Rendering.Diagrams.Types++import Data.List+import Data.Function++partitions :: Int -> [[Int]]+partitions n = partitions' n n+  where partitions' 0 _ = [[]]+        partitions' n 1 = [replicate n 1]+        partitions' n k = do s <- [k,k-1..1]+                             p <- partitions' (n-s) (min (n-s) s)+                             return (s:p)++parts = groupBy ((==) `on` head) . partitions++ferrersTableaux :: Int -> Diagram+ferrersTableaux = vsep 20 . map (hsep 20 . map ferrers) . parts++ferrers :: [Int] -> Diagram+ferrers = hsep 3 . map (vsep 3 . flip replicate (circle 10))++main = renderAs PNG "ferrers.png" (Height 300) (lw 0 $ fc black $ ferrersTableaux 6)
+ example/fontlist.hs view
@@ -0,0 +1,14 @@+module Main where++import System.Cmd.Utils (pipeLinesFrom)++import Graphics.Rendering.Diagrams++import CloudPacker (diagram)++main = do+    (ph, ls) <- pipeLinesFrom "fc-list" []+    let fontnames = map (takeWhile (\c -> c/=':' && c/=',')) ls+    renderAs PNG "fontlist.png" Auto $ diagram $ map mkText $ take 30 fontnames++mkText name = lw 0 $ fc black $ tf name $ textPath 12 name
+ example/ford.hs view
@@ -0,0 +1,40 @@+module Main where++import Graphics.Rendering.Diagrams++import Data.Ratio+import System.Random++(<+>) :: Rational -> Rational -> Rational+r1 <+> r2 = (numerator r1 + numerator r2) % (denominator r1 + denominator r2)++farey :: Integer -> [Rational]+farey 0 = [0%1, 1%1]+farey n = filter ((<=n) . denominator) $ insertMediants (farey (n-1))++insertMediants :: [Rational] -> [Rational]+insertMediants [] = []+insertMediants [x] = [x]+insertMediants (x:y:zs) = x : (x <+> y) : insertMediants (y:zs)++fordCircles :: Integer -> [Diagram]+fordCircles n = map toCircle $ farey n++toCircle r = translateX r' $+             circle (1 / (2 * d'^2))+  where r' = fromRational r+        d' = fromIntegral (denominator r)++dia :: [Color] -> Diagram+dia colors = view (0,0) (1,1/2) $+             unionA hcenter bottom $+             zipWith fc colors (fordCircles 20)++randomColors :: [Double] -> [Color]+randomColors (r:g:b:ds) = rgb r g b : randomColors ds++main :: IO ()+main = do+  g <- newStdGen+  let rs = randoms g+  renderAs PNG "ford.png" (Width 500) (dia $ randomColors rs)
+ example/logo.hs view
@@ -0,0 +1,27 @@+import Graphics.Rendering.Diagrams+import Data.Colour.SRGB++logo :: Diagram+logo = pad 3 3 $ hsepA 1 bottom [d,i,a,hspace (-1.7),g,r,a,m,s]++myGreen = sRGB 0 0.8 0++d,i,a,g,r,m,s :: Diagram++d = (fc red $ arc 4 (3/4) (1/4)) ## (fc black $ rect 0.5 8)++i = fc yellow $ rect 1 5++a = lc blue . lw 2 . fc myGreen $ rotRegPoly 3 2.5 (1/12)++g = fc aliceblue . dashing [0.1,0.1] 0 $ (arc 3 0 (1/2) ## arc 3 (1/4) (3/4))++r = curved 1 $ pathFromVertices [(0,6), (0,0), (3,1.5), (0.5, 3), (3,6)]++m = fc orange . lw 3 . lineJoin LineJoinRound $ halfM <> halfM2+  where halfM  = straight . closed $ pathFromVertices [(0,4), (0,0), (2,4)]+        halfM2 = straight . closed $ pathFromVertices [(2,4), (2,0), (0,4)]++s = lw 5 . lc blue $ arc 1.5 (1/4) (7/8) // arc 1.5 (3/4) (3/8)++main = renderAs PNG "logo.png" (Height 100) logo
+ example/permutations.hs view
@@ -0,0 +1,27 @@+module Main where+import Graphics.Rendering.Diagrams+import Data.Colour.SRGB.Linear++second f (x,y) = (x,f y)++select :: [a] -> [(a,[a])]+select []     = []+select (x:xs) = (x,xs) : map (second (x:)) (select xs)++permutations :: [a] -> [[a]]+permutations [] = [[]]+permutations xs = do (e, rest) <- select xs+                     map (e:) $ permutations rest++dia :: Diagram+dia = arrange $ map colorsToStrip (permutations [red, yellow, blue, green'])+  where green' = rgb 0 1 0++arrange :: [Diagram] -> Diagram+arrange = hsep 10 . map (vsep 5) . groups+  where groups = takeWhile (not . null) . map (take 6) . iterate (drop 6)++colorsToStrip :: Color c => [c] -> Diagram+colorsToStrip = hcat . map (\c -> fc c $ rect 10 10)++main = renderAs PNG "permutations.png" (Width 300) dia
+ example/sierpinski.hs view
@@ -0,0 +1,12 @@+module Main where++import Graphics.Rendering.Diagrams++sierpinski :: Int -> Diagram+sierpinski 0 = fc black $ lw 0 $ rotRegPoly 3 1 (-1/4)+sierpinski n = vcatA hcenter [         s+                             ,      s <> s]+  where s = sierpinski (n-1)++main = renderAs PNG "sierpinski.png" (Height 300) (sierpinski 6)+
+ example/snellen.hs view
@@ -0,0 +1,13 @@+module Main where++import Graphics.Rendering.Diagrams++main = renderAs PNG "snellen.png" (Width 400) snellen++snellen = vcatA hcenter $ zipWith text sizes letters++sizes = [36,24,18,12,9,6,5,4,3]+letters = ["A","D F","H Z P","T X U D","Z A D N H","P N T U H X"+          ,"U A Z N F D T","N P H T A F X U","X D F H P T Z A N"+          ,"F A X T D N H U P Z"]+
+ example/wordcloud.hs view
@@ -0,0 +1,73 @@+module Main where++-- Cobbled together from snippets and ideas by Chris Done+-- http://github.com/chrisdone/wordcloud/++import Control.Monad (liftM)+import Data.Char (isLetter, toLower)+import Data.List (sortBy, foldl')+import Data.Ord (comparing)+import qualified Data.Map as M++import System.Random (getStdGen, randomRs)+import System.Environment (getArgs)++import Graphics.Rendering.Diagrams+import Data.Colour (withOpacity)+import Data.Colour.SRGB.Linear (rgb)++import CloudPacker (diagram)++type Weight = Int+type Word = String+type Histogram = [(Word,Weight)]+type Colour = [Double]++-- Word histograms.+--+histogramByFreq :: [Word] -> String -> Histogram+histogramByFreq badws = list . table where+    table = filterByGood badws . histogram . words . map toLetter+    list = take 150 . sortBy (flip (comparing snd)) . M.toAscList++toLetter c | isLetter c = c+           | otherwise  = ' '++histogram = foldl' (flip $ flip (M.insertWith' $ const (+1)) 1) M.empty++filterByGood badws = M.filterWithKey (\x y -> goodWord x) where+    goodWord [_] = False+    goodWord w   = not $ any (==(map toLower w)) badws -- No articles.++stopwords = words "import qualified hiding data newtype type deriving instance do if then else case of let where"+++main = do+    args <- getArgs+    let input = case args of+                    "-":_       -> getContents+                    filename:_  -> readFile filename+                    _           -> readFile "wordcloud.hs"+    weightedwords <- histogramByFreq stopwords `liftM` input+    rands <- groupsOf 3 `liftM` randomRs (0,1) `liftM` getStdGen+    let sizedwords = mkWords weightedwords rands+    renderAs PNG "wordcloud.png" (Width 500) $ diagram sizedwords+++-- Sizing and colouring the text according to the+-- weight given in the histogram.+mkWords :: Histogram -> [Colour] -> [Diagram]+mkWords wwds cols = zipWith (mkWord maxweight) wwds cols+    where maxweight = snd $ head wwds++mkColour [r,g,b] a = rgb r g b `withOpacity` max a 0.1++mkWord :: Weight -> (Word,Weight) -> Colour -> Diagram+mkWord mx (s,w) col = fc c $ lw 0 $ tf "URW Bookman L" $ textPath sz s+    where sz = fromIntegral w * 10+          c  = mkColour col (max 0.2 (fromIntegral w/fromIntegral mx))++groupsOf :: Int -> [a] -> [[a]]+groupsOf n [] = []+groupsOf n xs = let (grp, remainder) = splitAt n xs+                in grp : groupsOf n remainder