Posted to tcl by schmitzu at Mon Apr 17 14:02:39 GMT 2023view raw

  1.  
  2. # get direction of line segment given
  3. # by start-/endpoint as unit vector [xu:yu]
  4. proc pp2uv {x1 y1 x2 y2} {
  5. set dx [expr {$x2 - $x1}]
  6. set dy [expr {$y2 - $y1}]
  7. set ab [expr {sqrt ($dx * $dx + $dy * $dy)}]
  8.  
  9. set xu [expr {$dx / $ab}]
  10. set yu [expr {$dy / $ab}]
  11.  
  12. return [list $xu $yu]
  13. }
  14.  
  15. # get perpedicular line on linesegment ls at
  16. # position t with lenth l
  17. # ls line segment {x1 y1 x2 y2}
  18. # t positon on ls [0..1]
  19. # l length of result segment
  20. # returns:
  21. # {px1 py1 px2 py2} start-/endpoint perpendicular linesegment
  22. proc getPpline {ls t l} {
  23. lassign $ls x1 y1 x2 y2
  24. # calculate point at t
  25. set it [expr {1-$t}]
  26. set xp [expr {$x1 * $t + $x2 * $it}]
  27. set yp [expr {$y1 * $t + $y2 * $it}]
  28. # get unit vector of ls
  29. lassign [pp2uv $x1 $y1 $x2 $y2] xu yu
  30.  
  31. set l2 [expr {$l / 2.}]
  32.  
  33. # generate start point of perpedicular line
  34. set px1 [expr {$xp - $yu * $l2}]
  35. set py1 [expr {$yp + $xu * $l2}]
  36.  
  37. # generate end point of perpedicular line
  38. set px2 [expr {$xp + $yu * $l2}]
  39. set py2 [expr {$yp - $xu * $l2}]
  40.  
  41. return [list $px1 $py1 $px2 $py2]
  42. }
  43.  
  44. set linesegment {1. 1. 9. 9.}
  45. set ppl [getPpline $linesegment 0.5 2.0]
  46.  
  47. puts $ppl
  48.