{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Diagarms.Potrace -- Copyright : (c) 2015 Christopher Chalmers -- License : BSD-style (see LICENSE) -- Maintainer : c.chalmers@me.com -- -- Trace bitmap images into paths using the potrace library. This module -- also provides helpers for turning "JuicyPixel" images to bitmap. -- module Diagrams.Potrace ( -- * Tracing tracePath , tracePath' -- * Bitmaps , Bitmap , generate , fromImage , lumaThreshold -- * Parameters , Parameters (..) , TurnPolicy (..) -- ** Lenses , turdSize , turnPolicy , alphaMax , optTolerance -- * Misc , loop , pt ) where import Diagrams.Prelude as D import Graphics.Potrace as P -- | Trace the bitmap image to a path using potrace with 'def' -- parameters. tracePath :: Bitmap -> Path V2 Double tracePath = tracePath' def -- | Trace the bitmap image to a path curves using potrace with given -- parameters. tracePath' :: Parameters -> Bitmap -> Path V2 Double tracePath' p bm = Path $ map (mapLoc Trail . loop) (trace' p bm) -- Internals ----------------------------------------------------------- pt :: P.P2 -> D.P2 Double pt (P2 x y) = mkP2 x y -- pt (P2 x y) = mkP2 (realToFrac x) (realToFrac y) loop :: Curve -> Located (Trail' Loop V2 Double) loop (P.Curve p0 segs) = closeLine (lineFromSegments (go p0' segs)) `at` p0' where p0' = pt p0 -- for some reason the starting point is actaully the very last point. go p (s:ss) = case s of P.Corner v b -> straight (pt v .-. p) : straight (pt b .-. pt v) : go (pt b) ss P.Bezier u v b -> bezier3 (pt u .-. p) (pt v .-. p) (pt b .-. p) : go (pt b) ss go _ [] = [] -- path :: [[P.Segment]] -> Path V2 Double -- path = Path . map (mapLoc Trail . loop) -- dia :: Renderable (Path V2 Double) b => P.Bitmap -> QDiagram b V2 Double Any -- dia = stroke . path . P.pic -- loop :: Curve (Trail' Loop V2 Double) -- loop = foldCurve mkP2 corner cubic (, mempty) <&> \(p, ss) -> -- where -- corner u v (p,r) = (p, straight (pt v .-. p) <| straight (pt b .-. pt v) <| r) -- cubic u v b (p,r) = (p, bezier3 (pt u .-. p) (pt v .-. p) (pt b .-. p) <| go (pt b) ss)