lib/maracasVisuLib/src/interface/tcl/general.tcl

   1 proc swig_cast { pointer newType } {
   2
   3     set pt [ split $pointer "_"]
   4     return "_[ lindex $pt 1 ]_$newType"
   5
   6 }
   7
   8 proc DistPoints { x1 y1 z1 x2 y2 z2 } {
   9
  10   set carre [ expr ( ( $x2 - $x1 ) * ( $x2 - $x1 ) ) + ( ( $y2 - $y1 ) * ( $y2 - $y1 ) ) + ( ( $z2 - $z1 ) * ( $z2 - $z1 ) ) ]
  11   set carre [ expr sqrt( $carre ) ]
  12   return $carre
  13
  14 }
  15
  16 proc VoxelCoord { xPto yPto zPto xOrig yOrig zOrig dimXVoxel dimYVoxel dimZVoxel } {
  17
  18   set d [ expr $xPto - $xOrig ]
  19   set d [ expr $d + 0.0 ]
  20   set floatLoc [ expr $d / $dimXVoxel ]
  21   set xVoxel [ expr round( $floatLoc ) ]
  22
  23   set d [ expr $yPto - $yOrig ]
  24   set d [ expr $d + 0.0 ]
  25   set floatLoc [ expr $d / $dimYVoxel ]
  26   set yVoxel [ expr round( $floatLoc ) ]
  27
  28   set d [ expr $zPto - $zOrig ]
  29   set d [ expr $d + 0.0 ]
  30   set floatLoc [ expr $d / $dimZVoxel ]
  31   set zVoxel [ expr round( $floatLoc ) ]
  32   return "$xVoxel $yVoxel $zVoxel"
  33
  34 }
  35
  36 proc PointCoord { xVoxel yVoxel zVoxel xOrig yOrig zOrig dimXVoxel dimYVoxel dimZVoxel } {
  37
  38
  39   set floatLoc [ expr $xVoxel * $dimXVoxel ]
  40   set xPto [ expr $floatLoc + $xOrig ]
  41
  42   set floatLoc [ expr $yVoxel * $dimYVoxel ]
  43   set yPto [ expr $floatLoc + $yOrig ]
  44
  45   set floatLoc [ expr $zVoxel * $dimZVoxel ]
  46   set zPto [ expr $floatLoc + $zOrig ]
  47
  48   return "$xPto $yPto $zPto"
  49 }
  50
  51 proc DrawSphere { name radius xc yc zc r g b } {
  52
  53     vtkSphereSource $name
  54         $name SetRadius $radius
  55         $name SetCenter $xc $yc $zc
  56     vtkPolyDataMapper mapper_sphere_$name
  57         mapper_sphere_$name SetInput [ $name GetOutput ]
  58         mapper_sphere_$name ImmediateModeRenderingOn
  59     vtkActor actor_sphere_$name
  60         actor_sphere_$name SetMapper mapper_sphere_$name
  61         [ actor_sphere_$name GetProperty ] SetColor  $r $g $b
  62
  63     return "actor_sphere_$name"
  64
  65 }
  66
  67 proc GetSphereActorName { name } {
  68
  69     return "actor_sphere_$name"
  70
  71 }
  72
  73 proc DeleteSphere { name } {
  74
  75     catch { actor_sphere_$name  Delete }
  76     catch { mapper_sphere_$name Delete }
  77     catch { $name               Delete }
  78
  79 }
  80
  81 proc pick_point_local_actor { x y renderer actor { tol 0.025 } } {
  82
  83 #    catch { pick_point_local_cell_picker Delete }
  84 #
  85 #    vtkWorldPointPicker pick_point_local_cell_picker
  86 #        pick_point_local_cell_picker Pick $x $y 0 $renderer
  87 #        set pickWPPos [ pick_point_local_cell_picker GetPickPosition ]
  88 #
  89 #    catch { pick_point_local_cell_picker Delete }
  90 #    return $pickWPPos
  91 #
  92     catch { pick_point_local_cell_picker Delete }
  93
  94     set actors [ $renderer GetActors ]
  95     vtkCellPicker pick_point_local_cell_picker
  96         pick_point_local_cell_picker SetTolerance $tol
  97         pick_point_local_cell_picker Pick $x $y 0 $renderer
  98         set positions [ pick_point_local_cell_picker GetPickedPositions ]
  99
 100     set ret {}
 101     for { set i 0 } { $i < [ $actors GetNumberOfItems ] } { incr i } {
 102
 103         set act [ $actors GetItemAsObject $i ]
 104         if { [ string compare $act $actor ] == 0 } {
 105
 106             set ret [ $positions GetPoint $i ]
 107             break
 108
 109         }
 110
 111     }
 112     catch { pick_point_local_cell_picker Delete }
 113     return $ret
 114
 115 }
 116
 117 proc change_float_precision { number decimals } {
 118
 119     set l [ split $number . ]
 120     set ret $number
 121     if { [ llength $l ] == 2 } {
 122
 123         set ret "[ lindex $l 0 ]."
 124         for { set i 0 } { $i < $decimals } { incr i } {
 125
 126             set ret "$ret[ string index [ lindex $l 1 ] $i ]"
 127
 128         }
 129
 130     }
 131     return $ret
 132
 133 }
 134
 135 # EOF - general.tcl