GS - Le code ci-dessous affiche des polyhèdres en 3d avec le modèle de Lambert (ombrage plat) ou en mode filaire. Il utilise uniquement le canvas. Le modèle d'illumination de Lambert est uniforme [1]. L'intensité de la couleur d'une face est proportionelle à l'angle entre sa normale et la direction d'un rayon lumineux.
- Une version startkit avec plus d'exemples est disponible ici [2]
- Une version tclet est visible ici [3] (sources [4])
L'algorithme de gestion des faces cachées fonctionne bien avec des objets convexes mais est très limité avec les autres types. Voir par exemple le tore ou la navette spatiale comme mauvais exemples.
# polyhedra.tcl # Author: Gerard Sookahet # Date: 30 Mai 2005 # Description: Rotating polyhedra using a 'standard' tk canvas. # Flat shading and wireframe mode. package require Tk 8.4 bind all <Escape> {exit} proc Barycenter {lcoords} { set X 0 set Y 0 set n [llength $lcoords] foreach vtx $lcoords { foreach {x y} $vtx { set X [expr {$X + $x}] set Y [expr {$Y + $y}] } } return [list [expr {$X/$n}] [expr {$Y/$n}]] } proc CrossProduct {x1 y1 z1 x2 y2 z2} { return [list [expr {$y1*$z2 - $y2*$z1}] \ [expr {$z1*$x2 - $z2*$x1}] \ [expr {$x1*$y2 - $x2*$y1}]] } proc DotProduct {x1 y1 z1 x2 y2 z2} { return [expr {$x1*$x2 + $y1*$y2 + $z1*$z2}] } proc MatrixVectorProduct {M V} { set x [lindex $V 0] set y [lindex $V 1] set z [lindex $V 2] return [list [expr {[lindex $M 0 0]*$x+[lindex $M 1 0]*$y+[lindex $M 2 0]*$z}] \ [expr {[lindex $M 0 1]*$x+[lindex $M 1 1]*$y+[lindex $M 2 1]*$z}] \ [expr {[lindex $M 0 2]*$x+[lindex $M 1 2]*$y+[lindex $M 2 2]*$z}]] } proc MatrixProduct {M1 M2} { set M {{0 0 0 0} {0 0 0 0} {0 0 0 0} {0 0 0 0}} for {set i 0} {$i<4} {incr i} { for {set j 0} {$j<4} {incr j} { lset M $i $j 0 for {set k 0} {$k<4} {incr k} { lset M $i $j [expr {[lindex $M $i $j]+[lindex $M1 $i $k]*[lindex $M2 $k $j]}] } } } return $M } proc MatrixRotation { ax ay az } { set sax [expr {sin($ax)}] set cax [expr {cos($ax)}] set say [expr {sin($ay)}] set cay [expr {cos($ay)}] set saz [expr {sin($az)}] set caz [expr {cos($az)}] set Mx {{1 0 0 0} {0 0 0 0} {0 0 0 0} {0 0 0 1}} set My {{0 0 0 0} {0 1 0 0} {0 0 0 0} {0 0 0 1}} set Mz {{0 0 0 0} {0 0 0 0} {0 0 1 0} {0 0 0 1}} # Rotation matrix around X axis with angle ax lset Mx 1 1 $cax lset Mx 1 2 $sax lset Mx 2 1 [expr {-1*$sax}] lset Mx 2 2 $cax # Rotation matrix around Y axis with angle ay lset My 0 0 $cay lset My 0 2 [expr {-1*$say}] lset My 2 0 $say lset My 2 2 $cay # Rotation matrix around Z axis with angle az lset Mz 0 0 $caz lset Mz 0 1 $saz lset Mz 1 0 [expr {-1*$saz}] lset Mz 1 1 $caz return [MatrixProduct [MatrixProduct $Mx $My] $Mz] } # Compute normal vector and norm for each face # ------------------------------------------------------------------- proc NormalVector {lvtx lcnx} { set lnv {} set lmv {} foreach face $lcnx { foreach {nx ny nz} [CrossProduct \ [expr {[lindex $lvtx [lindex $face 1] 0] - [lindex $lvtx [lindex $face 0] 0]}] \ [expr {[lindex $lvtx [lindex $face 1] 1] - [lindex $lvtx [lindex $face 0] 1]}] \ [expr {[lindex $lvtx [lindex $face 1] 2] - [lindex $lvtx [lindex $face 0] 2]}] \ [expr {[lindex $lvtx [lindex $face 2] 0] - [lindex $lvtx [lindex $face 1] 0]}] \ [expr {[lindex $lvtx [lindex $face 2] 1] - [lindex $lvtx [lindex $face 1] 1]}] \ [expr {[lindex $lvtx [lindex $face 2] 2] - [lindex $lvtx [lindex $face 1] 2]}]] {} lappend lnv [list $nx $ny $nz] lappend lmv [DotProduct $nx $ny $nz $nx $ny $nz] } return [list $lnv $lmv] } # 2D projection # ------------------------------------------------------------------- proc Projection {x y z M} { global scx scy vdist set nx [expr {[lindex $M 0 0]*$x+[lindex $M 1 0]*$y+[lindex $M 2 0]*$z}] set ny [expr {[lindex $M 0 1]*$x+[lindex $M 1 1]*$y+[lindex $M 2 1]*$z}] set nz [expr {([lindex $M 0 2]*$x+[lindex $M 1 2]*$y+[lindex $M 2 2]*$z+10)/$vdist}] return [list [expr {$nx/$nz+$scx/2.0}] [expr {$ny/$nz+$scy/2.0}]] } # Apply transformations to vertex coordinates # ------------------------------------------------------------------- proc Transformations {lvtx lnv} { global ax ay az update set lnew {} set lvn {} # Compute matrix rotation set M [MatrixRotation $ax $ay $az] set i 0 # Apply projection foreach vtx $lvtx { lappend lnew [Projection [lindex $vtx 0] [lindex $vtx 1] [lindex $vtx 2] $M] incr i } # Normal vector rotation foreach v $lnv {lappend lvn [MatrixVectorProduct $M $v]} return [list $M $lnew $lvn] } # Compute color entensity for each face # ------------------------------------------------------------------- proc Intensity {lnv lmv lvv} { set lclr {} set v [DotProduct [lindex $lvv 0] [lindex $lvv 1] [lindex $lvv 2] \ [lindex $lvv 0] [lindex $lvv 1] [lindex $lvv 2]] set i 0 foreach nv $lnv { set clr 31 set a [DotProduct [lindex $nv 0] [lindex $nv 1] [lindex $nv 2] \ [lindex $lvv 0] [lindex $lvv 1] [lindex $lvv 2]] set b [expr {sqrt([lindex $lmv $i]*$v)}] set clr [expr {round(31*($a/$b))}] lappend lclr [expr {$clr < 0 ? 31 : [expr {32 - $clr}]}] incr i } return $lclr } # Start the display and rotation loop # ------------------------------------------------------------------- proc DisplayModel {w s} { global stop global display global ax ay az tx ty tz $w.c delete all set stop 0 set ax 0.2 set ay 0.1 set az 0.3 set tx 0 set ty 0 set tz 0 set d $display foreach {t lvtx lcnx lclr} [ReadData $s] {} $w.c create text 10 10 -anchor w -fill white -text $t foreach {lnv lmv} [NormalVector $lvtx $lcnx] {} set lpoly [DisplayInit $w $d $lcnx $lclr] if {$d == "shaded"} then { for {set i 1} {$i<=820} {incr i} { if $stop break set ax [expr {$ax-0.02}] set az [expr {$az+0.02}] set ay [expr {$ay+0.025}] after 40 DisplayShaded $w $lpoly $lvtx $lcnx $lnv $lmv } } else { for {set i 1} {$i<=820} {incr i} { if $stop break set ax [expr {$ax-0.02}] set az [expr {$az+0.02}] set ay [expr {$ay+0.025}] after 40 Display $w $lpoly $lvtx $lcnx $lnv $lmv } } } # Data structure for models with vertices and connectivity # ------------------------------------------------------------------- proc ReadData { n } { set lvtx {} set lcnx {} set lclr {} set txt "" switch $n { tetrahedron { set txt "tetrahedron: 4 faces 4 vertices 5 edges" set a [expr {1.0/sqrt(3.0)}] set lvtx [list [list $a $a $a] [list $a -$a -$a] \ [list -$a $a -$a] [list -$a -$a $a]] set lcnx {{0 3 1} {2 0 1} {3 0 2} {1 3 2}} } cube { set txt "cube: 6 faces 8 vertices 12 edges" set lvtx {{0.7 0.7 0.7} {-0.7 0.7 0.7} {-0.7 -0.7 0.7} {0.7 -0.7 0.7} {0.7 0.7 -0.7} {-0.7 0.7 -0.7} {-0.7 -0.7 -0.7} {0.7 -0.7 -0.7}} set lcnx {{4 7 6 5} {0 1 2 3} {3 2 6 7} {4 5 1 0} {0 3 7 4} {5 6 2 1}} } octahedron { set txt "octahedron 8 faces 6 vertices 16 edges" set lvtx {{1 0 0} {0 1 0} {-1 0 0} {0 -1 0} {0 0 1} {0 0 -1}} set lcnx {{0 1 4} {1 2 4} {2 3 4} {3 0 4} {1 0 5} {2 1 5} {3 2 5} {0 3 5}} } dodecahedron { set txt "dodecahedron 12 faces 20 vertices 30 edges" set s3 [expr sqrt(3)] set s5 [expr sqrt(5)] set alpha [expr {sqrt(2.0/(3 + $s5))/$s3}] set beta [expr {(1.0 + sqrt(6.0/(3 + $s5) - 2 + 2*sqrt(2.0/(3.0 + $s5))))/$s3}] set gamma [expr {1.0/$s3}] set lvtx [list \ [list -$alpha 0 $beta] \ [list $alpha 0 $beta] \ [list -$gamma -$gamma -$gamma] \ [list -$gamma -$gamma $gamma] \ [list -$gamma $gamma -$gamma] \ [list -$gamma $gamma $gamma] \ [list $gamma -$gamma -$gamma] \ [list $gamma -$gamma $gamma] \ [list $gamma $gamma -$gamma] \ [list $gamma $gamma $gamma] \ [list $beta $alpha 0] \ [list $beta -$alpha 0] \ [list -$beta $alpha 0] \ [list -$beta -$alpha 0] \ [list -$alpha 0 -$beta] \ [list $alpha 0 -$beta] \ [list 0 $beta $alpha] \ [list 0 $beta -$alpha] \ [list 0 -$beta $alpha] \ [list 0 -$beta -$alpha]] set lcnx {{0 1 9 16 5} {1 0 3 18 7} {1 7 11 10 9} {11 7 18 19 6} {8 17 16 9 10} {2 14 15 6 19} {2 13 12 4 14} {2 19 18 3 13} {3 0 5 12 13} {6 15 8 10 11} {4 17 8 15 14} {4 12 5 16 17}} } icosahedron { set txt "icosahedron: 20 faces 12 vertices 30 edges" set X 0.525731112119133606 set Z 0.850650808352039932 set lvtx [list [list -$X 0.0 $Z] [list $X 0.0 $Z] [list -$X 0.0 -$Z] \ [list $X 0.0 -$Z] [list 0.0 $Z $X] [list 0.0 $Z -$X] \ [list 0.0 -$Z $X] [list 0.0 -$Z -$X] [list $Z $X 0.0] \ [list -$Z $X 0.0] [list $Z -$X 0.0] [list -$Z -$X 0.0]] set lcnx {{4 0 1} {9 0 4} {5 9 4} {5 4 8} {8 4 1} {10 8 1} {3 8 10} {3 5 8} {2 5 3} {7 2 3} {10 7 3} {6 7 10} {11 7 6} {0 11 6} {1 0 6} {1 6 10} {0 9 11} {11 9 2} {2 9 5} {2 7 11}} } } for {set i 0} {$i <= [llength $lcnx]} {incr i} { lappend lclr "0000[format %2.2x 255]" } return [list $txt $lvtx $lcnx $lclr] } # Initialization of canvas with polygonal objects filled or not # ------------------------------------------------------------------- proc DisplayInit {w d lcnx lclr} { set lpoly {} set i 0 if {$d == "shaded"} then { foreach cnx $lcnx { lappend lpoly [$w.c create polygon \ [string repeat " 0" [expr {2*[llength $cnx]}]] \ -fill "#[lindex $lclr $i]"] incr i } } else { foreach cnx $lcnx { lappend lpoly [$w.c create polygon \ [string repeat " 0" [expr {2*[llength $cnx]}]] \ -fill black -outline blue] } } return $lpoly } # Flat shaded display with gradient color # ------------------------------------------------------------------- proc DisplayShaded {w lpoly lvtx lcnx lnv lmv} { update set lgradB {} foreach {M lnew lvn} [Transformations $lvtx $lnv] {} # Light vector is set to <1 1 -1> foreach i [Intensity $lvn $lmv [list 1 1 -1]] { lappend lgradB [format %2.2x [expr {100+154*$i/32}]] } set i 0 foreach cnx $lcnx { set lcoords {} foreach j $cnx {lappend lcoords [lindex $lnew $j]} # Backface culing for hidden face. Not removed but only reduced to a point if {[lindex $lvn $i 2] < 0} { eval $w.c coords [lindex $lpoly $i] [join $lcoords] $w.c itemconfigure [lindex $lpoly $i] -fill "#0000[lindex $lgradB $i]" } else { $w.c coords [lindex $lpoly $i] [string repeat " [join [Barycenter $lcoords]]" [llength $cnx]] } incr i } } # Wireframe display # ------------------------------------------------------------------- proc Display {w lpoly lvtx lcnx lnv lmv} { update foreach {M lnew lvn} [Transformations $lvtx $lnv] {} set i 0 foreach cnx $lcnx { set lcoords {} foreach j $cnx {lappend lcoords [lindex $lnew $j]} # Backface culing for hidden face. Not removed but only reduced to a point if {[lindex $lvn $i 2] < 0} { eval $w.c coords [lindex $lpoly $i] [join $lcoords] } else { $w.c coords [lindex $lpoly $i] [string repeat " [join [Barycenter $lcoords]]" [llength $cnx]] } incr i } } # ------------------------------------------------------------------- proc Main {} { global stop global display global scx scy vdist set w .tdc catch {destroy $w} toplevel $w wm withdraw . wm title $w "Rotating polyhedra in Tk canvas " set display shaded set scx 420 set scy 420 set vdist 1200 pack [canvas $w.c -width $scx -height $scy -bg white -bg black -bd 0] $w.c delete all set f1 [frame $w.f1 -relief sunken -borderwidth 2] pack $f1 -fill x button $f1.brun -text Stop -command {set stop 1} button $f1.bq -text Quit -command exit label $f1.l1 -text " " radiobutton $f1.rbs -text "Shaded" -variable display -value shaded radiobutton $f1.rbw -text "Wireframe" -variable display -value wireframe eval pack [winfo children $f1] -side left set f2 [frame $w.f2 -relief sunken -borderwidth 2] pack $f2 -fill x foreach i {tetrahedron cube octahedron dodecahedron icosahedron} { button $f2.b$i -text $i -command "DisplayModel $w $i" } eval pack [winfo children $f2] -side left set f3 [frame $w.f3 -relief sunken -borderwidth 2] pack $f3 -fill x label $f3.l1 -text "View distance " scale $f3.sca -from 300 -to 1600 -length 300 \ -orient horiz -bd 1 -showvalue true -variable vdist eval pack [winfo children $f3] -side left } Main
dc Impressionant ! Je ne pensais pas qu'en si peu de lignes, on pouvait faire cela, voire même qu'on pouvait faire cela avec Tk seul. Encore une fois : Bravo !
J'ai néanmoins parfois des problèmes de faces cachées avec le tore notamment.
GS C'est normal car il s'agit d'objets non-convexes. Il faudrait dès lors utiliser des algorithmes plus subtils (Z-buffer) mais aussi plus gourmands car ils travaillent au niveau du pixel. Merci pour les compliments. La Force est avec Tcl-Tk ;-)
ulis du très beau travail !
dc dans la page http://gersoo.frJL