line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2007, 2008, 2009, 2010, 2011 Kevin Ryde |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# This file is part of Gtk2-Ex-NumAxis. |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Gtk2-Ex-NumAxis is free software; you can redistribute it and/or modify it |
6
|
|
|
|
|
|
|
# under the terms of the GNU General Public License as published by the Free |
7
|
|
|
|
|
|
|
# Software Foundation; either version 3, or (at your option) any later |
8
|
|
|
|
|
|
|
# version. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# Gtk2-Ex-NumAxis is distributed in the hope that it will be useful, but |
11
|
|
|
|
|
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
12
|
|
|
|
|
|
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
13
|
|
|
|
|
|
|
# for more details. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License along |
16
|
|
|
|
|
|
|
# with Gtk2-Ex-NumAxis. If not, see . |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package Gtk2::Ex::NumAxis; |
19
|
3
|
|
|
3
|
|
2575
|
use 5.008; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
112
|
|
20
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
94
|
|
21
|
3
|
|
|
3
|
|
24
|
use warnings; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
124
|
|
22
|
3
|
|
|
3
|
|
2628
|
use Gtk2 1.220; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use List::Util qw(min max); |
24
|
|
|
|
|
|
|
use Math::Round; |
25
|
|
|
|
|
|
|
use POSIX qw(floor ceil); |
26
|
|
|
|
|
|
|
use Gtk2::Ex::AdjustmentBits; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
29
|
|
|
|
|
|
|
#use Smart::Comments; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
our $VERSION = 5; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
use Glib::Ex::SignalBits; |
34
|
|
|
|
|
|
|
use Glib::Ex::SignalIds; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use Glib::Object::Subclass |
37
|
|
|
|
|
|
|
'Gtk2::DrawingArea', |
38
|
|
|
|
|
|
|
signals => { expose_event => \&_do_expose_event, |
39
|
|
|
|
|
|
|
size_request => \&_do_size_request, |
40
|
|
|
|
|
|
|
style_set => \&_do_style_or_direction, |
41
|
|
|
|
|
|
|
direction_changed => \&_do_style_or_direction, |
42
|
|
|
|
|
|
|
scroll_event => \&_do_scroll_event, |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
'set-scroll-adjustments' => |
45
|
|
|
|
|
|
|
{ param_types => ['Gtk2::Adjustment', |
46
|
|
|
|
|
|
|
'Gtk2::Adjustment'], |
47
|
|
|
|
|
|
|
return_type => undef, |
48
|
|
|
|
|
|
|
class_closure => \&_do_set_scroll_adjustments }, |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
'number-to-text' => |
51
|
|
|
|
|
|
|
{ param_types => ['Glib::Double','Glib::Int'], |
52
|
|
|
|
|
|
|
return_type => 'Glib::String', |
53
|
|
|
|
|
|
|
flags => ['run-last'], |
54
|
|
|
|
|
|
|
accumulator => \&Glib::Ex::SignalBits::accumulator_first_defined, |
55
|
|
|
|
|
|
|
class_closure => \&_do_number_to_text }, |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Glib::ParamSpec->scalar |
58
|
|
|
|
|
|
|
# ('transform', |
59
|
|
|
|
|
|
|
# 'transform', |
60
|
|
|
|
|
|
|
# '', |
61
|
|
|
|
|
|
|
# Glib::G_PARAM_READWRITE), |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
# Glib::ParamSpec->scalar |
64
|
|
|
|
|
|
|
# ('untransform', |
65
|
|
|
|
|
|
|
# 'untransform', |
66
|
|
|
|
|
|
|
# '', |
67
|
|
|
|
|
|
|
# Glib::G_PARAM_READWRITE), |
68
|
|
|
|
|
|
|
}, |
69
|
|
|
|
|
|
|
properties => [Glib::ParamSpec->object |
70
|
|
|
|
|
|
|
('adjustment', |
71
|
|
|
|
|
|
|
'Adjustment object', |
72
|
|
|
|
|
|
|
'The adjustment object to display values from.', |
73
|
|
|
|
|
|
|
'Gtk2::Adjustment', |
74
|
|
|
|
|
|
|
Glib::G_PARAM_READWRITE), |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Glib::ParamSpec->int |
77
|
|
|
|
|
|
|
('min-decimals', |
78
|
|
|
|
|
|
|
'Minimum decimals', |
79
|
|
|
|
|
|
|
'A minimum number of decimal places to display.', |
80
|
|
|
|
|
|
|
# range limited to 1000 decimals to try to catch garbage |
81
|
|
|
|
|
|
|
# going in and to try to stop calculated width becoming |
82
|
|
|
|
|
|
|
# something wild |
83
|
|
|
|
|
|
|
0, 1000, # min, max |
84
|
|
|
|
|
|
|
0, # default |
85
|
|
|
|
|
|
|
Glib::G_PARAM_READWRITE), |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Glib::ParamSpec->boolean |
88
|
|
|
|
|
|
|
('inverted', |
89
|
|
|
|
|
|
|
(do { # translation from GtkScrollbar |
90
|
|
|
|
|
|
|
my $str = 'Inverted'; |
91
|
|
|
|
|
|
|
eval { require Locale::Messages; |
92
|
|
|
|
|
|
|
Locale::Messages::dgettext('gtk20-properties',$str) |
93
|
|
|
|
|
|
|
} || $str }), |
94
|
|
|
|
|
|
|
'Invert the scale so numbers are drawn increasing from the bottom up, instead of the default top down.', |
95
|
|
|
|
|
|
|
0, # default |
96
|
|
|
|
|
|
|
Glib::G_PARAM_READWRITE), |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Glib::ParamSpec->enum |
99
|
|
|
|
|
|
|
('orientation', |
100
|
|
|
|
|
|
|
(do { # translation from GtkOrientable |
101
|
|
|
|
|
|
|
my $str = 'Orientation'; |
102
|
|
|
|
|
|
|
eval { require Locale::Messages; |
103
|
|
|
|
|
|
|
Locale::Messages::dgettext('gtk20-properties',$str) |
104
|
|
|
|
|
|
|
} || $str }), |
105
|
|
|
|
|
|
|
'Horizontal or vertical display and scrolling.', |
106
|
|
|
|
|
|
|
'Gtk2::Orientation', |
107
|
|
|
|
|
|
|
'vertical', |
108
|
|
|
|
|
|
|
Glib::G_PARAM_READWRITE), |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
]; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# as fraction of digit width |
114
|
|
|
|
|
|
|
# these not documented, could be properties or style properties |
115
|
|
|
|
|
|
|
use constant { TICK_WIDTH_FRAC => 0.8, |
116
|
|
|
|
|
|
|
TICK_GAP_FRAC => 0.5, |
117
|
|
|
|
|
|
|
TICK_HEIGHT_FRAC => 0.4, |
118
|
|
|
|
|
|
|
TICK_VGAP_FRAC => 0.1, |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
# right-margin 0.2 between number and right edge of window |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub INIT_INSTANCE { |
123
|
|
|
|
|
|
|
my ($self) = @_; |
124
|
|
|
|
|
|
|
$self->{'min_decimals'} = 0; # default |
125
|
|
|
|
|
|
|
$self->{'decided_done_for'} = 'x'; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub SET_PROPERTY { |
129
|
|
|
|
|
|
|
my ($self, $pspec, $newval) = @_; |
130
|
|
|
|
|
|
|
my $pname = $pspec->get_name; |
131
|
|
|
|
|
|
|
### SET_PROPERTY: $pname, $newval |
132
|
|
|
|
|
|
|
$self->{$pname} = $newval; # per default GET_PROPERTY |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
if ($pname eq 'adjustment') { |
135
|
|
|
|
|
|
|
my $adj = $newval; |
136
|
|
|
|
|
|
|
$self->{'adjustment_ids'} = $adj && do { |
137
|
|
|
|
|
|
|
Scalar::Util::weaken (my $weak_self = $self); |
138
|
|
|
|
|
|
|
Glib::Ex::SignalIds->new |
139
|
|
|
|
|
|
|
($adj, |
140
|
|
|
|
|
|
|
$newval->signal_connect (value_changed => \&_do_adj_value_changed, |
141
|
|
|
|
|
|
|
\$weak_self), |
142
|
|
|
|
|
|
|
$newval->signal_connect (changed => \&_do_adj_other_changed, |
143
|
|
|
|
|
|
|
\$weak_self)); |
144
|
|
|
|
|
|
|
}; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
$self->{'decided_done_for'} = 'x'; |
148
|
|
|
|
|
|
|
$self->queue_resize; |
149
|
|
|
|
|
|
|
$self->queue_draw; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# 'set-scroll-adjustments' class closure |
153
|
|
|
|
|
|
|
sub _do_set_scroll_adjustments { |
154
|
|
|
|
|
|
|
my ($self, $hadj, $vadj) = @_; |
155
|
|
|
|
|
|
|
$self->set (adjustment => ($self->get('orientation') eq 'horizontal' |
156
|
|
|
|
|
|
|
? $hadj : $vadj)); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# my %direction_to_orientation = (up => 'vertical', |
160
|
|
|
|
|
|
|
# down => 'vertical', |
161
|
|
|
|
|
|
|
# left => 'horizontal', |
162
|
|
|
|
|
|
|
# right => 'horizontal'); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# 'scroll-event' class closure |
165
|
|
|
|
|
|
|
sub _do_scroll_event { |
166
|
|
|
|
|
|
|
my ($self, $event) = @_; |
167
|
|
|
|
|
|
|
### NumAxis _do_scroll_event(): $event->direction |
168
|
|
|
|
|
|
|
if (my $adj = $self->{'adjustment'}) { |
169
|
|
|
|
|
|
|
_adjustment_scroll_event ($adj, $event, $self->{'inverted'}); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
return $self->signal_chain_from_overridden ($event); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my %direction_inverted = (up => 1, |
175
|
|
|
|
|
|
|
down => 0, |
176
|
|
|
|
|
|
|
left => 1, |
177
|
|
|
|
|
|
|
right => 0); |
178
|
|
|
|
|
|
|
# $event is a Gtk2::Gdk::Event::Scroll |
179
|
|
|
|
|
|
|
sub _adjustment_scroll_event { |
180
|
|
|
|
|
|
|
my ($adj, $event, $inverted) = @_; |
181
|
|
|
|
|
|
|
my $inctype = ($event->state & 'control-mask' |
182
|
|
|
|
|
|
|
? 'page_increment' |
183
|
|
|
|
|
|
|
: 'step_increment'); |
184
|
|
|
|
|
|
|
my $add = $adj->$inctype; |
185
|
|
|
|
|
|
|
unless ((!$inverted) ^ $direction_inverted{$event->direction}) { |
186
|
|
|
|
|
|
|
$add = -$add; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
Gtk2::Ex::AdjustmentBits::scroll_value ($adj, $add); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# 'size-request' class closure |
192
|
|
|
|
|
|
|
sub _do_size_request { |
193
|
|
|
|
|
|
|
my ($self, $req) = @_; |
194
|
|
|
|
|
|
|
### NumAxis _do_size_request() |
195
|
|
|
|
|
|
|
### orientation: $self->get('orientation') |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
if ($self->get('orientation') eq 'horizontal') { |
198
|
|
|
|
|
|
|
$req->width (0); |
199
|
|
|
|
|
|
|
$req->height (_decide_height ($self)); |
200
|
|
|
|
|
|
|
} else { |
201
|
|
|
|
|
|
|
$req->width (_decide_width ($self)); |
202
|
|
|
|
|
|
|
$req->height (0); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
### NumAxis _do_size_request() return: $req->width . 'x' . $req->height |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# 'number-to-text' class closure |
208
|
|
|
|
|
|
|
sub _do_number_to_text { |
209
|
|
|
|
|
|
|
my ($self, $number, $decimals) = @_; |
210
|
|
|
|
|
|
|
### _do_number_to_text() |
211
|
|
|
|
|
|
|
### $number |
212
|
|
|
|
|
|
|
### $decimals |
213
|
|
|
|
|
|
|
return sprintf ('%.*f', $decimals, $number); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub identity { |
217
|
|
|
|
|
|
|
return $_[0]; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
my %wh = (horizontal => 'width', |
221
|
|
|
|
|
|
|
vertical => 'height'); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub _do_expose_event { |
224
|
|
|
|
|
|
|
my ($self, $event) = @_; |
225
|
|
|
|
|
|
|
### NumAxis _do_expose_event(): $self->get_name |
226
|
|
|
|
|
|
|
### decided width: $self->{'decided_width'} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
my $adj = $self->{'adjustment'} || do { |
229
|
|
|
|
|
|
|
### no adjustment, no draw |
230
|
|
|
|
|
|
|
return Gtk2::EVENT_PROPAGATE; |
231
|
|
|
|
|
|
|
}; |
232
|
|
|
|
|
|
|
my $page_size = $adj->page_size || do { |
233
|
|
|
|
|
|
|
### zero height page, no draw |
234
|
|
|
|
|
|
|
return Gtk2::EVENT_PROPAGATE; |
235
|
|
|
|
|
|
|
}; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
my $lo = $adj->get_value; |
238
|
|
|
|
|
|
|
my ($unit, $unit_decimals) = _decide_unit ($self, $lo); |
239
|
|
|
|
|
|
|
### $unit |
240
|
|
|
|
|
|
|
### $unit_decimals |
241
|
|
|
|
|
|
|
if ($unit == 0) { |
242
|
|
|
|
|
|
|
### unit zero, no draw |
243
|
|
|
|
|
|
|
return Gtk2::EVENT_PROPAGATE; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
my $hi = $lo + $page_size; |
246
|
|
|
|
|
|
|
### $lo |
247
|
|
|
|
|
|
|
### $hi |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
my $layout = _layout($self); |
250
|
|
|
|
|
|
|
my $decimals = $self->{'min_decimals'}; |
251
|
|
|
|
|
|
|
my $state = $self->state; |
252
|
|
|
|
|
|
|
my $style = $self->style; |
253
|
|
|
|
|
|
|
my $win = $self->window; |
254
|
|
|
|
|
|
|
my $orientation = $self->get('orientation'); |
255
|
|
|
|
|
|
|
my $win_pixels = do { |
256
|
|
|
|
|
|
|
my $method = $wh{$orientation}; |
257
|
|
|
|
|
|
|
$self->allocation->$method |
258
|
|
|
|
|
|
|
}; |
259
|
|
|
|
|
|
|
my $clip_rect = $event->area; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
my $factor = $win_pixels / $page_size; |
262
|
|
|
|
|
|
|
my $offset = 0; |
263
|
|
|
|
|
|
|
if ($self->{'inverted'}) { |
264
|
|
|
|
|
|
|
$factor = -$factor; |
265
|
|
|
|
|
|
|
$offset = $win_pixels; |
266
|
|
|
|
|
|
|
### invert |
267
|
|
|
|
|
|
|
### $factor |
268
|
|
|
|
|
|
|
### $offset |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
$offset += -$lo * $factor; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
my $digit_height = $self->{'digit_height'}; |
273
|
|
|
|
|
|
|
$decimals = max ($decimals, $unit_decimals); |
274
|
|
|
|
|
|
|
my $widen = $digit_height / abs($factor); |
275
|
|
|
|
|
|
|
$lo -= $widen; |
276
|
|
|
|
|
|
|
$hi += $widen; |
277
|
|
|
|
|
|
|
### $win_pixels |
278
|
|
|
|
|
|
|
### $factor |
279
|
|
|
|
|
|
|
### digit_height pixels: $digit_height |
280
|
|
|
|
|
|
|
### which is widen value: $widen |
281
|
|
|
|
|
|
|
### widen to: "lo=$lo hi=$hi" |
282
|
|
|
|
|
|
|
### $unit |
283
|
|
|
|
|
|
|
### $decimals |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
my $tick_gc = $style->fg_gc($state); |
286
|
|
|
|
|
|
|
my $transform = $self->{'transform'} || \&identity; |
287
|
|
|
|
|
|
|
my $untransform = $self->{'untransform'} || \&identity; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
$lo = $transform->($lo); |
290
|
|
|
|
|
|
|
$hi = $transform->($hi); |
291
|
|
|
|
|
|
|
my $n = Math::Round::nhimult ($unit, $lo); |
292
|
|
|
|
|
|
|
### loop: "$lo to $hi, starting $n" |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# ENHANCE-ME: stop looping when a string goes past the end of the |
296
|
|
|
|
|
|
|
# $clip_rect, in whichever direction |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
if ($orientation eq 'horizontal') { |
299
|
|
|
|
|
|
|
my $decided_height = _decide_height($self); |
300
|
|
|
|
|
|
|
my $tick_height = ceil (TICK_HEIGHT_FRAC * $digit_height); |
301
|
|
|
|
|
|
|
my $text_y = $tick_height + ceil (TICK_VGAP_FRAC * $digit_height); |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
for ( ; $n <= $hi; $n += $unit) { |
304
|
|
|
|
|
|
|
my $str = $self->signal_emit ('number-to-text', $n, $decimals); |
305
|
|
|
|
|
|
|
$layout->set_text ($str); |
306
|
|
|
|
|
|
|
my ($str_width, $str_height) = $layout->get_pixel_size; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my $u = $untransform->($n); |
309
|
|
|
|
|
|
|
my $x = floor ($factor * $u + $offset); |
310
|
|
|
|
|
|
|
my $text_x = $x - int ($str_width/2); # left of text to centre |
311
|
|
|
|
|
|
|
### $x |
312
|
|
|
|
|
|
|
### $text_x |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
$win->draw_rectangle ($tick_gc, |
315
|
|
|
|
|
|
|
1, # filled |
316
|
|
|
|
|
|
|
$x, # x |
317
|
|
|
|
|
|
|
0, # y |
318
|
|
|
|
|
|
|
1, # width==1 |
319
|
|
|
|
|
|
|
$tick_height); # height |
320
|
|
|
|
|
|
|
$style->paint_layout ($win, |
321
|
|
|
|
|
|
|
$state, |
322
|
|
|
|
|
|
|
1, # use_text, for the text gc instead of the fg one |
323
|
|
|
|
|
|
|
$clip_rect, |
324
|
|
|
|
|
|
|
$self, # widget |
325
|
|
|
|
|
|
|
__PACKAGE__, # style detail string |
326
|
|
|
|
|
|
|
$text_x, |
327
|
|
|
|
|
|
|
$text_y, |
328
|
|
|
|
|
|
|
$layout); |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
if ($x >= 0 && $x < $win_pixels # only values more than half in window |
331
|
|
|
|
|
|
|
&& ($str_height += $text_y) > $decided_height) { |
332
|
|
|
|
|
|
|
### draw is higher than decided_height: "str=$str, height=$str_height cf decided_height=$decided_height" |
333
|
|
|
|
|
|
|
$decided_height = $self->{'decided_height'} = $str_height; |
334
|
|
|
|
|
|
|
$self->queue_resize; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
} else { # vertical |
339
|
|
|
|
|
|
|
my $decided_width = _decide_width($self); |
340
|
|
|
|
|
|
|
my $digit_width = $self->{'digit_width'}; |
341
|
|
|
|
|
|
|
my $tick_width = ceil (TICK_WIDTH_FRAC * $digit_width); |
342
|
|
|
|
|
|
|
my $text_x = $tick_width + ceil (TICK_GAP_FRAC * $digit_width); |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
for ( ; $n <= $hi; $n += $unit) { |
345
|
|
|
|
|
|
|
my $str = $self->signal_emit ('number-to-text', $n, $decimals); |
346
|
|
|
|
|
|
|
$layout->set_text ($str); |
347
|
|
|
|
|
|
|
my ($str_width, $str_height) = $layout->get_pixel_size; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
my $u = $untransform->($n); |
350
|
|
|
|
|
|
|
my $y = floor ($factor * $u + $offset); |
351
|
|
|
|
|
|
|
### $str |
352
|
|
|
|
|
|
|
### $y |
353
|
|
|
|
|
|
|
### $str_width |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
my $text_y = $y - int ($str_height/2); # top of text |
356
|
|
|
|
|
|
|
if ($text_y >= $win_pixels || $y + $str_height <= 0) { |
357
|
|
|
|
|
|
|
### outside window, skip |
358
|
|
|
|
|
|
|
next; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
$win->draw_rectangle ($tick_gc, |
362
|
|
|
|
|
|
|
1, # filled |
363
|
|
|
|
|
|
|
0, # x |
364
|
|
|
|
|
|
|
$y, # y |
365
|
|
|
|
|
|
|
$tick_width, # width |
366
|
|
|
|
|
|
|
1); # height==1 |
367
|
|
|
|
|
|
|
$style->paint_layout ($win, |
368
|
|
|
|
|
|
|
$state, |
369
|
|
|
|
|
|
|
1, # use_text, for the text gc instead of the fg one |
370
|
|
|
|
|
|
|
$clip_rect, |
371
|
|
|
|
|
|
|
$self, # widget |
372
|
|
|
|
|
|
|
__PACKAGE__, # style detail string |
373
|
|
|
|
|
|
|
$text_x, |
374
|
|
|
|
|
|
|
$text_y, |
375
|
|
|
|
|
|
|
$layout); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
if ($y >= 0 && $y < $win_pixels # only values more than half in window |
378
|
|
|
|
|
|
|
&& ($str_width += $text_x) > $decided_width) { |
379
|
|
|
|
|
|
|
### draw is wider than decided_width: "str=$str, width=$str_width cf decided_width=$decided_width" |
380
|
|
|
|
|
|
|
$decided_width = $self->{'decided_width'} = $str_width; |
381
|
|
|
|
|
|
|
$self->queue_resize; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
return Gtk2::EVENT_PROPAGATE; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub _decide_width { |
390
|
|
|
|
|
|
|
my ($self) = @_; |
391
|
|
|
|
|
|
|
### NumAxis _decide_width() |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
my $adj = $self->{'adjustment'}; |
394
|
|
|
|
|
|
|
my $for = ($adj |
395
|
|
|
|
|
|
|
? join(',', $adj->lower, $adj->upper, $adj->page_size) |
396
|
|
|
|
|
|
|
: ''); |
397
|
|
|
|
|
|
|
if ($self->{'decided_done_for'} eq $for) { |
398
|
|
|
|
|
|
|
return $self->{'decided_width'}; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
### old decided width: $self->{'decided_width'} |
402
|
|
|
|
|
|
|
### was for: $self->{'decided_done_for'} |
403
|
|
|
|
|
|
|
### now for: $for |
404
|
|
|
|
|
|
|
$self->{'decided_done_for'} = $for; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
my $layout = _layout($self); |
407
|
|
|
|
|
|
|
my $decimals = $self->{'min_decimals'}; |
408
|
|
|
|
|
|
|
my $digit_width = $self->{'digit_width'}; |
409
|
|
|
|
|
|
|
my $width = $digit_width * $decimals; |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
if ($adj) { |
412
|
|
|
|
|
|
|
my $lower = $adj->lower; |
413
|
|
|
|
|
|
|
my ($unit, $unit_decimals) = _decide_unit ($self, $lower); |
414
|
|
|
|
|
|
|
### $unit |
415
|
|
|
|
|
|
|
### $unit_decimals |
416
|
|
|
|
|
|
|
$decimals = max ($decimals, $unit_decimals); |
417
|
|
|
|
|
|
|
my $transform = $self->{'transform'} || \&identity; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# my $n = Math::Round::nhimult ($unit, $lo); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
foreach my $un ($lower, |
422
|
|
|
|
|
|
|
$adj->upper - $adj->page_size) { |
423
|
|
|
|
|
|
|
my $n = $transform->($un); |
424
|
|
|
|
|
|
|
# increase $n to 99.999 etc per its integer part and $decimals |
425
|
|
|
|
|
|
|
$n = ($n < 0 ? '-' : '') |
426
|
|
|
|
|
|
|
. ('9' x _num_integer_digits($n)) |
427
|
|
|
|
|
|
|
. '.' |
428
|
|
|
|
|
|
|
. ('9' x $decimals); |
429
|
|
|
|
|
|
|
my $str = $self->signal_emit ('number-to-text', $n, $decimals); |
430
|
|
|
|
|
|
|
$layout->set_text ($str); |
431
|
|
|
|
|
|
|
$width = max ($width, ($layout->get_pixel_size)[0]); |
432
|
|
|
|
|
|
|
### this str: $str |
433
|
|
|
|
|
|
|
### gives width pixels: $width |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
$width += ceil (TICK_WIDTH_FRAC * $digit_width) |
438
|
|
|
|
|
|
|
+ ceil (TICK_GAP_FRAC * $digit_width); |
439
|
|
|
|
|
|
|
### tick width: ceil (TICK_WIDTH_FRAC * $digit_width) |
440
|
|
|
|
|
|
|
### tick gap: ceil (TICK_GAP_FRAC * $digit_width) |
441
|
|
|
|
|
|
|
### _decide_width() result: $width |
442
|
|
|
|
|
|
|
return ($self->{'decided_width'} = $width); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub _decide_height { |
446
|
|
|
|
|
|
|
my ($self) = @_; |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
if ($self->{'decided_done_for'} eq '1') { |
449
|
|
|
|
|
|
|
return $self->{'decided_height'}; |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
$self->{'decided_done_for'} = 1; |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
my $adj = $self->{'adjustment'}; |
454
|
|
|
|
|
|
|
### _decide_height() |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
my $layout = _layout($self); |
457
|
|
|
|
|
|
|
my $decimals = $self->{'min_decimals'}; |
458
|
|
|
|
|
|
|
my $transform = $self->{'transform'} || \&identity; |
459
|
|
|
|
|
|
|
my $digit_height = $self->{'digit_height'}; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
my $height = $digit_height; |
462
|
|
|
|
|
|
|
foreach my $un ($adj |
463
|
|
|
|
|
|
|
? ($adj->lower, $adj->upper - $adj->page_size) |
464
|
|
|
|
|
|
|
: (0)) { |
465
|
|
|
|
|
|
|
my $n = $transform->($un); |
466
|
|
|
|
|
|
|
my $str = $self->signal_emit ('number-to-text', $n, $decimals); |
467
|
|
|
|
|
|
|
$layout->set_text ($str); |
468
|
|
|
|
|
|
|
$height = max ($height, ($layout->get_pixel_size)[1]); |
469
|
|
|
|
|
|
|
### this str: $str |
470
|
|
|
|
|
|
|
### this height: ($layout->get_pixel_size)[1] |
471
|
|
|
|
|
|
|
### gives height pixels: $height |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
$height += ceil(TICK_HEIGHT_FRAC * $digit_height) |
474
|
|
|
|
|
|
|
+ ceil(TICK_VGAP_FRAC * $digit_height); |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
### tick height: ceil (TICK_HEIGHT_FRAC * $digit_height) |
477
|
|
|
|
|
|
|
### tick vgap: ceil (TICK_VGAP_FRAC * $digit_height) |
478
|
|
|
|
|
|
|
### _decide_height() result: $height |
479
|
|
|
|
|
|
|
return ($self->{'decided_height'} = $height); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# return ($step, $decimals) |
483
|
|
|
|
|
|
|
sub _decide_unit { |
484
|
|
|
|
|
|
|
my ($self, $value) = @_; |
485
|
|
|
|
|
|
|
### _decide_unit(): "value=$value" |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
my ($win, $adj, $page_size); |
488
|
|
|
|
|
|
|
unless (($win = $self->window) |
489
|
|
|
|
|
|
|
&& ($adj = $self->{'adjustment'}) |
490
|
|
|
|
|
|
|
&& ($page_size = $adj->page_size) != 0) { |
491
|
|
|
|
|
|
|
return (0, 0); |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
my $transform = $self->{'transform'} || \&identity; |
495
|
|
|
|
|
|
|
my $min_decimals = $self->{'min_decimals'}; |
496
|
|
|
|
|
|
|
### $min_decimals |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
if ($self->get('orientation') eq 'horizontal') { |
499
|
|
|
|
|
|
|
my $win_width = $self->allocation->width; |
500
|
|
|
|
|
|
|
my $layout = _layout($self); |
501
|
|
|
|
|
|
|
my @samples = ($adj->value + 0.05 * $adj->page_size, |
502
|
|
|
|
|
|
|
$adj->value + 0.95 * $adj->page_size); |
503
|
|
|
|
|
|
|
for (;;) { |
504
|
|
|
|
|
|
|
my $str_width = max (map { |
505
|
|
|
|
|
|
|
$layout->set_text ($self->signal_emit |
506
|
|
|
|
|
|
|
('number-to-text', $_, $min_decimals)); |
507
|
|
|
|
|
|
|
($layout->get_pixel_size)[0] |
508
|
|
|
|
|
|
|
} @samples); |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
my $untrans_min_step = 2.0 * $adj->page_size * $str_width / $win_width; |
511
|
|
|
|
|
|
|
### page_size: $adj->page_size |
512
|
|
|
|
|
|
|
### $win_width |
513
|
|
|
|
|
|
|
### $str_width |
514
|
|
|
|
|
|
|
### $untrans_min_step |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
my $low_step = abs ($transform->($value) |
517
|
|
|
|
|
|
|
- $transform->($value + $untrans_min_step)); |
518
|
|
|
|
|
|
|
my $high_step = abs ($transform->($value + $page_size) |
519
|
|
|
|
|
|
|
- $transform->($value + $page_size |
520
|
|
|
|
|
|
|
- $untrans_min_step)); |
521
|
|
|
|
|
|
|
### $low_step |
522
|
|
|
|
|
|
|
### $high_step |
523
|
|
|
|
|
|
|
my ($unit, $decimals) = round_up_2_5_pow_10 (max ($low_step, $high_step)); |
524
|
|
|
|
|
|
|
if ($decimals <= $min_decimals) { |
525
|
|
|
|
|
|
|
return ($unit, $decimals); |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
$min_decimals = $decimals; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
} else { |
530
|
|
|
|
|
|
|
my $win_height = $self->allocation->height; |
531
|
|
|
|
|
|
|
my $str_height = $self->{'digit_height'}; |
532
|
|
|
|
|
|
|
my $untrans_min_step = 2.0 * $adj->page_size * $str_height / $win_height; |
533
|
|
|
|
|
|
|
### page_size: $adj->page_size |
534
|
|
|
|
|
|
|
### win_height: $win_height |
535
|
|
|
|
|
|
|
### $str_height |
536
|
|
|
|
|
|
|
### $untrans_min_step |
537
|
|
|
|
|
|
|
my $low_step = abs ($transform->($value) |
538
|
|
|
|
|
|
|
- $transform->($value + $untrans_min_step)); |
539
|
|
|
|
|
|
|
my $high_step = abs ($transform->($value + $page_size) |
540
|
|
|
|
|
|
|
- $transform->($value + $page_size |
541
|
|
|
|
|
|
|
- $untrans_min_step)); |
542
|
|
|
|
|
|
|
### $low_step |
543
|
|
|
|
|
|
|
### $high_step |
544
|
|
|
|
|
|
|
return round_up_2_5_pow_10 (max ($low_step, $high_step)); |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# return round_up_2_5_pow_10 (2 * $str_height / $factor); |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub _layout { |
551
|
|
|
|
|
|
|
my ($self) = @_; |
552
|
|
|
|
|
|
|
my $layout = ($self->{'layout'} ||= do { |
553
|
|
|
|
|
|
|
my $l = $self->create_pango_layout (''); |
554
|
|
|
|
|
|
|
$l->set_alignment ('center'); # perhaps a 'justify' prop like GtkLabel? |
555
|
|
|
|
|
|
|
$l |
556
|
|
|
|
|
|
|
}); |
557
|
|
|
|
|
|
|
if (! defined $self->{'digit_width'}) { |
558
|
|
|
|
|
|
|
($self->{'digit_width'}, $self->{'digit_height'}) |
559
|
|
|
|
|
|
|
= layout_digit_size ($layout); |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
return $layout; |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
# 'style-set' and 'direction-changed' class closures |
565
|
|
|
|
|
|
|
# |
566
|
|
|
|
|
|
|
sub _do_style_or_direction { |
567
|
|
|
|
|
|
|
my ($self, $prev_style) = @_; |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# context_changed() as advised by gtk_widget_create_pango_layout() |
570
|
|
|
|
|
|
|
if (my $layout = $self->{'layout'}) { |
571
|
|
|
|
|
|
|
$layout->context_changed; |
572
|
|
|
|
|
|
|
delete @{$self}{'digit_width','digit_height'}; # hash slice |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
$self->{'decided_done_for'} = 'x'; # possible new font or kerning |
576
|
|
|
|
|
|
|
$self->queue_resize; |
577
|
|
|
|
|
|
|
$self->queue_draw; |
578
|
|
|
|
|
|
|
return shift->signal_chain_from_overridden(@_); |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
# 'value-changed' on the adjustment |
582
|
|
|
|
|
|
|
sub _do_adj_value_changed { |
583
|
|
|
|
|
|
|
my ($adj, $ref_weak_self) = @_; |
584
|
|
|
|
|
|
|
### _do_adj_value_changed(), queue_draw |
585
|
|
|
|
|
|
|
my $self = $$ref_weak_self || return; |
586
|
|
|
|
|
|
|
$self->queue_draw; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# 'changed' on the adjustment |
590
|
|
|
|
|
|
|
sub _do_adj_other_changed { |
591
|
|
|
|
|
|
|
my ($adj, $ref_weak_self) = @_; |
592
|
|
|
|
|
|
|
my $self = $$ref_weak_self || return; |
593
|
|
|
|
|
|
|
### _do_adj_other_changed(), resize |
594
|
|
|
|
|
|
|
$self->queue_resize; # possible width for new upper/lower |
595
|
|
|
|
|
|
|
$self->queue_draw; # possible new page-size |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
599
|
|
|
|
|
|
|
# mostly generic |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# Return ($digit_width, $digit_height) which is the size in pixels of a |
602
|
|
|
|
|
|
|
# digit in the given $layout. |
603
|
|
|
|
|
|
|
# |
604
|
|
|
|
|
|
|
sub layout_digit_size { |
605
|
|
|
|
|
|
|
my ($layout) = @_; |
606
|
|
|
|
|
|
|
my $digit_width = 0; |
607
|
|
|
|
|
|
|
my $digit_height = 0; |
608
|
|
|
|
|
|
|
foreach my $n (0 .. 9) { |
609
|
|
|
|
|
|
|
$layout->set_text ($n); |
610
|
|
|
|
|
|
|
my ($str_width, $str_height) = $layout->get_pixel_size; |
611
|
|
|
|
|
|
|
$digit_width = max ($digit_width, $str_width); |
612
|
|
|
|
|
|
|
$digit_height = max ($digit_height, $str_height); |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
return ($digit_width, $digit_height); |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
# Round $n up to the next higher unit of the form 10^k, 2*10^k or 5*10^k |
618
|
|
|
|
|
|
|
# (for an integer k, possibly negative) and return two values "($unit, |
619
|
|
|
|
|
|
|
# $decimals)", where $decimals is how many decimal places are necessary to |
620
|
|
|
|
|
|
|
# represent that unit. For instance, |
621
|
|
|
|
|
|
|
# |
622
|
|
|
|
|
|
|
# round_up_2_5_pow_10(0.0099) = (0.01, 2) |
623
|
|
|
|
|
|
|
# round_up_2_5_pow_10(0.15) = (0.2, 1) |
624
|
|
|
|
|
|
|
# round_up_2_5_pow_10(3.5) = (5, 0) |
625
|
|
|
|
|
|
|
# round_up_2_5_pow_10(60) = (100, 0) |
626
|
|
|
|
|
|
|
# |
627
|
|
|
|
|
|
|
sub round_up_2_5_pow_10 { |
628
|
|
|
|
|
|
|
my ($n) = @_; |
629
|
|
|
|
|
|
|
my $k = ceil (POSIX::log10 ($n)); |
630
|
|
|
|
|
|
|
my $unit = POSIX::pow (10, $k); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# at this point $unit is the next higher value of the form 10^k, see if |
633
|
|
|
|
|
|
|
# either 5*10^(k-1) or 2*10^(k-1) would suffice to be bigger than $n |
634
|
|
|
|
|
|
|
if ($unit * 0.2 >= $n) { |
635
|
|
|
|
|
|
|
$unit *= 0.2; |
636
|
|
|
|
|
|
|
$k--; |
637
|
|
|
|
|
|
|
} elsif ($unit * 0.5 >= $n) { |
638
|
|
|
|
|
|
|
$unit *= 0.5; |
639
|
|
|
|
|
|
|
$k--; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
### $unit |
642
|
|
|
|
|
|
|
### $k |
643
|
|
|
|
|
|
|
### decimals: max (-$k, 0) |
644
|
|
|
|
|
|
|
return ($unit, max (-$k, 0)); |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# Return the number of digits in the integer part of $n, so for instance |
648
|
|
|
|
|
|
|
# _num_integer_digits(0) == 1 |
649
|
|
|
|
|
|
|
# _num_integer_digits(99) == 2 |
650
|
|
|
|
|
|
|
# _num_integer_digits(100.25) == 3 |
651
|
|
|
|
|
|
|
# Just the absolute value is used, so the results are the same for negatives, |
652
|
|
|
|
|
|
|
# num_integer_digits(-100.25) == 3 |
653
|
|
|
|
|
|
|
# |
654
|
|
|
|
|
|
|
sub _num_integer_digits { |
655
|
|
|
|
|
|
|
my ($n) = @_; |
656
|
|
|
|
|
|
|
return 1 + max (0, floor (POSIX::log10 (abs ($n)))); |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
# configure_event => \&_do_configure_event, |
662
|
|
|
|
|
|
|
# # 'configure-event' class closure |
663
|
|
|
|
|
|
|
# sub _do_configure_event { |
664
|
|
|
|
|
|
|
# my ($self, $event) = @_; |
665
|
|
|
|
|
|
|
# $self->queue_draw; |
666
|
|
|
|
|
|
|
# return shift->signal_chain_from_overridden(@_); |
667
|
|
|
|
|
|
|
# } |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
1; |
670
|
|
|
|
|
|
|
__END__ |