Posted to tcl by auriocus at Thu Jun 19 20:43:04 GMT 2014view raw

  1. package require Tk
  2. package require vectcl
  3. namespace import vectcl::*
  4.  
  5. # this demonstration shows how to use VecTcl
  6. # to perform an orthogonal 3D transform on a set of points
  7. # and display it on a canvas.
  8.  
  9.  
  10.  
  11. # create random lines
  12. set data {}
  13. for {set i 0} {$i<1000} {incr i} {
  14. set r1 [expr {rand()-0.5}]
  15. set r2 [expr {rand()-0.5}]
  16. set r3 [expr {rand()-0.5}]
  17. lappend data [list $r1 $r2 $r3]
  18. }
  19.  
  20. vproc eulerx {phi} {
  21. list( \
  22. list(1.0, 0.0, 0.0), \
  23. list(0.0, cos(phi), sin(phi)), \
  24. list(0.0, -sin(phi), cos(phi)))
  25. }
  26.  
  27. vproc eulery {phi} {
  28. list( \
  29. list(cos(phi), 0.0, sin(phi)), \
  30. list(0.0, 1.0, 0.0), \
  31. list(-sin(phi), 0.0, cos(phi)))
  32. }
  33.  
  34. vproc eulerz {phi} {
  35. list( \
  36. list(cos(phi), sin(phi), 0.0), \
  37. list(-sin(phi), cos(phi), 0.0), \
  38. list(0.0, 0.0, 1.0))
  39. }
  40.  
  41. vproc euler {phi chi psi} {
  42. # this function returns the
  43. # subsequent rotation around the axis x,y,z
  44. # with angles phi, chi, psi
  45. # it is slow, but only called once for every frame
  46. eulerz(psi)*eulery(chi)*eulerx(phi)
  47. }
  48.  
  49. # create a canvas
  50. canvas .c -width 500 -height 500
  51. # four sliders
  52. ttk::scale .s -variable s -from 1.0 -to 250.0 -command updatePlot
  53. ttk::scale .phi -variable phi -from 0.0 -to 6.28 -command updatePlot
  54. ttk::scale .chi -variable chi -from 0.0 -to 6.28 -command updatePlot
  55. ttk::scale .psi -variable psi -from 0.0 -to 6.28 -command updatePlot
  56.  
  57. set s 100.0
  58. set phi 0.5
  59. set chi 0.12
  60. set psi 0.0
  61.  
  62. grid .s -sticky nsew
  63. grid .phi -sticky nsew
  64. grid .chi -sticky nsew
  65. grid .psi -sticky nsew
  66. grid .c -sticky nsew
  67.  
  68. grid rowconfigure . 0 -weight 1
  69. grid columnconfigure . 0 -weight 1
  70.  
  71.  
  72. proc updatePlot {args} {
  73. set width [winfo width .c]
  74. set height [winfo height .c]
  75.  
  76. lassign [do3DTransform $::data $width $height] x y
  77.  
  78. .c delete all
  79. # create lines in the canvas - shimmers to list
  80. foreach {x1 x2} $x {y1 y2} $y {
  81. .c create line [list $x1 $y1 $x2 $y2]
  82. }
  83. }
  84.  
  85. vproc do3DTransform {data width height} {
  86. T = euler(::phi, ::chi, ::psi)
  87. Tx = ::s*(T*::data')'
  88. x = Tx[:, 0]+width/2
  89. y = -Tx[:, 1]+height/2
  90. list(x,y)
  91. }
  92.  
  93. update; # let the geometry propagate
  94. updatePlot
  95.