gammaButton

[TFW] - I was toying around with trying to find modernize buttons with graphics and I found a clever use for the -gamma function. The code below creates a little button bar that when the mouse is over a button, the image is brightened and when depressed darkens. Not unlike many applications. This can be easily combined with button help to create nice effects.
---
 #----------------------------------------------------------------------------
 # Demo to show how gamma correction can be used to highlight button images
 #----------------------------------------------------------------------------
 namespace eval gammaButton {
 }
 package require Img
 console show
 #----------------------------------------------------------------------------
 # Select the appropriate image
 #----------------------------------------------------------------------------
 proc gammaButton::button {w} {
    set img [$w cget -image]
    if {$img ne ""} {
       rewrite $img ;# This seems to allow gamma to work for png images
       bind $w <Any-Enter> [list gammaButton::_buttonProcess enter %W]
       bind $w <Any-Leave> [list gammaButton::_buttonProcess leave %W]
       bind $w <ButtonPress-1> [list gammaButton::_buttonProcess down %W ]
       bind $w <ButtonRelease-1> [list gammaButton::_buttonProcess leave %W ]
    }
 }
 #----------------------------------------------------------------------------
 # Callback to handle the highlights, ignore sunken (depressed) buttons
 #----------------------------------------------------------------------------
 proc gammaButton::_buttonProcess {how w} {
    ##
    # brighten/darken image
    #
    set ok [expr {[$w cget -relief] != "sunken"}]
    switch -- $how {
       "enter" {
          if {$ok} {
             [$w cget -image] configure -gamma 2
          }
       }
       "leave" {
          if {$ok} {
             [$w cget -image] configure -gamma 1
          }
       }
       "down" {
          [$w cget -image] configure -gamma .5
       }
       default {}
    }
 }
 #----------------------------------------------------------------------------
 # Rewrite the transparency bits, needed to gamma correct
 # pngs with alpha channels (tk bug?). Not needed for gifs.
 #----------------------------------------------------------------------------
 proc gammaButton::rewrite {image} {
    set width  [image width  $image]
    set height [image height $image]
    for {set y 0} {$y < $height} {incr y} {
       set row [list]
       for {set x 0} {$x < $width} {incr x} {
          set trbit [$image transparency get $x $y]
          lappend trans $x $y $trbit
       }
    }
    foreach {x y t} $trans {
       $image transparency set $x $y $t
    }
 }
 #----------------------------------------------------------------------------
 # Sample images
 #----------------------------------------------------------------------------
 image create photo actions-player_start -data {
    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/I
    NwWK6QAAABl0RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIe
    SURBVHjaYrBN3fRfzmfpfwYGBh4GYoHxzPrgst3vGXQ7awACiEVPU4rhx+9n
    DI8YGHiBUl8IaPTXUxed0JRlrmBrJMWwdssRWYAAYnn5lYHh62+CNsrz83Es
    KEwyd4jzVmf484+B4c03iBRAALG8AhnwC6dGfiDZEBZoXJAaosPAxMbOcOIJ
    A8M/oIcVBSFKAAIIYsBvrJrzVdSkGwrS7QSEhHkZzrxmYPj5FyHNww6hAQKI
    5dNPoMQfFI32PEL8E2JjbA2UlKUYrr5nYPj2HtN8aV4IDRBALKDgB2EGmVAF
    FgXfaUa2BgEuzroMt98xMFy7jTtYYAYABBALTEDILPKYua8XAzPQnzvvIhQy
    4jDgLTQQAQKICSbw6dH9k9cuP2B4/oWwZmQAEEBwF/w5Uxz48C+b5fu7tyfI
    GBvJCkhL4dcI1QkQQCwsQDcwwaw6n7vu03mGjdeezKyR1lEr1rAx5uUW4MVq
    AD8XhAYIICZeTgYGdlYUub8MZ9Mbn165pXto4brFD0+eZeBl/ckgAjQHGXNz
    QBQDBBALyICPLFisOJv+EJg84i5+nzn33qXbzXa+Frbaxgpw6V9QVwMEEAsf
    pgvQDTr4mYHBbuvrKUm3Tss3uAZbyCoqi8ClAQII4gUWIoL7fM6821ef6U5r
    WNW8bt4BBqa/P8HCAAHEyGA4eSvD359cDJdKwoH8V0RmZ3mG359yGT5euQUQ
    YABfm6OJXIn9ywAAAABJRU5ErkJggg==
 }

 image create photo actions-player_play -data {
    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAB3RJTUUH1gIF
    ABAECAIgiAAAAAlwSFlzAAAewgAAHsIBbtB1PgAAAARnQU1BAACxjwv8YQUA
    AAH6SURBVHjaY2AAAeOZ891ztt0H0vEMZAHjmfvffvv/f8H2+/+VA1ftB/Lt
    STbg5pv//28B8Z23//+n9Zz5L+S8eD5QXJ6QVmYwKeWbEBlsrHDpJQPDiy8M
    DOb6Ugwu1ooG7778Sbj/y5KD4fmWgwQNsHMzVnjwgYHh7XcGhkcfGRg+/WNn
    sDWT59DTknR4zuaS8JbV7gHQoJvoBrDAGM8/MzDcf48qeeMNA4MwjxRDdraU
    wsEjNzds4Vx44Nf3HwUMZ9MvYhgAcjrIBegAJHb2OQODmLw6Q36lgsPG7Vcu
    3GKYuQAoBTLoI9yAH78ZGL7+wu7P/0D8BSh37z07g46NMYOkplrCuZ2HAj5/
    zFWHG/DzL+6QZoQaAgIPgeHz7OIthu8v7h5muDMZ4YVPQBvYWBjwgtd3HzA8
    Onro5s/HR9sZ7s3aABRCeEGIh4HhDxN2jZ/ff2a4uG3/53fXj3Qx3OyeCwpz
    jEAEGfCPGVXjzx8/GU7tOstw+8CuWQwvtk9meHfqOlAYxbNwAzg5GBhEWBES
    x3ZfZji789CB7/d3NADj/ywoHLG5Dm4ADzcQA+lrl54xbFy499m720eqgP7c
    AhR6iy9c4Ab8//aZYeHsY5+vHjkyneF6ywSg0Ct05+KKIQYGw8lBDN+fWTG8
    3LWY4f1ZkD9/EdIIAwCJUNZXWEEekwAAAABJRU5ErkJggg==
 }
 image create photo actions-player_stop -data {
    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAB3RJTUUH1gIF
    AA4xivDbdAAAAAlwSFlzAAAewgAAHsIBbtB1PgAAAARnQU1BAACxjwv8YQUA
    AACTSURBVHjaY2QAArvUTf/tjKQYSAEts45vYzif68cC4uhqSTFEhxiTZsCM
    w+JAihNswKsvDAyXX5KkHw4gBnxlYLjyaiAN+PiTgeHRRwoM+A/F5AAmMvUN
    IgPAYcACNIadhQIDeDgZGCSFKDCAj4OBQVqQAgN4gS6QpsgFFBjACCYNJ29l
    +PdHnCSd3x9vZrjV1wUAo7UkPLXyJE0AAAAASUVORK5CYII=
 }
 image create photo actions-player_end -data {
    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/I
    NwWK6QAAABl0RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJO
    SURBVHjaYnDO2PJexHnhfgbjmfoMxALjmfkxdfv/MxhO3goQQExG2hICZ5aH
    OxTGG18ASswHYn4ijBBwsVNjYPj3RxwggJg+/wLSLOwM2dHGDHsXRiY4WCo9
    ANlAyIT7HyA0QAAxfQEacPc9A8PRxwwMX1h4GdrLXQQmNPpMUAhedx9okD1O
    A95DaIAAYgEZ8PQzA8ODDwhJMXEphgmtgQrLNl4+sJl74YHvX38kMJxNf4jN
    AIAAYgF54flnhACypJqJLkOTuZrDsrVnH5xnmNkAFJoANOgjSO7VV4gagAAC
    u+D2W1QXwABIjJWJncHG04rByEq3YeOqQwVvGGYWgOT+Q9UABBDLn78MDK+B
    pn39hd2vIIXHgOHDxszL4B3nLXD8wrMFd3ftgssDBBATsVH/C2jR2bufGV5d
    ufz57/fPN2HiAAHExAQ0gpUFaAMOzA7ETH9/Mjw/e5bhxqr5mz/sq7YFumst
    zACAAGLhYGVgEOJhYPiDwy0PLt5kuH3k+Nnvd3e2MTxeAXL7FwaltACQpSAA
    EEAszMwQA/4xo2p8du8Zw7m9Z569unJkOsPN7lmggEeWF+GF0AABxPIbSHBy
    AAVYIQJfPv9k2Lf++Ocbhw4sZ3i5ewLD22O3gMJ/0V0GMwAggFi42BkYeLiB
    /v3DwLBv01mGEzuPbv56b3cvw/Mtx0FhhytQRfggNEAAgQ24eeEBw6alh26+
    unm0neHerA1A8Y+EYgXmAoAAYmTQ7+tk+AFMize75wL5z4nMzvYMf771Mvz+
    cBYgwADt09msilOyDgAAAABJRU5ErkJggg==
 }

 #------------------------------------------------------------------------------
 # Demo code
 #------------------------------------------------------------------------------
 proc demo {args} {
    foreach {image} {
       actions-player_start
       actions-player_play
       actions-player_stop
       actions-player_end
    } {
       pack [button .$image -image $image -relief flat] -side left
       gammaButton::button .$image

       if {[catch {$image write $image.gif -format gif} result] } then {
          puts $result
          file delete -force $image.gif
       } else {
          puts "Wrote $image.gif"
       }

    }
 }
 demo