1## -*- tcl -*- 2# ### ### ### ######### ######### ######### 3 4## A discrete zoom-control widget based on two buttons and label. 5## The API is similar to a scale. 6 7# ### ### ### ######### ######### ######### 8## Requisites 9 10package require Tcl 8.4 ; # No {*}-expansion :( 11package require Tk 12package require snit ; # 13package require uevent::onidle ; # Some defered actions. 14 15# ### ### ### ######### ######### ######### 16## 17 18snit::widget ::canvas::zoom { 19 # ### ### ### ######### ######### ######### 20 ## API 21 22 option -orient -default vertical -configuremethod O-orient \ 23 -type {snit::enum -values {vertical horizontal}} 24 option -levels -default {0 10} -configuremethod O-levels \ 25 -type {snit::listtype -minlen 1 -maxlen 2 -type snit::integer} 26 option -variable -default {} -configuremethod O-variable 27 option -command -default {} -configuremethod O-command 28 29 constructor {args} { 30 install reconfigure using uevent::onidle ${selfns}::reconfigure \ 31 [mymethod Reconfigure] 32 33 set options(-variable) [myvar myzoomlevel] ;# Default value 34 $self configurelist $args 35 36 # Force redraw if it could not be triggered by options. 37 if {![llength $args]} { 38 $reconfigure request 39 } 40 return 41 } 42 43 # ### ### ### ######### ######### ######### 44 ## Option processing. Any changes force a refresh of the grid 45 ## information, and then a redraw. 46 47 method O-orient {o v} { 48 if {$options($o) eq $v} return 49 set options($o) $v 50 $reconfigure request 51 return 52 } 53 54 method O-levels {o v} { 55 # When only a single value was specified, we use it as 56 # our maximum, and default the minimum to zero. 57 if {[llength $v] == 1} { 58 set v [linsert $v 0 0] 59 } 60 if {$options($o) == $v} return 61 set options($o) $v 62 $reconfigure request 63 return 64 } 65 66 method O-variable {o v} { 67 # The handling of an attached variable is very simple, without 68 # any of the trace management one would expect to be 69 # here. That is because we are using an unmapped aka hidden 70 # scale widget to do this for us, at the C level. 71 72 if {$options($o) == $v} return 73 set options($o) $v 74 $reconfigure request 75 return 76 } 77 78 method O-command {o v} { 79 if {$v eq $options(-command)} return 80 set options(-command) $v 81 return 82 } 83 84 # ### ### ### ######### ######### ######### 85 86 component reconfigure 87 method Reconfigure {} { 88 # (Re)generate the user interface. 89 90 eval [linsert [winfo children $win] 0 destroy] 91 92 set side $options(-orient) 93 set var $options(-variable) 94 foreach {lo hi} $options(-levels) break 95 96 set vwidth [expr {max([string length $lo], [string length $hi])}] 97 set pre [expr {[info commands ::ttk::button] ne "" ? "::ttk" : "::tk"}] 98 99 ${pre}::frame $win.z -relief solid -borderwidth 1 100 ${pre}::button $win.z.plus -image ::canvas::zoom::plus -command [mymethod ZoomIn] 101 ${pre}::label $win.z.val -textvariable $var -justify c -anchor c -width $vwidth 102 ${pre}::button $win.z.minus -image ::canvas::zoom::minus -command [mymethod ZoomOut] 103 104 # Use an unmapped scale to keep var between lo and hi and 105 # avoid doing our own trace management 106 scale $win.z.sc -from $lo -to $hi -variable $var 107 108 pack $win.z -fill both -expand 1 109 if {$side eq "vertical"} { 110 pack $win.z.plus $win.z.val $win.z.minus -side top -fill x 111 } else { 112 pack $win.z.plus $win.z.val $win.z.minus -side left -fill y 113 } 114 return 115 } 116 117 # ### ### ### ######### ######### ######### 118 ## Events which act on the zoomlevel. 119 120 method ZoomIn {} { 121 upvar #0 $options(-variable) zoomlevel 122 foreach {lo hi} $options(-levels) break 123 if {$zoomlevel >= $hi} return 124 incr zoomlevel 125 $self Callback 126 return 127 } 128 129 method ZoomOut {} { 130 upvar #0 $options(-variable) zoomlevel 131 foreach {lo hi} $options(-levels) break 132 if {$zoomlevel <= $lo} return 133 incr zoomlevel -1 134 $self Callback 135 return 136 } 137 138 method Callback {} { 139 if {![llength $options(-command)]} return 140 141 upvar #0 $options(-variable) zoomlevel 142 uplevel #0 [linsert $options(-command) end $win $zoomlevel] 143 return 144 } 145 146 # ### ### ### ######### ######### ######### 147 ## State 148 149 variable myzoomlevel 0 ; # The variable to use if the user 150 # did not supply one to -variable. 151 152 # ### ### ### ######### ######### ######### 153} 154 155# ### ### ### ######### ######### ######### 156## Images for the buttons 157 158image create bitmap ::canvas::zoom::plus -data { 159 #define plus_width 8 160 #define plus_height 8 161 static char bullet_bits = { 162 0x18, 0x18, 0x18, 0xff, 0xff, 0x18, 0x18, 0x18 163 } 164} 165 166image create bitmap ::canvas::zoom::minus -data { 167 #define minus_width 8 168 #define minus_height 8 169 static char bullet_bits = { 170 0x00, 0x00, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00 171 } 172} 173 174# ### ### ### ######### ######### ######### 175## Ready 176 177package provide canvas::zoom 0.2.1 178return 179 180# ### ### ### ######### ######### ######### 181## Scrap yard. 182