module Graphics.Curves
(
module Graphics.Curves.Math
, module Graphics.Curves.Colour
, Image
, point, line, lineStrip, poly, circle, circleSegment
, curve, curve_, curve'
, bSpline, bSpline', closedBSpline
, bezier, bezierSegment
, reverseImage
, (+++), (+.+), (<++), (++>)
, differentiate, mapImage, zipImage, transformImage
, curveLength
, freezeImageSize, freezeImageOrientation, freezeImage, freezeImageStyle
, unfreezeImage
, BlendFunc
, combine, mapColour
, unionBlend, intersectBlend, diffBlend
, (<>)
, (><), (<->)
, imageBounds, sampleImage
, module Graphics.Curves.Attribute
, module Graphics.Curves.Style
, autoFit, autoStretch
, renderImage
, version
)
where
import Graphics.Curves.Math
import Graphics.Curves.BoundingBox
import Graphics.Curves.Curve
import Graphics.Curves.Image
import Graphics.Curves.Colour
import Graphics.Curves.Render hiding (sampleImage)
import Graphics.Curves.Compile
import Graphics.Curves.Attribute
import Graphics.Curves.Style
import Data.Version (showVersion)
import qualified Paths_curves as Paths
autoFit :: Point -> Point -> Image -> Image
autoFit p q = loop 0
where
loop oldk i
| abs (k 1) < 0.01 = i'
| abs (oldk k) < 0.01 = i'
| otherwise = loop k i'
where
(k, i') = autoFit' p q i
autoFit' :: Point -> Point -> Image -> (Scalar, Image)
autoFit' p0 p1 i =
(getX k, translate (p0 q0 + offs) $ scaleFrom q0 k i)
where
Seg q0 q1 = bboxToSegment $ bounds $ compileImage i
screen = p1 p0
world = q1 q0
k = diag $ vuncurry min (screen / world)
world' = k * world
offs = 0.5 * (screen world')
autoStretch :: Point -> Point -> Image -> Image
autoStretch p q = loop 0
where
loop oldk i
| abs (getX k 1) < 0.01 &&
abs (getY k 1) < 0.01 = i'
| getX (abs $ oldk k) < 0.01 = i'
| otherwise = loop k i'
where
(k, i') = autoStretch' p q i
autoStretch' :: Point -> Point -> Image -> (Vec, Image)
autoStretch' p0 p1 i =
(k, translate (p0 q0 + offs) $ scaleFrom q0 k i)
where
Seg q0 q1 = bboxToSegment $ bounds $ compileImage i
screen = p1 p0
world = q1 q0
k = screen / world
world' = k * world
offs = 0.5 * (screen world')
imageBounds :: Image -> Segment
imageBounds i0
| d < 50 = getBounds (50 / d) i
| otherwise = s
where
i = i0 `with` [LineWidth := 0, LineBlur := 0, FillBlur := 0]
s@(Seg p q) = getBounds 1 i
d = vuncurry max (q p)
getBounds k' i = scale (1/k) $ bboxToSegment $ bounds $ compileImage $ scale k i
where k = diag k'
sampleImage :: Image -> Scalar -> [[Point]]
sampleImage IEmpty t = []
sampleImage (Combine _ i j) t = sampleImage i t ++ sampleImage j t
sampleImage (ICurve (Curves cs _)) t = [map (sampleCurve t) cs]
where
sampleCurve t (Curve f g _ _) = g t (f t)
freezeImageStyle :: Image -> Image
freezeImageStyle i = mapCurve (freezeLineStyle res) i
where res = vuncurry min (p1 p0) / 100
Seg p0 p1 = imageBounds i
class Transformable a => ImageElement a where
toImage :: a -> Image
instance ImageElement Image where
toImage = id
instance ImageElement Segment where
toImage (Seg p q) = line p q
instance ImageElement Vec where
toImage = point
version :: String
version = showVersion Paths.version