Tcl Source Code

In the script below, running the display command causes a fatal 
error. I have traced it to the "lsort -command compareView" 
command in that proc. Using a trivial comparison procedure 
does not produce the error (e.g. compareView2).

# solids3d.tcl --
#
#    Package for displaying 3D solid bodies
#    (sample Workbench module)
#
# Notes:
#    This package is a quick hack to get started only
#
# Version information:
#    version 0.2: improved sorting of polygons, september 2002
#    version 0.1: initial implementation, september 2002

package provide Solids3D 0.1

namespace eval ::Solids3D {

   namespace export func deriv

   variable display_options

# normalToPlane --
#    Return the normal vector to a plane given as three points
#
# Arguments:
#    point1       First point
#    point2       Second point
#    point3       Third point
#
# Result:
#    Vector {x,y,z}, a normal vector to the plane
#
proc normalToPlane {point1 point2 point3} {
   foreach {dummy px1 py1 pz1} $point1 {break}
   foreach {dummy px2 py2 pz2} $point2 {break}
   foreach {dummy px3 py3 pz3} $point3 {break}
   set vx1 [expr {$px2-$px1}]
   set vy1 [expr {$py2-$py1}]
   set vz1 [expr {$pz2-$pz1}]
   set vx2 [expr {$px3-$px1}]
   set vy2 [expr {$py3-$py1}]
   set vz2 [expr {$pz3-$pz1}]

   set nx  [expr {$vy1*$vz2-$vz1*$vy2}]
   set ny  [expr {$vz1*$vx2-$vx1*$vz2}]
   set nz  [expr {$vx1*$vy2-$vy1*$vx2}]

   return [list VECTOR $nx $ny $nz]
}

# pointOnTorus --
#    Return the coordinates of a point on a torus, as given by
#    two parameters (angles)
#
# Arguments:
#    phi          Angle with respect to x-axis
#    theta        Angle with respect to "inner" axis of torus
#
# Result:
#    Point {x,y,z}, the coordinates of the point
#
proc pointOnTorus {phi theta} {
   set cosphi [expr {cos($phi)}]
   set sinphi [expr {sin($phi)}]
   set costh4 [expr {0.25*cos($theta)}]
   set sinth4 [expr {0.25*sin($theta)}]
   set x [expr {$cosphi*(1.0+$costh4)}]
   set y [expr {$sinphi*(1.0+$costh4)}]
   set z [expr {1.0+$sinth4}]

   return [list POINT $x $y $z]
}

# constructTorus --
#    Return a list of polygons, together forming an approximation 
to a
#    torus
#
# Arguments:
#    nophi        Number of steps along main perimeter
#    notheta      Number of steps along secondary perimeter
#
# Result:
#    List of polygons
#
proc constructTorus {nophi notheta} {
   variable angle

   set pi     3.1415926
   set dphi   [expr {2.0*$pi/double($nophi)}]
   set dtheta [expr {2.0*$pi/double($notheta)}]

   set polygons {POLYGON-LIST}

   for { set iphi 0 } { $iphi < $nophi } { incr iphi } {
     set phi1 [expr {$dphi*double($iphi)}]
     set phi2 [expr {$dphi*double($iphi+1)}]

     for { set itheta 0 } { $itheta < $notheta } { incr itheta } {
        set theta1 [expr {$dtheta*double($itheta)}]
        set theta2 [expr {$dtheta*double($itheta+1)}]

        set point1 [pointOnTorus $phi1 $theta1]
        set point2 [pointOnTorus $phi1 $theta2]
        set point3 [pointOnTorus $phi2 $theta2]
        set point4 [pointOnTorus $phi2 $theta1]

        set red    [expr {int(125*(1.0+cos($phi1)))}]
        set green  [expr {int(125*(1.0+sin($phi1)))}]
        set blue   [expr {int(125*(1.0+sin($theta1)))}]
        set colour [format "#%2.2X%2.2X%2.2X" $red $green $blue]
      #  set zdepth [lindex [rotateY $angle $point1] 3]
        set normal [normalToPlane $point1 $point2 $point4]

        lappend polygons \
           [list POLYGON $colour $normal $point1 $point2 $point3 
$point4]
      }
   }
   return $polygons
}

# rotateY --
#    Rotate around the y axis
#
# Arguments:
#    angle        Angle over which to rotate
#    point        Point to rotate
#
# Result:
#    New coordinates
#
proc rotateY {angle point} {
   foreach {dummy x y z} $point break
   set xr [expr {$x*cos($angle)-$z*sin($angle)}]
   set yr $y
   set zr [expr {$x*sin($angle)+$z*cos($angle)}]

   return [list POINT $xr $yr $zr]
}

# projectOnYZ --
#    Project a point on the YZ-plane (and scale as we do this)
#
# Arguments:
#    point        Point to rotate
#
# Result:
#    XY coordinates (for the screen)
#
proc projectOnYZ {point} {
   variable scale
   variable yoffset
   variable zoffset
   foreach {dummy x y z} $point break
   set xp [expr {int($scale*($y-$yoffset))}]
   set yp [expr {int($scale*($zoffset-$z))}]

   return [list $xp $yp]
}

# compareView --
#    Compare the relative position of two polygons w.r.t. the 
viewpoint
#
# Arguments:
#    polygon1     First polygon
#    polygon2     Second polygon
#
# Result:
#    1, -1 if the first polygon lies before or after the second,
#    0, if they intersect
#
# Note:
#    The third element of the list that constitutes a polygon (index 2!)
#    is supposed to be a vector normal to the polygon. For 
reasons of
#    speed.
#
proc compareView2 {polygon1 polygon2} { return 1 }

proc compareView {polygon1 polygon2} {
   variable angle
   variable viewpoint

   #
   # Determine the relevant sign
   #
   foreach {dummy nx ny nz} [lindex $polygon1 2] {break}
   foreach {dummy vx vy vz} $viewpoint {break}
   set vn [expr {$nx*$vx+$ny*$vy+$nz*$vz}]
   if { $vn < 0 } {
      set nx [expr -$nx]
      set ny [expr -$ny]
      set nz [expr -$nz]
   }

   #
   # For each point of the second polygon, does the inproduct 
have
   # the same sign? If the number of identical signs is 4, then
   # polygon lies either on the same side as the viewpoint or
   # on the opposite side, but we have reached a conclusion.
   #
   set count 0
   foreach point [lrange $polygon2 3 end] {
      foreach {dummy px py pz} $point {break}
      set pn [expr {$nx*$px+$ny*$py+$nz*$pz}]
      if { $pn > 0.0 } {
         incr count
      } else {
         incr count -1
      }
   }

   if { $count == 4 } {
      return -1
   } elseif { $count == -4 } {
      return 1
   } else {
      set rc [compareView $polygon2 $polygon1]
      expr {-$rc}
   }
}

# display --
#    Quick and dirty implementation to display a set of polygons
#
# Arguments:
#    polygons     List of 3D polygons
#
# Result:
#    None
#
# Side effect:
#    Display of polygons in the canvas
#
proc display {polygons} {
   variable angle
   variable viewpoint

   set viewpoint [list POINT [expr cos($angle)] 0.0 [expr sin
($angle)]]

   #
   # Sort the polygons first
   # Note:
   # The comparison is too simple, but for now it should work
   #
   set plane_polygons  [lrange $polygons 1 end]

   set sorted_polygons [lsort -command compareView 
$plane_polygons]

   foreach polygon $sorted_polygons {
      set colour [lindex $polygon 1]
      set points [lrange $polygon 3 end]
      set coords {}
      foreach point $points {
         set coords [concat $coords [projectOnYZ [rotateY $angle 
$point]]]
      }
      .cnv create polygon $coords -fill $colour -outline black
   }
}

#
# Initialise the variables
#
variable angle   [expr {0.25*3.1415926}]
variable scale   100.0
variable yoffset  -1.5
variable zoffset   2.0

} ;# End of namespace

#
# Run the program
#

canvas .cnv -width 300 -height 300 -background white
pack .cnv -fill both
set torus [::Solids3D::constructTorus 16 16]
::Solids3D::display $torus

Logged In: YES 
user_id=72656

This is an ... expected problem in that oversize windows can 
fail on some window managers.  In this case, the 
MessageBox was displaying a very long error.  Since I can't 
see the value in very long errors there, I have truncated the 
displayed text to no more than 1024 chars for 8.4.2.  This 
applies to startup errors only, not tk_messageBox in general.
BTW, this was a Tk bug.

Logged In: YES 
user_id=99768

I'm puzzled about why this one is assigned to me.
All I did was reproduce the failure on my box.
I'm not usually a Tk maintainer, although I'll be
glad to help.

Logged In: YES 
user_id=72656

I believe this error is due to window size limitations, as the 
error that pops up shows an enormous trace of the loop (goes 
way off screen to the bottom).  I can't repro it on Win2K, but 
I'm fairly sure that's the problem.

In general, Tk has to do a better job of limiting window size 
requests to < 32K pixels, in almost all cases.  There are 
various ways you can make Tk blow up this way, on both 
Windows and X.

Logged In: YES 
user_id=80530

anything here we can fix for 8.4.1 ?

Logged In: YES 
user_id=80530

The submitted code has its own bugs, yes,
but that's not the point.

I triggers a startup error message in wish,
and there is a pointer smash in the handling
of that message on Windows (98?), that we
still need to dig out and fix.

Logged In: YES 
user_id=79902

That's a really strange comparison routine; it doesn't even
work.  The one below does though (and is much faster too) so
I suspect we've got a case of "pilot error".  (And I don't
see a crash on IRIX anyway.)

  proc compareView {polygon1 polygon2} {
     set x1 0.0
     foreach point [lrange $polygon1 3 end] {
        foreach {dummy px py pz} $point {break}
        set x1 [expr {$x1+$px}]
     }
     set x2 0.0
     foreach point [lrange $polygon2 3 end] {
        foreach {dummy px py pz} $point {break}
        set x2 [expr {$x2+$px}]
     }
     if {$x1<$x2} {
        return 1
     } elseif {$x1>$x2} {
        return -1
     } else {
        return 0
     }
  }

Logged In: YES 
user_id=80530

This is really a Tk bug.  Something in an exit handler.

Logged In: YES 
user_id=80530

Does the script:

proc infinite {} {
infinite
}
infinite

also reproduce the bug?

File Added - 31002: c:/users/kennykb/tmp/arjen.tcl

Logged In: YES 
user_id=99768

Source above is damaged by the SF display engine. 
Uploading a clean copy