proc 3d'reset {} { variable 3d array set 3d { x0 3 y0 -3 z0 3 hy0 0 hz0 0 hyi 0 hzi 0 zoom 50 flat 3d } } # Create a new polygon proc 3d'poly {id points args} { variable 3d lappend 3d(polygons) $id set 3d($id) [list $points $args] } # Map a point in 3D space to a x/y location in 2D space on the canvas proc 3d'project {point} { variable 3d; variable proj set factor $3d(zoom) if {![info exist proj($point)]} { foreach {x y z} $point break if {$z == ""} {set z 0} set rxy 0; set rxz 0 switch -- $3d(flat) { x {set x [expr {$y*$factor}]; set y [expr {-$z*$factor}] ;# side view} y {set x [expr {$x*$factor}]; set y [expr {-$z*$factor}] ;# front view} z {set x [expr {$x*$factor}]; set y [expr {-$y*$factor}] ;# top view} default { set dx [expr {$x-$3d(x0)}] set dy [expr {$y-$3d(y0)}] set dz [expr {$z-$3d(z0)}] set 3d(hy0) [expr {-atan2($3d(y0),$3d(x0))+$3d(hyi)}] set 3d(hz0) [expr {-atan2($3d(z0),$3d(y0))+$3d(hzi)}] set 3d(hy0) $3d(hyi) set 3d(hz0) $3d(hzi) set rxy [expr {hypot($dx,$dy)}] if {$rxy} { set ay [expr {-atan2($dy,$dx)+$3d(hy0)}] } else {set ay 0 ;#$3d(hy0)} set t $rxy set rxz [expr {hypot($t,$dz)}] if {$rxz} { set az [expr {+atan2($dz,$t)-$3d(hz0)}] } else {set az 0 ;#$3d(hz0)} set x [expr {cos($ay) * $3d(zoom)*2}] set y [expr {-sin($az) * $3d(zoom)*2}] } } set proj($point) [list $rxy $x $y] } #debug'locals set proj($point) } # This is called whenever a parameter has changed proc 3d'redraw {w} { variable 3d; variable proj $w delete all $w create line -100 0 100 0 -fill blue $w create line 0 -100 0 100 -fill blue catch {unset proj} set tmp {} foreach id $3d(polygons) { set sum 0 set n 0 foreach point [lindex $3d($id) 0] { set sum [expr {$sum+[lindex [3d'project $point] 0]}] incr n } puts [list $sum $n [expr {$sum/$n}] $id] lappend tmp [list [expr {$sum/$n}] $id] } set sorted {} foreach i [lsort -real -index 0 -decr $tmp] { lappend sorted [lindex $i 1] } foreach id $sorted { foreach {points args} $3d($id) break set 2dpoints {} foreach point $points { eval lappend 2dpoints [lrange [3d'project $point] 1 end] } eval $w create poly $2dpoints -outline black $args -tag $id } $w lower bg $w config -scrollregion [$w bbox all] wm title . "Observer: $3d(x0) $3d(y0) $3d(z0)/$3d(hy0),$3d(hz0)" } proc sgn x {expr {$x>0? 1: $x<0? -1: 0}} proc debug'locals {} { uplevel 1 { puts ----------[info level 0] foreach i [lsort [info locals]] { if {![array exists $i]} {puts $i=[set $i]} } } } # Building the chapel from polygons: catch {console show} ;# not available on Unix 3d'reset 3d'poly lawn {{-3 -3} {7 -3} {7 6} {-3 6}} -fill green3 -tag bg 3d'poly towerbot {{0 0 0} {0 1 0} {1 1 0} {1 0 0}} -fill blue 3d'poly towerfront {{0 0 0} {0 0 4} {1 0 4} {1 0 0}} -fill beige 3d'poly towerleft {{0 0 0} {0 1 0} {0 1 4} {0 0 4}} -fill yellow 3d'poly towerback {{0 1 0} {0 1 4} {1 1 4} {1 1 0}} -fill beige 3d'poly towerright {{1 0 0} {1 1 0} {1 1 4} {1 0 4}} -fill beige 3d'poly trfront {{0 0 4} {.5 .5 5} {1 0 4}} -fill red 3d'poly trback {{0 1 4} {.5 .5 5} {1 1 4}} -fill red 3d'poly trleft {{0 0 4} {.5 .5 5} {0 1 4}} -fill red 3d'poly trright {{1 0 4} {.5 .5 5} {1 1 4}} -fill red 3d'poly floor {{1 0} {4 0} {4 2} {1 2}} -fill grey 3d'poly front {{1 0} {4 0} {4 0 2} {1 0 2}} -fill orange 3d'poly left {{1 0} {1 0 2} {1 1 3} {1 2 2} {1 2} {1 1.8} {1 1.8 1} {1 1.3 1} {1 1.3}} -fill beige ;# with door 3d'poly back {{1 2} {4 2} {4 2 2} {1 2 2}} -fill bisque 3d'poly right {{4 0} {4 0 2} {4 1 3} {4 2 2} {4 2}} -fill bisque 3d'poly rfront {{1 0 2} {4 0 2} {4 1 3} {1 1 3}} -fill red 3d'poly rback {{1 2 2} {4 2 2} {4 1 3} {1 1 3}} -fill red pack [canvas .c] -fill both -expand 1 3d'redraw .c # Key bindings: bind . <Escape> {exec wish $argv0 &; exit} bind . <Up> {set 3d(z0) [expr $3d(z0)+1]; 3d'redraw .c} bind . <Down> {set 3d(z0) [expr $3d(z0)-1]; 3d'redraw .c} bind . <Left> {set 3d(x0) [expr $3d(x0)-1]; 3d'redraw .c} bind . <Right> {set 3d(x0) [expr $3d(x0)+1]; 3d'redraw .c} bind . <Alt-Up> {set 3d(y0) [expr $3d(y0)+1]; 3d'redraw .c} bind . <Alt-Down> {set 3d(y0) [expr $3d(y0)-1]; 3d'redraw .c} bind . <Shift-Up> {set 3d(hzi) [expr $3d(hzi)-.1]; 3d'redraw .c} bind . <Shift-Down> {set 3d(hzi) [expr $3d(hzi)+.1]; 3d'redraw .c} bind . <Shift-Left> {set 3d(hyi) [expr $3d(hyi)-.1]; 3d'redraw .c} bind . <Shift-Right> {set 3d(hyi) [expr $3d(hyi)+.1]; 3d'redraw .c} bind . x {set 3d(flat) x; 3d'redraw .c} bind . y {set 3d(flat) y; 3d'redraw .c} bind . z {set 3d(flat) z; 3d'redraw .c} bind . 3 {set 3d(flat) 3; 3d'redraw .c} bind . + {set 3d(zoom) [expr $3d(zoom)*2]; 3d'redraw .c} bind . - {set 3d(zoom) [expr $3d(zoom)*0.5]; 3d'redraw .c} bind . r {3d'reset; 3d'redraw .c} update; raise .
Richard, you're an absolutely brilliant programmer. What you can do in 100 lines of Tcl is just amazing. But as regards 3D, you'd be a zillion times more effective in Quake.The Quake game engine and derivatives of it is what 99% of today's computer games are written in. And the 3D Worlds that these game engines support are fantastically accurate and realistic. They not only support 3D buildings that you can walk around in, but wallpaper, and water, and rain, and grass and flowers, and people you can interact with too.And better still, Quake (the early but still very powerful versions of it,) are OPEN SOURCE. And even better is the way the Quake developers have implemented the entire system. In brief there's:-
- Typically GUI based editers like Worldcraft, for creating the 3D Worlds...
- MAP files - which are plain ASCII text files - which store the 3D World definitions in...
- Compiler tools, which convert the MAP files into the BSP (binary) files that the game engine EXEs actually run.
- And of course, the game engines themselves.
- A data file format (perhaps in XML), for storing the 3D world definitions in,
- A conversion tool for converting that data file to a MAP file, and;
- Some GUI based program for editing the data file - whilst seeing your software draw the work in progress as you go,
Completely off-topic, but I noticed this page because there is a town in Durham (NE England) of that name:-http://www.streetmap.co.uk/newmap.srf?x=387760&y=537200&z=5&sv=385000,535000&st=4&ar=Y&mapp=newmap.srf&searchp=newsearch.srfRS:-) I don't know that place, I was just instigated by a chapel model in a math book, and I named it after who might be the patron saint of Tcl/Tk...LV: I am relatively certain that our St. John would really get a chuckle out of this.