#!/bin/sh
# the next line restarts using wish \
exec wish8.4 "$0" "$@"

package require tcl3d

set ambient #00d0d0
set specular #ffff00
set material #eeeeee
set emission #000000

set shinines 25.0

# Stellt Hintergrundfehler in einem Dialog dar
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg"
    exit
}

# Wird einmal bei der Initialisierung aufgerufen, 
# setzt die Position des Lichts
proc tclCreateFunc { toglwin } {

    # Hintergrundfarbe
    glClearColor 0.0 0.0 0.0 0.0

    #glPolygonMode GL_FRONT_AND_BACK GL_LINE
    glShadeModel GL_SMOOTH
    glEnable GL_DEPTH_TEST

    # Definiert eigenes Licht
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0
    set light_position { 1.0 1.0 1.0 0.0 }
    glLightfv GL_LIGHT0 GL_POSITION $light_position

    # Schaltet Materialspezifisches Licht an
    glColorMaterial GL_FRONT GL_DIFFUSE
    glEnable GL_COLOR_MATERIAL

    # Initiales Setzen der Farbe
    farbe

}

# Wird für jedes Anzeigen aufgerufen, 
# zeichnet eine neue Kugel. 
proc tclDisplayFunc { toglwin } {
    # Löscht bisherige Geometrie
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    # Erzeugt Kugel
    glutSolidSphere 1.0 32 32 
    glFlush
}

# Wird bei jeder Änderung der Farben aufgerufen, 
# setzt Materialfarbe
proc farbe { args } {

    # Lichtfarbe
    glLightfv GL_LIGHT0 GL_AMBIENT  [ farbe2liste $::ambient] 

    # Materialfarbe
    glMaterialf GL_FRONT GL_SHININESS $::shinines
    glMaterialfv GL_FRONT GL_SPECULAR [ farbe2liste $::specular]

    glMaterialfv GL_FRONT GL_EMISSION [ farbe2liste $::emission]

    glColor4fv [ farbe2liste $::material]

    .fr.toglwin postredisplay
}

# Wandel HEX-Farbe in RGB-Liste 
proc farbe2liste { farbe } {
    set retval {}
    set liste [ winfo rgb . $farbe ]
    foreach c $liste {
	lappend retval [expr $c / 65535.0]
    }
    return $retval
}

# Wird bei der Größenänderung des Fensters aufgerufen 
proc tclReshapeFunc { toglwin  w h } {
    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    if { $w <= $h } {
        glOrtho -1.5 1.5 [expr -1.5*double($h)/double($w)] \
                [expr 1.5*double($h)/double($w)] -10.0 10.0
    } else {
        glOrtho [expr -1.5*double($w)/double($h)] \
                [expr 1.5*double($w)/double($h)] -1.5 1.5 -10.0 10.0
    }
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
}


wm title . "Listing 5: Farbe und Beleuchtung"
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 500 -height 500 -double false -depth true \
                 -createproc tclCreateFunc \
                 -reshapeproc tclReshapeFunc \
                 -displayproc tclDisplayFunc 

grid .fr.toglwin -row 0 -column 0 -columnspan 3 -sticky news

label .fr.ambientL -text "Ambient" -anchor e
button .fr.ambient -background $::ambient -command {
    set neu [ tk_chooseColor  -initialcolor $::ambient ]
    if { [string length $neu] > 0 } {
	set ::ambient $neu
	.fr.ambient conf -background $neu
	farbe
    }
}
grid .fr.ambientL .fr.ambient -row 2  -sticky ew

label .fr.reflexL -text "Reflex" -anchor e
button .fr.reflex -background $::specular -command {
    set neu [ tk_chooseColor  -initialcolor $::specular ]
    puts $neu
    if { [string length $neu] > 0 } {
	puts a
	set ::specular $neu
	.fr.reflex configure -background $neu
	farbe
    }
}

grid .fr.reflexL .fr.reflex -row 4 -sticky ew

label .fr.shineL -text "Reflex Stärke"  -anchor e
scale .fr.shine -orient horizontal -from 0 -to 128 \
     -showvalue false  -variable shinines -command farbe
grid .fr.shineL  .fr.shine -row 5 -sticky ew


label .fr.matL -text "Material" -anchor e
button .fr.mat -background $::material -command {
    set neu [ tk_chooseColor  -initialcolor $::material ]
    if { [string length $neu] > 0 } {
	set ::material $neu
	.fr.mat configure -background $neu
	farbe
    }
}

grid .fr.matL .fr.mat -row 6 -sticky ew


label .fr.emL -text "Leuchtfarbe" -anchor e
button .fr.em -background $::emission -command {
    set neu [ tk_chooseColor  -initialcolor $::emission ]
    if { [string length $neu] > 0 } {
	set ::emission $neu
	.fr.em configure -background $neu
	farbe
    }
}

grid .fr.emL .fr.em -row 7 -sticky ew

grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 1 -weight 2