diff --git a/Graphics/Typography.lhs b/Graphics/Typography.lhs new file mode 100644 --- /dev/null +++ b/Graphics/Typography.lhs @@ -0,0 +1,89 @@ +\begin{code} +{-# OPTIONS -XFlexibleInstances -XNamedFieldPuns #-} +-- | This module contains basic tools for geometric types and functions. +module Graphics.Typography (Matrix2(..), + inverse,rotation, + Geometric(..), + leftMost,rightMost,topMost,bottomMost) + where + +import Algebra.Polynomials.Numerical + +-- | The type of the transformation matrices used in all geometrical applications. +data Matrix2 a= + -- | The application of @Matrix2 a b c d@ to vector @(x,y)@ should be + -- @(ax+by,cx+dy)@. + Matrix2 a a a a deriving (Show, Read, Eq) + +-- | Inverses an inversible matrix. If it is not inversible, +-- The behaviour is undefined. +inverse::(Fractional a, Num a)=>Matrix2 a->Matrix2 a +inverse (Matrix2 a b c d)= + let det=a*d-c*b in + Matrix2 (d/det) (-b/det) (-c/det) (a/det) + + + +instance Num a=>Num (Matrix2 a) where + (+) (Matrix2 a b c d) (Matrix2 e f g h)= + Matrix2 (a+e) (b+f) (c+g) (d+h) + (*) (Matrix2 a b c d) (Matrix2 e f g h)= + Matrix2 (a*e+b*g) (a*f+b*h) (c*e+d*g) (c*f+d*h) + fromInteger a=Matrix2 (fromInteger a) 0 0 (fromInteger a) + abs=undefined + signum=undefined + +instance Intervalize Matrix2 where + intervalize (Matrix2 a b c d)= + Matrix2 (interval a) (interval b) (interval c) (interval d) + + intersects (Matrix2 a b c d) (Matrix2 a' b' c' d')= + (intersectsd a a') && + (intersectsd b b') && + (intersectsd c c') && + (intersectsd d d') + +-- | A class for applying geometric applications to objects +class Geometric g where + translate::Double->Double->g->g + apply::Matrix2 Double->g->g + +-- | The matrix of a rotation +rotation::Floating a=>a->Matrix2 a +rotation theta= + let ct=cos theta + st=sin theta + in + Matrix2 ct (-st) st ct + +instance Geometric g=>Geometric [g] where + + translate x y cur=map (translate x y) cur + apply m cur=map (apply m) cur + + +-- | @'leftMost' a b@ is the leftmost point between @a@ and @b@. +leftMost::(Double,Double)->(Double,Double)->(Double,Double) +leftMost u@(a,_) v@(b,_) + | a(Double,Double)->(Double,Double) +rightMost u@(a,_) v@(b,_) + | a(Double,Double)->(Double,Double) +bottomMost u@(_,a) v@(_,b) + | a(Double,Double)->(Double,Double) +topMost u@(_,a) v@(_,b) + | aDouble +rnd (Interval a b)=(a+b)/2 + + +-- | Approximates a list of 'Curves' with a list of degree 3 Bernstein curves. +approximate::[Curve]->[(Bernsteinp Int Double,Bernsteinp Int Double)] +approximate []=[] +approximate l0@(h0:_)= -- traceShow "starting" $ + let approx::Double->Double->[Curve]->[(Bernsteinp Int Double,Bernsteinp Int Double)] + approx _ _ []=[] + approx x0 y0 (cc@(Circle {..}):s)= -- traceShow "circle" $ + let theta=abs $ t1-t0 in + if theta <= pi/2 then + let x0_=cos $ theta/2 + y0_=sin $ theta/2 + x1_=(4-x0_)/3 + y1_=(1-x0_)*(3-x0_)/(3*y0_) + + c0=cos $! theta/2+t0 + s0=sin $! theta/2+t0 + + + px0=c0*x0_ - s0*y0_ + py0=s0*x0_ + c0*y0_ + + px1=c0*x1_ - s0*y1_ + py1=s0*x1_ + c0*y1_ + + px2=c0*x1_ + s0*y1_ + py2=s0*x1_ - c0*y1_ + + -- px3=c0*x0_ + s0*y0_ + -- py3=s0*x0_ - c0*y0_ + + x1=cx0+(a*px0+b*py0) + y1=cy0+(c*px0+d*py0) + + (Matrix2 a b c d)=matrix + x=Bernsteinp 4 $ UV.fromList + [ x0, -- cx0+(a*px3+b*py3), + cx0+(a*px2+b*py2), + cx0+(a*px1+b*py1), + x1] + + y=Bernsteinp 4 $ UV.fromList + [ y0, -- cy0+(c*px3+d*py3), + cy0+(c*px2+d*py2), + cy0+(c*px1+d*py1), + y1 ] + in + (x,y):(approx x1 y1 s) + + else + let t1'=(t1+t0)/2 in + approx x0 y0 $ (cc { t1=t1' }):(cc { t0=t1' }):s +{- + approx x0 y0 (h@(Bezier{}):s)= + -- incorrect ! + (restriction (cx h) (t0 h) (t1 h), + restriction (cy h) (t0 h) (t1 h)): + (approx (UV.last $ coefs $ cx h) + (UV.last $ coefs $ cy h) s) +-} + -- Ce qui suit est une methode de moindres carres + approx x0 y0 (off_:s)= -- traceShow ("offset") $ + -- On commence par chercher les points ou la derivee de la norme + -- de la tangente est maximale. C'est la qu'on va couper s'il y + -- a un probleme. + let bx=restriction (cx off_) (t0 off_) (t1 off_) + by=restriction (cy off_) (t0 off_) (t1 off_) + off=off_ { cx=bx,cy=by,t0=0,t1=1 } + ibx=elevate (bounds by-bounds bx) $ intervalize bx + iby=elevate (bounds bx-bounds by) $ intervalize by + points= + let np=10 in + map (\x->(x/np,x/np)) [0..np] + -- Ensuite, moindres carres standard, comme dans Hoschek 88. + + vx0=ibx?1-ibx?0 + vy0=iby?1-iby?0 + vx1=ibx?(bounds ibx-2)-ibx?(bounds ibx-1) + vy1=iby?(bounds iby-2)-iby?(bounds iby-1) + + (wx0,wy0)=evalCurve off 0 + (wx1,wy1)=evalCurve off 1 + + wx=Bernsteinp 4 $ UV.fromList [wx0,wx0,wx1,wx1] :: Bernsteinp Int Interval + wy=Bernsteinp 4 $ UV.fromList [wy0,wy0,wy1,wy1] :: Bernsteinp Int Interval + + bern1=Bernsteinp 4 $ UV.fromList [0,1,0,0] :: Bernsteinp Int Interval + bern2=Bernsteinp 4 $ UV.fromList [0,0,1,0] :: Bernsteinp Int Interval + + sumAll a b c d x1 y1 ((h1,h2):ss)= + + let h=Interval h1 h2 + (xi,yi)=evalCurve off h + + b1=eval bern1 h + b2=eval bern2 h + + a'=a + (vx0*vx0+vy0*vy0)*b1*b1 + b'=b + (vx0*vx1 + vy0*vy1)*b1*b2 + c'=c + (vx0*vx1 + vy0*vy1)*b1*b2 + d'=d + (vx1*vx1+vy1*vy1)*b2*b2 + + dx=xi-(eval wx h) + dy=yi-(eval wy h) + + x1'=x1 + (vx0*dx + vy0*dy)*b1 + y1'=y1 + (vx1*dx + vy1*dy)*b2 + in + sumAll a' b' c' d' x1' y1' ss + + sumAll a b c d x1 y1 []=(a,b,c,d,x1,y1) + + (ra,rb,rc,rd,rx1,ry1)=sumAll 0 0 0 0 0 0 points + + (Matrix2 a_ b_ c_ d_)=inverse $ Matrix2 ra rb rc rd + lambda1=a_*rx1+b_*ry1 + lambda2=c_*rx1+d_*ry1 + + -- On a la courbe optimale. Il faut chercher ou on va couper, maintenant + xap=Bernsteinp 4 $ UV.fromList [wx0, + wx0+lambda1*vx0, + wx1+lambda2*vx1, + wx1] + yap=Bernsteinp 4 $ UV.fromList [wy0, + wy0+lambda1*vy0, + wy1+lambda2*vy1, + wy1] + (err,arg)=foldl (\m (h1,h2)-> + let (xi,yi)=evalCurve off (Interval h1 h2) + xj=eval xap (Interval h1 h2) + yj=eval yap (Interval h1 h2) + in + max m (iup $ abs $ (xi-xj)*(xi-xj)+(yi-yj)*(yi-yj), (h1+h2)/2)) + (0,0) points + in + if err<=0.01 then + (desintervalize xap,desintervalize yap):(approx (rnd wx1) (rnd wy1) s) + else + approx x0 y0 $ + (off { cx=restriction (cx off) 0 arg, + cy=restriction (cy off) 0 arg }): + (off { cx=restriction (cx off) arg 1, + cy=restriction (cy off) arg 1 }):s + + (x0h,y0h)=evalCurve h0 $ Interval (t0 h0) (t0 h0) + + in + approx (rnd x0h) (rnd y0h) l0 + +desintervalize::(Bernsteinp a Interval)->(Bernsteinp a Double) +desintervalize b=b { coefs=UV.map rnd $ coefs b} + +\end{code} diff --git a/Graphics/Typography/Bezier.lhs b/Graphics/Typography/Bezier.lhs new file mode 100644 --- /dev/null +++ b/Graphics/Typography/Bezier.lhs @@ -0,0 +1,749 @@ +\documentclass{article} +%include lhs2TeX.fmt +\begin{document} +\begin{code} +{-# OPTIONS -XUnboxedTuples -XBangPatterns -XNamedFieldPuns -XRecordWildCards -XMagicHash -cpp #-} +-- | This module contains the basic functions for manipulating Bezier curves. It is heavily +-- based on the book by N. M. Patrikalakis and T. Maekawa, Shape Interrogation for Computer +-- Aided Design and Manufacturing. + +module Graphics.Typography.Bezier ( + Curve(..),line,bezier3, + offset, + inter, + evalCurve,distance, + left,bottom,right,top) where + +import Algebra.Polynomials.Bernstein +import Algebra.Polynomials.Numerical +import Graphics.Typography +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as UV +import Data.List (partition,sort) + +-- | The type for representing all types of curves. +data Curve= + Bezier { cx::Bernsteinp Int Double, + cy::Bernsteinp Int Double, + t0::Double, + t1::Double } + + | Offset { cx::Bernsteinp Int Double, + cy::Bernsteinp Int Double, + t0::Double, + t1::Double, + matrix::Matrix2 Double + } + | Circle { cx0::Double, + cy0::Double, + t0::Double, + t1::Double, + matrix::Matrix2 Double + } + deriving (Show) + + +-- | The basic constructor for lines : a line is a degree 1 Bezier curve +line::Double->Double->Double->Double->Curve +line px py px' py'=Bezier { cx=Bernsteinp 2 $ UV.fromList [px,px'], + cy=Bernsteinp 2 $ UV.fromList [py,py'], + t0=0,t1=1 } + +-- | A shortcut to define degree 3 Bezier curves from points. If the control +-- points are @a,b,c,d@, the function should be called with +-- @'bezier3' xa ya xb yb xc yc xd yd@. +bezier3::Double->Double->Double->Double->Double->Double->Double->Double->Curve +bezier3 px0 py0 px1 py1 px2 py2 px3 py3= + Bezier { cx=Bernsteinp 4 $ UV.fromList [px0,px1,px2,px3], + cy=Bernsteinp 4 $ UV.fromList [py0,py1,py2,py3], + t0=0,t1=1 } + +instance Geometric Curve where + translate x y cur@(Circle{cx0,cy0})= + cur { cx0=cx0+x,cy0=cy0+y } + translate x y cur= + cur { cx=(cx cur) { coefs=UV.map (+x) $ coefs $ cx cur}, + cy=(cy cur) { coefs=UV.map (+y) $ coefs $ cy cur} } + + apply m0@(Matrix2 a b c d) cir@(Circle{cx0,cy0,matrix})= + cir { cx0=a*cx0+b*cy0, cy0=c*cx0+d*cy0, matrix=m0*matrix } + apply (Matrix2 a b c d) cur= + cur { cx=(scale a $ cx cur)+(scale b $ cy cur), + cy=(scale c $ cx cur)+(scale d $ cy cur) } + + + +-- | Gives the point corresponding to the given value of the parameter +evalCurve::Curve->Interval->(Interval,Interval) +evalCurve (Offset{..}) t= + let ix=intervalize cx + iy=intervalize cy + xt=eval ix t + yt=eval iy t + m@(Matrix2 a b c d)=intervalize matrix + (Matrix2 a_ b_ c_ d_)=inverse m + xt0'=eval (derivate ix) t + yt0'=eval (derivate iy) t + xt'=a_*xt0' + b_*yt0' + yt'=c_*xt0' + d_*yt0' + dd=sqrt $ xt'*xt' + yt'*yt' + in + (xt+(a*yt'-b*xt')/dd, yt+(c*yt'-d*xt')/dd) + +evalCurve (Circle{..}) alpha= + let xx=cos alpha + yy=sin alpha + (Matrix2 a b c d)=intervalize matrix + in + (interval cx0+a*xx+b*yy, interval cy0+c*xx+d*yy) + +evalCurve (Bezier{..}) t= + let ix=intervalize cx + iy=intervalize cy + xx=eval ix t + yy=eval iy t + in + (xx,yy) + +data Topo=Dehors | SurLaLigne | Dedans deriving Eq + +-- | @'inter' c0 c1@ is a list of all possible points of intersection +-- between curves @c0@ and @c1@ : if @(u,v,w,x)@ is returned by 'inter', +-- then curve @c0@ may intersect with @c1@ between parameter values @u@ +-- and @v@, which corresponds to parameter values between @w@ and @x@ for +-- @c1@. The implementation guarantees that all actual solutions are found, +-- but possibly false solutions may also be returned. + +inter::Curve->Curve->[((Double,Double,Double,Double))] +inter op@(Offset { cx=bxp_,cy=byp_,matrix=mp,t0=t0a,t1=t1a }) + (Offset { cx=bxq_,cy=byq_,matrix=mq,t0=t0b,t1=t1b })= + + -- Attention : verifier si c'est la meme generatrice + let thrx=1e-5 + solutions _ []=[] + solutions thr boxes@(_:_)= + let sol0=concatMap (solve thr (V.fromList [eq0,eq1,eq2,eq3])) boxes + + (correct,toRefine)=partition (\(u,v,_,_,_,_,_,_)-> + let (xu,yu)=evalCurve op (Interval u u) + (xv,yv)=evalCurve op (Interval v v) + in + (iup $ (xu-xv)^(2::Int)+(yu-yv)^(2::Int))<=thrx) sol0 + in + correct++(solutions (thr/2) toRefine) + in + map (\(u,v,w,x,_,_,_,_)->(u,v,w,x)) $ solutions 1e-2 $ + [(t0a,t1a,t0b,t1b,0,1,0,1):: + (Double,Double,Double,Double,Double,Double,Double,Double)] + + where + + + imp@(Matrix2 ap bp cp dp)=intervalize mp + imq@(Matrix2 aq bq cq dq)=intervalize mq + (Matrix2 ap_ bp_ cp_ dp_)=inverse imp + (Matrix2 aq_ bq_ cq_ dq_)=inverse imq + + bxp=intervalize bxp_ + byp=intervalize byp_ + bxq=intervalize bxq_ + byq=intervalize byq_ + + bxp4=promote 1 bxp + byp4=promote 1 byp + bxq4=promote 2 bxq + byq4=promote 2 byq + + + bxp'=derivate bxp + byp'=derivate byp + bxq'=derivate bxq + byq'=derivate byq + + bXp'=promote 1 $ (scale ap_ bxp')+(scale bp_ byp') + bYp'=promote 1 $ (scale cp_ bxp')+(scale dp_ byp') + + bXq'=promote 2 $ (scale aq_ bxq')+(scale bq_ byq') + bYq'=promote 2 $ (scale cq_ bxq')+(scale dq_ byq') + + bomp@(Bernsteinp _ omegap)=(bXp'*bXp')+(bYp'*bYp') :: Bernsteinp (Int,Int,Int,Int) Interval + bomq@(Bernsteinp _ omegaq)=(bXq'*bXq')+(bYq'*bYq') :: Bernsteinp (Int,Int,Int,Int) Interval + + au= + let au_=sqrt $ UV.minimum $ UV.map ilow omegap in + max 0 $ fpred au_ + bu= + let bu_=sqrt $ UV.maximum $ UV.map iup omegap in + fsucc bu_ + av= + let av_=sqrt $ UV.minimum $ UV.map ilow omegaq in + max 0 $ fpred av_ + bv= + let bv_=sqrt $ UV.maximum $ UV.map iup omegaq in + fsucc bv_ + + alphau=Bernsteinp (1,1,2,1) $ UV.fromList [Interval au au,Interval bu bu] + alphav=Bernsteinp (1,1,1,2) $ UV.fromList [Interval av av,Interval bv bv] + + eq0= + ((bxp4*alphau*alphav) + (scale ap $ bYp'*alphav) - (scale bp $ bXp'*alphav) + -(bxq4*alphau*alphav) - (scale aq $ bYq'*alphau) + (scale bq $ bXq'*alphau)) + eq1= + ((byp4*alphau*alphav) + (scale cp $ bYp'*alphav) - (scale dp $ bXp'*alphav) + -(byq4*alphau*alphav) - (scale cq $ bYq'*alphau) + (scale dq $ bXq'*alphau)) + eq2=bomp-(alphau*alphau) + eq3=bomq-(alphav*alphav) + + + + +inter b@(Circle{}) a@(Offset{})= + map (\(i,j,k,l)->(k,l,i,j)) $ inter a b + +inter o@(Offset { cx=bxp, cy=byp, matrix=mp }) + cir@(Circle{cx0,cy0,matrix=mq})= + + let ix=intervalize bxp + iy=intervalize byp + m@(Matrix2 a b c d)=intervalize mp + (Matrix2 a_ b_ c_ d_)=inverse m + x'=derivate ix + y'=derivate iy + xx'=(scale a_ x')+(scale b_ y') + yy'=(scale c_ x')+(scale d_ y') + omega@(Bernsteinp _ omegap)=xx'*xx'+yy'*yy' + au= + let au_=sqrt $ UV.minimum $ UV.map ilow omegap in + max 0 $ fpred au_ + bu= + let bu_=sqrt $ UV.maximum $ UV.map iup omegap in + fsucc bu_ + + alphau=Bernsteinp (1,2) $ UV.fromList [Interval au au,Interval bu bu] + + lambda=(promote 1 omega) - alphau*alphau + -- Avant multiplication par M_C^-1 + xx0=(promote 1 $ ix-(intervalize $ constant cx0))*alphau + +(promote 1 $ scale a yy'-scale b xx') + yy0=(promote 1 $ iy-(intervalize $ constant cy0))*alphau + +(promote 1 $ scale c yy'-scale d xx') :: Bernsteinp (Int,Int) Interval + + (Matrix2 ac_ bc_ cc_ dc_)=inverse $ intervalize mq + xx1=(scale ac_ xx0)+(scale bc_ yy0) + yy1=(scale cc_ xx0)+(scale dc_ yy0) + + eqc=xx1*xx1+yy1*yy1-alphau*alphau + + thrx=1e-5 + + solutions _ []=[] + solutions thr boxes@(_:_)= + let sol0=concatMap (solve thr (V.fromList [eqc,lambda])) boxes + + (correct,toRefine)=partition (\(u,v,_,_)-> + let (xu,yu)=evalCurve o (Interval u u) + (xv,yv)=evalCurve o (Interval v v) + in + (iup $ (xu-xv)^(2::Int)+(yu-yv)^(2::Int))<=thrx) sol0 + in + correct++(solutions (thr/2) toRefine) + + + -- Removing false positives by computing the distance to the center of + -- the circle (this is quite fast). + + removeFalse cl0 (h@(_,v,_,_):h'@(u',_,_,_):s)= + let u''=(v+u')/2 + (xu,yu)=evalCurve o (Interval u'' u'') + Interval dl du=distance xu yu cir + cl1 + | du<1 = Dedans + | dl>1 = Dehors + | otherwise = SurLaLigne + in + if cl0/=cl1 then h:(removeFalse cl1 (h':s)) else + removeFalse cl1 (h':s) + removeFalse _ l=l + + initCl= + let (x0,y0)=evalCurve o (Interval (t0 o) (t0 o)) + Interval dl du=distance x0 y0 cir + in + if dl>1 then Dehors else if du<1 then Dedans else SurLaLigne + in + foldl (\l (u,v,_,_)-> + let (Interval xl xu,Interval yl yu)=evalCurve o (Interval u v) in + case angle (Interval xl xu) (Interval yl yu) cir of + Just (Interval a0 a1)-> + (u,v,a0,a1):l + Nothing->l + ) [] $ removeFalse initCl $ sort $ solutions 1e-2 [(t0 o,t1 o,0::Double,1::Double)] + + +inter a@(Circle{cx0=x0a,cy0=y0a,matrix=ma}) + b@(Circle{cx0=x0b,cy0=y0b,matrix=mb})= + + if (intervalize ma)`intersects`(intervalize mb) && x0a==x0b && y0a==y0b then + let up ix@(Interval _ x_) tt0 tt1 + | x_tt1 = + down (ix-(2*interval pi)) tt0 tt1 + | x__ + case (up aa (t0 a) (t1 a), + up ab (t0 a) (t1 a)) of + + (Just ba,Just bb) + | ilow aa<=iup ab -> [(ilow ba, iup bb, + ilow aa, iup ab)] + | otherwise-> + case (up (interval $ t0 b) (t0 a) (t1 a), + up (interval $ t1 b) (t0 a) (t1 a)) of + (Just b0,Just b1)-> + [(ilow b0,iup bb, + t0 b, iup ab), + (ilow ba,iup b1, + ilow aa, t1 b)] + _->[] + _->[] + _->[] + + else + let thr=1e-5 + solutions=solve thr (V.fromList [eq0,eq1]) (fpred u0,fsucc v0, + fpred w0,fsucc x0) + in + foldl (\l (u,v,w,x)-> + let alpha=angle (Interval u v) (Interval w x) a + beta=angle (Interval u v) (Interval w x) b + in + case alpha of + Just (Interval a0l a0u)-> + case beta of + Just (Interval b0l b0u)->(a0l,a0u,b0l,b0u):l + _->l + _->l + ) [] solutions + where + + ima@(Matrix2 am bm cm dm)=intervalize ma + + maxa=max (iup $ abs am+abs bm) (iup $ abs cm+abs dm) + (u0,v0,w0,x0)=(x0a-maxa,x0a+maxa,y0a-maxa,y0a+maxa) + + -- x-x0 + xxa0=intervalize $ Bernsteinp (2,1) $ UV.fromList [-x0a,1-x0a] :: Bernsteinp (Int,Int) Interval + yya0=intervalize $ Bernsteinp (1,2) $ UV.fromList [-y0a,1-y0a] :: Bernsteinp (Int,Int) Interval + (Matrix2 aa_ ba_ ca_ da_)=inverse ima + xxa=(scale aa_ xxa0)+(scale ba_ yya0)::Bernsteinp (Int,Int) Interval + yya=(scale ca_ xxa0)+(scale da_ yya0) + + xxb0=intervalize $ Bernsteinp (2,1) $ UV.fromList [-x0b,1-x0b] + yyb0=intervalize $ Bernsteinp (1,2) $ UV.fromList [-y0b,1-y0b] + (Matrix2 ab_ bb_ cb_ db_)=inverse $ intervalize mb + xxb=(scale ab_ xxb0)+(scale bb_ yyb0) + yyb=(scale cb_ xxb0)+(scale db_ yyb0) + + c1=Bernsteinp (1,1) $ UV.singleton 1 + + eq0=xxa*xxa+yya*yya-c1 + eq1=xxb*xxb+yyb*yyb-c1 + +inter op@(Bezier{cx=bxa,cy=bya,t0=t0a,t1=t1a}) (Bezier{cx=xb,cy=yb,t0=t0b,t1=t1b})= + + let p0=(promote 1 $ intervalize bxa)-(promote 2 $ intervalize xb) :: Bernsteinp (Int,Int) Interval + p1=(promote 1 $ intervalize bya)-(promote 2 $ intervalize yb) :: Bernsteinp (Int,Int) Interval + thrx=1e-2 + solutions _ []=[] + solutions thr boxes@(_:_)= + let sol0=concatMap (solve thr (V.fromList [p0,p1])) boxes + + (correct,toRefine)=partition (\(u,v,_,_)-> + let (xu,yu)=evalCurve op (Interval u u) + (xv,yv)=evalCurve op (Interval v v) + in + (iup $ (xu-xv)^(2::Int)+(yu-yv)^(2::Int))<=thrx) sol0 + in + correct++(solutions (thr/2) toRefine) + in + solutions 1e-2 [(t0a,t1a,t0b,t1b)] + + +inter cir@(Circle{}) bez@(Bezier{})=map (\(u,v,w,x)->(w,x,u,v)) $ inter bez cir + +inter bez@(Bezier{}) cir@(Circle{})= + let xx=(intervalize $ cx bez)-(intervalize $ constant $ cx0 cir) + yy=(intervalize $ cy bez)-(intervalize $ constant $ cy0 cir) + (Matrix2 a b c d)=inverse $ intervalize $ matrix cir + xx0=scale a xx+scale b yy + yy0=scale c xx+scale d yy + + thrx=1e-5 + + solutions _ []=[] + solutions thr boxes@(_:_)= + let sol0=concatMap (solve thr (V.singleton (xx0*xx0+yy0*yy0-(constant 1)))) boxes + + (correct,toRefine)=partition (\(u,v)-> + let (xu,yu)=evalCurve bez (Interval u u) + (xv,yv)=evalCurve bez (Interval v v) + in + (iup $ (xu-xv)^(2::Int)+(yu-yv)^(2::Int))<=thrx) sol0 + in + correct++(solutions (thr/2) toRefine) + in + foldl (\l (u,v)-> + let (Interval xl xu,Interval yl yu)=evalCurve bez (Interval u v) in + case angle (Interval xl xu) (Interval yl yu) cir of + Just (Interval a0 a1)-> + (u,v,a0,a1):l + Nothing->l + ) [] $! + solutions (1e-2) [(t0 bez,t1 bez)] + +inter bez@(Bezier{}) off@(Offset{})=map (\(u,v,w,x)->(w,x,u,v)) $ inter off bez + + +inter off@(Offset{}) bez@(Bezier{})= + + let thr=1e-2 + thrx=1e-5 + solutions _ []=[] + solutions thr boxes@(_:_)= + let sol0=concatMap (solve thr (V.fromList [eq0,eq1,eq2])) boxes + + (correct,toRefine)=partition (\(u,v,_,_,_,_)-> + let (xu,yu)=evalCurve off (Interval u u) + (xv,yv)=evalCurve off (Interval v v) + in + (iup $ (xu-xv)^(2::Int)+(yu-yv)^(2::Int))<=thrx) sol0 + in + correct++(solutions (thr/2) toRefine) + in + map (\(a,b,c,d,_,_)->(a,b,c,d)) $ solutions 1e-2 $ + [(0,1,0,1,0,1)::(Double,Double,Double,Double,Double,Double)] + where + + bxp=intervalize $ cx off + byp=intervalize $ cy off + bxq=intervalize $ cx bez + byq=intervalize $ cy bez + + bxp'=derivate bxp + byp'=derivate byp + bxp3=promote 1 bxp + byp3=promote 1 byp + bxq3=promote 2 bxq + byq3=promote 2 byq + + mp@(Matrix2 ap bp cp dp)=intervalize $ matrix $ off + (Matrix2 ap_ bp_ cp_ dp_)=inverse mp + bXp'=promote 1 $ (scale ap_ bxp')+(scale bp_ byp') + bYp'=promote 1 $ (scale cp_ bxp')+(scale dp_ byp') + + omp@(Bernsteinp _ omegap)=(bXp'*bXp')+(bYp'*bYp') + au= + let au_=sqrt $ UV.minimum $ UV.map ilow omegap in + max 0 $ fpred au_ + bu= + let bu_=sqrt $ UV.maximum $ UV.map iup omegap in + fsucc bu_ + + alphau=Bernsteinp (1,1,2) $ UV.fromList [Interval au au,Interval bu bu] + eq0=bxp3*alphau + (scale ap bYp') - (scale bp bXp') - bxq3 + eq1=byp3*alphau + (scale cp bYp') - (scale dp bXp') - byq3 + eq2=alphau*alphau-omp + + + +angle::Interval->Interval->Curve->Maybe Interval +angle x y (Circle { cx0,cy0,matrix,t0,t1 })= + let vx=x-interval cx0 + vy=y-interval cy0 + + Matrix2 a b c d=inverse $ intervalize matrix + -- L'arithmetique d'intervalles fait un peu n'importe quoi + -- quand le vecteur est trop long. On le raccourcit. + alpha= + let co@(Interval col cou)=a*vx+b*vy + Interval sil siu=c*vx+d*vy + co2= + let (col2,cou2)=if col*col=0 then ac else + Interval (negate $ min (abs acl) (abs acu)) + (max (abs acl) (abs acu)) + up ix + | iup ixt1 = + down $ ix-(2*interval pi) + | iup ixInterval->Curve->Interval +distance x0 y0 (Bezier{..})= + distance x0 y0 (Offset{cx,cy,t0,t1,matrix=Matrix2 1 0 0 1}) + +distance x0 y0 (Offset{..})= + let (Matrix2 a b c d)=inverse $ intervalize matrix + vx_=intervalize cx-(constant x0) + vy_=intervalize cy-(constant y0) + vx=scale a vx_+scale b vy_ + vy=scale c vx_+scale d vy_ + + dist=vx*vx+vy*vy + in + foldl (\di (u,v)->let di'=eval dist (Interval u v) in + if iup diCurve->[Curve] +offset m (Bezier{cx=x@(Bernsteinp nx bx),cy=y@(Bernsteinp ny by)})= + if nx <=1 && ny <=1 then + [Circle { cx0=UV.head bx,cy0=UV.head by,t0=ilow 0,t1=iup $ 2*pi,matrix=m }] + else + [ c0,c1,c2,c3 ] + + where + im=intervalize m + (Matrix2 a_ b_ c_ d_)=inverse im + + ibx=intervalize x + iby=intervalize y + + lastCoef (Bernsteinp n c) + | n>=1 = UV.last c + | otherwise = 0 + firstCoef (Bernsteinp n c) + | n>=1 = UV.head c + | otherwise = 0 + + -- Premiere courbe offset + c0=Offset { cx=x, cy=y, t0=0,t1=1,matrix=m } + + -- Demi-cercle 1 + + ibx'=derivate ibx + iby'=derivate iby + + -- Calcul du vecteur tangent au bout du premier + + alpha0= + let xx0=lastCoef ibx' + yy0=lastCoef iby' + + xx0'=a_*xx0+b_*yy0 + yy0'=c_*xx0+d_*yy0 + norm0=sqrt $ xx0'*xx0'+yy0'*yy0' + + xx'=xx0'/norm0 + yy'=yy0'/norm0 + in + if ilow xx'>=0 then + -(acos yy') + else + if iup xx'<=0 then + acos yy' + else + let Interval u v=acos yy' in + Interval (negate $ max (abs u) (abs v)) + (max (abs u) (abs v)) + + + alpha0'=alpha0+interval pi + c1=Circle { cx0=lastCoef x, + cy0=lastCoef y, + t0=ilow alpha0, + t1=iup alpha0', + matrix=m } + + + -- Deuxieme courbe offset + c2=Offset { cx=reorient x, + cy=reorient y, + t0=0,t1=1, + matrix=m } + + -- Deuxieme demi-cercle + alpha1= + let xx0=firstCoef ibx' + yy0=firstCoef iby' + + xx0'=a_*xx0+b_*yy0 + yy0'=c_*xx0+d_*yy0 + norm0=sqrt $ xx0'*xx0'+yy0'*yy0' + + xx'=xx0'/norm0 + yy'=yy0'/norm0 + in + if ilow xx'>=0 then + -(acos yy') + else + if iup xx'<=0 then + acos yy' + else + let Interval u v=acos yy' in + Interval (negate $ max (abs u) (abs v)) + (max (abs u) (abs v)) + + alpha1'=alpha1-pi + c3=Circle { cx0=firstCoef x, + cy0=firstCoef y, + t0=ilow alpha1', + t1=iup alpha1, + matrix=m } + + +offset _ _=error "offset : undefined yet for other than Bezier" + + +rnd::Interval->Double +rnd (Interval a b)=(a+b)/2 + +derivRoots::Double->Curve->([(Double,Double)],[(Double,Double)]) +derivRoots thr (Bezier{..})= + (solve thr (V.singleton $ derivate $ intervalize cx) (t0,t1), + solve thr (V.singleton $ derivate $ intervalize cy) (t0,t1)) +derivRoots thr (Offset{..})= + let ix=intervalize cx + iy=intervalize cy + x'=derivate ix + y'=derivate iy + m@(Matrix2 a b c d)=intervalize matrix + (Matrix2 a_ b_ c_ d_)=inverse m + + xx'=(scale a_ x')+(scale b_ y') + yy'=(scale c_ x')+(scale d_ y') + xx''=derivate xx' + yy''=derivate yy' + + omega=xx'*xx'+yy'*yy' + au= + let au_=sqrt $ UV.minimum $ UV.map ilow $ coefs omega in + max 0 $ fpred au_ + bu= + let bu_=sqrt $ UV.maximum $ UV.map iup $ coefs omega in + fsucc bu_ + alphau=Bernsteinp (1,2) $ UV.fromList [Interval au au,Interval bu bu] + + eqx0=(promote 1 yy'')*(alphau^(2::Int))-(promote 1 $ yy'*yy''+xx'*xx'') + eqy0=(promote 1 $ yy'*yy''+xx'*xx'')-(promote 1 xx'')*(alphau^(2::Int)) + + eqx=(promote 1 x')*(alphau^(3::Int))+(scale a eqx0)+(scale b eqy0) + :: Bernsteinp (Int,Int) Interval + eqy=(promote 1 y')*(alphau^(3::Int))+(scale c eqx0)+(scale d eqy0) + + eq=(promote 1 omega)-alphau^(2::Int) :: Bernsteinp (Int,Int) Interval + in + (map (\(u,v,_,_)->(u,v)) $ solve thr (V.fromList [eqx,eq]) + ((t0,t1,0,1)::(Double,Double,Double,Double)), + map (\(u,v,_,_)->(u,v)) $ solve thr (V.fromList [eqy,eq]) + ((t0,t1,0,1)::(Double,Double,Double,Double))) +derivRoots _ (Circle{..})= + let (Matrix2 a b c d)=intervalize matrix + aa=sqrt $ a*a+b*b + cc=sqrt $ c*c+d*d + sx + | ilow a>=0 = acos $ b/aa + | otherwise = negate $ acos $ b/aa + sy + | ilow c>=0 = acos $ d/cc + | otherwise = negate $ acos $ d/cc + Interval ux vx=(-sx)-pi/2 + Interval uy vy=(-sy)-pi/2 + in + ([(ux,vx)],[(uy,vy)]) + +-- | The leftmost point on a curve +left::Curve->(Double,Double) +left cur= + let (x,y)= + foldl (\m@(xx,_) (s,t)-> + let m'@(xx',_)=evalCurve cur $ interval $ (s+t)/2 in + if ilow xx(Double,Double) +bottom cur= + let (x,y)= + foldl (\m@(_,yy) (s,t)-> + let m'@(_,yy')=evalCurve cur $ interval $ (s+t)/2 in + if ilow yy(Double,Double) +right cur= + let (x,y)= + foldl (\m@(xx,_) (s,t)-> + let m'@(xx',_)=evalCurve cur $ interval $ (s+t)/2 in + if iup xx>iup xx' then m else m') (-1/0,-1/0) $ + (t0 cur,t0 cur):(t1 cur,t1 cur):(fst $ derivRoots 1e-5 cur) + in + (rnd x,rnd y) +-- | The topmost point on a curve +top::Curve->(Double,Double) +top cur= + let (x,y)= + foldl (\m@(_,yy) (s,t)-> + let m'@(_,yy')=evalCurve cur $ interval $ (s+t)/2 in + if iup yy>iup yy' then m else m') (-1/0,-1/0) $ + (t0 cur,t0 cur):(t1 cur,t1 cur):(snd $ derivRoots 1e-5 cur) + in + (rnd x,rnd y) +\end{code} diff --git a/Graphics/Typography/Outlines.lhs b/Graphics/Typography/Outlines.lhs new file mode 100644 --- /dev/null +++ b/Graphics/Typography/Outlines.lhs @@ -0,0 +1,291 @@ +\begin{code} +{-# OPTIONS -XUnboxedTuples -cpp -XRecordWildCards -XNamedFieldPuns -XBangPatterns -XMagicHash -XScopedTypeVariables #-} +-- | This module contains the necessary calls to the other modules of Metafont' +-- to compute the outlines of a given number of pen strokes. The normal way of +-- using it is by calling 'outlines'. One other possible way would be : +-- +-- @ +-- let curves=cutAll curvesList in +-- remerge $ contour curves $ intersections curves +-- @ + +module Graphics.Typography.Outlines (cutAll, intersections, contour, remerge, outlines) where + +import Algebra.Polynomials.Bernstein +import Algebra.Polynomials.Numerical +import Graphics.Typography.Bezier +import Graphics.Typography +import Data.List (sort) +import qualified Data.Map as M +import qualified Data.Vector as V + +import Control.Parallel + +(!)::V.Vector a->Int->a +(!)=(V.!) + +-- | Cuts a curve into a list of consecutive non-selfintersecting curves. +cutNoSelf::Curve->[Curve] +cutNoSelf c@(Circle{})=[c] +cutNoSelf bez@(Bezier{..})= + let ix=intervalize cx + dx=derivate ix + solutions= + sort $ filter (\(s,t)->(ilow $ eval ix (Interval s s))* + (iup $ eval ix (Interval t t)) <= 0) $ + solve 1e-10 (V.singleton dx) (t0,t1) + roots lastU []= + if lastU>=t1 then + [] + else + [bez { t0=lastU }] + roots lastU (u:s) + | u<=lastU = roots lastU s -- on ne coupe pas au debut + | otherwise = + (bez { t0=lastU, t1=u }): + (roots u s) + in + roots t0 $ map (\(s,t)->(s+t)/2) solutions + +cutNoSelf off@(Offset{..})= -- offset + let thr=1e-2 + ix=intervalize cx + iy=intervalize cy + x'=derivate ix + y'=derivate iy + (Matrix2 a b c d)=intervalize matrix + (Matrix2 a_ b_ c_ d_)=inverse $ intervalize matrix + + xx'=(scale a_ x')+(scale b_ y') + yy'=(scale c_ x')+(scale d_ y') + + xx''=derivate xx' + yy''=derivate yy' + + evalC (t::Interval)= + let norm=sqrt $ (eval xx' t)*(eval xx' t)+(eval yy' t)*(eval yy' t) + derx=(eval yy'' t)/norm - + ((eval yy' t)*((eval xx' t)*(eval xx'' t)+ + (eval yy' t)*(eval yy'' t)))/(norm*norm*norm) + dery=(eval xx'' t)/norm - + ((eval xx' t)*((eval xx' t)*(eval xx'' t)+ + (eval yy' t)*(eval yy'' t)))/(norm*norm*norm) + in + ((eval x' t)+(a*derx-b*dery), (eval y' t)+(c*derx-d*dery)) + + zerosx= + let verif t lastxx + | t>=t1 = [] + | otherwise = + let (xx,_)=evalC (Interval t t) in + if (iup $ xx*lastxx)<=0 then + t:verif (t+thr) xx + else + verif (t+thr) xx + + + + in + verif t0 $ fst $ evalC (Interval t0 t0) + + roots lastU []= + if lastU>=t1 then + [] + else + [off { t0=lastU }] + roots lastU (u:s) + | u<=lastU = roots lastU s -- on ne coupe pas au debut + | otherwise = + (off { t0=lastU, t1=u }): + (roots u s) + in + roots t0 zerosx + +-- | @'cutAll' curves@ is the array of all the curves, cut such that +-- each part does not intersect itself. +cutAll::[[Curve]]->V.Vector (V.Vector Curve) +cutAll l=V.fromList $ map (\c->V.fromList $ concatMap cutNoSelf c) l + + +data Topology=Dedans | SurLaLigne | Dehors deriving (Eq, Ord, Show) + +minsert::Ord a=>a->b->M.Map a [b]->M.Map a [b] +minsert x y m=M.insertWith' (++) x [y] m + +munion::Ord a=>M.Map a [b]->M.Map a [b]->M.Map a [b] +munion=M.unionWith (++) + + +mdeleteFindMin::Ord a=>M.Map a [b]->(Maybe (a,b),M.Map a [b]) +mdeleteFindMin m= + if M.null m then + (Nothing, m) + else + let ((a,b),m')=M.deleteFindMin m in + case b of + []->mdeleteFindMin m' + (h:s)->(Just (a,h), if null s then m' else M.insert a s m') + + +-- | Computes the intersections between any pair of curves given +-- as input, in parallel in GHC using @+RTS -N@. +intersections::V.Vector (V.Vector Curve)-> + M.Map (Int,Int,Double) [(Int,Int,Double,Double)] +intersections curves= + let interAll ci cj + | ci>=V.length curves = M.empty + | cj>=V.length curves = interAll (ci+1) (ci+1) + | otherwise = + -- traceShow (ci,i,cj,j) $ + let next=interAll ci (cj+1) + inters + | ci==cj = + V.ifoldl' + (\s0 i curvei-> + V.ifoldl' + (\s1 j curvej-> + foldl (\s2 (ti,ti',tj,tj')-> + minsert (ci,i,ti) (cj,j+i+1,tj,tj') $ + minsert (cj,j+i+1,tj) (ci,i,ti,ti') $ s2) s1 $ + inter curvei curvej + ) + s0 $ V.drop (i+1) (curves!cj) + ) M.empty $ V.take (V.length (curves!ci)-1) (curves!ci) + | otherwise = + V.ifoldl' + (\s0 i curvei-> + V.ifoldl' + (\s1 j curvej-> + foldl (\s2 (ti,ti',tj,tj')-> + minsert (ci,i,ti) (cj,j,tj,tj') $ + minsert (ci,i,ti') (cj,j,tj,tj') $ + minsert (cj,j,tj) (ci,i,ti,ti') $ + minsert (cj,j,tj') (ci,i,ti,ti') $ s2) s1 $ + inter curvei curvej + ) + s0 (curves!cj) + ) M.empty $ V.take (V.length (curves!ci)-1) (curves!ci) + in + (next`par`inters)`seq` + (next`munion`inters) + in + interAll 0 0 + +-- | 'contour' takes the curves and the intersections computed as in 'intersections', +-- and outputs a list of all simple closed paths defined by the curves in the input. +contour::V.Vector (V.Vector Curve)-> + M.Map (Int,Int,Double) [(Int,Int,Double,Double)]-> + [[(Int,Int,Double,Double)]] +contour curves inters0= + + let allPaths inters1 passages1= + let (first,inters2)=mdeleteFindMin inters1 in + case first of + Nothing->[] + Just ((ci0,i0,ti0),(cj0,j0,tj0a,tj0b))-> + --traceShow ("new path",pi0,pj0) $ + let walk ci i tia tib inters passages= + --traceShow ("point",ci,i,tia,tib) $ traceShow (inters) $ + let (a,b)=M.split (ci,i,tib) inters + (next,b')=mdeleteFindMin b + in + case next of + Nothing-> -- traceShow ("echec 1") $ + ([],a,passages) + Just ((ci',i',ti'),(cj,j,tja,tjb)) + | ci==ci0 && i==i0 && (ci',i',ti')>=(ci,i,ti0)-> + -- fin du chemin + ([(ci,i,tia,ti0)],a`munion`b',passages) + + | ci==ci' && i==i' -> + let isVisible= + let tt=(tia+ti')/2 + (xi,yi)=evalCurve (curves!ci!i) (Interval tt tt) + in + V.foldl (\vis cur-> + vis && + iup (distance xi yi $ (cur!0) {t0=0,t1=1})>=1) + True curves + in + if (not isVisible) then + --traceShow ("invisible",pi') $ + ([],a`munion`b',passages) + else + let alreadyPassed= + let (_,p1)=M.split (ci,i,ti') passages in + (not $ M.null p1) && + (let ((ci_,i_,_),ti'_)=M.findMin p1 in + ci_==ci && i_==i && ti'_<=ti') + in + if alreadyPassed then + --traceShow ("already passed",pi') $ + ([],a`munion`b',passages) + else + --traceShow ("trying",pi') $ + let (nextPath,nextInters,nextPassages)= + walk cj j tja tjb (a`munion`b') $ + M.insert (ci,i,ti') tia passages + in + if null nextPath then + walk ci i tia tib (a`munion`b') passages + else + ((ci,i,tia,ti'):nextPath, + nextInters, + M.insert (ci,i,ti') tia nextPassages) + | otherwise -> --traceShow ("echec 2",ci',i',ti') $ + ([],inters,passages) + + (path,inters3,passages1')=walk cj0 j0 tj0a tj0b inters2 passages1 + in + if null path then + --traceShow ("abandon") $ + allPaths inters3 passages1' + else + --traceShow ("reussi") $ + path:(allPaths inters3 passages1') + in + allPaths inters0 M.empty + +-- | 'remerge' takes the curves, the output of 'contour', and outputs +-- the list of "remerged" curves, i.e. where the parts free of self-intersections +-- are glued back to each other. +remerge::V.Vector (V.Vector Curve)->[(Int,Int,Double,Double)]->[Curve] +remerge _ []=[] +remerge curves [(ci,i,ti0,ti1)]=[(curves!ci!i) { t0=ti0,t1=ti1 }] +remerge curves (l@((ci,i,ti0,_):s))= + + let (cj,j,_,tj1)=last s in + if ci==cj && j+1==i && tj1==ti0 then + -- dans ce cas, le dernier est colle au premier + let takeFirsts []=(# [],[] #) + takeFirsts ((h@(ci',_,_,_)):ss) + | ci'==ci = + let (# u,v #)=takeFirsts ss in + (# h:u, v #) + | otherwise = (# [],h:ss #) + (# uu,vv #)=takeFirsts l + in + remerge_ $ vv++uu + else + remerge_ l + + where + remerge_ []=[] + remerge_ [(cj,j,tj0,tj1)]=[(curves!cj!j) { t0=tj0,t1=tj1 }] + remerge_ ((cj,j,tj0,tj1):(cck@(ck,k,tk0,_)):ss) + | cj==ck && k==j+1 && tj1==tk0 = + let (h':s')=remerge_ $ cck:ss in + (h' { t0=tj0 }) : s' + + | otherwise = + ((curves!cj!j) { t0=tj0,t1=tj1 }) : (remerge_ $ cck:ss) + + +-- | Takes a list of curves, potentially offset, and outputs the relevants part +-- of the outlines. +outlines::[[Curve]]->[[Curve]] +outlines curves= + let curves'=cutAll curves in + map (remerge curves') $ contour curves' $ intersections curves' + +\end{code} diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main=defaultMain diff --git a/typography-geometry.cabal b/typography-geometry.cabal new file mode 100644 --- /dev/null +++ b/typography-geometry.cabal @@ -0,0 +1,18 @@ +Name: typography-geometry +Version: 1.0 +Synopsis: Drawings for printed text documents +Description: Drawings for printed text documents +Category: Typography +Maintainer: Pierre-Etienne Meunier +License: GPL +License-file: LICENSE +Build-Type: Simple +Cabal-Version: >=1.6 +source-repository this + type: darcs + location: http://www.lama.univ-savoie.fr/~meunier/darcs/typography-geometry + tag: 1.0 +Library + Build-Depends: base<5, vector,polynomials-bernstein,containers,parallel + Exposed-modules: Graphics.Typography, Graphics.Typography.Bezier, + Graphics.Typography.Approximation, Graphics.Typography.Outlines