diff options
Diffstat (limited to 'Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro')
-rw-r--r-- | Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro | 358 |
1 files changed, 273 insertions, 85 deletions
diff --git a/Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro b/Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro index d6a7521a745..900934684b6 100644 --- a/Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro +++ b/Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro @@ -9,7 +9,7 @@ %% This is a generated file. %% %% Project: pst-intersect -%% Version: 0.3 (2014/03/04) +%% Version: 0.4 (2014/03/16) %% %% Copyright (C) 2007-2014 by Christoph Bersch <usenet@bersch.net> %% @@ -40,7 +40,7 @@ tx@IntersectDict begin /VecScale { dup 4 -1 roll mul 3 1 roll mul } bind def -/ToVec { +/ToPnt { [ 3 1 roll ] } bind def /MaxPrecision 1e-6 def @@ -50,7 +50,7 @@ tx@IntersectDict begin /H2Interval [0.5 MaxPrecision add 1] def /IntersectBeziers { 2 copy length 2 eq exch length 2 eq and { - IntersectLines + IntersectLineSegms }{ 2 copy [0 1] [0 1] IterateIntersection } ifelse @@ -63,24 +63,87 @@ tx@IntersectDict begin 8 -2 roll 2 copy 10 4 roll 4 2 roll 2 copy 6 2 roll 10 2 roll VecSub 6 2 roll 4 2 roll VecSub - 8 4 roll 4 2 roll VecSub % X3-X4 Y3-Y4 X2-X1 Y2-Y1 X3-X1 Y3-Y1 % b1 b2 a1 a2 c1 c2 + 8 4 roll 4 2 roll VecSub 6 copy 12 -4 roll neg 4 -1 roll mul 3 1 roll mul add dup 0 eq { - % no intersections 9 { pop } repeat [] [] } { dup 10 1 roll 5 1 roll 4 -1 roll mul 3 1 roll mul sub exch div 6 1 roll 4 -1 roll mul 3 1 roll mul sub exch div - 2 copy 2 copy 0 ge exch 0 ge and 3 1 roll 1 le exch 1 le and and { - [ exch ] exch [ exch ] - } { - pop pop [] [] - } ifelse - } ifelse + [ exch ] exch [ exch ] + } ifelse + DebugEnd +} bind def +/IntersectLineSegms { + IntersectLines + dup length 0 eq not { + 0 get exch 0 get + 2 copy 2 copy 0 ge exch 0 ge and 3 1 roll 1 le exch 1 le and and { + [ exch ] exch [ exch ] + } { + pop pop [] [] + } ifelse + } if +} bind def +/IntersectLineLineSegm { + tx@IntersectDict begin IntersectLines end + dup length 0 eq not { + 0 get dup dup 0 ge exch 1 le and { + [ exch ] + } { + pop pop [] [] + } ifelse + } if + 3 -1 roll exch +} bind def +/IntersectLinePath { + (IntersectLinePath) DebugBegin + 3 dict begin + PreparePath + 2 copy ElongateLine exch 3 -1 roll pop + /isect [] def + /t -1 def + /n -1 def + { + /n n 1 add def + 2 copy IntersectBeziers + dup 5 1 roll LoadIntersectionPoints + dup length 0 gt { + /isect exch def + 0 get aload pop add 0.5 mul n add /t exch def + exch pop + exit + } { + pop pop pop + } ifelse + } forall + t isect + end DebugEnd } bind def +/ElongateLine { + exch { aload pop } forall + 4 2 roll 2 copy 6 2 roll + VecSub 0 5 1 roll + 6 -1 roll { + { + aload pop + 6 2 roll 4 copy 10 4 roll + 6 2 roll VecSub 4 2 roll + tx@EcldDict begin Project end + tx@Dict begin Pyth end + 6 -1 roll 2 copy + gt { pop } { exch pop } ifelse + 5 1 roll + } forall + } forall + % for a line + 5 -1 roll VecScale 4 copy VecSub ToPnt 5 1 roll VecAdd ToPnt ToPnt + % for a ray + %4 2 roll 2 copy ToPnt 6 1 roll 4 2 roll 5 -1 roll 1.1 mul VecScale VecAdd ToPnt ToPnt +} bind def /IntersectPaths { (IntersectPaths) DebugBegin 6 dict begin @@ -106,7 +169,6 @@ tx@IntersectDict begin } forall pop % remove [pathA] [ isect { aload pop } forall ] 3 1 roll tA exch tB - % [intersections] [pathA] [tA] [pathB] [tB] end DebugEnd } bind def @@ -116,39 +178,72 @@ tx@IntersectDict begin 2 copy PreparePath dup length /n exch def /isect [] def /tA [] def /tB [] def - { % [curveA] [Bi] + { /n n 1 sub def - exch dup 3 -1 roll % [curveA] [curveA] [Bi] + exch dup 3 -1 roll IntersectBeziers - 4 copy LoadIntersectionPoints % [curveA] [tA] [curveB] [tB] + 4 copy LoadIntersectionPoints [ exch isect aload pop ] /isect exch def pop 3 -1 roll pop [ tB aload length 2 add -1 roll TArray { n add } forall ] /tB exch def [ tA aload length 2 add -1 roll TArray aload pop ] /tA exch def } forall - pop % remove [curveA] + pop [ isect { aload pop } forall ] 3 1 roll tA exch tB - % [intersections] [curveA] [tA] [pathB] [tB] end DebugEnd } bind def /IntersectPathCurve { exch IntersectCurvePath 4 2 roll } bind def +/MergeAndSortArrays { + [ 3 1 roll aload pop counttomark -1 roll aload pop ] + dup length 0 gt { + dup dup 0 get type /arraytype eq { + hulldict /comp get + } { + /lt + } ifelse + exch quicksort + } if +} bind def /SaveIntersection { (SaveIntersection) DebugBegin - 4 dict dup 10 -1 roll exch def - begin % - /Points 6 -1 roll def - 5 -1 roll dup 4 -1 roll def % /curveA [curveA] [tA] [tB] /curveB /curveB [curveB] def - nametostr (@t) strcat cvn exch TArray def % /curveA [curveA] [tA] /curveB@t [tB] def - 3 -1 roll dup 4 -1 roll def - nametostr (@t) strcat cvn exch TArray def - end + exch dup 3 1 roll % isectname add? isectname + currentdict exch known and { + load begin % pnts A tA B tB /A /B + dup currentdict exch known { % /nameB already saved. + 4 -1 roll pop % pnts A tA tB /A /B + nametostr (@t) strcat cvn dup load 4 -1 roll + MergeAndSortArrays def + } { + dup 5 -1 roll def % pnts A tA B tB /A /B + nametostr (@t) strcat cvn 3 -1 roll TArray def + } ifelse % pnts A tA /A + dup currentdict exch known { % /nameB already saved. + 3 -1 roll pop + nametostr (@t) strcat cvn dup load 3 -1 roll + MergeAndSortArrays def + } { + dup 4 -1 roll def + nametostr (@t) strcat cvn exch TArray def + } ifelse + /Points exch ArrayToPointArray Points ArrayToPointArray + MergeAndSortArrays PointArrayToArray def + end + } { + 4 dict dup 3 1 roll def + begin + dup 5 -1 roll def + nametostr (@t) strcat cvn 3 -1 roll TArray def + dup 4 -1 roll def + nametostr (@t) strcat cvn exch TArray def + /Points exch def + end + } ifelse DebugEnd } bind def /TArray { - (TArray) DebugBegin dup length 0 gt { dup 0 get type /arraytype eq { [ exch @@ -158,37 +253,64 @@ tx@IntersectDict begin } if dup /lt exch quicksort } if - DebugEnd %1 debug } bind def /InitTracing { /movetype /moveto load def /linetype /lineto load def /curvetype /curveto load def } bind def -InitTracing /GetFullPath { + (GetFullPath) DebugBegin { /movetype counttomark 3 roll } { /linetype counttomark 3 roll } { /curvetype counttomark 7 roll }{} pathforall + DebugEnd +} bind def +/ReversePath { + gsave newpath + [ exch aload pop InitTracing + { counttomark 0 eq { exit } if + load exec + } loop + reversepath + GetFullPath ] + grestore +} bind def +/ReverseCurve { + PointArrayToArray aload pop % [ tstart tstop [ X0 Y0 X1 Y1... + counttomark -2 4 { 2 roll } for ] ArrayToPointArray +} bind def +/ReverseInterval { + 3 -1 roll dup 4 1 roll GetSegmentCount + dup 4 1 roll exch sub 3 1 roll sub exch +} bind def +/UnifyInterval { + exch dup 0 lt { pop 0 } if exch + 3 -1 roll dup 4 1 roll GetSegmentCount + 2 copy exch dup 3 1 roll % [curve] tstart tstop cnt tstop cnt tstop + lt exch 0 lt or { exch } if pop % (tstop < 0 | cnt < tstop) } bind def /PreparePath { + (PreparePath) DebugBegin [ exch aload pop { dup type /nametype eq not { exit } if dup /movetype eq { - pop ToVec /@mycp exch def + pop ToPnt /@mycp exch def } { dup /linetype eq { - pop [ @mycp 4 2 roll 2 copy ToVec /@mycp exch def ToVec ] + pop [ @mycp 4 2 roll 2 copy ToPnt /@mycp exch def ToPnt ] } { - pop [ @mycp 8 2 roll 2 copy ToVec /@mycp exch def - ToVec 5 1 roll ToVec 4 1 roll ToVec 3 1 roll ] + pop [ @mycp 8 2 roll 2 copy ToPnt /@mycp exch def + ToPnt 5 1 roll ToPnt 4 1 roll ToPnt 3 1 roll ] } ifelse counttomark 1 roll } ifelse } loop ] + DebugEnd } bind def /GetSegmentCount { + (GetSegmentCount) DebugBegin dup IsPath { [ exch aload pop 0 { @@ -207,8 +329,9 @@ InitTracing exch pop } { % a Bezier curve is a single segment - pop 1 + length 0 gt { 1 } { 0 } ifelse } ifelse + DebugEnd } bind def /LoadLineIntersectionPoints { (LoadLineIntersectionPoints) DebugBegin @@ -226,7 +349,6 @@ InitTracing [ exch { aload pop } forall ] exch [ exch { aload pop } forall ] } repeat - % [A0.x A0.y ... AM.x AM.y] [tA0a tA0b ... tAMa tAMb] [tB0a tB0b ... tBNa tBNb] [B0.x B0.y ... BN.x BN.y] tx@Dict begin tx@FuncDict begin 2 dict begin dup length 2 idiv 1 sub /BezierType exch def /Points exch def [ exch { GetBezierCoor } forall ] @@ -234,15 +356,12 @@ InitTracing dup length 2 idiv 1 sub /BezierType exch def /Points exch def [ exch { GetBezierCoor } forall ] end - %2 debug - % [IB0.xa IB0.ya IB0.xb IB0.yb ... IBM.yb] [IA0.xa IA0.ya IA0.xb IA0.yb ... IAM.yb] 2 { [ exch aload length 4 idiv { [ 5 1 roll ] counttomark 1 roll } repeat ] exch } repeat - % [[IB0.xa ...] ... [... IBM.yb]] [[IA0.xa IA0.ya IA0.xb IA0.yb] ...[IAM.xa ... IAM.yb]] 2 { dup hulldict /comp get exch quicksort exch } repeat @@ -253,16 +372,7 @@ InitTracing 2 copy aload pop VecSub Pyth exch aload pop VecSub Pyth lt { exch } if pop aload pop VecAdd 0.5 VecScale - } for - % merge near intersection points - %counttomark 2 idiv 1 1 3 -1 roll { - % pop - % counttomark 4 lt { exit } if - % 4 copy 4 2 roll ToVec 3 1 roll ToVec AreNear { - - % } - %} for - ] + } for ] end end end DebugEnd @@ -328,14 +438,13 @@ domsB domsA /depth depth 1 add def /dom null def /counter counter 1 add def - CheckIT { (>> curve subdivision performed: dom(A) = ) domA CurveToString strcat (, dom(B) = ) strcat domB CurveToString strcat ( <<) strcat == } if CurveA IsConstant CurveB IsConstant and { -CurveA MiddlePoint ToVec -CurveB MiddlePoint ToVec AreNear { +CurveA MiddlePoint ToPnt +CurveB MiddlePoint ToPnt AreNear { domA domB 4 -1 roll exch PutInterval PutInterval } { pop pop @@ -350,8 +459,8 @@ domB Extent precision ge or and not { iter 100 ge { false } { -CurveA MiddlePoint ToVec -CurveB MiddlePoint ToVec AreNear { +CurveA MiddlePoint ToPnt +CurveB MiddlePoint ToPnt AreNear { domA domB true }{ false @@ -364,7 +473,6 @@ CheckIT { (, iter: ) iter 20 string cvs strcat strcat (, depth: ) depth 20 string cvs strcat strcat == } if - CurveA CurveB ClipCurve /dom exch def CheckIT {(dom : ) dom CurveToString strcat == } if @@ -388,8 +496,8 @@ CurveB IsConstant CurveA IsConstant and { (C1: [ ) CurveA { CurveToString ( ) strcat strcat } forall (]) strcat == (C2: [ ) CurveB { CurveToString ( ) strcat strcat } forall (]) strcat == } if - CurveA MiddlePoint ToVec - CurveB MiddlePoint ToVec AreNear { + CurveA MiddlePoint ToPnt + CurveB MiddlePoint ToPnt AreNear { domA domB true } { false @@ -472,7 +580,7 @@ CheckIT { ToUnitRange exch ToUnitRange 2 copy gt { exch } if - ToVec + ToPnt } bind def /ToUnitRange { dup 0 lt { @@ -489,7 +597,7 @@ CloneVec } forall ] } bind def /CloneVec { - aload pop ToVec + aload pop ToPnt } bind def /MapTo { (MapTo) DebugBegin @@ -556,7 +664,7 @@ exch sub 0 1 3 -1 roll % L-1 t [CurveB] 0 1 L-i-1 3 -1 roll dup 1 exch sub 3 1 roll % [A] (1-t) [B] t exch aload pop 3 -1 roll VecScale % [A] (1-t) B.x*t B.y*t 4 2 roll - exch aload pop 3 -1 roll VecScale VecAdd ToVec % [A.x*(1-t)+B.x*t A.y*(1-t)+B.y*t] + exch aload pop 3 -1 roll VecScale VecAdd ToPnt % [A.x*(1-t)+B.x*t A.y*(1-t)+B.y*t] DebugEnd } bind def /IsConstant { @@ -750,80 +858,85 @@ pop dup length 1 sub get type /nametype eq { true } { false } ifelse } bind def /ShowPathPortion { - 6 dict begin + (ShowPathPortion) DebugBegin + 8 dict begin /tstop exch def /tstart exch def + /savecp { ToPnt cvx /@cp exch def } def InitTracing /n 0 def mark exch aload pop { - counttomark 0 eq n tstop ge or { pop exit } if + counttomark 0 eq n tstop ge or { cleartomark exit } if dup /movetype eq not { /n n 1 add def } if - dup /movetype eq { - load exec + pop savecp } { - tstart n gt { + tstart n ge { /curvetype eq { 6 2 roll 4 { pop } repeat } if - movetype + savecp } { tstart n 1 sub gt tstop n lt or { tstart n sub 1 add tstop n sub 1 add ToUnitInterval exch /linetype eq { - 3 1 roll ToVec currentpoint ToVec exch ToVec + 3 1 roll ToPnt + tstart n 1 sub gt { @cp ToPnt } { currentpoint ToPnt } ifelse exch ToPnt dup 3 -1 roll Portion aload pop exch tstart n 1 sub gt { exch aload pop 3 -1 roll aload pop ArrowA tstop n le { - currentpoint 4 2 roll ArrowB lineto pop pop + currentpoint 4 2 roll ArrowB linetype pop pop } { - lineto + linetype } ifelse } { - pop aload pop currentpoint 4 2 roll ArrowB lineto pop pop + pop aload pop currentpoint 4 2 roll ArrowB linetype pop pop } ifelse } { - 7 1 roll [ currentpoint 9 3 roll ] ArrayToPointArray - dup 3 -1 roll Portion + 7 1 roll + [ tstart n 1 sub gt { @cp }{ currentpoint } ifelse + 9 3 roll ] ArrayToPointArray + dup 3 -1 roll + Portion { aload pop } forall - 8 -2 roll - tstart n 1 sub gt { moveto } { pop pop } ifelse - 6 -2 roll currentpoint ArrowA 6 2 roll - tstop n le { - ArrowB - } if - curveto + tstart n 1 sub gt { + 8 -4 roll 4 2 roll ArrowA 6 2 roll + } { + 8 -2 roll pop pop + } ifelse + tstop n le { ArrowB } if + curvetype } ifelse }{ tstart n 1 sub eq { /linetype eq { - currentpoint ArrowA + @cp ArrowA tstop n eq { - currentpoint 4 2 roll ArrowB lineto pop pop + currentpoint 4 2 roll ArrowB linetype pop pop } { - lineto + linetype } ifelse } { - 6 -2 roll currentpoint ArrowA 6 2 roll + 6 -2 roll @cp ArrowA 6 2 roll tstop n eq { ArrowB } if - curveto + curvetype } ifelse } { /linetype eq { tstop n eq { - currentpoint 4 2 roll ArrowB lineto pop pop + currentpoint 4 2 roll ArrowB linetype pop pop }{ - lineto + linetype } ifelse } { tstop n eq { ArrowB } if - curveto + curvetype } ifelse } ifelse } ifelse @@ -831,6 +944,81 @@ pop } ifelse } loop end + DebugEnd +} bind def +/GetCurvePoint { + dup IsPath { + 5 dict begin + exch dup /tstart exch def + 1 add cvi /tstop exch def + /savecp { ToPnt cvx /@cp exch def } def + /n 0 def + mark exch aload pop + { + counttomark 0 eq n tstop ge or { cleartomark exit } if + dup /movetype eq not { /n n 1 add def } if + dup /movetype eq { + pop savecp + } { + tstart n ge { + /curvetype eq { 6 2 roll 4 { pop } repeat } if + savecp + } { + tstart n 1 sub gt { + tstart n sub 1 add tstop n sub 1 add + ToUnitInterval exch + /linetype eq { + 3 1 roll ToPnt + tstart n 1 sub gt { @cp ToPnt } { currentpoint ToPnt } ifelse exch ToPnt + dup 3 -1 roll Portion + } { + 7 1 roll + [ @cp 9 3 roll ] ArrayToPointArray + dup 3 -1 roll + Portion + } ifelse + 0 get aload pop + }{ + /curvetype eq { + pop pop pop pop + } if + } ifelse + counttomark 1 add 2 roll cleartomark exit + } ifelse + } ifelse + } loop + end + } { + exch dup 0 eq { + pop 0 get aload pop + } { + 0 exch ToUnitInterval exch dup 3 -1 roll Portion + dup length 1 sub get aload pop + } ifelse + } ifelse +} bind def +/TraceCurveOrPath { + 4 1 roll + UnifyInterval + 3 -1 roll dup IsPath { + 4 -1 roll pop + 3 1 roll 2 copy gt { + ReverseInterval + 3 -1 roll ReversePath 3 1 roll + } if + ShowPathPortion + }{ % tstart tstop [curve] + mark exch 4 2 roll % [ [curve] tstart tstop + 2 copy gt { % tstart > tstop + exch + [ 4 -1 roll ReverseCurve 3 1 roll % [ [curve'] tstart tstop + } if + ToUnitInterval exch dup 3 -1 roll Portion + { aload pop } forall + counttomark -2 4 { 2 roll } for + counttomark 2 sub 2 idiv + counttomark 2 add -1 roll exec + } ifelse } bind def % Graham Scal algorithm to compute the convex hull of a set of % points. Code written by Bill Casselman, |