(Stacked)Panes

 

ulis, 2006-11-17. Un package rapidement hacké pour faire des panneaux empilés.


Pourquoi

Pour 'mettre au propre' le megawidget panes de Tk par l'exemple - le megawidget panes.

C'est aussi pour comparer l'effort entre une procédure (50 lignes) et un package (500 lignes).


Comment

Voir Tk par l'exemple - le megawidget panes.


Utilisation

  stackedpanes .sp -titles {firefox opera iexplorer}

  # ====================================
  #  options :
  #
  # - toutes les options du frame, plus
  #   -button    commande pour créer un bouton (commande 'button')
  #   -count     nombre de panneaux (aucun bouton visible)
  #   -orient    orientation (horizontal ou vertical)
  #   -pane      commande pour créer un panneau (commande 'frame')
  #   -titles    liste des titres des boutons (si visibles)
  #
  # - toutes les options des boutons sous la forme :
  #   -b:option valeur (donne la valeur à cette option pour tous les boutons)
  #   -b($n):option valeur (donne la valeur à cette option pour le bouton $n)
  #
  # - toutes les options des panneaux sous la forme :
  #   -p:option valeur (donne la valeur à cette option pour tous les panneaux)
  #   -p($n):option valeur (donne la valeur à cette option pour le panneau $n)
  # ------------------------------------
  #  opérations :
  #
  # cget : retourne la valeur d'une option
  # create : crée un widget panes
  # configure : modifie les valeurs des options
  # get : retourne une valeur par défaut
  # set : modifie des valeurs par défaut
  # ------------------------------------
  # sous-widgets
  #
  #   $w.b($n) (le bouton $n)
  #   $w.p($n) (le panneau $n)
  # ====================================

Configuration

Installation

Utilisation

  package require StackedPanes

Le package StackedPanes

  if {[info exists ::stackedpanes::version]} { return }

  namespace eval ::stackedpanes \
  {
  # #############################
  #
  # package (Staked)Panes
  #
  variable version 1.0
  #
  # (C) ulis, 2006
  # Licence NOL (No Obligation Licence)
  #
  # ====================================
  #  options :
  #
  # - toutes les options du frame, plus
  #   -button    commande pour créer un bouton (commande 'button')
  #   -count     nombre de panneaux (aucun bouton visible)
  #   -orient    orientation (horizontal ou vertical)
  #   -pane      commande pour créer un panneau (commande 'frame')
  #   -titles    liste des titres des boutons (si visibles)
  #
  # - toutes les options des boutons sous la forme :
  #   -b:option valeur (donne la valeur à cette option pour tous les boutons)
  #   -b($n):option valeur (donne la valeur à cette option pour le bouton $n)
  #
  # - toutes les options des panneaux sous la forme :
  #   -p:option valeur (donne la valeur à cette option pour tous les panneaux)
  #   -p($n):option valeur (donne la valeur à cette option pour le panneau $n)
  # ------------------------------------
  #  opérations :
  #
  # cget : retourne la valeur d'une option
  # create : crée un widget panes
  # configure : modifie les valeurs des options
  # get : retourne une valeur par défaut
  # set : modifie des valeurs par défaut
  # ------------------------------------
  # sous-widgets
  #
  #   $w.b($n) (le bouton $n)
  #   $w.p($n) (le panneau $n)
  # ====================================
  # #############################

    ##########################
    #
    # entry point
    #
    ##########################

    namespace export stackedpanes

    ##########################
    #
    # package
    #
    ##########################

    package require Tk 8.4

    package provide StackedPanes $version

    ##########################
    #
    # globals
    #
    ##########################

    variable {}
    variable options
    set w ._stackedpanes_
    frame $w
    set options [list -bd -bg]
    foreach option [$w config] \
    {
      if {[llength $option] == 5} \
      {
        foreach {key - - - value} $option break
        if {[string match *color $key] || [string match *ground $key]} \
        {
          foreach {r g b} [winfo rgb . $value] break
          foreach c {r g b} \
          { set $c [expr [set $c] & 255] }
          set value [format #%2.2x%2.2x%2.2x $r $g $b]
        }
        switch -glob -- $key \
        {
          -padx   -
          -pady   {}
          -high*  { set key [string range $key 0 10]* }
          default { set key [string range $key 0 3]* }
        }
        array set {} [list $key $value]
        lappend options $key
      }
    }
    destroy $w
    unset w

    array set {} \
    {
      :-button    button
      :-count     0
      :-height    200
      :-orient    horizontal
      :-pane      frame
      :-relief    ridge
      :-titles    {"1" "2"}
      :-width     150
    }

    ##########################
    #
    # panes proc
    #
    ##########################

    proc stackedpanes {{oper {}} args} \
    {
      set code [catch \
      {
        if {$oper == ""} \
        { error "panes operations are create, get or set" }
        switch -glob -- $oper \
        {
          cre*    { uplevel 1 ::stackedpanes::panes:create $args }
          get     { uplevel 1 ::stackedpanes::panes:get    $args }
          set     { uplevel 1 ::stackedpanes::panes:set    $args }
          default \
          {
            if {[string match .* $oper]} \
            { uplevel 1 ::stackedpanes::panes:create $oper $args } \
            else \
            { error "unknown panes operation '$oper'" }
          }
        }
      } result]
      return -code $code $result
    }

    ##########################
    #
    # panes:get proc
    #
    ##########################

    proc panes:get {args} \
    {
      variable {}
      variable options
      if {[llength $args] != 1} \
      { error "use is 'panes get -option'" }
      set key [lindex $args 0]
      switch -glob -- $key \
      {
        -but*   { set $(:-button) }
        -cou*   { set $(:-count) }
        -hei*   { set $(:-height) }
        -ori*   { set $(:-orient) }
        -pan*   { set $(:-pane) }
        -rel*   { set $(:-relief) }
        -tit*   { set $(:-titles) }
        -wid*   { set $(:-width) }
        default \
        {
          if {[set n [lsearch -glob $options $key]] > -1} \
          {
            switch -- $key \
            {
              -bd     { set (:-bor*) }
              -bg     { set (:-bac*) }
              default { set (:[lindex $options $n]) }
            }
          } \
          else \
          { error "unknown panes option '$key'" }
        }
      }
    }

    ##########################
    #
    # panes:set proc
    #
    ##########################

    proc panes:set {args} \
    {
      variable {}
      variable options
      if {[llength $args] % 2 != 0} \
      { error "use is 'panes set ?-option value?...'" }
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          -but*   { set $(:-button) $value }
          -cou*   { check:count "" $value }
          -ori*   { check:orient "" $value }
          -pan*   { set $(:-pane) $value }
          -tit*   { set (:-titles) $value }
          default \
          {
            if {[lsearch -glob $options $key] > -1} \
            {
              switch -- $key \
              {
                -bd     { set (:-bor*) $value }
                -bg     { set (:-bac*) $value }
                default { set (:[lindex $options $n]) $value }
              }
            } \
            else \
            { error "unknown panes option '$key'" }
          }
        }
      }
    }

    ##########################
    #
    # panes:create proc
    #
    ##########################

    proc panes:create {{w ""} args} \
    {
      variable {}
      # default values
      set defaults [list]
      foreach name [array names {} :-*] \
      { lappend defaults [lindex [split $name :] 1] $($name) }
      # create panes
      frame $w -class Panes
      $w config
      canvas $w.c -bd 1 -highlightt 0
      canvas $w.cc -bd 0 -highlightt 0
      grid rowconfig $w 1000 -weight 1
      grid columnconf $w 1000 -weight 1
      grid $w.c -row 1 -column 1 -sticky nsew \
         -rowspan 1000 -columnspan 1000
      # create reference
      rename $w ::stackedpanes::_$w
      interp alias {} ::$w {} ::stackedpanes::panes:dispatch $w
      # configure
      set ($w:-orient) horizontal
      set ($w:-titles) {}
      set ($w:-count) 0
      set ($w:count) 0
      eval ::stackedpanes::panes:config $w $defaults
      eval ::stackedpanes::panes:config $w $args
      # select first
      ::stackedpanes::panes:select $w 0
      # return reference
      return $w
    }

    ##########################
    #
    # panes:dispatch proc
    #
    ##########################

    proc panes:dispatch {w {oper ""} args} \
    {
      set code [catch \
      {
        if {$oper == ""} \
        { error "pane $w operations are cget, configure or select" }
        switch -glob -- $oper \
        {
          cge*    { uplevel 1 ::stackedpanes::panes:cget   $w $args }
          con*    { uplevel 1 ::stackedpanes::panes:config $w $args }
          sel*    { uplevel 1 ::stackedpanes::panes:select $w $args }
          default \
          { error "unknown pane operation '$oper'" }
        }
      } result]
      return -code $code $result
    }

    ##########################
    #
    # panes:cget proc
    #
    ##########################

    proc panes:cget {w args} \
    {
      variable {}
      variable options
      if {[llength $args] != 1} \
      { error "use is '$w cget -option'" }
      set key [lindex $args 0]
      switch -glob -- $key \
      {
        -but*   { set ($w:-button) }
        -hei*   { set ($w:-height) }
        -ori*   { set ($w:-orient) }
        -pan*   { set ($w:-pane) }
        -rel*   { set ($w:-relief) }
        -tit*   { set ($w:-titles) }
        -wid*   { set ($w:-width) }
        default \
        {
          if {[set n [lsearch -glob $options $key]] > -1} \
          { ::stackedpanes::_$w cget $key }
          else \
          { error "unknown panes option '$key'" }
        }
      }
    }

    ##########################
    #
    # panes:config proc
    #
    ##########################

    proc panes:config {w args} \
    {
      variable {}
      variable options
      if {[llength $args] % 2 != 0} \
      { error "use is '$w config ?-option value?...'" }
      set fdraw 0
      set ioptions [list]
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          -*:*    { lappend ioptions $key $value }
          -but*   { set ($w:-button) $value }
          -cou*   \
          {
            check:count $w $value
            set ($w:titles) 0
            set fdraw 1
          }
          -hei*   { $w.c config -height $value }
          -ori*   \
          {
            check:orient $w $value
            set fdraw 1
          }
          -pan*   { set ($w:-pane) $value }
          -rel*   { $w.c config -relief $value }
          -tit*   \
          {
            set ($w:-titles) $value
            set ($w:titles) [llength $value]
            set fdraw 1
          }
          -wid*   { $w.c config -width $value }
          default \
          {
            if {[lsearch -glob $options $key] > -1} \
            { ::stackedpanes::_$w config $key $value } \
            else \
            { error "unknown panes option '$key'" }
          }
        }
      }
      if {$fdraw} { draw:panes $w }
      eval item:config $w $ioptions
    }

    ##########################
    #
    # panes:select proc
    #
    ##########################

    proc panes:select {w args} \
    {
      variable {}
      switch [llength $args] \
      {
        0       \
        { return $($w:selected)}
        1       \
        {
          set n [lindex $args 0]
          incr n 0
          set count [llength $($w:-titles)]
          if {$n < 0 || $n > $count - 1} \
          { error "index '$n' is out of range" }
          if {[winfo exists $w.b($n)]} \
          {
            set dim3 width; set dim4 height; set relx 0.0; set rely 1.0; set x -2; set y 2
            if {$($w:-orient) == "vertical"} \
            { set dim3 height; set dim4 width; set relx 1.0; set rely 0.0; set x 2; set y -2 }
            set dim [winfo $dim3 $w.b($n)]
            incr dim -3
            $w.cc config -$dim3 $dim -$dim4 2 -bg [$w.p($n) cget -bg]
            place $w.cc -in $w.b($n) -x $x -y $y -relx $relx -rely $rely
            raise $w.cc
          }
          raise $w.p($n)
          set ($w:selected) $n
        }
        default \
        { error "use is '$w select count'" }
      }
    }

    ##########################
    #
    # draw:panes proc
    #
    ##########################

    proc draw:panes {w} \
    {
      variable {}
      set titles $($w:-titles)
      set oldcount $($w:count)
      set butcount $($w:titles)
      set newcount $butcount
      if {$newcount == 0} { set newcount $($w:-count) }
      set ($w:count) $newcount
      set mincount $oldcount
      if {$mincount > $newcount} { set mincount $newcount }
      set maxcount $oldcount
      if {$maxcount < $newcount} { set maxcount $newcount }
      set dim1 row; set dim2 column
      if {$($w:-orient) == "vertical"} \
      { set dim1 column; set dim2 row }
      for {set n 0} {$n < $mincount} {incr n} \
      {
        if {$butcount == 0 && [winfo exists $w.b($n)]} \
        { destroy $w.b($n) } \
        elseif {![winfo exists $w.b($n)]} \
        {
          $($w:-button) $w.b($n) -bd 1 -relief ridge \
            -text [lindex $titles $n] \
            -command [list ::stackedpanes::panes:select $w $n]
          grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
        } \
        else \
        {
          $w.b($n) config -text [lindex $titles $n]
          grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
        }
        grid $w.p($n) -row 1 -column 1 -sticky nsew \
           -rowspan 1000 -columnspan 1000 -padx 1 -pady 1
      }
      for {set n $mincount} {$n < $maxcount} {incr n} \
      {
        if {$newcount > $mincount} \
        {
          if {![winfo exists $w.b($n)]} \
          {
            $($w:-button) $w.b($n) -bd 1 -relief ridge \
              -text [lindex $titles $n] \
              -command [list ::stackedpanes::panes:select $w $n]
            grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
          } \
          else \
          {
            $w.b($n) config -text [lindex $titles $n]
            grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
          }
          if {![winfo exists $w.p($n)]} \
          {
            $($w:-pane) $w.p($n)
            grid $w.p($n) -row 1 -column 1 -sticky nsew \
              -rowspan 1000 -columnspan 1000 -padx 1 -pady 1
          } \
          else \
          {
            grid $w.p($n) -row 1 -column 1 -sticky nsew \
              -rowspan 1000 -columnspan 1000
          }
        } \
        else \
        {
          if {[winfo exists $w.b($n)]} \
          { destroy $w.b($n) }
          destroy $w.p($n)
        }
      }
    }

    ##########################
    #
    # item:config proc
    #
    ##########################

    proc item:config {w args} \
    {
      variable {}
      set count $($w:count)
      foreach {key value} $args \
      {
        foreach {type n option} [item:option $key] break
        if {$n == ""} \
        {
          for {set n 0} {$n < $count} {incr n} \
          { $w.${type}($n) config -$option $value }
        } \
        else \
        {
          if {$n < 0 || $n > $count - 1} \
          { error "index in '$key' is out of range" }
          $w.${type}($n) config -$option $value
        }
      }
    }

    proc item:option {key} \
    {
      set items [split $key -:()]
      set id ""
      if {[llength $items] == 3} \
      { foreach {- type option} $items break } \
      else \
      { foreach {- type id - option} $items break }
      return [list $type $id $option]
    }

    ##########################
    #
    # check procs
    #
    ##########################

    proc check:int {value} \
    {
      set x 0
      incr x $value
    }

    proc check:color {w key value} \
    {
      variable {}
      if {$value != "" && [catch { winfo rgb . $value }]} \
      { error "bad $key value '$value'" }
      set ($w:$key) $value
    }

    proc check:count {w value} \
    {
      variable {}
      if {![string is integer -strict $value] || $value < 0} \
      { error "bad -count value '$value'" }
      set ($w:-count) $value
    }

    proc check:orient {w value} \
    {
      variable {}
      switch -glob -- $value \
      {
        hor*    { set ($w:-orient) horizontal }
        ver*    { set ($w:-orient) vertical }
        default \
        { error "bad -orient value '$value'" }
      }
    }

  }
  namespace import ::stackedpanes::stackedpanes

Script de description pkgIndex.tcl

  package ifneeded StackedPanes 1.0 [list source [file join $dir StackedPanes.tcl]]

La démo

    package require StackedPanes

    . config -padx 10 -pady 10
    set titles {firefox iexplorer opera}
    set colors {#fee #eef #efe}
    set w .sp
    stackedpanes $w -titles $titles -orient vert -b:width 8 -b:height 5
    set n -1
    foreach title $titles color $colors \
    {
      incr n
      $w config -p($n):bg $color -b($n):bg $color
      label $w.p($n).l -text $title -bg $color
      grid $w.p($n).l
    }
    grid $w
    after 1 $w select 0
    after 2000 [list $w select 2]
    after 4000 [list $w config -orient horiz -b:height 1]
    after 4001 [list $w select 1]
    after 6000 [list $w config -count 2]
    after 6001 [list $w select 1]
    after 7000 [list $w select 0]

Voir aussi


Discussion


Catégorie Paquet | Catégorie Interface utilisateur