This is a butcher job on the Moving an anthropomorphous robot arm.
I needed a simpler example for my students--this is a first attempt.
proc deg2rad { angle_degrees } {expr {($angle_degrees)*0.0174532925199}} proc rad2deg { angle_radians } {expr {($angle_radians)*57.2957795131}} proc math_sin_cos { angle nickname } { uplevel [list set cos_$nickname [expr {cos(($angle))}]] uplevel [list set sin_$nickname [expr {sin(($angle))}]] } proc matrix_rotation_z { angle } { math_sin_cos $angle t list $cos_t $sin_t 0 0 [expr -$sin_t] $cos_t 0 0 0 0 1 0 0 0 0 1 } proc matrix_rotation_x { angle } { math_sin_cos $angle t list 1 0 0 0 0 $cos_t $sin_t 0 0 [expr -$sin_t] $cos_t 0 0 0 0 1 } proc matrix_rotation_y { angle } { math_sin_cos $angle t list $cos_t 0 $sin_t 0 0 1 0 0 [expr -$sin_t] 0 $cos_t 0 0 0 0 1 } proc matrix_translation {x y z} { #list 1 0 0 $x 0 1 0 $y 0 0 1 $z 0 0 0 1 list 1 0 0 0 0 1 0 0 0 0 1 0 $x $y $z 1 } proc matrix_identity {} { list 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 } proc matrix_multiply { matA matB } { # use tcl trick to assign these variables foreach {b11 b12 b13 b14 b21 b22 b23 b24 b31 b32 b33 b34 b41 b42 b43 b44} $matB {} set result {} foreach {x y z w} $matA { lappend result \ [expr {$x*$b11+$y*$b21+$z*$b31+$w*$b41}] \ [expr {$x*$b12+$y*$b22+$z*$b32+$w*$b42}] \ [expr {$x*$b13+$y*$b23+$z*$b33+$w*$b43}] \ [expr {$x*$b14+$y*$b24+$z*$b34+$w*$b44}] } return $result } proc apply_current_matrix { coords } { set ::currentmatrix [matrix_multiply $::worldmatrix $::viewmatrix] # use tcl trick to assign these variables foreach {a11 a12 a13 a14 a21 a22 a23 a24 a31 a32 a33 a34 a41 a42 a43 a44} $::currentmatrix {} set result {} foreach {x y z ONE} $coords { lappend result \ [expr {$x*$a11+$y*$a21+$z*$a31+ $a41}] \ [expr {$x*$a12+$y*$a22+$z*$a32+ $a42}] \ [expr {$x*$a13+$y*$a23+$z*$a33+ $a43}] \ 1 } set coords $result set result {} foreach { x y z o } $coords { if { $::perspective == 0 } { lappend result [expr $x + $::screencenter_x] \ [expr $::screencenter_y - $y] } else { set z [expr $z + 1500] if { $z == 0 } { set z 1 } lappend result [expr $x/$z*1200 + $::screencenter_x] \ [expr $::screencenter_y - $y/$z*1200] } } return $result } ## ------------------------------------------------------------ ## Basic graphical elements. ## ------------------------------------------------------------ proc draw_3D_line { xyzcoords {obj_tag {}} {tags {}} } { set coords [apply_current_matrix $xyzcoords] if { ![info exists ::id($obj_tag)] } { set ::id($obj_tag) [$::maincanvas create line $coords -tags \ [lappend tags $obj_tag] ] } else { $::maincanvas coords $::id($obj_tag) $coords } } proc draw_prism { prism_tag xsize ysize zsize \ xoffset yoffset zoffset {tags Robot} } { foreach {face coords} { A {-1 -1 -1 1 1 -1 -1 1 1 1 -1 1 -1 1 -1 1 -1 -1 -1 1} B {-1 -1 1 1 1 -1 1 1 1 1 1 1 -1 1 1 1 -1 -1 1 1} C {-1 -1 -1 1 -1 -1 1 1 -1 1 1 1 -1 1 -1 1 -1 -1 -1 1} D { 1 -1 -1 1 1 -1 1 1 1 1 1 1 1 1 -1 1 1 -1 -1 1} } { set results {} foreach {x y z one} $coords { lappend results \ [expr $x * $xsize + $xoffset] \ [expr $y * $ysize + $yoffset] \ [expr $z * $zsize + $zoffset] \ 1 } set coords $results draw_3D_line $coords ${prism_tag}_$face $tags } } proc draw_plane { obj_tag indices {tags {}} } { set delta 30.0 set num 11 set max [expr {$delta*($num-1)}] set coords { 0 0 0 1 0 0 0 1} set counter 0 foreach { a b c } $indices { set vector $coords set plane_tag ${obj_tag}_[incr counter] for {set x 0.0} {$x <= $max} {set x [expr {$x+$delta}]} { lset vector $a $x lset vector $b $x lset vector $c $max draw_3D_line $vector ${plane_tag}_$x [concat [list $obj_tag] $tags] } } } ## ------------------------------------------------------------ ## TK options. ## ------------------------------------------------------------ option add *command_buttons.exit.text "Exit" ## ------------------------------------------------------------ ## Widget procedures. ## ------------------------------------------------------------ proc create_scale { linkname master varname {from 0} {to 90} {default 0}} { set ::mem($varname.from) $from set ::mem($varname.to) $to set ::mem($varname.default) $default set $varname $default set f [labelframe $master.$varname -class [string totitle $varname]] set column_index 0 label [set label_widget $f.lab_$varname] -text $linkname scale [set scale_widget $f.$varname] \ -from $::mem($varname.from) -to $::mem($varname.to) $scale_widget set $::mem($varname.default) $scale_widget configure -command \ [list update_parameter_from_scale_widget $varname] grid $label_widget -column $column_index -row 0 -sticky news grid $scale_widget -column $column_index -row 1 -sticky news incr column_index return $f } proc update_parameter_from_scale_widget { param_name param_value } { set $param_name $param_value after 0 update_and_draw } ## ------------------------------------------------------------ ## Main procedures. ## ------------------------------------------------------------ proc main_exit {} {exit} proc main_program {} { widget_setup_defaults # configure_toplevel wm geometry . +20+20 wm title . "Simple 3D Robot Arm" grid columnconfigure . 0 -weight 1 grid rowconfigure . 0 -weight 1 set ::maincanvas [canvas .drawing -width 600 -height 600 -bg #f8f8f8] frame .controlsFrame grid $::maincanvas .controlsFrame -sticky news set camerabox [build_camera_controls .controlsFrame] set robotbox [build_robot_controls .controlsFrame] grid $camerabox -sticky news grid $robotbox -sticky news set ::bp [button .controlsFrame.pers -command toggle_perspective] $::bp config -text "Perspective is On" grid $::bp grid [button .controlsFrame.exit -command main_exit -text "Exit"] update_and_draw configure_drawing ;# do this once } proc toggle_perspective {} { if {$::perspective} { set ::perspective 0 $::bp config -text "Perspective is Off" } else { set ::perspective 1 $::bp config -text "Perspective is On" } after 0 update_and_draw } proc set_worldmatrix {mat} { set ::worldmatrix $mat } proc set_viewmatrix {mat} { set ::viewmatrix $mat } proc mult_worldmatrix {mat} { set ::worldmatrix [matrix_multiply $mat $::worldmatrix] } proc mult_viewmatrix {mat} { set ::viewmatrix [matrix_multiply $mat $::viewmatrix] } proc get_worldmatrix {} { return $::worldmatrix } proc get_viewmatrix {} { return $::viewmatrix } #============================================================ proc update_and_draw {} { set_viewmatrix [matrix_rotation_x [deg2rad $::cam_angle1]] mult_viewmatrix [matrix_rotation_y [deg2rad $::cam_angle2]] set_worldmatrix [matrix_identity] # draw workspace ----------------------------------- draw_plane WorkSpace_XY { 0 4 5 1 5 4 } [list WorkSpace] draw_plane WorkSpace_YZ { 1 5 6 2 6 5 } [list WorkSpace] draw_plane WorkSpace_ZX { 2 6 0 4 0 6 } [list WorkSpace] draw_3D_line {0 0 0 1 300 0 0 1} XAXIS draw_3D_line {0 0 0 1 0 300 0 1} YAXIS draw_3D_line {0 0 0 1 0 0 300 1} ZAXIS ### move this set ::mem(link0) [matrix_rotation_y [deg2rad $::theta_base]] set ::mem(link1) [matrix_rotation_x [deg2rad $::anngle1]] set ::mem(link2) [matrix_rotation_x [deg2rad $::anngle2]] set ::mem(link3) [matrix_rotation_x [deg2rad $::anngle3]] set ::mem(link4) [matrix_rotation_z [deg2rad $::theta_hand]] set ::mem(left5) [matrix_translation $::sllde5 0 0] set ::mem(right5) [matrix_translation [expr -$::sllde5] 0 0] # draw robot --------------------------------------- set_worldmatrix [matrix_translation 200 0 150] mult_worldmatrix $::mem(link0) # draw base draw_prism base 40 50 40 -40 50 0 mult_worldmatrix [matrix_translation 5 75 0] mult_worldmatrix $::mem(link1) # draw link 1 draw_prism part1 5 10 10 0 0 0 draw_prism part2 10 10 50 15 0 30 mult_worldmatrix [matrix_translation 0 0 80] mult_worldmatrix $::mem(link2) # draw link 2 draw_prism part3 5 10 10 0 0 0 draw_prism part4 10 10 50 -15 0 30 mult_worldmatrix [matrix_translation 0 0 80] mult_worldmatrix $::mem(link3) # draw link 3 draw_prism part5 5 10 10 0 0 0 draw_prism part6 10 10 50 15 0 30 mult_worldmatrix [matrix_translation 15 0 85] mult_worldmatrix $::mem(link4) draw_prism part7 10 10 5 0 0 0 draw_prism part8 60 10 10 0 0 15 set savemat [get_worldmatrix] ;# save current matrix mult_worldmatrix $::mem(left5) draw_prism lefthand 10 10 50 10 0 75 set_worldmatrix $savemat ;# restore previous matrix mult_worldmatrix $::mem(right5) draw_prism righthand 10 10 50 -10 0 75 } proc build_robot_controls { master } { set frame0 [labelframe $master.robot -text "Robot Controls"] grid \ [create_scale base $frame0 ::theta_base 180 -180 0] \ [create_scale arm1 $frame0 ::anngle1 180 -180 0] \ [create_scale arm2 $frame0 ::anngle2 180 -180 0] \ [create_scale arm3 $frame0 ::anngle3 180 -180 0] \ -sticky news grid \ [create_scale handspin $frame0 ::theta_hand 90 -90 0] \ [create_scale grasp $frame0 ::sllde5 40 0 40] \ -sticky news return $frame0 } proc build_camera_controls { master } { set f [labelframe $master.camera -text "Camera Controls"] grid \ [create_scale psi $f ::cam_angle1 180 -180 -22] \ [create_scale phi $f ::cam_angle2 180 -180 -150] \ -sticky news return $f } proc configure_drawing {} { $::maincanvas itemco WorkSpace -fill #00bb00 $::maincanvas itemco Robot -width 2 $::maincanvas itemco XAXIS -fill red $::maincanvas itemco YAXIS -fill #008800 $::maincanvas itemco ZAXIS -fill blue } proc widget_setup_defaults {} { set ::screencenter_x 300 set ::screencenter_y 400 set ::perspective 1 option add *Workspace.text "Camera" option add *Robot.text "Robot" } main_program