GlassCube

For construction of image, a “glass cube” is helpful for snapping points. An additional tool displays one.

namespace eval GlassCube {
  namespace import ::tcl::mathfunc::* ::tcl::mathop::*
  
  proc p3D {x y z} {
    dict create\
      x [+ 125.0 $x]\
      y [+ 125.0 $y]\
      z [+ 125.0 $z]
  }
  
  variable center [p3D 0 0 0]
  
  variable baseCube [list\
      [p3D -50 -50 -50]\
      [p3D  50 -50 -50]\
      [p3D  50  50 -50]\
      [p3D -50  50 -50]\
      [p3D -50 -50  50]\
      [p3D  50 -50  50]\
      [p3D  50  50  50]\
      [p3D -50  50  50]]
  
  proc dotOptions 3Dpoint {
    list -x [dict get $3Dpoint x]  -y [dict get $3Dpoint y]
  }
  
  variable dots [lmap pt $baseCube {obj new dot {*}[dotOptions $pt]}]
  
  proc line {a b} {
    variable dots
    obj new line [lindex $dots $a] [lindex $dots $b]
  }
  
  variable group [obj new group -constraint {
      gravity
      noprint
      linecolor
      linewidth
    } [line 4 5] [line 5 6] [line 6 7] [line 7 4]\
      [line 0 4] [line 1 5] [line 2 6] [line 3 7]\
      [line 0 1] [line 1 2] [line 2 3] [line 3 0]]

  variable phi 0
  variable chi 0 
}

proc GlassCube::rotate {x y phi cX cY} {
  # coords x, y rotated by phi around cX, cY
  set c [cos $phi]
  set s [sin $phi]
  list\
    [expr {($x - $cX) * $c - ($y - $cY) * $s + $cX}]\
    [expr {($y - $cY) * $c + ($x - $cX) * $s + $cY}]
}

proc GlassCube::rotateYaxis {3Dpoint phi} {
  variable center
  set cX [dict get $center x]
  set cY [dict get $center z]
  set x [dict get $3Dpoint x]
  set y [dict get $3Dpoint z]
  lassign [rotate $x $y $phi $cX $cY] x y
  dict set 3Dpoint x $x
  dict set 3Dpoint z $y
}

proc GlassCube::rotateXaxis {3Dpoint phi} {
  variable center
  set cX [dict get $center z]
  set cY [dict get $center y]
  set x [dict get $3Dpoint z]
  set y [dict get $3Dpoint y]
  lassign [rotate $x $y $phi $cX $cY] x y
  dict set 3Dpoint z $x
  dict set 3Dpoint y $y
}

proc GlassCube::rotateCube {cube phi chi} {
  set cube [lmap pt $cube {rotateYaxis $pt $phi}]
  set cube [lmap pt $cube {rotateXaxis $pt $chi}]
}

proc GlassCube::glassCube {} {
  variable phi
  variable chi
  variable group
  variable baseCube
  variable dots
  foreach dot $dots p3d [rotateCube $baseCube [degree $phi] [degree $chi]] {
    $dot configure {*}[dotOptions $p3d]
  }
  $group draw
}

proc GlassCube::pi args [subst -novariable {expr "[acos -1] $args"}]

proc GlassCube::slider {canvas {onoff on}} {
  destroy $canvas.horizontal $canvas.vertical
  if {$onoff} then {
    variable group
    foreach element [$group elements] {
      if {[incr i] < 5} then {
        $element configure -outline grey72
      } elseif {$i < 9} then {
        $element configure -outline grey60 
      } else {
        $element configure -outline grey30
      }
    }
    set horizontal [scale $canvas.horizontal -orient horizontal\
        -from -90 -to 90 -resolution -1 -showvalue no\
        -variable [namespace current]::phi\
        -command [list apply [list num {
            glassCube
          } [namespace current]]]]
    set vertical [scale $canvas.vertical -orient vertical\
        -from 90 -to -90 -resolution -1 -showvalue no\
        -variable [namespace current]::chi\
        -command [list apply [list num {
            glassCube
          } [namespace current]]]]
    place $horizontal -anchor sw -relwidth 1.0 -relx 0.0 -rely 1.0\
      -width -[winfo reqwidth $vertical]
    place $vertical -anchor ne -relheight 1.0 -relx 1.0 -rely 0.0\
      -height -[winfo reqheight $horizontal]
    bind $horizontal <<ControlClick>> "$horizontal set 0; break"
    bind $vertical <<ControlClick>> "$vertical set 0; break"
    set group
  }
}

© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z