scripts/panelbar.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 class tlc::Panelbar {
   4         inherit tlc::Mywidget tlc::Baselog
   5
   6         constructor {args} {}
   7
   8         itk_option define -width width Width 120
   9         itk_option define -pady padY PadY 20
  10
  11         public {
  12                 variable select_cb                      {}
  13                 variable activebackground
  14
  15                 method addpanel {name {id ""}}
  16                 method panel_exists {id}
  17                 method additem {panel idinfo {image {}}}
  18                 method open {id}
  19
  20                 method width {}
  21                 method bottom_y {}
  22                 method get_open {}
  23                 method new_open {obj}
  24                 method select {id}
  25                 method redraw {}
  26
  27                 method attach_signal {panel item signal {sense normal}}
  28         }
  29
  30         private {
  31                 variable panel_obj
  32                 variable last                   ""
  33                 variable open_panel             ""
  34                 variable last_obj               ""
  35                 variable this_obj               ""
  36                 variable next_obj               ""
  37                 variable dominos
  38
  39                 method _redraw {}
  40         }
  41 }
  42
  43
  44 configbody tlc::Panelbar::activebackground { #<<<1
  45         log debug $w
  46         option add *$wdb*activeBackground       $activebackground
  47 }
  48
  49
  50 body tlc::Panelbar::constructor {args} { #<<<1
  51         log debug $w
  52         array set dominos       {}
  53
  54         tlc::Domino #auto dominos(need_redraw) -name "$w need_redraw"
  55
  56         itk_component add canv {
  57                 canvas $w.canv
  58         } {
  59                 keep -borderwidth -relief -background
  60         }
  61
  62         eval itk_initialize $args
  63
  64         $w.canv yview moveto 0.0
  65         $w.canv xview moveto 0.0
  66
  67         blt::table $w \
  68                 $w.canv         1,1 -fill both -width $itk_option(-width)
  69
  70         bind $w.canv <Configure> [code $this redraw]
  71
  72         $dominos(need_redraw) attach_output [code $this _redraw]
  73 }
  74
  75
  76 body tlc::Panelbar::addpanel {name {id ""}} { #<<<1
  77         log debug $w
  78         if {$id == ""} {
  79                 set id  $name
  80         }
  81
  82         set last        [Panelbar_Panel ::#auto -parent $this \
  83                 -id $id -name $name -previous $last -canv $w.canv]
  84         set panel_obj($id)      $last
  85 }
  86
  87
  88 body tlc::Panelbar::panel_exists {id} { #<<<1
  89         log debug $w
  90         return [info exists panel_obj($id)]
  91 }
  92
  93
  94 body tlc::Panelbar::additem {panel idinfo {image {}}} { #<<<1
  95         log debug $w
  96         if {![info exists panel_obj($panel)]} {
  97                 #error "No such panel: ($panel)"
  98                 addpanel $panel
  99         }
 100
 101         if {$image == {}} {
 102                 set image       [$::tlc::theme get_icon default_panelbar_icon]
 103         }
 104
 105         set name        ""
 106         set id          ""
 107         foreach {name id} $idinfo break
 108
 109         if {$id == ""} {
 110                 set id          $name
 111         }
 112
 113         $panel_obj($panel) additem $name $id $image \
 114                         -pady $itk_option(-pady)
 115 }
 116
 117
 118 body tlc::Panelbar::open {id} { #<<<1
 119         log debug $w
 120         $panel_obj($id) open
 121 }
 122
 123
 124 body tlc::Panelbar::width {} { #<<<1
 125         log debug $w
 126         return [expr {$itk_option(-width) - 4}]
 127         return [expr {[winfo reqwidth $w.canv] - 2}]
 128 }
 129
 130
 131 body tlc::Panelbar::bottom_y {} { #<<<1
 132         log debug $w
 133         blt::table arrange $w
 134         update idletasks
 135         blt::table arrange $w
 136
 137         set ext_info    [blt::table extents $w c1]
 138         #if {[package vsatisfies $::blt_version 3.0]}
 139         switch -- [llength $ext_info] {
 140                 6 {foreach {id foo x y wd ht} $ext_info break}
 141                 5 {foreach {id x y wd ht} $ext_info break}
 142                 default {error "Bad table extent format: ($ext_info)"}
 143         }
 144
 145         return [expr {$ht - 1 - 4}]
 146 }
 147
 148
 149 body tlc::Panelbar::get_open {} { #<<<1
 150         log debug $w
 151         return $open_panel
 152 }
 153
 154
 155 body tlc::Panelbar::new_open {obj} { #<<<1
 156         log debug $w
 157         #puts "tlc::Panelbar::new_open: ($obj)"
 158         #foreach v {last_obj this_obj next_obj} {
 159         #       puts "$v: ([set $v])"
 160         #}
 161         set last_obj            $this_obj
 162         set this_obj            $obj
 163         set next_obj            ""
 164
 165         set open_panel  $obj
 166 }
 167
 168
 169 body tlc::Panelbar::select {id} { #<<<1
 170         log debug $w
 171         if {$select_cb != ""} {
 172                 uplevel #0 $select_cb [list $id]
 173         }
 174 }
 175
 176
 177 body tlc::Panelbar::redraw {} { #<<<1
 178         log debug $w
 179         $dominos(need_redraw) tip
 180 }
 181
 182
 183 body tlc::Panelbar::_redraw {} { #<<<1
 184         log debug $w
 185         foreach {key obj} [array get panel_obj] {
 186                 $obj redraw
 187         }
 188 }
 189
 190
 191 body tlc::Panelbar::attach_signal {panel item signal {sense normal}} { #<<<1
 192         log debug $w
 193         [$panel_obj($panel) item_ref $item] attach_signal $signal $sense
 194 }
 195
 196