blob: 0641b4a2383dee1dbea9072354b39d2b950429d2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
%!
% PostScript prologue for pst-eucl.tex.
% Version 1.01 2012/09/21
% For distribution, see pstricks.tex.
%
/tx@EcldDict 40 dict def tx@EcldDict begin
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Pi
/Pi 3.14159265359 def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% e
/E 2.718281828459045 def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x -> true (if |x| < 1E-6)
/ZeroEq { abs 1E-6 lt } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x1 y1 x2 y2 -> a b c (ax-by+c=0 with a^2+b^2=1)
/EqDr {
4 copy 3 -1 roll sub 7 1 roll exch sub 5 1 roll 4 -1 roll
mul 3 1 roll mul exch sub
2 index dup mul 2 index dup mul add sqrt
4 -1 roll 1 index div exch
4 -1 roll 1 index div exch
4 -1 roll 1 index div exch pop
} bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% orthogonal projection of M1 onto (OM2)
%% x1 y1 x2 y2 -> x3 y3
/Project {
2 copy dup mul exch dup mul add 5 1 roll 2 copy 5 -1 roll mul exch
5 -1 roll mul add 4 -1 roll div dup 4 -1 roll mul exch 3 -1 roll mul
} bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% a b c (ax2+bx+c=0) -> x1 y1
/SolvTrin {
/c exch def /b exch def /a exch def
b dup mul a c mul 4 mul sub dup 0 lt
{ pop 0 0 } %% no solutions
{sqrt dup b neg add a 2 mul div exch b add neg 2 a mul div }
ifelse } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x1 y1 x2 y2 -> Dist
/ABDist { 3 -1 roll sub dup mul 3 1 roll sub dup mul add sqrt } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x1 y1 x2 y2 -> x2-x1 y2-y1
/ABVect { 3 -1 roll exch sub 3 1 roll sub exch } bind def
%/ABVect { 3 -1 roll sub 3 1 roll exch sub exch } bind def %% wrong version
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x1 y1 x2 y2 x3 y3 x4 y4 -> x y
/InterLines {
EqDr /D1c exch def /D1b exch def /D1a exch def
EqDr /D2c exch def /D2b exch def /D2a exch def
D1a D2b mul D1b D2a mul sub dup ZeroEq
% { pop pop pop 0 0 } %% parallel lines % --- hv 20110714
{ pop 0 0 } %% parallel lines --- hv 20110714
{
/Det exch def
D1b D2c mul D1c D2b mul sub Det div
D1a D2c mul D2a D1c mul sub Det div
} ifelse } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% a b c R -> x1 y1 x2 y2
/InterLineCircle {
/CR exch def /Dc exch def neg /Db exch def /Da exch def
ABVect /Vy exch def /Vx exch def
%% Dc==0 then O belong to the line
%% First project O on the line -> M (-ca;-cb)
%% l'abscisse de M sur (OM) divisée par R donne le cosinus
%Dc neg dup Db mul exch Da mul 2 copy 0 0
%ABDist dup CR gt { pop pop pop 0 0 0 0 }
%{ ZeroEq { pop pop Db Da } if Atan /alpha exch def
Dc abs CR gt { 0 0 0 0 }
{ Db neg Da neg Atan /alpha exch def
Dc CR div dup dup mul 1 exch sub sqrt exch Atan /beta exch def
alpha beta add dup cos CR mul exch sin CR mul
alpha beta sub dup cos CR mul exch sin CR mul
4 copy ABVect Vy mul 0 le exch Vx mul 0 le and
{ 4 2 roll } if } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% R R' OO' -> x1 y1 x2 y2
/InterCircles {
/OOP exch def /CRP exch def /CR exch def
OOP dup mul CRP dup mul sub CR dup mul add OOP div 2 div
dup dup mul CR dup mul exch sub dup
0 lt { pop pop 0 0 0 0 } { sqrt 2 copy neg } ifelse
} bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x y theta -> x' y' (rotation of theta)
/Rotate {
dup sin /sintheta exch def cos /costheta exch def /y exch def /x exch def
x costheta mul y sintheta mul sub
y costheta mul x sintheta mul add
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% N -> x y
/GetNode {
tx@NodeDict begin
tx@NodeDict 1 index known { load GetCenter } { pop 0 0 } ifelse
end
} bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x -> ch(x)
/ch { dup Ex exch neg Ex add 2 div } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x -> sh(x)
/sh { dup Ex exch neg Ex sub 2 div } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x -> e^(x)
/Ex { E exch exp } bind def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% x f g -> x y n
/NewtonSolving {
/g exch def /f exch def 0
{ %%% STACK: x0 n
1 add exch %% one more loop
dup ZeroEq
{ dup 0.0005 add fgeval
1 index 0.0005 sub fgeval sub .001 div }
{ dup 1.0005 mul fgeval
1 index 0.9995 mul fgeval sub .001 2 index mul div } ifelse %%% STACK: n x0 fg'(x0)
%%% compute x1=x0-fg(x0)/fg'(x0)
1 index fgeval exch div dup 4 1 roll sub exch %% stack: dx x0 n
3 -1 roll ZeroEq %% exit if root found
1 index 100 eq or { exit } if %% or looping for more than 100 times
} loop
dup 100 lt { exch dup /x exch def f } { pop 0 0 } ifelse
3 -1 roll
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/fgeval { /x exch def f g sub } bind def
end
% END ps-euclide.pro
|
