#!/bin/sh
# Einfaches Beispiel  für Tcl3d, basiert
# auf adaptiertent OpenGL Tutorial von 
# http://nehe.gamedev.net/
# \
exec wish $0 $@
package require tcl3d 0.2

# Window size.
set winWidth  640
set winHeight 480

set Posx 0
set Posy 0
set Posz -300

set Rotx -45
set Roty -300
set Rotz 0


set PI [ expr 2* asin(1)]


# Berechnet einer RGB Farbe, aus http://wiki.tcl.tk/666
proc hls2rgb {h l s} {
    set h6 [expr {($h-floor($h))*6}]
    set r [expr {  $h6 <= 3 ? 2-$h6
		   : $h6-4}]
    set g [expr {  $h6 <= 2 ? $h6
		   : $h6 <= 5 ? 4-$h6
		   : $h6-6}]
    set b [expr {  $h6 <= 1 ? -$h6
		   : $h6 <= 4 ? $h6-2
		   : 6-$h6}]
    set r [expr {$r < 0.0 ? 0.0 : $r > 1.0 ? 1.0 : double($r)}]
    set g [expr {$g < 0.0 ? 0.0 : $g > 1.0 ? 1.0 : double($g)}]
    set b [expr {$b < 0.0 ? 0.0 : $b > 1.0 ? 1.0 : double($b)}]
    
    set r [expr {(($r-1)*$s+1)*$l}]
    set g [expr {(($g-1)*$s+1)*$l}]
    set b [expr {(($b-1)*$s+1)*$l}]
    return [list $r $g $b]
}

# Kugelmodel erzeugen
proc kugel  { radius } {
    set kante 10

    set ::displayliste [ glGenLists 1]
    glNewList $::displayliste GL_COMPILE
    
    for { set l 0} {$l <= 360} {incr l 5} {
	for { set b -90 } {$b <= 90} {incr b 5} {
	    # Position im Bogenmaß
	    set lr [ expr $l / 180.0 * $::PI]
	    set br [ expr $b / 180.0 * $::PI]
		   
	    # die Farbe für das nächste Element wird gesetzt
	    set hue [expr sin($br/3.0)]
	    eval glColor3f   [hls2rgb $hue 1 1 ]

	    # nun kommt ein Dreieck 
	    glBegin GL_TRIANGLES

	    glVertex3f [ expr $radius * cos( $lr) * cos($br) ] \
		[ expr $radius * sin($lr) * cos($br) ] \
		[ expr $radius * sin($br) ]

	    glVertex3f [ expr $radius * cos( $lr) * cos($br) ] \
		[ expr $radius  * sin($lr) * cos($br) +$kante ] \
		[ expr $radius * sin($br) ]

	    glVertex3f [ expr $radius * cos( $lr) * cos($br) ] \
		[ expr $radius * sin($lr) * cos($br) ] \
		[ expr $radius   * sin($br)+ $kante ]

	    glEnd 

	}
    }

    glEndList
}

# Setzt ein paar Startwerte und erzeugt die Displayliste
#, wird beim Erzeugen des Fensters augerufen
proc tclCreateFunc { toglwin } {

    # Schwarzer Hintergrund
    glClearColor 0.0 0.0 0.0 0.0 
    
    # Ein bischen Tuning
    glClearDepth 1.0            
    glEnable GL_DEPTH_TEST      
    glShadeModel GL_FLAT
    glDepthFunc GL_LEQUAL       
    glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST 

    # Displayliste einmalig erzeugen
    kugel 100
}


# In dieser Funktion wird das 3D Modell angezeigt
proc tclDisplayFunc { toglwin } {
    # Screen And Depth Buffer Löschen
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] 

    # Anfangsposition setzen
    glLoadIdentity        
    glTranslatef $::Posx $::Posy $::Posz
    glRotatef $::Rotx 1.0 0.0 0.0
    glRotatef $::Roty 0.0 1.0 0.0
    glRotatef $::Rotz 0.0 0.0 1.0

    # Displayliste Abrufen
    glCallList $::displayliste

    $toglwin swapbuffers
}

# Berechnet eine passende Ansicht auf das Model,
# wird aufgerufen wenn sich die Fenstergröße ändert
proc tclReshapeFunc { toglwin  b h } {
    # verhindert Teilen durch Null
    set h [ expr $h < 1 ? 1  : $h ]

    # Viewport neu berechnen
    glViewport 0 0 $b $h       
    glMatrixMode GL_PROJECTION  

    # wieder Einheitsmatrix setzen
    glLoadIdentity              

    # Perspektive berechnen lassen und aktive machen
    set winkel 45
    set verhaeltnis [ expr double($b)/double($h)]
    set von 0.1
    set bis 5000
    gluPerspective $winkel $verhaeltnis $von $bis
    glMatrixMode GL_MODELVIEW   
}


# speichert die Mausposition beim Drücken der
# linken Maustaste
proc RotStart {x y W } {
    global startx starty 

    set startx $x
    set starty $y

}

# berechnet die neue Rotation nach dem Loslassen
# der linken Maustaste
proc RotMove {x y W} {
    global startx starty 

    set ::Rotx [expr $::Rotx + 0.1 * ($x - $startx)]
    set ::Roty [expr $::Roty + 0.1 * ($y - $starty)]

    $W postredisplay
}


# Bewegt das Modell beim drehen des Mausrads
proc MovePos { dist W } {
    # Berechne neue Position
    set ::Posx  0
    set ::Posy  0
    set ::Posz  [ expr int($::Posz +$dist)  ]

    $W postredisplay
}

# Bewegt das Modell mit den Pfeiltasten
proc LinksRechtsObenUnten { key W } {

     if {[string match Left $key] } { 
 	incr ::Posx -10
     } elseif {[string match Right $key] } {
 	incr ::Posx 10
     } elseif {[string match Up $key] } {
 	incr ::Posy 10
     } elseif {[string match Down $key] } {
 	incr ::Posy -10
     }
    .toglwin postredisplay
}

# Create Our OpenGL Window
togl .toglwin -width $::winWidth -height $::winHeight \
    -double true -depth true \
    -reshapeproc tclReshapeFunc \
    -displayproc tclDisplayFunc \
    -createproc tclCreateFunc

pack .toglwin -expand 1 -fill both

# An Events binden
bind . <Key> {LinksRechtsObenUnten %K %W}
bind .toglwin <Button-4> { MovePos 20 %W}
bind .toglwin <Button-5>  { MovePos -20 %W}
bind .toglwin <ButtonPress-1> {RotStart %x %y %W}
bind .toglwin <B1-Motion> {RotMove %x %y %W}