#!/bin/sh 
# now start wish, whereever it is \
exec wish "$0" "$@"
##############################################################################
# TKMatman by Andreas Butz <butz@dfki.uni-sb.de> 
# Version 1.1unoff, 02/97
# Home page at http://www.dfki.uni-sb.de/~butz/tkmatman/index.html
##############################################################################
# external commands, change here...
##############################################################################

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

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

# Default value for the environmen variable SHADERS
set shaderpathdefault "/usr/local/BMRT/shaders:/usr/local/shaders:/project/imedia/lib/bmrt"

# Default directory for temporary files
set tmpdir "/tmp"

# Default values for the rendering parameters
set imagesize 128
set pixelsamples 1
set brightness 1
set geomtype sphere
set geomfile ""

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

set version 1.2

set shadertypes \
	{surface displacement imager light interior exterior atmosphere}

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

set commonargs-argnames "Brightness"
set commonargs-brightness-value $brightness

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 $top.$type
}

frame $top
pack $top
bind . <Escape> "exit"
wm resizable . 0 0

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

proc update-color { type inframe name value } {
    global $type-$name-red $type-$name-green $type-$name-blue
    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
}

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

    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
    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
    global $shadertype-$name-value 
    if {[set $shadertype-$name-value] == 0} then {
	set max 1.0
    } else {
	set max [expr [set $shadertype-$name-value] * 5 ]
    }
    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
}    

##############################################################################
# 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
    entry $inframe.$name.entry -width 21 -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
    global allshaders allshadernames
    global env
    set i 0
    set allshaders ""
    if {[string length [array names env SHADERS]] == 0} then {
	array set env "SHADERS $shaderpathdefault"
	puts stdout "Environment variable SHADERS not set, assuming default:"
	puts stdout $shaderpathdefault
    }
    set spathstr $env(SHADERS) 
    regsub -all ":" $spathstr " " spathstr
    foreach p $spathstr {
	append allshaders "[glob -nocomplain $p/*.so] "
	}
    foreach s $allshaders {
	regsub -all "/|\.so" $s " " dummy
	set dummy [lindex $dummy end]
	lappend allshadernames $dummy
	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
	    lappend newlist $element
	}
    }
    return $newlist
}

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

proc create-shaders-listbox { } {
    global brws 
    global longestshadername allshaders 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 "write-all-rib-shaders stdout"
    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 buttons and fields for the rendering options
##############################################################################

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

    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.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.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
    label $file.label -text " Input file    "
    pack $file.label -in $file -side left -fill y
    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 brightness

    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-brightness-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 40 -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 x

    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 stdout 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 to find out about shader arguments.

USAGE:
  After starting TKMatman you see a list of available shaders. Select one of them 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 lightsource 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 writes a RIB specification of the selected parameters to stdout. Test renders a test frame, Help and Quit do the obvious.

OPTIONS:
  Below the shader list is a box with general options. 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, an arbitrary RIB file can be used for the test frame. This file must specify all necessary translations and rotations to show the given objects in the frame. Image size controls the size of the rendered test frame, Pixel samples adjusts the supersampling rate (must be a positive whole number). The Brightness slider controls the brightness of the default lights that are used to render the test frames. The sliders for color and opacity adjust the corresponding global RenderMan settings.

SHORTCUTS:
  The Escape key exits the help screen as well as the whole program like it does for the testframe displayed by rendrib.

ENVIRONMENT:
  Set your environment variable SHADERS to the place where your compiled shader files (*.so) live. Since we work in an X environment, the DISPLAY variable also has to be set properly. The programs rendrib and sotell have to be inside your PATH.

BUGS:
  Starting a new test frame with the same surface and displacement shaders before the last one is finished will kill the first one, since the corresponding RIB file is overwritten. No other bugs are yet known, tell me if you find some...

DISTRIBUTION:
  TKMatman was written by Andreas Butz, butz@dfki.uni-sb.de. It may be distributed freely without modification. In case you use it for something commercial I'd like to 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 fine shaders, 2.) send me some cookies or bisquits, 3.) distribute it to other people. Any combination of the above as well as any general comments and feedback are welcome. The TKMatMan home page is at http://www.dfki.uni-sb.de/~butz/tkmatman/index.html

CREDITS:
  Some bug fixes were 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."

    $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-parameter-frame
    create-common-args
    create-action-buttons
    pack $brws -in $top -side left -anchor n
    wm title . "TKMatman $version by A. Butz"
}

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

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 {\[|\]|:} $shaderarguments " " shaderarguments
    set shadertype [lindex $shaderarguments 2]
    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 6 end]
    set $shadertype-shaderarguments $shaderarguments

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

    while { $i < $l } {
	set arg [lindex $shaderarguments $i]
	set name [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 + 2]]
		set $shadertype-$name-green [lindex $shaderarguments [expr $i + 3]]
		set $shadertype-$name-blue [lindex $shaderarguments [expr $i + 4]]
		incr i 4 }
	    point {
		global $shadertype-$name-x $shadertype-$name-y \
		    $shadertype-$name-z
		set $shadertype-$name-x [lindex $shaderarguments [expr $i + 2]]
		set $shadertype-$name-y [lindex $shaderarguments [expr $i + 3]]
		set $shadertype-$name-z [lindex $shaderarguments [expr $i + 4]]
		incr i 4 }
	    scalar {
		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 {puts stdout "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
}

##############################################################################
# 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
##############################################################################

proc update-gui {} {
    global top brws shadertypes 
    global shadername shadertype shaderarguments argnames argtypes
    foreach type $shadertypes { global $type }

    if {[string compare $shadername ""] != 0} {
	scan-shader-arguments
	if {[lsearch -exact $shadertypes $shadertype] >= 0 } then {
	    set pane [set $shadertype]
	    set i 0
	    set l [llength $argnames]
	    if {[winfo exists $pane]} {destroy $pane}
	    frame $pane -relief raised -bd 3
	    pack $pane -in $top -side left -anchor ne
	    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}\; 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
	    
	    while { $i < $l } {
		set name [string tolower [lindex $argnames $i]]
		set type [lindex $argtypes $i]
		switch $type {
		    color {
			create-color-slider $pane $name
		    }
		    point {
			create-point-entry $pane $name
		    }
		    scalar {
			create-scalar-slider $pane $name
		    }
		    string {
			create-string-entry $pane $name
		    }
		    default {puts stdout "Unknown argument type: $type"}
		}
		incr i
	    }
	} else {
	    puts stdout "Can't handle $shadertype shaders yet."
	}
    }
}

##############################################################################
# the arguments of a shader (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; lappend 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] " \] " }
	    default {puts stdout "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
    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\" "}
	    string { append output "string\" "}
	    color { append output "color\" " }
	    point { append output "point\" " }
	}
    }
    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 commonargs-brightness-value

    if {[string compare [set light-shadername] ""] != 0 } then {
	write-rib-shader light $stream
    } else {
	puts $stream "LightSource \"ambientlight\" 0 \"intensity\" [expr 0.1 * ${commonargs-brightness-value}] \"lightcolor\"  \[ 1 1 1 \]"
	puts $stream "LightSource \"distantlight\" 1 \"intensity\" [expr 1 * ${commonargs-brightness-value}] \"lightcolor\" \[ 1 1 1 \] \"from\" \[ -1 1 -1 \] \"to\" \[ 0 0 0 \]"
	puts $stream "LightSource \"distantlight\" 2 \"intensity\" [expr 0.5 * ${commonargs-brightness-value}] \"lightcolor\" \[ 1 1 1 \] \"from\" \[ 1 1 2 \] \"to\" \[ 0 0 0 \]"
	puts $stream "LightSource \"distantlight\" 3 \"intensity\" [expr 0.3 * ${commonargs-brightness-value}] \"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
    global shadername shadertype argnames argtypes lightnumber output
    set shadername [set $type-shadername]
    set argnames [set $type-argnames]
    set argtypes [set $type-argtypes]
    
    if {[string compare $shadername ""] != 0} {
	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 {puts stdout "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
    }
}

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

proc render-test-frame { } {
    global rendrib tmpdir shadertypes geomfile 
    global imagesize pixelsamples
    foreach type $shadertypes { global $type-shadername }
    set filename "[set surface-shadername][set displacement-shadername]"
    set stream [open $tmpdir/$filename.rib w]
    puts $stream "Format $imagesize $imagesize 1"
    puts $stream "PixelSamples $pixelsamples $pixelsamples"
    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