A tile exercise!

======
# ImageLib.tcl ---
# Automatically created by: CreateImageLib.tcl

set images(scope-oval) [image create photo -data {
R0lGODlhGAAOAIAAAAAAAAAAACH5BAkAAAEALAAAAAAYAA4AAAIcjAOpy3Df
IntI2nSudrv7D4biSFalcWYhhX5PAQA7
}]
set images(scope-ovalBlank) [image create photo -data {
R0lGODlhGAAOAJEAAAAAAKSkpAAAAAAAACH5BAkKAAIAIf/8SUNDUkdCRzEw
MTIAAALAYXBwbAIAAABtbnRyUkdCIFhZWiAH2QAHAB4AAAAAAABhY3NwQVBQ
TAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA9tYAAQAAAADTLWFwcGwAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAxy
WFlaAAABFAAAABRnWFlaAAABKAAAABRiWFlaAAABPAAAABR3dHB0AAABUAAA
ABRjaGFkAAABZAAAACxyVFJDAAABkAAAAA5nVFJDAAABoAAAAA5iVFJDAAAB
sAAAAA52Y2d0AAABwAAAADBu/2RpbgAAAfAAAAA4ZGVzYwAAAigAAAB0Y3By
dAAAApwAAAAkWFlaIAAAAAAAAHRLAAA+HQAAA8xYWVogAAAAAAAAWnMAAKym
AAAXJlhZWiAAAAAAAAAoGAAAFVcAALgzWFlaIAAAAAAAAPNRAAEAAAABFsxz
ZjMyAAAAAAABDEIAAAXe///zJgAAB5MAAP2Q///7ov///aMAAAPcAADAbmN1
cnYAAAAAAAAAAQIzAABjdXJ2AAAAAAAAAAECMwAAY3VydgAAAAAAAAABAjMA
AHZjZ3QAAAAAAAAAAQABAAAAAAAAAAEAAAABAAAAAAAAAAEAAAABAAAAAAAA
AAEAANBuZGluAAAAAAAAADAAAKFIAABXCgAAS4UAAJrhAAAnrgAAE7YAAFAN
AABUOQACMzIAAjMyAAIzMmRlc2MAAAAAAAAAGkNhbGlicmF0ZWQgUkdCIENv
bG9yc3BhY2UAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAdGV4
dAAAAABDb3B5cmlnaHQgQXBwbGUsIEluYy4sIDIwMDkAACwAAAAAGAAOAAAC
HJQVqctx3yJ7SNp0rna7+w+G4khWpXFmIYV+TwEAOw==
}]
set images(scope-ovalDark) [image create photo -data {
R0lGODlhGAAOAIAAAAAAAAAAACH5BAkAAAEALAAAAAAYAA4AAAIcjAOpy3Df
IntI2nSudrv7D4biSFalcWYhhX5PAQA7
}]
======

The code:

======
# scopebutton.tcl ---
# -------------------------------------------------------------------------
#   Includes code (styling and graphics) from the Coccinella application.  
#     Copyright (c) 2005-2008  Mats Bengtsson
#
#   Additional modifications
#     (c) 2009 Kevin Walzer/WordTech Communications LLC. 
#
#   Further modifications for inclusion into TclMacBag
#     (C) 2007-2009 Peter Caffin and other parties.
#
#   Turned the original source into a namespace's package +
#   further changes where done to eliminate the need of the Img library.
#     (c) 2009, Johann Oberdorfer  Johann.Oberdorfer@gmail.com
#
#   This file is BSD style licensed.
# -------------------------------------------------------------------------
#
# From Apple's Human Interface Guidelines: 
#   "The scope button is used in a scope bar to specify the scope of an
#   operation, such as search... 
#   Scope buttons are designed to be used in scope bars and related filter
#   rows only. They are not intended to be used in the toolbar or
#   bottom-bar areas or outside of a scope bar in the window body. 
#   The recessed scope button style is used to display types or
#   groups of objects or locations the user can select to narrow the
#   focus of a search or other operation."

# In this context, we are implementing a scopebutton as a styled
# ttk::radiobutton. 
#
# A command will fire when the ttk::radiobutton variable changes. 
# The "scope bar" should be a simple frame widget. 
# We are not implementing scope-style menubuttons because they
#  add interface and programming complexity. 
# -------------------------------------------------------------------------

package provide scopebutton 0.1

if { [info patchlevel] < 8.5 } {
   package require tile 0.8
}


namespace eval ::scopebutton:: {
  variable wLocals

  namespace export scopebutton

  set thisDir [file dirname [info script]]

  array set wLocals [list \
    imageDir [file join $thisDir "images"] \
    imageLib [file join $thisDir "ImageLib.tcl"] \
    imageArrayName "images" \
  ]

  # try to load image library file...
  if { [file exists $wLocals(imageLib)] } {

      source $wLocals(imageLib)
      array set wLocals [array get images]

  } else {

      proc LoadImages {imgdir {patterns {*.gif}}} {
        foreach pattern $patterns {
          foreach file [glob -directory $imgdir $pattern] {
            set img [file tail [file rootname $file]]
            if {![info exists images($img)]} {
              set images($img) [image create photo -file $file]
            }
        }}
        return [array get images]
      }

      array set wLocals [LoadImages $wLocals(imageDir) "*.gif"]
  }
}


proc ::scopebutton::DefineOrUpdateCustomStyle {} {
  variable wLocals

  # create a new element for each available theme

  foreach themeName [ttk::style theme names] {

     # temporarily sets the current theme to themeName,
     # evaluate script, then restore the previous theme.

     ttk::style theme settings $themeName {

     # make sure, element is created only once:
     set elementNames [ttk::style element names]

     if { [lsearch $elementNames ScopeButtonStyle.background] == -1 } {

          # scope type button--create the layout
          ttk::style element create ScopeButtonStyle.background image \
              [list $wLocals(scope-ovalBlank) \
                   {background}                  $wLocals(scope-ovalBlank) \
                   {active !disabled !pressed}   $wLocals(scope-oval)      \
                   {pressed !disabled}           $wLocals(scope-ovalDark)  \
                   {selected !disabled !pressed} $wLocals(scope-ovalDark)  \
                   {selected disabled}           $wLocals(scope-ovalDark)] \
                 \
              -border {6 6 6 6} -padding {0} -sticky news

          ttk::style layout ScopeButtonStyle {
              ScopeButtonStyle.background -children {
                  ScopeButtonStyle.padding -children {
                      ScopeButtonStyle.label
                  }
              }
          }          

          ttk::style configure ScopeButtonStyle  \
              -padding {6 0 6 1} -relief flat -font TkTooltipFont

          ttk::style map ScopeButtonStyle -foreground {
              {active   !disabled !pressed}  white
              {pressed  !disabled !disabled} white
              {selected !disabled !pressed}  white
          }
       }
     }
  }
}


proc ::scopebutton::scopebutton {w args} {
  variable wLocals

  DefineOrUpdateCustomStyle
  set w [eval ttk::radiobutton $w $args -style ScopeButtonStyle]

  return $w
}


# -------------------------------------------------------------------------
# test code:
# -------------------------------------------------------------------------
if 0 {

  package require tile 0.8
  package require scopebutton

  wm withdraw .
  set t [toplevel .test]
  wm geometry $t "400x200"

  set f [ttk::frame $t.status]
    pack $f -side top -fill x

  for {set cnt 0} {$cnt < 5} {incr cnt} {

     set scb $f.scb1_{$cnt}

     ::scopebutton::scopebutton $scb \
         -text "Test:$cnt" -variable ::v -value $cnt
       pack $scb -side left -padx 5
  }
 
}

======



----
!!!!!!
%| [Category Package] |%
!!!!!!