0026106: BRepMesh - revision of data model
[occt.git] / src / DrawResources / Vector.tcl
1 # Copyright (c) 2016 OPEN CASCADE SAS
2 #
3 # This file is part of Open CASCADE Technology software library.
4 #
5 # This library is free software; you can redistribute it and/or modify it under
6 # the terms of the GNU Lesser General Public License version 2.1 as published
7 # by the Free Software Foundation, with special exception defined in the file
8 # OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
9 # distribution for complete text of the license and disclaimer of any warranty.
10 #
11 # Alternatively, this file may be used under the terms of Open CASCADE
12 # commercial license or contractual agreement.
13 #
14 # Created by: M.Sazonov
15 #
16 # Working with vectors and various measurements
17 #
18 # [2d] point is represented by (two/three) coords
19 # [2d] vector is represented by (two/three) coords
20 # plane is represented by an origin point and a normal vector
21 # [2d] line is represented by an origin point and a vector
22
23 help vec {vec x1 y1 z1 x2 y2 z2
24   returns coordinates of vector between two points\
25 } {Vector and measurement Commands}
26
27 proc vec {x1 y1 z1 x2 y2 z2} {
28     uplevel list [dval ($x2)-($x1)] [dval ($y2)-($y1)] [dval ($z2)-($z1)]
29 }
30
31 help 2dvec {2dvec x1 y1 x2 y2
32   returns coordinates of 2D vector between two 2D points\
33 } {Vector and measurement Commands}
34
35 proc 2dvec {x1 y1 x2 y2} {
36     uplevel list [dval ($x2)-($x1)] [dval ($y2)-($y1)]
37 }
38
39 help pln {pln x1 y1 z1 x2 y2 z2 x3 y3 z3
40   returns plane built on three points\
41 } {Vector and measurement Commands}
42
43 proc pln {x1 y1 z1 x2 y2 z2 x3 y3 z3} {
44     set v12 [uplevel eval norm [vec $x1 $y1 $z1 $x2 $y2 $z2]]
45     set v13 [uplevel eval norm [vec $x1 $y1 $z1 $x3 $y3 $z3]]
46     set vn [eval cross $v12 $v13]
47     set N [eval module $vn]
48     if [expr $N < 1e-7] {
49         puts "points are on a line"
50         return
51     }
52     concat $x1 $y1 $z1 [eval norm $vn]
53 }
54
55 help module {module x y z
56   returns module of a vector\
57 } {Vector and measurement Commands}
58
59 proc module {x y z} {
60     uplevel dval sqrt(($x)*($x)+($y)*($y)+($z)*($z))
61 }
62
63 help 2dmodule {2dmodule x y
64   returns module of a 2D vector\
65 } {Vector and measurement Commands}
66
67 proc 2dmodule {x y} {
68     uplevel dval sqrt(($x)*($x)+($y)*($y))
69 }
70
71 help norm {norm x y z
72   returns unified vector from a given vector\
73 } {Vector and measurement Commands}
74
75 proc norm {x y z} {
76     set N [uplevel dval sqrt(($x)*($x)+($y)*($y)+($z)*($z))]
77     list [uplevel dval ($x)/$N] [uplevel dval ($y)/$N] [uplevel dval ($z)/$N]
78 }
79
80 help 2dnorm {2dnorm x y
81   returns unified vector from a given 2D vector\
82 } {Vector and measurement Commands}
83
84 proc 2dnorm {x y} {
85     set N [uplevel dval sqrt(($x)*($x)+($y)*($y))]
86     list [uplevel dval ($x)/$N] [uplevel dval ($y)/$N]
87 }
88
89 help inverse {inverse x y z
90   returns inversed vector\
91 } {Vector and measurement Commands}
92
93 proc inverse {x y z} {
94     list [uplevel dval -$x] [uplevel dval -$y] [uplevel dval -$z]
95 }
96
97 help 2dinverse {2dinverse x y
98   returns inversed 2D vector\
99 } {Vector and measurement Commands}
100
101 proc 2dinverse {x y} {
102     list [uplevel dval -$x] [uplevel dval -$y]
103 }
104
105 help 2dort {2dort x y
106   returns 2D vector rotated on 90 degrees\
107 } {Vector and measurement Commands}
108
109 proc 2dort {x y} {
110     list [uplevel dval -$y] [uplevel dval $x]
111 }
112
113 help distpp {distpp x1 y1 z1 x2 y2 z2
114   returns distance between two points\
115 } {Vector and measurement Commands}
116
117 proc distpp {x1 y1 z1 x2 y2 z2} {
118     eval module [uplevel vec $x1 $y1 $z1 $x2 $y2 $z2]
119 }
120
121 help 2ddistpp {2ddistpp x1 y1 x2 y2
122   returns distance between two 2D points\
123 } {Vector and measurement Commands}
124
125 proc 2ddistpp {x1 y1 x2 y2} {
126     eval 2dmodule [uplevel 1 2dvec $x1 $y1 $x2 $y2]
127 }
128
129 help distplp {distplp xo yo zo dx dy dz xp yp zp
130   returns distance between plane and point\
131 } {Vector and measurement Commands}
132
133 proc distplp {xo yo zo dx dy dz xp yp zp} {
134     set vop [uplevel vec $xo $yo $zo $xp $yp $zp]
135     set vn [uplevel norm $dx $dy $dz]
136     eval dot $vop $vn
137 }
138
139 help distlp {distlp xo yo zo dx dy dz xp yp zp
140   returns distance between line and point\
141 } {Vector and measurement Commands}
142
143 proc distlp {xo yo zo dx dy dz xp yp zp} {
144     set vop [uplevel vec $xo $yo $zo $xp $yp $zp]
145     set vl [uplevel norm $dx $dy $dz]
146     eval module [eval cross $vl $vop]
147 }
148
149 help 2ddistlp {2ddistlp xo yo dx dy xp yp
150   returns distance between 2D line and point\
151 } {Vector and measurement Commands}
152
153 proc 2ddistlp {xo yo dx dy xp yp} {
154     set vop [uplevel 1 2dvec $xo $yo $xp $yp]
155     set vl [uplevel 1 2dnorm $dx $dy]
156     eval 2dcross $vl $vop
157 }
158
159 help distppp {distppp x1 y1 z1 x2 y2 z2 x3 y3 z3
160   returns deviation of point p2 from segment p1-p3\
161 } {Vector and measurement Commands}
162
163 proc distppp {x1 y1 z1 x2 y2 z2 x3 y3 z3} {
164     set vop [uplevel vec $x1 $y1 $z1 $x2 $y2 $z2]
165     set vl [uplevel eval norm [vec $x1 $y1 $z1 $x3 $y3 $z3]]
166     eval module [eval cross $vl $vop]
167 }
168
169 help 2ddistppp {2ddistppp x1 y1 x2 y2 x3 y3
170   returns deviation of 2D point p2 from segment p1-p3 (sign shows the side)\
171 } {Vector and measurement Commands}
172
173 proc 2ddistppp {x1 y1 x2 y2 x3 y3} {
174     set vop [uplevel 1 2dvec $x1 $y1 $x2 $y2]
175     set vl [uplevel eval 2dnorm [2dvec $x1 $y1 $x3 $y3]]
176     eval 2dcross $vl $vop
177 }
178
179 help barycen {barycen x1 y1 z1 x2 y2 z2 par
180   returns point of a given parameter between two points\
181 } {Vector and measurement Commands}
182
183 proc barycen {x1 y1 z1 x2 y2 z2 par} {
184     uplevel list [dval ($x1)*(1-($par))+($x2)*($par)]\
185         [dval ($y1)*(1-($par))+($y2)*($par)]\
186         [dval ($z1)*(1-($par))+($z2)*($par)]
187 }
188
189 help 2dbarycen {2dbarycen x1 y1 x2 y2 par
190   returns 2D point of a given parameter between two points\
191 } {Vector and measurement Commands}
192
193 proc 2dbarycen {x1 y1 x2 y2 par} {
194     uplevel list [dval ($x1)*(1-($par))+($x2)*($par)]\
195         [dval ($y1)*(1-($par))+($y2)*($par)]
196 }
197
198 help cross {cross x1 y1 z1 x2 y2 z2
199   returns cross product of two vectors\
200 } {Vector and measurement Commands}
201
202 proc cross {x1 y1 z1 x2 y2 z2} {
203     set x [uplevel dval ($y1)*($z2)-($z1)*($y2)]
204     set y [uplevel dval ($z1)*($x2)-($x1)*($z2)]
205     set z [uplevel dval ($x1)*($y2)-($y1)*($x2)]
206     list $x $y $z
207 }
208
209 help 2dcross {2dcross x1 y1 x2 y2
210   returns cross product of two 2D vectors\
211 } {Vector and measurement Commands}
212
213 proc 2dcross {x1 y1 x2 y2} {
214     uplevel dval ($x1)*($y2)-($y1)*($x2)
215 }
216
217 help dot {dot x1 y1 z1 x2 y2 z2
218   returns scalar product of two vectors\
219 } {Vector and measurement Commands}
220
221 proc dot {x1 y1 z1 x2 y2 z2} {
222     uplevel dval ($x1)*($x2)+($y1)*($y2)+($z1)*($z2)
223 }
224
225 help 2ddot {2ddot x1 y1 x2 y2
226   returns scalar product of two 2D vectors\
227 } {Vector and measurement Commands}
228
229 proc 2ddot {x1 y1 x2 y2} {
230     uplevel dval ($x1)*($x2)+($y1)*($y2)
231 }
232
233 help vecangle {vecangle x1 y1 z1 x2 y2 z2
234   returns angle between two vectors\
235 } {Vector and measurement Commands}
236
237 proc vecangle {x1 y1 z1 x2 y2 z2} {
238   set d  [uplevel dot $x1 $y1 $z1 $x2 $y2 $z2]
239   set c  [uplevel cross $x1 $y1 $z1 $x2 $y2 $z2]
240   set cm [uplevel module $c]
241   
242   set m1 [uplevel module $x1 $y1 $z1]
243   set m2 [uplevel module $x2 $y2 $z2]
244   set mm [expr $m1*$m2]
245   
246   if { $cm < $d } {
247     expr asin($cm/$mm)
248   } else {
249     expr acos($d/$mm)
250   }
251 }
252
253 help 2dvecangle {2dvecangle x1 y1 x2 y2
254   returns angle between two vectors\
255 } {Vector and measurement Commands}
256
257 proc 2dvecangle {x1 y1 x2 y2} {
258   set d  [uplevel 1 2ddot $x1 $y1 $x2 $y2]
259   set c  [uplevel 1 2dcross $x1 $y1 $x2 $y2]
260   
261   set m1 [uplevel 1 2dmodule $x1 $y1]
262   set m2 [uplevel 1 2dmodule $x2 $y2]
263   set mm [expr $m1*$m2]
264   
265   if { $c < $d } {
266     expr asin($c/$mm)
267   } else {
268     expr acos($d/$mm)
269   }
270 }
271
272 help scale {scale x y z factor
273   returns vector multiplied by scalar\
274 } {Vector and measurement Commands}
275
276 proc scale {x y z factor} {
277     list [dval $x*$factor] [dval $y^$factor] [dval $z*$factor]
278 }
279
280 help 2dscale {2dscale x y factor
281   returns 2D vector multiplied by scalar\
282 } {Vector and measurement Commands}
283
284 proc 2dscale {x y factor} {
285     list [dval $x*$factor] [dval $y^$factor]
286 }
287
288 help pntc {pntc curve u
289   returns coordinates of point on curve with given parameter\
290 } {Vector and measurement Commands}
291
292 proc pntc {curv u} {
293     upvar \#0 $curv c
294     cvalue c $u x y z
295     return "[dval x] [dval y] [dval z]"
296 }
297
298 help 2dpntc {2dpntc curv2d u
299   returns coordinates of 2D point on 2D curve with given parameter\
300 } {Vector and measurement Commands}
301
302 proc 2dpntc {curv2d u} {
303     upvar \#0 $curv2d c
304     2dcvalue c $u x y
305     return "[dval x] [dval y]"
306 }
307
308 help pntsu {pntsu surf u v
309   returns coordinates of point on surface with given parameters\
310 } {Vector and measurement Commands}
311
312 proc pntsu {surf u v} {
313     upvar \#0 $surf s
314     svalue s $u $v x y z
315     return "[dval x] [dval y] [dval z]"
316 }
317
318 help pntcons {pntcons curv2d surf u
319   returns coordinates of point on surface defined by 
320   point on 2D curve with given parameter\
321 } {Vector and measurement Commands}
322
323 proc pntcons {curv2d surf u} {
324     upvar \#0 $curv2d c $surf s
325     2dcvalue c $u u0 v0
326     svalue s u0 v0 x y z
327     return "[dval x] [dval y] [dval z]"
328 }
329
330 help pnt {pnt point_or_vertex
331   returns coordinates of point in the given Draw variable of type point or vertex\
332 } {Vector and measurement Commands}
333
334 proc pnt var {
335     upvar \#0 $var v
336     set type [dtyp v]
337     set pp v
338     if {[lindex $type 1] == "VERTEX"} {
339         mkpoint p v
340         set pp p
341         set type "point"
342     }
343     if {$type == "point"} {
344         if [catch {coord $pp x y z}] {
345             if ![catch {coord $pp x y}] {
346                 return "[dval x] [dval y]"
347             }
348         } else {
349             return "[dval x] [dval y] [dval z]"
350         }
351     }
352 }
353
354 help drseg {drseg name x1 y1 z1 x2 y2 z2
355   creates a trimmed line between two points\
356 } {Vector and measurement Commands}
357
358 proc drseg {name x1 y1 z1 x2 y2 z2} {
359     set x [uplevel dval $x1]
360     set y [uplevel dval $y1]
361     set z [uplevel dval $z1]
362     set dx [uplevel dval ($x2)-($x1)]
363     set dy [uplevel dval ($y2)-($y1)]
364     set dz [uplevel dval ($z2)-($z1)]
365     set len [module $dx $dy $dz]
366     uplevel line $name $x $y $z $dx $dy $dz
367     uplevel trim $name $name 0 $len
368 }
369
370 help 2ddrseg {2ddrseg name x1 y1 x2 y2
371   creates a trimmed 2D line between two 2D points\
372 } {Vector and measurement Commands}
373
374 proc 2ddrseg {name x1 y1 x2 y2} {
375     set x [uplevel dval $x1]
376     set y [uplevel dval $y1]
377     set dx [uplevel dval ($x2)-($x1)]
378     set dy [uplevel dval ($y2)-($y1)]
379     set len [2dmodule $dx $dy]
380     uplevel line $name $x $y $dx $dy
381     uplevel trim $name $name 0 $len
382 }
383
384 help mpick {show coordinates at mouse click\
385 } {Vector and measurement Commands}
386
387 proc mpick {} {
388     puts "Pick position"
389     pick id x1 y1 z1 b
390     concat [dval x1] [dval y1] [dval z1]
391 }
392
393 help mdist {compute distance between two points of mouse clicks\
394 } {Vector and measurement Commands}
395
396 proc mdist {} {
397     puts "Pick first position"
398     pick id x1 y1 z1 b
399     puts "Pick second position"
400     pick id x2 y2 z2 b
401     dval sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)+(z1-z2)*(z1-z2))
402 }