# AC3D
# (C) Copyright 2003 by Inivis

# TCL stuff to handle editing of palette entries


# popup menu bound to each palette button

menu .palette_menu -tearoff 0
.palette_menu add command -label "Edit material..." -command "edit_palette_entry"
.palette_menu add command -label "Select surfaces with this material" -command {ac3d select_surfaces_by_material $current_palette_index }
.palette_menu add command -label "Append new material" -command "new_palette_entry"



proc popup_palette_menu { x y entry colindex} {
global current_palette_edit select_mode current_palette_index

#puts "popup_palette_menu $entry $colindex"

	if { ($select_mode == "surface") || ($select_mode == "vertex") } {
		.palette_menu entryconfigure 1 -state normal
	} else {
		.palette_menu entryconfigure 1 -state disabled
	}

    set current_palette_edit $entry
	set current_palette_index $colindex
    tk_popup .palette_menu $x $y

}


proc add_palette_button { colrgb colindex } {
global .palette_frame.canvas.f
global .palette_frame.canvas
global tcl_platform
global cp

    set parent $cp.palette_frame.canvas.f

    set newname [ format "$parent.%04d" $colindex ]
#puts $newname"

if {$tcl_platform(platform) == "windows"} {
    button $newname -text $colindex -background $colrgb \
        -command "ac3d set_col $colindex" -bd 1 -padx 0 -pady 0 \
        -activebackground $colrgb -highlightthickness 0\
        -bitmap "" -default disabled
    $newname configure -width 3 -height 1

} else {
    button $newname -text $colindex -background $colrgb \
        -command "ac3d set_col $colindex" -bd 1 -padx 0 -pady 0 \
        -activebackground $colrgb -highlightthickness 0\
        -bitmap ""
    $newname configure -width 3 -height 1

}

    
    pack $newname -side left -in $parent

#update
    set width [winfo reqwidth $newname]
    set height [winfo reqheight $newname ]
#puts "$width $height"

    set newwidth "[expr ($width * ($colindex + 1))]"
#puts "newwidth $newwidth"

    $parent configure -width $newwidth
    set region  "0 0 $newwidth 0"

    $cp.palette_frame.canvas configure -scrollregion $region


    bind $newname <3> "popup_palette_menu %X %Y %W $colindex" 
    add_balloon $newname "Set all selected surfaces to this col\n(right click for a popup menu)"
}












# called when the popup menu on a palette entry is selected 

proc edit_palette_entry { } {
global current_palette_edit

    # extract the number of the palette entry from the end of the buttns name
    # there must be an easier way of doing this...
    set buttonid [ string range $current_palette_edit [expr [ string length .cp.palette_frame.canvas.f]+1] end ]

#puts "button id $buttonid"
    ac3d edit_palette_entry $buttonid
}


proc new_palette_entry { } {
global current_palette_edit

    # extract the number of the palette entry from the end of the buttns name
    # there must be an easier way of doing this...
    set buttonid [ string range $current_palette_edit [expr [ string length .cp.palette_frame.canvas.f]+1] end ]

    ac3d new_palette_entry $buttonid
}


set SCALEWIDTH 9



proc create_scale { name text entry} {
global SCALEWIDTH
    set len 5c
    set res 0.0039215686
    scale $name -width $SCALEWIDTH -label $text -from 0.0 -to 1.0 -length $len -orient horizontal -command "newcolour $entry" -resolution $res
}



proc newcolour { index value } {
global prefs_realtimecolour
global progset
global current_palette_edit

    set index $current_palette_edit

#puts $index
        
        if { $progset == 0} {
          show_col_on_palbutton
          if { $prefs_realtimecolour} {
            ac3d set_palette_entry $index [.c.f1.diffuse_red get ] [.c.f1.diffuse_green get ]  [.c.f1.diffuse_blue get]\
                [.c.f2.ambient_red get ] [.c.f2.ambient_green get ]  [.c.f2.ambient_blue get] \
                [.c.f3.emissive_red get] [.c.f3.emissive_green get] [.c.f3.emissive_blue get]  \
                [.c.f4.specular_red get] [.c.f4.specular_green get] [.c.f4.specular_blue get] \
                [.c.f5.shininess get] [.c.f5.transparency get]
            ac3d redraw_3d
          }
        }

    } 

proc show_col_on_palbutton {} {

global current_palette_edit
global cp

    set palframe $cp.palette_frame.canvas.f

    set index $current_palette_edit

    set palbuttonname [ format "$palframe.%04d" $index ]

#puts $palbuttonname

# perhaps average out diff/amb/emm for a better approximation for button????

    set r  [expr int([.c.f1.diffuse_red get ] * 255)]
    set g  [expr int([.c.f1.diffuse_green get ] * 255)]
    set b  [expr int([.c.f1.diffuse_blue get ] * 255)]
        
    set col  [format #%02x%02x%02x $r $g $b ]
        
    $palbuttonname configure  -background $col -activebackground $col

}

  
proc okpal { } {
global current_palette_edit

    set index $current_palette_edit
    show_col_on_palbutton

    ac3d set_palette_entry $index [.c.f1.diffuse_red get ] [.c.f1.diffuse_green get ]  [.c.f1.diffuse_blue get]\
                [.c.f2.ambient_red get ] [.c.f2.ambient_green get ]  [.c.f2.ambient_blue get] \
                [.c.f3.emissive_red get] [.c.f3.emissive_green get] [.c.f3.emissive_blue get]  \
                [.c.f4.specular_red get] [.c.f4.specular_green get] [.c.f4.specular_blue get] \
                [.c.f5.shininess get] [.c.f5.transparency get]
        ac3d redraw_3d
#        destroy .c 
}

proc cancelpal { index diffuse_red diffuse_green diffuse_blue ambient_red ambient_green ambient_blue \
            emmisive shininess transparency } {
#        ac3d set_palette_entry $index $r $g $b $e $s
        destroy .c
        ac3d redraw_3d
}



proc col_picker { id titlest parentw previewwidget } {
	set color [tk_chooseColor -title "#$id $titlest" -parent $parentw] 
	puts "col $color"
	if {$color != "" } {
		$previewwidget configure  -background $color
		set l [rgb2dec $color]
		puts "list $l"
	}

}



proc create_palette_window { title entry} {
global prefs_realtimecolour SCALEWIDTH

#puts "create_palette_window $entry"

    toplevel .c
    wm transient .c [winfo toplevel [winfo parent .c]]
    wm title .c $title

    frame .c.f1
    frame .c.f2
    frame .c.f3
    frame .c.f4
    frame .c.f5

#    button .c.f1.test -command "col_picker $entry Diffuse .c .c.f1.test"
#	pack .c.f1.test


    create_scale .c.f1.diffuse_red "Diffuse Red" $entry
    create_scale .c.f1.diffuse_green "Diffuse Green" $entry
    create_scale .c.f1.diffuse_blue "Diffuse Blue" $entry

    create_scale .c.f2.ambient_red "Ambient Red" $entry
    create_scale .c.f2.ambient_green "Ambient Green" $entry
    create_scale .c.f2.ambient_blue "Ambient Blue" $entry

    create_scale .c.f3.emissive_red "Emissive Red" $entry
    create_scale .c.f3.emissive_green "Emissive Green" $entry
    create_scale .c.f3.emissive_blue "Emissive Blue" $entry

    create_scale .c.f4.specular_red "Specular Red" $entry
    create_scale .c.f4.specular_green "Specular Green" $entry
    create_scale .c.f4.specular_blue "Specular Blue" $entry


    pack .c.f1.diffuse_red .c.f1.diffuse_green .c.f1.diffuse_blue

    pack .c.f2.ambient_red .c.f2.ambient_green .c.f2.ambient_blue
#    pack .c.f1 .c.f2 -side top  -anchor w
#    pack .c.f1 .c.f2 -anchor nw -side left  -expand 1 -fill x


    pack .c.f3.emissive_red .c.f3.emissive_green .c.f3.emissive_blue
    pack .c.f4.specular_red .c.f4.specular_green .c.f4.specular_blue
#    pack .c.f3 .c.f4 -side top  -anchor w

#    pack .c.f3 .c.f4 -anchor sw -side left -fill x -expand 1


    scale .c.f5.shininess  -width $SCALEWIDTH -label Shininess -from 0.0 -to 128.0 -length 5c -orient horizontal -command "newcolour $entry" -resolution 1
    create_scale .c.f5.transparency "Transparency" $entry

    pack  .c.f5.shininess .c.f5.transparency
#    pack .c.f5


    frame .c.f
#    button .c.f.okbutton -text "OK" -command "okpal"
    button .c.f.cancelbutton -text "Close" -command "okpal; wm withdraw .c; grab release .c"
    checkbutton .c.f.rtu -text "Realtime update" -variable prefs_realtimecolour
    pack .c.f.rtu -side top
    pack   .c.f.cancelbutton   -side left 


    grid .c.f1 -column 0 -row 0
    grid .c.f2 -column 1 -row 0
    grid .c.f3 -column 0 -row 1
    grid .c.f4 -column 1 -row 1
    grid .c.f5 -column 0 -row 2

    grid .c.f -column 1 -row 2

    centre_window_on_screen .c
}







proc edit_colour_ui { entry   diffuse_red diffuse_green diffuse_blue ambient_red ambient_green ambient_blue \
     emissive_red emissive_green emissive_blue \
     specular_red specular_green specular_blue shininess transparency} {

    global prefs_realtimecolour
    global progset
    global current_palette_edit

    set progset 1


#puts "edit_colour_ui $entry"


    set exists dunno
    catch {set exists [wm state .c]}
    if { $exists == "dunno" } {
        create_palette_window "Edit Material $entry" $entry
        grab .c
    } else {
        wm deiconify .c
        wm title .c  "Edit Material $entry"

    }
    set current_palette_edit $entry


    .c.f1.diffuse_red set $diffuse_red
    .c.f1.diffuse_green set $diffuse_green
    .c.f1.diffuse_blue set $diffuse_blue

    .c.f2.ambient_red set $ambient_red
    .c.f2.ambient_green set $ambient_green
    .c.f2.ambient_blue set $ambient_blue

    .c.f3.emissive_red set $emissive_red
    .c.f3.emissive_green set $emissive_green
    .c.f3.emissive_blue set $emissive_blue

    .c.f4.specular_red set $specular_red
    .c.f4.specular_green set $specular_green
    .c.f4.specular_blue set $specular_blue

    .c.f5.shininess set $shininess
    .c.f5.transparency set $transparency

    set progset 0
    focus .c

}


# rgb2dec --
#
#   Turns #rgb into 3 elem list of decimal vals.
#
# Arguments:
#   c		The #rgb hex of the color to translate
# Results:
#   Returns a #RRGGBB or #RRRRGGGGBBBB color
#
proc rgb2dec c {
    set c [string tolower $c]
    if {[regexp -nocase {^#([0-9a-f])([0-9a-f])([0-9a-f])$} $c x r g b]} {
	# double'ing the value make #9fc == #99ffcc
	scan "$r$r $g$g $b$b" "%x %x %x" r g b
    } else {
	if {![regexp {^#([0-9a-f]+)$} $c junk hex] || \
		[set len [string length $hex]]>12 || $len%3 != 0} {
	    if {[catch {winfo rgb . $c} rgb]} {
		return -code error "bad color value \"$c\""
	    } else {
		return $rgb
	    }
	}
	set len [expr {$len/3}]
    	scan $hex "%${len}x%${len}x%${len}x" r g b
    }
    return [list $r $g $b]
}

# dec2rgb --
#
#   Takes a color name or dec triplet and returns a #RRGGBB color.
#   If any of the incoming values are greater than 255,
#   then 16 bit value are assumed, and #RRRRGGGGBBBB is
#   returned, unless $clip is set.
#
# Arguments:
#   r		red dec value, or list of {r g b} dec value or color name
#   g		green dec value, or the clip value, if $r is a list
#   b		blue dec value
#   clip	Whether to force clipping to 2 char hex
# Results:
#   Returns a #RRGGBB or #RRRRGGGGBBBB color
#
proc dec2rgb {r {g 0} {b UNSET} {clip 0}} {
    if {![string compare $b "UNSET"]} {
	set clip $g
	if {[regexp {^-?(0-9)+$} $r]} {
	    foreach {r g b} $r {break}
	} else {
	    foreach {r g b} [winfo rgb . $r] {break}
	}
    } 
    set max 255
    set len 2
    if {($r > 255) || ($g > 255) || ($b > 255)} {
	if {$clip} {
	    set r [expr {$r>>8}]; set g [expr {$g>>8}]; set b [expr {$b>>8}]
	} else {
	    set max 65535
	    set len 4
	}
    }
    return [format "#%.${len}X%.${len}X%.${len}X" \
	    [expr {($r>$max)?$max:(($r<0)?0:$r)}] \
	    [expr {($g>$max)?$max:(($g<0)?0:$g)}] \
	    [expr {($b>$max)?$max:(($b<0)?0:$b)}]]
}

# shade --
#
#   Returns a shade between two colors
#
# Arguments:
#   orig	start #rgb color
#   dest	#rgb color to shade towards
#   frac	fraction (0.0-1.0) to move $orig towards $dest
# Results:
#   Returns a shade between two colors based on the
# 
proc shade {orig dest frac} {
    if {$frac >= 1.0} { return $dest } elseif {$frac <= 0.0} { return $orig }
    foreach {origR origG origB} [rgb2dec $orig] \
	    {destR destG destB} [rgb2dec $dest] {
	set shade [format "\#%02x%02x%02x" \
		[expr {int($origR+double($destR-$origR)*$frac)}] \
		[expr {int($origG+double($destG-$origG)*$frac)}] \
		[expr {int($origB+double($destB-$origB)*$frac)}]]
	return $shade
    }
}

# complement --
#
#   Returns a complementary color
#   Does some magic to avoid bad complements of grays
#
# Arguments:
#   orig	start #rgb color
# Results:
#   Returns a complement of a color
# 
proc complement {orig {grays 1}} {
    foreach {r g b} [rgb2dec $orig] {break}
    set R [expr {(~$r)%256}]
    set G [expr {(~$g)%256}]
    set B [expr {(~$b)%256}]
    if {$grays && abs($R-$r) < 32 && abs($G-$g) < 32 && abs($B-$b) < 32} {
	set R [expr {($r+128)%256}]
	set G [expr {($g+128)%256}]
	set B [expr {($b+128)%256}]
    }
    return [format "\#%02x%02x%02x" $R $G $B]
}



proc make_palette { w } {
	ScrolledHorizCanvas $w 10 16 {0 0 1000 0}
#	frame $w.palstuff
#	label $w.palstuff.current -text 0 -width 4
#	button $w.palstuff.set -text Set
#	button $w.palstuff.edit -text Edit...
#	pack $w.palstuff.current $w.palstuff.set $w.palstuff.edit -side left
#	pack $w.palstuff -side bottom

}















