#!/bin/sh 
# now start wish, whereever it is \
exec wish "$0" "$@"
##############################################################################
# TKMatman by Andreas Butz <butz@cs.uni-sb.de> 
# Version 1.7, 01/25/99
# This version was tested with BMRT 2.4beta and Tcl 4.2 and 8.0
# it might fail with substantially older versions.
# Home page at http://www.butz.org/~butz/tkmatman/index.html
##############################################################################
# external commands, change here, make sure they are in your PATH...
##############################################################################

set rendrib "rendrib -silent -d 16"
set sotell "slctell"

##############################################################################
# global vars, default values may be changed...
##############################################################################

# Default value for the environment variable SHADERS
set shaderpathdefault "/usr/local/BMRT/shaders:/usr/local/shaders:/opt/BMRT2.4/shaders"

# Default directory for temporary files, /temp on windows, /tmp on unix 
# you might change that to create the rib files for the test rendering
# in another place, maybe to preserve them...
set tmpdir "/temp"
if { "[glob -nocomplain /tmp]" == "/tmp" } then {
  set tmpdir "/tmp"
}

# Default values for the rendering parameters as they appear in the 
# GUI. Change to your taste...
set imagesize 128
set pixelsamples 1
set gain 1.0
set gamma 1.0
set geomtype sphere
set geomfile ""

# Default values for the TKMatman switches in the GUI
# Changing this might save you one mouse click each time you start tkmatman...
set usescrollbars 0
set usewindows 0
set sliderrange 5

# Default values for subtle changes in the TKMatman behaviour

# This can be set to "" or "\n" to put the declare statements 
# in separate lines
set declarenewline "\n"

# This can be "word", "char" or "none", sets wrapping in the RIB code window 
set wrapribcode "word"

##############################################################################
# more global vars, you shouldn't have to change anything below this line
##############################################################################

set version 1.7

# determine whether we run on windows or unix (Mac is not supported).
set runonwindows [expr [string compare [lindex [array get tcl_platform platform] 1] "windows"] == 0]

set shadertypes {surface displacement imager light interior exterior atmosphere}

foreach type $shadertypes {
    set $type-shadername ""
    set $type-argnames ""
    set $type-argtypes ""
}

set commonargs-argnames "Gain Gamma"
set commonargs-gain-value $gain
set commonargs-gamma-value $gamma

set shadertype ""
set shadername ""
set shaderarguments ""
set argnames ""
set argtypes ""

set allshaders ""
set allshadernames ""
set longestshadername 1
set lightnumber 1
set output ""

set color-red 1
set color-green 1
set color-blue 1
set opacity-red 1
set opacity-green 1
set opacity-blue 1

##############################################################################
# some toplevel widget names
##############################################################################

set top .top

foreach type $shadertypes {
    set $type-pane $top.$type
}

frame $top
pack $top -anchor nw
bind . <Escape> "exit"

##############################################################################
# call the TCL-TK builtin color dialog box from a color slider
##############################################################################

proc open-color-dialog { shadertype name inframe } {
    global $shadertype-$name-red $shadertype-$name-green $shadertype-$name-blue $shadertype-$name-hexcolor

    set newcolor [tk_chooseColor -initialcolor [set $shadertype-$name-hexcolor] -title $name]

    if { $newcolor != "" } then {
        set $shadertype-$name-hexcolor $newcolor
	set $shadertype-$name-red [expr "0x[string range $newcolor 1 2]" / 255.0]
	set $shadertype-$name-green [expr "0x[string range $newcolor 3 4]" / 255.0]
	set $shadertype-$name-blue [expr "0x[string range $newcolor 5 6]" / 255.0]
    }
    update-color $shadertype $inframe $name 0
}

proc update-color { type inframe name value } {
    global $type-$name-red $type-$name-green $type-$name-blue $type-$name-hexcolor
    set hexcolor [format "#%02x%02x%02x" \
		      [expr round([set $type-$name-red]*255)] \
		      [expr round([set $type-$name-green]*255)] \
		      [expr round([set $type-$name-blue]*255)]]
    set compcolor [format "#%02x%02x%02x" \
		      [expr round(255-[set $type-$name-red]*255)] \
		      [expr round(255-[set $type-$name-green]*255)] \
		      [expr round(255-[set $type-$name-blue]*255)]]
    $inframe.$name.show config -bg $hexcolor -activebackground $hexcolor \
	-fg $compcolor -activeforeground black
    set $type-$name-hexcolor $hexcolor
}

###############################################################################
# create a color slider for the shader's color arguments
###############################################################################

proc create-color-slider { inframe name } {
    global shadertype
    global $shadertype-$name-red $shadertype-$name-green $shadertype-$name-blue $shadertype-$name-hexcolor

    frame $inframe.$name
    frame $inframe.$name.s
    frame $inframe.$name.s.r

    scale $inframe.$name.s.r.s -from 0.0 -to 1.0 -resolution 0.01 -showvalue 0 \
	-variable $shadertype-$name-red -orient horizontal -relief raised \
	-troughcolor red -command "update-color $shadertype $inframe $name" 
    entry $inframe.$name.s.r.e -textvariable $shadertype-$name-red -width 6
    pack $inframe.$name.s.r.s $inframe.$name.s.r.e \
	-in $inframe.$name.s.r -side left
    
    frame $inframe.$name.s.g
    scale $inframe.$name.s.g.s -from 0.0 -to 1.0 -resolution 0.01 -showvalue 0 \
	-variable $shadertype-$name-green -orient horizontal -relief raised \
	-troughcolor green -command "update-color $shadertype $inframe $name"
    entry $inframe.$name.s.g.e -textvariable $shadertype-$name-green -width 6
    pack $inframe.$name.s.g.s $inframe.$name.s.g.e \
	-in $inframe.$name.s.g -side left
    
    frame $inframe.$name.s.b
    scale $inframe.$name.s.b.s -from 0.0 -to 1.0 -resolution 0.01 -showvalue 0 \
	-variable $shadertype-$name-blue -orient horizontal -relief raised \
	-troughcolor blue -command "update-color $shadertype $inframe $name"
    entry $inframe.$name.s.b.e -textvariable $shadertype-$name-blue -width 6
    pack $inframe.$name.s.b.s $inframe.$name.s.b.e \
	-in $inframe.$name.s.b -side left
    
    pack $inframe.$name.s.r -in $inframe.$name.s -side top 
    pack $inframe.$name.s.g -in $inframe.$name.s -side top 
    pack $inframe.$name.s.b -in $inframe.$name.s -side top 
    pack $inframe.$name.s -in $inframe.$name -side right -fill y
    
    button $inframe.$name.show -text $name -command "open-color-dialog $shadertype $name $inframe"
    pack $inframe.$name.show -in $inframe.$name -side left -fill both -expand yes
    pack $inframe.$name -in $inframe -side top -fill both
}

###############################################################################
# create a scalar slider for the shader's scalar arguments
###############################################################################

proc create-scalar-slider { inframe name } {
    global shadertype sliderrange
    global $shadertype-$name-value 
    if {[set $shadertype-$name-value] == 0} then {
	set max 1.0
    } else {
	set max [expr [set $shadertype-$name-value] * $sliderrange ]
    }
    frame $inframe.$name
    label $inframe.$name.l -text [find-argument-name $name]
    scale $inframe.$name.s -from 0.0 -to $max \
	-resolution [expr $max / 100] -showvalue 0 \
	-variable $shadertype-$name-value -orient horizontal -relief raised
    entry $inframe.$name.e -textvariable $shadertype-$name-value -width 6
    pack $inframe.$name.e $inframe.$name.s \
	-in $inframe.$name -side right
    pack $inframe.$name.l -in $inframe.$name -side left -fill x -expand yes
    pack $inframe.$name -in $inframe -side top -fill x
}    

##############################################################################
# call the TCL-TK builtin color dialog box from a color slider
##############################################################################

proc open-file-dialog { shadertype name inframe } {
    global $shadertype-$name-value

    set types {{{TIFF Files} {.tif .tiff}} {{Text Files} {.txt}} {{All Files} *}}

    set $shadertype-$name-value [tk_getOpenFile -title $name -filetypes $types]
}

###############################################################################
# create a string entry for the shader's string arguments
###############################################################################

proc create-string-entry { inframe name } {
    global shadertype
    global $shadertype-$name-value 

    frame $inframe.$name
#    label $inframe.$name.label -text $name
    button $inframe.$name.label -padx 2 -pady 0 -text $name -command "open-file-dialog $shadertype $name $inframe"
    entry $inframe.$name.entry -width 22 -textvariable $shadertype-$name-value
    pack $inframe.$name.label -in $inframe.$name -side left -fill x -expand yes 
    pack $inframe.$name.entry -in $inframe.$name -side left -fill x
    pack $inframe.$name -in $inframe -side top -fill x
}

###############################################################################
# create three real entries for the shader's point arguments
###############################################################################

proc create-point-entry { inframe name } {
    global shadertype
    global $shadertype-$name-x $shadertype-$name-y $shadertype-$name-z
    frame $inframe.$name
    label $inframe.$name.label -text $name
    entry $inframe.$name.x -width 6 -textvariable $shadertype-$name-x
    entry $inframe.$name.y -width 6 -textvariable $shadertype-$name-y
    entry $inframe.$name.z -width 6 -textvariable $shadertype-$name-z
    pack $inframe.$name.label -in $inframe.$name -side left -fill x -expand yes 
    pack $inframe.$name.x $inframe.$name.y $inframe.$name.z \
	-in $inframe.$name -side left -fill x
    pack $inframe.$name -in $inframe -side top -fill x
}

##############################################################################
# read the available shader names
##############################################################################

proc scan-all-shaders {} {
    global shadername longestshadername shaderpathdefault shaderpathoption
    global allshaders allshadernames shaderarray runonwindows
    global env
    set i 0
    set allshaders ""
    if {[string length [array names env SHADERS]] == 0} then {
	array set env "SHADERS $shaderpathdefault"
	tk_dialog .shaders "SHADERS variable" "Environment variable SHADERS not set, assuming default: $shaderpathdefault" "" 0 "OK"
    }
    set spathstr $env(SHADERS) 
    regsub -all {\\} $spathstr {/} spathstr
    if $runonwindows then {
	regsub -all ";" $spathstr " " spathstr
	set shaderpathoption "Option \"searchpath\" \"shader\" \["
    } else {
	regsub -all ":" $spathstr " " spathstr
	set shaderpathoption "Option \"searchpath\" \"shader\" \[\""
    }
    foreach p $spathstr {
	append allshaders "[glob -nocomplain $p/*.slc] "
	if $runonwindows then {
	    append shaderpathoption "\"$p\" "
	} else {
	    append shaderpathoption "$p:"
	}
    }
    if $runonwindows then {
	append shaderpathoption "\]"
    } else {
	append shaderpathoption "\"\]"
    }
    foreach s $allshaders {
	regsub -all "/|\.slc" $s " " dummy
	set dummy [lindex $dummy end]
	lappend allshadernames $dummy
	array set shaderarray "$dummy $s"
	set l [string length $dummy]
	if {$l > $longestshadername} then {set longestshadername $l}
    }
    set allshadernames [lsort $allshadernames]
    set allshadernames [luniq $allshadernames]
}

proc luniq { list } {
    set newlist ""
    set oldelement ""
    foreach element $list {
	if {[string compare $element $oldelement] != 0} then {
	    set oldelement $element
	    append newlist " $element"
	}
    }
    return $newlist
}

##############################################################################
# make a listbox with shader names 
##############################################################################

proc create-shaders-listbox { } {
    global brws 
    global longestshadername allshadernames 

    set browser $brws.brws
    scan-all-shaders
    set boxwidth $longestshadername
    if [expr $boxwidth < 28] {set boxwidth 28}

    frame $browser -relief raised -bd 3
    frame $browser.box
    scrollbar $browser.box.scroll -command "$browser.box.list yview"
    listbox $browser.box.list -yscroll "$browser.box.scroll set" \
	-relief sunken -width $boxwidth -height 10 -setgrid yes
    pack $browser.box.list -in $browser.box -side left -fill both -expand yes
    pack $browser.box.scroll -in $browser.box -side right -fill y
    pack $browser.box -in $browser -side top -fill both -expand yes
    $browser.box.list delete 0 end
    foreach i $allshadernames {
	$browser.box.list insert end $i
    } 
    set shadername [lindex $allshadernames 0]
    pack $browser -in $brws -side top -fill both -expand yes
    bind $browser.box.list <Double-Button-1> \
	{set shadername [selection get]; update-gui}
}

##############################################################################
# make some command buttons 
##############################################################################

proc create-action-buttons { } {
    global brws shadername
    set buttons $brws.buttons
    frame $buttons -relief raised -bd 3
    button $buttons.rib -text "RIB" -command "create-ribcode-frame"
    pack $buttons.rib -in $buttons -side left -fill x -expand yes
    button $buttons.rend -text "Test" -command render-test-frame
    pack $buttons.rend -in $buttons -side left -fill x -expand yes
    button $buttons.help -text "Help" -command create-help-frame
    pack $buttons.help -in $buttons -side left -fill x -expand yes
    button $buttons.quit -text Quit -command exit
    pack $buttons.quit -in $buttons -side left -fill x -expand yes
    pack $buttons -in $brws -side top -fill x -expand yes
}

##############################################################################
# make switches for tkmatman behaviour
##############################################################################

proc create-matman-switches { } {
    global brws usescrollbars usewindows sliderrange
    set switches $brws.switches
    frame $switches -relief raised -bd 3

    checkbutton $switches.scroll -text "scrollbars" \
	-variable usescrollbars -onvalue 1 -offvalue 0 \
	-indicatoron false -selectcolor grey
    pack $switches.scroll -in $switches -side left -fill x -expand yes

    checkbutton $switches.win -text "windows" \
	-variable usewindows -onvalue 1 -offvalue 0 \
	-indicatoron false -selectcolor grey
    pack $switches.win -in $switches -side left -fill x -expand yes

    frame $switches.range
    label $switches.range.l -text "slider range" -anchor w
    entry $switches.range.e -width 2 -textvariable sliderrange
    pack $switches.range.l -in $switches.range -side left -fill y
    pack $switches.range.e -in $switches.range -side left -fill both -expand yes
    pack $switches.range -in $switches -side left -fill x -expand yes

    pack $switches -in $brws -side top -fill x -expand yes
}

##############################################################################
# make buttons and fields for the rendering options
##############################################################################

proc create-parameter-frame { } {
    global brws shadertype
    global geomtype geomfile imagesize pixelsamples gain gamma

    set params $brws.params
    frame $params -relief raised -bd 3

    set gtype $params.geomtype
    set file $params.file
    frame $gtype
    foreach type { sphere cone cylinder cube patch } {
	radiobutton $gtype.$type -variable geomtype -value $type \
	    -text $type -indicatoron false -selectcolor grey \
	    -command "$file.label config -state disabled -fg grey; $file.entry config -state disabled -fg grey; focus $gtype"
	pack $gtype.$type -in $gtype -side left -fill x -expand yes
    }
    radiobutton $gtype.file -variable geomtype -value file -text $type \
	-text "file" -indicatoron false -selectcolor grey \
	-command "$file.label config -state normal -fg black; $file.entry config -state normal -fg black; focus $file.entry"
    pack $gtype.file -in $gtype -side left -fill x -expand yes
    pack $gtype -in $params -side top -fill x -expand yes
    
    frame $file
    entry $file.entry -width 10 -textvariable geomfile
    button $file.label -padx 2 -pady 0 -text "input file" -command {set geomfile [tk_getOpenFile -filetypes {{{RIB files} {.rib}} {{all files} {.*}}} -defaultextension {.rib}]}
    pack $file.label -in $file -side left -fill none
    pack $file.entry -in $file -side left -fill both -expand yes
    pack $file -in $params -side top -fill x -expand yes
    $gtype.$geomtype invoke

    set size $params.size
    frame $size

    label $size.sizelabel -text " Image size " -anchor w
    entry $size.sizeentry -width 4 -textvariable imagesize
    pack $size.sizelabel -in $size -side left -fill y
    pack $size.sizeentry -in $size -side left -fill both -expand yes

    label $size.samplabel -text "Pixel samples" -anchor w
    entry $size.sampentry -width 2 -textvariable pixelsamples
    pack $size.samplabel -in $size -side left -fill y
    pack $size.sampentry -in $size -side left -fill both -expand yes
    pack $size -in $params -side top -fill x -expand yes

    set shadertype "commonargs"
    create-scalar-slider $params gain
    create-scalar-slider $params gamma

    pack $params -in $brws -side top -fill x -expand yes
}

##############################################################################
# make sliders for the common parameters color and opacity
##############################################################################

proc create-common-args { } {
    global commonargs brws shadertype
    global commonargs-color-red commonargs-color-green commonargs-color-blue
    global commonargs-opacity-red commonargs-opacity-green commonargs-opacity-blue
    global commonargs-gain-value commonargs-gamma-value

    set commonargs $brws.commonargs
    set shadertype "commonargs"
    set commonargs-color-red 1
    set commonargs-color-green 1
    set commonargs-color-blue 1
    set commonargs-opacity-red 1
    set commonargs-opacity-green 1
    set commonargs-opacity-blue 1
    frame $commonargs -relief raised -bd 3
    create-color-slider $commonargs color
    create-color-slider $commonargs opacity
    set shadertype ""
    pack $commonargs -in $brws -side top -fill x -expand yes
}

##############################################################################
# create a toplevel frame with a help text
##############################################################################

proc create-help-frame { } {
    global version shadertypes
    set help .help

    set text " TKMatman Help " 
    set wmname $text

    if [winfo exists $help] {destroy $help}
    toplevel $help
    wm title $help $wmname

    frame $help.contents
    text $help.contents.text -wrap word -relief sunken -bd 2 -yscrollcommand\
	    "$help.contents.scroll set" -setgrid true -height 30 -width 80
    scrollbar $help.contents.scroll -command "$help.contents.text yview"
    pack $help.contents.scroll -side right -fill y -in $help.contents
    pack $help.contents.text -expand yes -fill both -in $help.contents

    frame $help.header
    label $help.header.label -relief flat -text $text
    button $help.header.close -command "destroy $help" -text Close

    bind $help <Escape> "destroy $help"

    pack $help.header.close -in $help.header -side right
    pack $help.header.label -fill x -in $help.header -side left
    pack $help.header -in $help -side top -fill x
    pack $help.contents -in $help -side top -fill both -expand yes

    set contents "Welcome to TKMatman, Version $version by A. Butz

DESCRIPTION:
  TKMatman allows you to adjust Parameters for RenderMan shaders, render test frames with these settings and write them to a window as RIB code. TKMatman can be used for surface, displacement, imager, light, interior, exterior, atmosphere shaders and their combinations. It uses the BMRT package to render test images and scans the compiled shader files (.slc) to find out about shader arguments.

PLATFORMS:
  TKMatman runs on various kinds of UNIX (tested on Linux, Solaris, IRIX) and on Windows '95/NT. It is written in TCL-TK and requires TK 4.2 or above. It also requires the BMRT package, version 2.3.6 or above.

GENERAL USAGE:
  After starting TKMatman you see a list of available shaders. If you don't see any, your SHADERS variable isn't set properly. Select one of the shaders in the list by double-clicking on it. The appropriate sliders or editable fields will appear in a new box at the right side. The top of this new box contains the shader type, name and a button to deselect it. If another shader of the same type is selected from the list, the former one is automatically replaced, since it makes no sense to have two shaders of the same type. If you select shaders of different types, they will appear one besides each other. This way you can combine a surface and a displacement shader for example. Selecting a light shader replaces the default lights that are used to render the other shader types by a light source with the selected shader. If a volume shader is selected, a dialog box appears to assign it to the interior, exterior or atmosphere shader. The button RIB at the bottom left side of the main panel shows a RIB specification of the selected parameters in a text window, from where you can cut and paste it. Test renders a test frame, Help and Quit do the obvious.

PARAMETER TYPES:
  The shader parameters generate appropriate sliders or editable fields. You can adjust the value of a FLOAT parameter by using the slider or by entering a value in the field directly. However, you can only enter values within the range of the slider. The default range for sliders is from 0 to 5 times their default value or 1, if this is zero. To change this, change the value of the 'slider range' field in the options box. By clicking on the big colored button of a color slider you can open the platform specific color selection box. 

OPTIONS:
  Below the shader list is a box with general options. The upper ones control the behavior of TKMatman, while the lower ones control rendering parameters. If 'scrollbars' is selected, large shaders will be displayed in one column wih a scrollbar, otherwise in several columns. If 'windows' is selected, each shader will open its own toplevel window. Otherwise it will just open a frame inside the TKMatman window. The buttons sphere - patch select geometric primitives to be used in the test frame. By selecting the file button and entering a file name below, a RIB file can be used as the geometry for the test frame. By clicking on the 'input file' button a file can be selected in a platform specific file selection box. This file must specify all necessary translations and rotations to show the given objects in the frame. It must NOT contain any other statements, such as 'begin world' and 'end world'. For reference see the example files on the TKMatman home page. Image size controls the size of the rendered test frame, Pixel samples adjusts the supersampling rate (must be a positive whole number). The Gain and Gamma sliders control the gain and gamma of the exposure process (see RenderMan spec). The sliders for color and opacity adjust the corresponding global RenderMan settings.

SHORTCUTS:
  The Escape key exits single windows as well as the whole program and the testframe displayed by rendrib.

ENVIRONMENT:
  Set your environment variable SHADERS to the place where your compiled shader files (*.slc) live. If you work in an X environment, the DISPLAY variable also has to be set properly. The program rendrib has to be within your PATH.

BUGS:
  Starting a new test frame before the last one is finished may kill the first one, since the corresponding RIB file may be overwritten. No other bugs are yet known, tell me if you find some...

DISTRIBUTION:
  TKMatman was written by Andreas Butz, butz@cs.uni-sb.de. It may be distributed freely without modification. In case you use it for something commercial I'd like to know about it and see my name in the credits list, though. If you find the program useful, you have the choice between different kinds of payment: 1.) send me some cookies or bisquits, 2.) offer me a good job, 3.) distribute it to other people and tell them to do 1.) or 2.). Any combination of the above as well as any general comments and feedback on TKMatman are welcome. General RenderMan questions should be directed to the corresponding FAQs, BMRT questions to Larry Gritz <lg@pixar.com>. The TKMatMan home page is at http://www.butz.org/~butz/tkmatman/index.html

CREDITS:
  A bug fix was provided by Florian Hars <hars@math.uni-hamburg.de>. The original MatMan program for the SGI was written by Sam Samai <sams@molly.cs.monash.edu.au> The BMRT package was written by Larry Gritz <lg@pixar.com>, TCL/TK was written by John Ousterhout <john.ousterhout@eng.sun.com>."

    $help.contents.text insert end $contents
}

##############################################################################
# create the fix part of the gui
##############################################################################

proc create-fix-part { } {
    global top brws version
    set brws $top.browser
    frame $brws 
    create-shaders-listbox
    create-matman-switches
    create-parameter-frame
    create-common-args
    create-action-buttons
    pack $brws -in $top -side left -anchor n
    wm title . "TKMatman $version by A. Butz"
    update
    wm resizable . 0 0
}

##############################################################################
# find the arguments of a selected shader
##############################################################################

proc scan-shader-arguments2 {} {
    global shadername shadertype shaderarray
    global top brws shadertypes
    foreach type $shadertypes { global $type }
    global shadertype shaderarguments argnames argtypes
 
    set shaderfile [lindex [array get shaderarray $shadername] 1]
    set shaderstream [open $shaderfile r]
    set shaderarguments [read $shaderstream]
    close $shaderstream

    set shadertype [lindex $shaderarguments 0]
    if { $shadertype == "version" } {
      # maybe the first line was of the form "version BMRT 2.4.0besa"
      # and the shadertype comes after that
      set shadertype [lindex $shaderarguments 3]
    }

    if {[string compare $shadertype "volume"] == 0} assign-volume-shader
    global $shadertype-shadername $shadertype-argnames $shadertype-argtypes
    set $shadertype-shadername $shadername

    set argnames ""
    set argtypes ""

    set i [lsearch -exact $shaderarguments "param"]
    if {$i == -1} then {
	set shaderarguments ""
    } else {
	set shaderarguments [lrange $shaderarguments [expr $i + 1] end]
    }

    while { $i > 0 } {
	set arg [lindex $shaderarguments 0]
	set name [lindex $shaderarguments 1]
	append argnames " $name"
	append argtypes " $arg"
	set name [string tolower $name]
	switch $arg {
	    color {
		global $shadertype-$name-red $shadertype-$name-green \
		    $shadertype-$name-blue
		set $shadertype-$name-red [lindex $shaderarguments 2]
		set $shadertype-$name-green [lindex $shaderarguments 3]
		set $shadertype-$name-blue [lindex $shaderarguments 4]
		incr i 4 }
	    point {
		global $shadertype-$name-x $shadertype-$name-y \
		    $shadertype-$name-z
		set $shadertype-$name-x [lindex $shaderarguments 2]
		set $shadertype-$name-y [lindex $shaderarguments 3]
		set $shadertype-$name-z [lindex $shaderarguments 4]
		incr i 4 }
	    vector {
		global $shadertype-$name-x $shadertype-$name-y \
		    $shadertype-$name-z
		set $shadertype-$name-x [lindex $shaderarguments 2]
		set $shadertype-$name-y [lindex $shaderarguments 3]
		set $shadertype-$name-z [lindex $shaderarguments 4]
		incr i 4 }
	    scalar {
		global $shadertype-$name-value
		set $shadertype-$name-value \
		    [lindex $shaderarguments 2]
		incr i 2 }
	    float {
		global $shadertype-$name-value
		set $shadertype-$name-value \
		    [lindex $shaderarguments 2]
		incr i 2 }
	    string {
		global $shadertype-$name-value
		set $shadertype-$name-value \
		    [lindex $shaderarguments 2]
		incr i 2
	    }
	    default {bgerror "Unknown argument type: $arg"; return}
	}
	set i [lsearch -exact $shaderarguments "param"]
	if {$i == -1} then {
	    set shaderarguments ""
	} else {
	    set shaderarguments [lrange $shaderarguments [expr $i + 1] end]
	}
    }
    set $shadertype-argnames $argnames
    set $shadertype-argtypes $argtypes
}

##############################################################################
# find the arguments of a selected shader (new version)
##############################################################################

proc scan-shader-arguments {} {
    global sotell shadername shadertype
    global top brws shadertypes
    foreach type $shadertypes { global $type }
    global shadertype shaderarguments argnames argtypes
 
    set shaderarguments [exec $sotell $shadername]
    regsub -all {\[|\]|uniform\ |Default\ value:} $shaderarguments "" shaderarguments

    set shadertype [lindex $shaderarguments 0]
    if {[string compare $shadertype "volume"] == 0} assign-volume-shader
    global $shadertype-shadername $shadertype-shaderarguments
    global $shadertype-argnames $shadertype-argtypes
    set $shadertype-shadername $shadername
    set shaderarguments [lrange $shaderarguments 2 end]
    set $shadertype-shaderarguments $shaderarguments

    set i 0
    set l [llength $shaderarguments]
    
    set argnames ""
    set argtypes ""

    while { $i < $l } {
	set name [lindex $shaderarguments $i]
	set arg [lindex $shaderarguments [expr $i + 1]]
	lappend argnames $name
	lappend argtypes $arg
	set name [string tolower $name]
	switch $arg {
	    color {
		global $shadertype-$name-red $shadertype-$name-green \
		    $shadertype-$name-blue
		set $shadertype-$name-red [lindex $shaderarguments [expr $i + 3]]
		set $shadertype-$name-green [lindex $shaderarguments [expr $i + 4]]
		set $shadertype-$name-blue [lindex $shaderarguments [expr $i + 5]]
		incr i 5 }
	    point {
		global $shadertype-$name-x $shadertype-$name-y \
		    $shadertype-$name-z
		set $shadertype-$name-x [lindex $shaderarguments [expr $i + 3]]
		set $shadertype-$name-y [lindex $shaderarguments [expr $i + 4]]
		set $shadertype-$name-z [lindex $shaderarguments [expr $i + 5]]
		incr i 5 }
	    vector {
		global $shadertype-$name-x $shadertype-$name-y \
		    $shadertype-$name-z
		set $shadertype-$name-x [lindex $shaderarguments [expr $i + 3]]
		set $shadertype-$name-y [lindex $shaderarguments [expr $i + 4]]
		set $shadertype-$name-z [lindex $shaderarguments [expr $i + 5]]
		incr i 5 }
	    scalar {
		global $shadertype-$name-value
		set $shadertype-$name-value \
		    [lindex $shaderarguments [expr $i + 2]]
		incr i 2 }
	    float {
		global $shadertype-$name-value
		set $shadertype-$name-value \
		    [lindex $shaderarguments [expr $i + 2]]
		incr i 2 }
	    string {
		global $shadertype-$name-value
		set $shadertype-$name-value \
		    [lindex $shaderarguments [expr $i + 2]]
		incr i 2
	    }
	    default {tkerror "Unknown argument type: $arg"; return}
	}
	incr i
    }
    set $shadertype-argnames $argnames
    set $shadertype-argtypes $argtypes
}

##############################################################################
# shader arg. names may contain uppercase letters while TCL var names may not.
##############################################################################

proc find-argument-name {name} {
    global shadertype
    global $shadertype-argnames
    foreach rname [set $shadertype-argnames] {
	if {[string compare $name [string tolower $rname]]==0} {return $rname}
    }
    return $name
}

##############################################################################
# Wow, guy, I'm impressed. You read so far through my code and you are
# even reading the comments.... This doesn't happen very often!
# I felt it's about time to put an easteregg somewhere into my code,
# but I don't have a good idea yet. If you have one, let me know!
##############################################################################

##############################################################################
# volume shaders can be used as interior, exterior or atmosphere shaders..
##############################################################################

proc assign-volume-shader {} {
    global shadername shadertype
    global shaderarguments argnames argtypes
    set possibletypes {interior exterior atmosphere}
    
    set choice [global shadername; tk_dialog .assign "volume shader" \
		    "Use volume shader $shadername as" "" 2 \
		    "interior" "exterior" "atmosphere"]
    set shadertype "[lindex {interior exterior atmosphere} $choice]"
}

##############################################################################
# update the whole gui
##############################################################################
# Sorry, this procedure got really messy with the recent additions.
# I normally hate to write that kind of code...

proc update-gui {} {
    global top brws shadertypes usescrollbars usewindows
    global shadername shadertype argnames argtypes

    foreach type $shadertypes { global $type-pane }

    if {[string compare $shadername ""] != 0} {
	scan-shader-arguments
	if {[lsearch -exact $shadertypes $shadertype] >= 0 } then {

# destroy any existing pane of that shader type
	    if {[winfo exists [set $shadertype-pane]]} {destroy [set $shadertype-pane]}

	    if $usewindows {
# if we use separate windows, make a new toplevel
		set pane [set $shadertype-pane .toplevel-$shadertype]
		toplevel $pane
		frame $pane.f -relief raised -bd 3
		pack $pane.f -in $pane -anchor nw
		wm title $pane "$shadername"
		wm resizable $pane 0 0
		bind $pane <Escape> "$pane.f.stat.clear invoke"
		set pane $pane.f
	    } else {
# otherwise, just put it into the top frame
		set pane [set $shadertype-pane $top.$shadertype]
		frame $pane -relief raised -bd 3
	    }

	    set i 0
	    set l [llength $argnames]

# first, create a fixed title line to each shadertype
	    frame $pane.stat 
	    label $pane.stat.label -text $shadertype -anchor w
	    global $shadertype-shadername
	    label $pane.stat.entry -width 10 -text [ set $shadertype-shadername ] -relief sunken 
	    button $pane.stat.clear -text "clear" -padx 4 -pady 0 -command \
		"set $shadertype-shadername \"\"\; set shadername \"\"\; foreach s \[pack slaves $pane\] {destroy \$s}\; if \{\"\[winfo toplevel $pane\]\" != \".\"\} \{destroy [winfo toplevel $pane]\} else {destroy $pane}\; update-gui"
	    pack $pane.stat.label -in $pane.stat -side left -fill x
	    pack $pane.stat.entry -in $pane.stat -side left -fill x -expand yes
	    pack $pane.stat.clear -in $pane.stat -side left -fill none
	    pack $pane.stat -in $pane -side top -fill x -expand yes
	    
# then comes the changing part
	    frame $pane.dyn 
	    canvas $pane.dyn.canvas -relief flat -borderwidth 0 
	    frame $pane.dyn.canvas.parm

# first attempt: pack all sliders into one frame
	    while { $i < $l } {
		set name [string tolower [lindex $argnames $i]]
		set type [lindex $argtypes $i]
		switch $type {
		    color {
			create-color-slider $pane.dyn.canvas.parm $name
		    }
		    point {
			create-point-entry $pane.dyn.canvas.parm $name
		    }
		    vector {
			create-point-entry $pane.dyn.canvas.parm $name
		    }
		    scalar {
			create-scalar-slider $pane.dyn.canvas.parm $name
		    }
		    float {
			create-scalar-slider $pane.dyn.canvas.parm $name
		    }
		    string {
			create-string-entry $pane.dyn.canvas.parm $name
		    }
		    default {bgerror "Unknown argument type: $type"}
		}
		incr i
	    }
	    update

# now, check if the frame fits onto the screen
	    set fullheight [winfo reqheight $pane.dyn.canvas.parm]
#	    set availableheight [expr [winfo height .] - [winfo reqheight $pane.stat] - 10]
	    set availableheight [expr [winfo screenheight .] - [winfo reqheight $pane.stat] - 65]

	    if {$fullheight <= $availableheight} {
# if so, just display it
		$pane.dyn.canvas configure -width [winfo reqwidth $pane.dyn.canvas.parm] -height $fullheight
		$pane.dyn.canvas create window 0 0 -anchor nw -window $pane.dyn.canvas.parm
	    } else {
		if $usescrollbars {
# otherwise, either create a scrollbar for it
		    scrollbar $pane.dyn.scroll -command "$pane.dyn.canvas yview"
		    pack $pane.dyn.scroll -in $pane.dyn -side right -fill y -expand yes

		    $pane.dyn.canvas configure -yscrollcommand "$pane.dyn.scroll set " \
			-width [winfo reqwidth $pane.dyn.canvas.parm] -height $availableheight \
			-scrollregion "0 0 [winfo reqwidth $pane.dyn.canvas.parm] $fullheight"
		    $pane.dyn.canvas create window 0 0 -anchor nw -window $pane.dyn.canvas.parm
		} else {
# or put it into several columns
		    set columns [expr 1 + abs($fullheight / $availableheight)]
		    set goalheight [expr ($fullheight / $columns) + 20]
		    if {$goalheight > $availableheight} {set goalheight $availableheight}
		    set c 1
		    set hpos 0
		    set maxheight 0
		    set actframe $pane.dyn.canvas.parm$c
		    frame $actframe

		    set i 0
		    while { $i < $l } {
			set name [string tolower [lindex $argnames $i]]
			set type [lindex $argtypes $i]
			switch $type {
			    color {
				create-color-slider $actframe $name
			    }
			    point {
				create-point-entry $actframe $name
			    }
			    vector {
				create-point-entry $actframe $name
			    }
			    scalar {
				create-scalar-slider $actframe $name
			    }
			    float {
				create-scalar-slider $actframe $name
			    }
			    string {
				create-string-entry $actframe $name
			    }
			    default {bgerror "Unknown argument type: $type"}
			}
			update
			if {([winfo reqheight $actframe] > $goalheight)} {
			    pack forget [lindex [pack slaves $actframe] end]
			    incr i -1
			    update
			    set maxheight [expr [winfo reqheight $actframe] > $maxheight ? \
					       [winfo reqheight $actframe] : $maxheight]
			    $pane.dyn.canvas create window $hpos 0 -anchor nw -window $actframe
			    incr hpos [winfo reqwidth $actframe]
			    incr c 1
			    set actframe $pane.dyn.canvas.parm$c
			    frame $actframe
			}
			incr i 1
		    }
		    set maxheight [expr [winfo reqheight $actframe] > $maxheight ? \
				       [winfo reqheight $actframe] : $maxheight]
		    $pane.dyn.canvas create window $hpos 0 -anchor nw -window $actframe
		    incr hpos [winfo reqwidth $actframe]
		    $pane.dyn.canvas configure -width $hpos -height $maxheight
		}
	    }

	    if $usewindows {
# if we use separate windows, open the new toplevel
	    } else {
# otherwise, just put it into the top frame
		pack $pane -in $top -side left -anchor ne
	    }
	    
	    pack $pane.dyn.canvas -in $pane.dyn -side right -fill both -expand yes
	    pack $pane.dyn -in $pane -side top -fill x -expand yes
	} else {
	    bgerror "Can't handle $shadertype shaders yet."
	}
    }
}

##############################################################################
# write the arguments of a shader to a stream (not a top-level function !!)
##############################################################################

proc write-arguments { stype argnames argtypes stream } {
    global output
    for {set i 0} {$i < [llength $argnames]} {incr i} {
	set a [lindex $argnames $i]
	append output " \"$a\""
	set a [string tolower $a]
	set atype [lindex $argtypes $i]
	
	switch $atype {
	    scalar { global $stype-$a-value; append output \
			 " [set $stype-$a-value]"}
	    float { global $stype-$a-value; append output \
			 " [set $stype-$a-value]"}
	    string { global $stype-$a-value; append output " \"" \
			 [set $stype-$a-value] "\"" }
	    color { global $stype-$a-red $stype-$a-green $stype-$a-blue; \
			append output " \[ " [set $stype-$a-red] " " \
			[set $stype-$a-green] " " [set $stype-$a-blue] " \]" }
	    point { global $stype-$a-x $stype-$a-y $stype-$a-z; \
			append output " \[ " [set $stype-$a-x] " "\
			[set $stype-$a-y] " " [set $stype-$a-z] " \]" }
	    vector { global $stype-$a-x $stype-$a-y $stype-$a-z; \
			append output " \[ " [set $stype-$a-x] " "\
			[set $stype-$a-y] " " [set $stype-$a-z] " \]" }
	    default {bgerror "Unknown argument type: $atype"}
	}
    }
    puts $stream $output
}

##############################################################################
# declare the arguments of a shader (not a top-level function !!)
##############################################################################

proc write-declares { stype argnames argtypes stream } {
    global output declarenewline
    set output ""
    for {set i 0} {$i < [llength $argnames]} {incr i} {
	set a [lindex $argnames $i]
	append output "Declare  \"$a\" \"uniform "
	set atype [lindex $argtypes $i]
	
	switch $atype {
	    scalar { append output "float\" "}
	    float { append output "float\" "}
	    string { append output "string\" "}
	    color { append output "color\" " }
	    point { append output "point\" " }
	    vector { append output "vector\" " }
	}
	append output $declarenewline
    }
    puts $stream $output
}

##############################################################################
# make some RIB output from the common arguments color and opacity
##############################################################################

proc write-common-args { stream } {
    global commonargs-color-red commonargs-color-green commonargs-color-blue
    global commonargs-opacity-red commonargs-opacity-green commonargs-opacity-blue
    set output "Color \[ [set commonargs-color-red] [set commonargs-color-green] [set commonargs-color-blue] \]"
    puts $stream $output
    set output "Opacity \[ [set commonargs-opacity-red] [set commonargs-opacity-green] [set commonargs-opacity-blue] \]"
    puts $stream $output
}

##############################################################################
# make some RIB output for the selected geometry
##############################################################################

proc write-geometry-statements { stream } {
    global geomtype geomfile
    switch $geomtype { 
	sphere { 
	    puts $stream "Translate 0 0 3.1"
	    puts $stream "Rotate -90 1 0 0"
	    puts $stream "Sphere 1 -1 1 360"
	}
	cone { 
	    puts $stream "Translate 0 -0.8 3.5"
	    puts $stream "Rotate -90 1 0 0"
	    puts $stream "Disk 0 1 360"
	    puts $stream "Cone 2 1 360"
	}
	cylinder { 
	    puts $stream "Translate 0 0.1 4.1"
	    puts $stream "Rotate -125 1 0 0"
	    puts $stream "Disk 1 1 360"
	    puts $stream "Cylinder 1 -1 1 360"
	}
	cube { 
	    puts $stream "Translate 0 0.2 5"
	    puts $stream "Rotate -35 1 0 0"
	    puts $stream "Rotate 45 0 1 0"
	    puts $stream "TextureCoordinates \[ 0 0  0.5 0  0.5 0.5  0 0.5 \]"
	    puts $stream "Polygon \"P\" \[ 1 1 -1  1 -1 -1  -1 -1 -1  -1 1 -1 \] \"N\" \[ 0 0 -1 0 0 -1 0 0 -1 0 0 -1 \]"; # left
	    puts $stream "Polygon \"P\" \[ 1 1 1  1 1 -1  -1 1 -1  -1 1 1 \] \"N\" \[ 0 1 0 0 1 0 0 1 0 0 1 0 \]"; # up
	    puts $stream "Polygon \"P\" \[ 1 1 1  1 1 -1  1 -1 -1  1 -1 1 \] \"N\" \[ 1 0 0 1 0 0 1 0 0 1 0 0 \]"; # right
	    puts $stream "Polygon \"P\" \[ 1 1 1  1 -1 1  -1 -1 1  -1 1 1 \] \"N\" \[ 0 0 1 0 0 1 0 0 1 0 0 1 \]"; # right back
	    puts $stream "Polygon \"P\" \[ 1 -1 1  1 -1 -1  -1 -1 -1  -1 -1 1 \] \"N\" \[ 0 -1 0 0 -1 0 0 -1 0 0 -1 0 \]"; # left back
	    puts $stream "Polygon \"P\" \[ -1 1 1  -1 1 -1  -1 -1 -1  -1 -1 1 \] \"N\" \[ -1 0 0 -1 0 0 -1 0 0 -1 0 0 \]"; # down
	}
	patch {
	  puts $stream "Translate 0 0 4"
	  puts $stream "Rotate -90 1 0 0"
	  puts $stream "Translate 0 0 -0.8"
	  puts $stream "Patch \"bilinear\" \"P\" \[-2 0 3   2 0 3  -2 0 -2  2 0 -2\]"
	}
	file {
	    puts $stream "ReadArchive \"$geomfile\""
	}
    }
}

##############################################################################
# make some RIB output for the selected light shader or the default lights
##############################################################################

proc write-light-statements { stream } {
    global light-shadername

    if {[string compare [set light-shadername] ""] != 0 } then {
	write-rib-shader light $stream
    } else {
	puts $stream "LightSource \"ambientlight\" 0 \"intensity\" 0.1 \"lightcolor\"  \[ 1 1 1 \]"
	puts $stream "LightSource \"distantlight\" 1 \"intensity\" 1.0 \"lightcolor\" \[ 1 1 1 \] \"from\" \[ -1 1 -1 \] \"to\" \[ 0 0 0 \]"
	puts $stream "LightSource \"distantlight\" 2 \"intensity\" 0.5 \"lightcolor\" \[ 1 1 1 \] \"from\" \[ 1 1 2 \] \"to\" \[ 0 0 0 \]"
	puts $stream "LightSource \"distantlight\" 3 \"intensity\" 0.3 \"lightcolor\" \[ 1 1 1 \] \"from\" \[ 1 -1 -1 \] \"to\" \[ 0 0 0 \]"
    }
}

##############################################################################
# make some RIB output from a given shader
##############################################################################

proc write-rib-shader {type stream} {
    global $type-shadername $type-argnames $type-argtypes $type-pane
    global shadername shadertype argnames argtypes lightnumber output
    set shadername [set $type-shadername]
    set argnames [set $type-argnames]
    set argtypes [set $type-argtypes]
    
    if [winfo exists [set $type-pane]] {
	write-declares $type "$argnames" "$argtypes" $stream
	switch $type {
	    surface {set output "Surface \"$shadername\" "}
	    displacement {set output "Displacement \"$shadername\" "}
	    imager {set output "Imager \"$shadername\" "}
	    light {set output "LightSource \"$shadername\" $lightnumber "}
	    interior {set output "Interior \"$shadername\" "}
	    exterior {set output "Exterior \"$shadername\" "}
	    atmosphere {set output "Atmosphere \"$shadername\" "}
	    default {bgerror "Unknown shader type $type"; return}
	}
	write-arguments $type "$argnames" "$argtypes" $stream
    }
}

##############################################################################
# write all RIB shaders (e.g. to stdout)
##############################################################################

proc write-all-rib-shaders { stream } {
    global shadertypes
    write-common-args $stream
    foreach type $shadertypes {
        write-rib-shader $type $stream
    }
}

##############################################################################
# Alternatively, show all RIB shaders in a window
##############################################################################

proc create-ribcode-frame { } {
    global version shadertypes tmpdir wrapribcode
    set ribcode .ribcode

    set text " TKMatman RIB code " 
    set wmname $text

    if [winfo exists $ribcode] {destroy $ribcode}
    toplevel $ribcode
    wm title $ribcode $wmname

    frame $ribcode.contents
    text $ribcode.contents.text -wrap $wrapribcode -relief sunken -bd 2 -yscrollcommand\
	    "$ribcode.contents.scroll set" -setgrid true -height 20 -width 80
    scrollbar $ribcode.contents.scroll -command "$ribcode.contents.text yview"
    pack $ribcode.contents.scroll -side right -fill y -in $ribcode.contents
    pack $ribcode.contents.text -expand yes -fill both -in $ribcode.contents

    frame $ribcode.header
    label $ribcode.header.label -relief flat -text $text
    button $ribcode.header.close -command "destroy $ribcode" -text Close

    bind $ribcode <Escape> "destroy $ribcode"

    pack $ribcode.header.close -in $ribcode.header -side right
    pack $ribcode.header.label -fill x -in $ribcode.header -side left
    pack $ribcode.header -in $ribcode -side top -fill x
    pack $ribcode.contents -in $ribcode -side top -fill both -expand yes

    set contents ""
    set ribcodefile [open $tmpdir/ribcode.txt w]
    write-all-rib-shaders $ribcodefile
    close $ribcodefile

    set line ""
    set ribcodefile [open $tmpdir/ribcode.txt r]
    while {([gets $ribcodefile line] >= 0)} {
	$ribcode.contents.text insert end "$line\n"
    }
    close $ribcodefile
}

##############################################################################
# render a test frame
##############################################################################

proc render-test-frame { } {
    global rendrib tmpdir shadertypes geomfile 
    global imagesize pixelsamples shaderpathoption
    global commonargs-gain-value commonargs-gamma-value
    set filename ""
    foreach type $shadertypes { 
	global $type-shadername $type-pane
	if {[winfo exists [set $type-pane]] == 0} {set $type-shadername ""}
	append filename "[set $type-shadername]"
    }
    if {[string length $filename] > 8} \
	    {set filename [string range $filename 0 7]}
    set stream [open $tmpdir/$filename.rib w]
    puts $stream "$shaderpathoption"
    puts $stream "Format $imagesize $imagesize 1"
    puts $stream "PixelSamples $pixelsamples $pixelsamples"
    puts $stream "Exposure  [set commonargs-gain-value] [set commonargs-gamma-value]"
    puts $stream "FrameBegin 1"
    puts $stream "Display \"$tmpdir/$filename.tif\" \"file\" \"rgb\""
    puts $stream "Projection \"perspective\" \"fov\" 40"
    write-rib-shader imager $stream
    puts $stream "WorldBegin"
    write-light-statements $stream
    write-common-args $stream
    write-rib-shader surface $stream
    write-rib-shader displacement $stream
    write-rib-shader interior $stream
    write-rib-shader exterior $stream
    write-rib-shader atmosphere $stream
    write-geometry-statements $stream
    puts $stream "WorldEnd"
    puts $stream "FrameEnd"
    close $stream
    eval "exec $rendrib $tmpdir/$filename.rib &"
}

##############################################################################
# build up the basic GUI and wait for input
##############################################################################

create-fix-part