if 0 {
[Richard Suchenwirth] 2004-02-23 - In [Playing 3D], first steps were taken to represent
3D objects in memory, and render them by projection on a 2D [canvas]. The
unsatisfying part was that the positions of the "observer" were limited to
curvy trajectories along the x axis, or very flat views parallel to the
3D axes.  In this continuation I experiment with freely choosable
observer position, so you can really "walk through" the scene, a little church on a green meadow which I call St John's chapel. Use cursor keys, possibly modified with Shift or Alt, to experiment what you can do. "+"/"-" to zoom in or out; "x", "y", "z" to see a projection along one of the main axes; "3" to return to 3D display.

[http://mini.net/files/stjohn.jpg]

There are still many shortcomings to this code, especially when you try to walk inside the church - corrections are very welcome! I suspect the ''3d'project'' proc has bugs, but my math books couldn't help me further...
}
 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
    }
 }
 proc 3d'poly {id points args} {
    variable 3d
    lappend 3d(polygons) $id
    set 3d($id) [list $points $args]
 }
 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)
 }
 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]}
        }
    }
 }
 #----------------------
 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

 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 deivatives 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 water, and rain, 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 EXE files actually run.

Now the Quake game engines are absolutely brilliant at running/rendering the 3D Worlds. The problem with 3D Worlds is not the rendering of them - but CREATING them. It is still a painfully tedious process. But the MAP files that describe those worlds are ASCII TEXT files.

And Perl and Tcl and Tk are exactly the tools we need to make more effective tools for creating 3D Worlds in.