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