Posted to tcl by florentis at Wed Oct 21 05:42:40 GMT 2026view raw

  1. # illustration of TIP 764, using prototype V15
  2.  
  3. type def point {
  4. {double}x;
  5. {double}y;
  6. }
  7.  
  8. set {point}A 100 250
  9. set {point}B -100 -200
  10.  
  11. type def segment list(2).point
  12.  
  13. set {segment}AB $A $B
  14.  
  15. type def rect list(4).point
  16.  
  17. proc segment2rect {S} {(
  18. [type get $S] ne "segment" ? [return]:;
  19.  
  20. A is point = $S(0) ; x_a = $A(x) ; y_a = $A(y);
  21. C is point = $S(1) ; x_c = $C(x) ; y_c = $C(y) ;
  22.  
  23. # Milieu
  24. M is point = (
  25. x_m = ($x_a + $x_c)/2.0,
  26. y_m = ($y_a + $y_c)/2.0
  27. );
  28.  
  29. MC is segment = ($M, $C);
  30. B is point = (
  31. x_b = $x_m - ($y_c - $y_m),
  32. y_b = $y_m + ($x_c - $x_m)
  33. );
  34. D is point = (
  35. x_d = 2*$x_m - $x_b,
  36. y_d = 2*$y_m - $y_b
  37. );
  38.  
  39. return [($A,$B,$C,$D)]
  40. )}
  41.  
  42. segment2rect $AB ; # {100 250} {225.0 -75.0} {-100 -200} {-225.0 125.0}
  43.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week