summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2014-03-17 22:55:23 +0000
committerKarl Berry <karl@freefriends.org>2014-03-17 22:55:23 +0000
commitfbbfbf6dd1459939387d20e98c9b5ab8c8b8fc4c (patch)
tree0fd8dc74eb25e586f7d5c57d92e0d3ed87eeb4b2 /Master/texmf-dist/dvips
parente5648acf4c3dffe742901c883a29b53f65690f65 (diff)
pst-intersect (17mar14)
git-svn-id: svn://tug.org/texlive/trunk@33210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/dvips')
-rw-r--r--Master/texmf-dist/dvips/pst-intersect/pst-intersect.pro358
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,