tile themes - base64 encoded

JOB The following helper script allows to generate and maintain theme related packages - base64 encoded.

The goal is to:

  • improve performance when calling up an application,
  • establish a convenient method to ship images together within example code.

To see of how it's intended to use, you might want to look at: dynnotebook. This script is used as well in the BWidget package (currently in CVS) to pack together themes for the demo code.

Place the following script in the theme related root directory:

#!/usr/bin/ksh
# the next line restarts using wish \
exec wish "$0" "[email protected]"


# CreateImageLibCmd.tcl ---
# -------------------------------------------------------------------------
# Purpose:
#   A utility script to create base64 multimedia encoded gif's
#   from a given image directory.
#
# Copyright(c) 2009,  Johann Oberdorfer
#                     mail-to: [email protected]
# -------------------------------------------------------------------------
# This source file is distributed under the BSD license.
# -------------------------------------------------------------------------


# where to find tcllib:
lappend auto_path [file join $::env(HOME) "t/lib1"]
  package require base64


namespace eval ::CreateImageLib:: {
  variable defaults
  
  array set defaults {
    pattern       "*.gif"
    imageDir       "images"
    imageLib       "ImageLib.tcl"
    dclsFile       "CreateImageLib.def"
    imageArrayName "images"
  }
}


proc ::CreateImageLib::ReadDeclaredImageNames { fname } {
  set imagename_dcls [list]

  if { ![file exists $fname] } { return $imagename_dcls }

  set fp [open $fname "r"]

  while { ![eof $fp] } {
    if { [string length [set row [string trim [gets $fp]]]] } {
      lappend imagename_dcls $row
    }
  }

  close $fp
  return $imagename_dcls
}


proc ::CreateImageLib::ConvertFile { fileName } {

  set fp [open $fileName "r"]
  fconfigure $fp -translation binary

  set data [read $fp [file size $fileName]]
  close $fp

  return [base64::encode $data]
}


proc ::CreateImageLib::CreateImageLib {dir} {
  variable defaults

  set cdir [pwd]
  cd $dir

  # verify if there is a declaration file available
  # which triggers the image lib creation... 

  if { ![file exists $defaults(dclsFile)] ||
       ![llength [set imagename_dcls \
                     [ReadDeclaredImageNames $defaults(dclsFile)]]] ||
       ![file isdirectory $defaults(imageDir)] ||
       ![llength [set fileList \
                    [glob -nocomplain \
                          [file join $defaults(imageDir) \
                                     $defaults(pattern)]]]] } {
      cd $cdir
      return
  }

  # puts "Creating file: [file join $dir $defaults(imageLib)] ..."

  set fp [open $defaults(imageLib) "w"]
  puts $fp "# [file tail $defaults(imageLib)] ---"
  puts $fp "# Automatically created by: [file tail [info script]]\n"

  set cnt     0
  set created 0
  set skipped 0
  
  foreach fname $fileList {

      set keystr [file tail [file rootname $fname]]

      if { [file isfile $fname] &&
               [lsearch -regexp $imagename_dcls $keystr] != -1} {

          # assemble array name:
          set imageName $defaults(imageArrayName)
          append imageName "("
          append imageName [file rootname [file tail $fname]]
          append imageName ")"

          set imageData [ConvertFile $fname]

          puts $fp "set $imageName \[image create photo -data \{"
          puts $fp "$imageData\n\}\]"
          incr created
      } else {
          incr skipped
      }

      incr cnt
  }

  close $fp

  puts \
"
  [info script] summary:
  
      Image Library created ... [file join $dir $defaults(imageLib)]
      Images processed ........ $cnt
      Created images .......... $created
      Skipped ................. $skipped
"

  flush stdout
  cd $cdir
}


proc ::CreateImageLib::ProcessDir {dir} {
  variable defaults

  set cdir [pwd]
  cd $dir

  foreach fp [glob -nocomplain [file join $dir "*"]] {
    if { [file isdirectory $fp] &&
         [string compare -nocase [file tail $fp] "CVS"] != 0 &&
         [string compare [file tail $fp] $defaults(imageDir)] != 0 } {
        
        # process current dir and continue proceccing afterwards...
        # puts "--> $fp"

        CreateImageLib $fp
        ProcessDir $fp
    }
  }

  flush stdout
  cd $cdir
}


proc ::CreateImageLib::RunCreate {} {

  # retrieve all sub'directories starting from:
  set dir [pwd]
  ProcessDir $dir
  cd $dir
}


# here we go ...
::CreateImageLib::RunCreate
exit 0

For example, the code providing the theme support might look like the following (pay attention to the header section with the LoadImages function):

# aquativo --
#
#   Copyright (C) 2004 Pat Thoyts <[email protected]>
#
#   Import the aquativo Gtk theme (C) Andrew Wyatt, FEWT Software
#   Original: http://www.fewt.com
#   Link: http://art.gnome.org/themes/gtk2/432.php
# ------------------------------------------------------------------------------
# Revision change history:
#   $Id: aquativo.tcl,v 1.4 2009/10/25 20:53:27 oberdorfer Exp $
#
#   Aug.'08: code refractured for the use with >= tk8.5,
#            [email protected]
# ------------------------------------------------------------------------------

package require Tk 8.4;                 # minimum version for Tile
package require tile 0.8;               # depends upon tile

namespace eval ttk {
  namespace eval theme {
    namespace eval aquativo {
      variable version 0.0.1
    }
  }
}

# TkDefaultFont", "TkTextFont" and "TkMenuFont
#   font create System {*}[font actual System] 
#   font configure System -size 16 -weight bold


namespace eval ttk::theme::aquativo {

  variable I

  set thisDir  [file dirname [info script]]
  set imageDir [file join $thisDir "images"]
  set imageLib [file join $thisDir "ImageLib.tcl"] \

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

      source $imageLib
      array set I [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 I [LoadImages $imageDir "*.gif"]
  }

  
  # "-parent" option controls the treeview "+" icon (collapse/expand)
  # at the beginning of each tree node
  
  ::ttk::style theme create aquativo -settings {
    
    # Defaults
    
    ::ttk::style configure "." \
        -font TkDefaultFont \
        -background "#fafafa" \
        -foreground "Black"
    
    # I really like the mapping options!
    ::ttk::style map "." \
        -foreground { disabled "#565248" } \
        -background { \
            disabled "#e3e1dd"
            pressed  "#bab5ab"
            active   "#c1d2ee" }
        
    # Troughs

    ::ttk::style element create Horizontal.Scale.trough \
        image $I(horizontal_trough) -border 0

    ::ttk::style element create Vertical.Scale.trough \
        image $I(vertical_trough) -border 0

    ::ttk::style element create Progress.trough \
        image $I(vertical_trough) -border 0

    # Panedwindow parts

    ::ttk::style element create hsash \
            image $I(hseparator) -border {2 0}
    ::ttk::style element create vsash \
            image $I(vseparator) -border {0 2}

    # Buttons, Checkbuttons and Radiobuttons
    
    ::ttk::style layout TButton {
      Button.background
      Button.button -children {
        Button.focus -children {
          Button.label
        }
      }
    }
    
    ::ttk::style element create Button.button image \
        [list $I(buttonNorm) \
              pressed $I(buttonPressed) active $I(buttonPressed)] \
        -border {4 4} -padding 3 -sticky nsew
    
    ::ttk::style element create Checkbutton.indicator image \
        [list $I(checkbox_unchecked) selected $I(checkbox_checked)] \
        -width 20 -sticky w
    ::ttk::style element create Radiobutton.indicator image \
        [list $I(option_out) selected $I(option_in)] \
        -width 20 -sticky w
    
    # Menubuttons
    
    ::ttk::style element create Menubutton.button image \
        [list $I(menubar_option) ] \
        -border {7 10 29 15} -padding {7 4 29 4} -sticky news
    
    ::ttk::style element create Menubutton.indicator image \
        [list $I(menubar_option_arrow) \
              disabled $I(menubar_option_arrow_insensitive)] \
        -width 11 -sticky w -padding {0 0 18 0}
    
    # Scrollbar

    ::ttk::style element create Horizontal.Scrollbar.trough \
        image $I(horizontal_trough) -width 16 -border 0 -sticky ew

    ::ttk::style element create Vertical.Scrollbar.trough \
        image $I(vertical_trough) -height 16 -border 0 -sticky ns

    ::ttk::style element create Horizontal.Scrollbar.thumb \
        image [list $I(scrollbar_horizontal) \
                    {active !disabled} $I(scrollbar_horizontal) \
                    disabled  $I(horizontal_trough)] \
        -border 7 -width 16 -height 0 -sticky nsew

    ::ttk::style element create Vertical.Scrollbar.thumb \
        image [list $I(scrollbar_vertical) \
                    {active !disabled}  $I(scrollbar_vertical) \
                    disabled $I(vertical_trough)] \
         -border 7 -width 0 -height 16 -sticky nsew
    
    # Scale
    
    ::ttk::style element create Horizontal.Scale.slider \
        image $I(scrollbar_horizontal) \
        -border 3 -width 30 -height 16
    
    ::ttk::style element create Vertical.Scale.slider \
        image $I(scrollbar_vertical) \
        -border 3 -width 16 -height 30
    
    # Progress
    
    ::ttk::style element create Progress.bar image $I(progressbar)
    
    # Arrows
    
    ::ttk::style element create uparrow image \
        [list $I(arrow_up_normal) \
              pressed $I(arrow_up_active) \
              disabled $I(arrow_up_insensitive)] -width 12
    ::ttk::style element create downarrow image \
        [list $I(arrow_down_normal) \
              pressed $I(arrow_down_active) \
              disabled $I(arrow_down_insensitive)] -width 12
    ::ttk::style element create leftarrow image \
        [list $I(arrow_left_normal) \
              pressed $I(arrow_left_active) \
              disabled $I(arrow_left_insensitive)] -height 12
    ::ttk::style element create rightarrow image \
        [list $I(arrow_right_normal) \
              pressed $I(arrow_right_active) \
              disabled $I(arrow_right_insensitive)] -height 12
    
    # Notebook parts
    
    ::ttk::style element create tab image \
        [list $I(notebook) selected $I(notebook_active) \
                           active   $I(notebook_inactive) \
                           disabled $I(notebook_inactive)] \
        -sticky news \
        -border {10 2 10 2} -height 10
    
    ::ttk::style configure TNotebook.Tab -padding {2 2}
    ::ttk::style configure TNotebook -expandtab {2 2}
    
    
    # Labelframes
    
    ::ttk::style configure TLabelframe -borderwidth 2 -relief groove
  }
}

namespace eval ::tablelist:: {

    proc aquativoTheme {} {
      variable themeDefaults
      array set themeDefaults [list \
        -background                white \
        -foreground                black \
        -disabledforeground        black \
        -stripebackground        #EDF3FE \
        -selectbackground        #000000 \
        -selectforeground        #ffffff \
        -selectborderwidth        0 \
        -font                        TkTextFont \
        -labelbackground        #fafafa \
        -labeldisabledBg        #fafafa \
        -labelactiveBg                #fafafa \
        -labelpressedBg                #fafafa \
        -labelforeground        black \
        -labeldisabledFg        black \
        -labelactiveFg                black \
        -labelpressedFg                black \
        -labelfont                TkDefaultFont \
        -labelborderwidth        2 \
        -labelpady                1 \
        -arrowcolor                #777777 \
        -arrowstyle                flat7x7 \
        -showseparators         yes \
      ]
   }
}

package provide ttk::theme::aquativo $::ttk::theme::aquativo::version

The base64 creation script asumes to have a declaration file CreateImageLib.def in each theme's sub-directory, with e.g. the following content (image name reference list):

arrow_down_active
arrow_down_insensitive
arrow_down_normal
arrow_left_active
arrow_left_insensitive
arrow_left_normal
arrow_right_active
arrow_right_insensitive
arrow_right_normal
arrow_up_active
arrow_up_insensitive
arrow_up_normal
button
buttonNorm
buttonPressed
checkbox_checked
checkbox_unchecked
horizontal_trough
hseparator
menubar_option
menubar_option_arrow
menubar_option_arrow_insensitive
notebook
notebook_active
option_in
option_out
progressbar
scrollbar_horizontal
scrollbar_horizontal_inactive
scrollbar_vertical
scrollbar_vertical_inactive
vertical_trough
vseparator

and as well the images, which need to be in a sub-directory which is named images.