1#!/usr/bin/perl
2use X11::Protocol;
3use X11::Protocol::Constants
4  qw(Exposure_m ButtonPress_m ButtonRelease_m ButtonMotion_m
5     PointerMotionHint_m StructureNotify_m
6     Expose ButtonPress ButtonRelease MotionNotify
7     ClientMessage ConfigureNotify
8     Convex Nonconvex InputOutput CopyFromParent Replace
9     Origin);
10
11use IO::Select;
12use strict;
13
14sub clamp { $_[1] < $_[0] ? $_[0] : $_[1] > $_[2] ? $_[2] : $_[1] }
15sub sign { $_[0] ? $_[0] / abs($_[0]) : 0 }
16sub min { $_[0] <= $_[1] ? $_[0] : $_[1] }
17sub max { $_[0] >= $_[1] ? $_[0] : $_[1] }
18
19# Look and feel parameters to play with:
20my $length = 300;
21my $thumb = 100;
22my $thickness = 20;
23my $padding = 5;
24my $depth = 2;
25my $relief_frac = .1; # relief area / thickness, 0 => relief doesn't scale
26my $trough_rgb = [0xa3a3, 0xa3a3, 0xb3b3];
27my $bg_rgb = [0xc6c6, 0xc6c6, 0xd6d6];
28my $fill_rgb = [0xb6b6, 0x3030, 0x6060];
29my $shade = .5; # 0 => shadows black, hilights white; 1 => no shading
30# for relief, 0 => raised, 1 => sunk, 2 => ridge, 3 => groove
31my $prog_relief = 1; my $sbar_relief = 1; my $slider_relief = 0;
32my $arrow_relief = 0; my $dimple_relief = 1;
33my $arrow_change = 1; # these bits will flip when pressed
34my $dimple = .3; # size / scrollbar thickness, 0 for none
35my $font_frac = .6; # text fills 60% of the height of the progresss bar
36# Note that the progress bar prefers scalable fonts, so that it can keep
37# the same proportions when the window is resized. Depending on how modern
38# your X installation is, this may be nontrivial.
39# * The best case is if you have a font that includes both hand-edited
40# bitmaps for small sizes and outlines that can be scaled arbitrarily.
41# All recent X releases come with bitmaps provided by Adobe for Helvetica,
42# so if you also have a corresponding Type 1 outline, that's the best
43# choice:
44# (bitmaps for sizes 8, 10, 11, 12, 14, 17, 18, 20, 24, 25, and 34)
45#my $fontname = "-adobe-helvetica-medium-r-normal--%d-*-*-*-*-*-iso8859-1";
46# (If you're using Debian Linux like me, you'll need to install the
47#  gsfonts and gsfonts-x11 packages to get the Type 1 versions. The
48#  outline isn't the genuine Adobe version; it's a free clone that
49#  can also be accessed directly (without Adobe's bitmaps) as)
50my $fontname = "-urw-nimbus sans l-regular-r-normal--%d-*-*-*-*-*-iso8859-1";
51# * Recent X releases also include some scalable fonts, though not any
52# sans-serif ones. In the following, adobe-utopia can be replaced by
53# adobe-courier, bitstream-courier, or bitstream-charter:
54#my $fontname = "-adobe-utopia-medium-r-normal--%d-*-*-*-*-*-iso8859-1";
55# * Also, recent X servers can scale bitmaps, though the results are usually
56# fairly ugly.
57# * If your X system predates XLFD (the 14-hyphen names), your font
58# selection is probably pretty miniscule; try to pick something around
59# 12 pixels:
60#my $fontname = "7x13";
61my $cursor_id = 132;
62my $initial_delay = 0.15; # secs
63my $delay = 0.05; # secs
64my $accel = 0.5;
65my $smooth_progress = 0; # and un-smooth scrollbar
66my $text_shading_style = 1; # 0 => diagonalish, 1 => squarish
67
68#   +--------------------------------------------------+
69#   | main_win	   ^v padding   	[bg]           |
70#   | +----------------------------------------------+ |
71#   | |#prog_win###########        ^                 |<|
72#   | |##########[fill]####        :thickness        |>|
73#   | |####################        :                 |:|
74#   | |<-------- length -----------:---------------->|:|
75#   | |####################        V     [trough]    |:|
76#   | +----------------------------------------------+:|
77#   |         	     ^v padding 	              :|
78#   | +----------------------------------------------+:|
79#   | | sbar_win +------------------------+          |:|
80#   |<|          |+----+ slider_win +----+| [trough] |:|
81#   |>|<-slider->|| <| |<-lt_win    | |> ||          |:|
82#   |:|	  pos  	 |+----+    rt_win->+----+|          |:|
83#   |:|	       	 +------------------------+          |:|
84#   |:+----------:------------------------:----------+:|
85#   |:         	 :   ^v padding           :           :|
86#   +:-----------:------------------------:-----------:+
87#    :  	 :	                  :	      :
88#    :           :	                  :	      :
89#  padding       :<------- thumb -------->:	   padding
90
91my($main_win, $prog_win, $sbar_win, $slider_win, $lt_win, $rt_win);
92my($trough_gc, $bg_gc, $fill_gc, $hilite_gc, $shadow_gc);
93my $frac = 0;
94
95my $X = X11::Protocol->new;
96my $cmap = $X->default_colormap;
97
98my($bg,) = $X->AllocColor($cmap, (@$bg_rgb));
99my($trough,) = $X->AllocColor($cmap, (@$trough_rgb));
100my($shadow,) = $X->AllocColor($cmap, (map($_ * $shade, @$bg_rgb)));
101my($hilite,) = $X->AllocColor($cmap, (map(65535 - $shade * (65535 - $_),
102					  @$bg_rgb)));
103
104my $delete_atom = $X->atom('WM_DELETE_WINDOW');
105
106my $fontsize = $font_frac * $thickness;
107my $font = $X->new_rsrc;
108$X->OpenFont($font, sprintf($fontname, $fontsize));
109
110my $total_wd = 2*$padding + $length;
111my $base_wd =  2*$padding + 2*$depth + 4;
112my $total_ht = 3*$padding + 2*$thickness;
113my $base_ht =  3*$padding + 4*$depth + 3;
114
115my $cursor_font = $X->new_rsrc;
116$X->OpenFont($cursor_font, "cursor");
117my $cursor = $X->new_rsrc;
118$X->CreateGlyphCursor($cursor, $cursor_font, $cursor_font, $cursor_id,
119		      $cursor_id + 1, (0, 0, 0), (65535, 65535, 65535));
120
121$main_win = $X->new_rsrc;
122$X->CreateWindow($main_win, $X->root, InputOutput, CopyFromParent,
123		 CopyFromParent, (0, 0), $total_wd, $total_ht, 0,
124		 'cursor' => $cursor, 'background_pixel' => $bg,
125		 'event_mask' => StructureNotify_m);
126
127$X->ChangeProperty($main_win, $X->atom('WM_ICON_NAME'), $X->atom('STRING'),
128		   8, Replace, "widgets");
129$X->ChangeProperty($main_win, $X->atom('WM_NAME'), $X->atom('STRING'), 8,
130		   Replace, "Raw X widgets (X11::Protocol)");
131$X->ChangeProperty($main_win, $X->atom('WM_CLASS'), $X->atom('STRING'), 8,
132		   Replace, "widgets\0Widgets");
133$X->ChangeProperty($main_win, $X->atom('WM_NORMAL_HINTS'),
134		   $X->atom('WM_SIZE_HINTS'), 32, Replace,
135		   pack("Lx16llx16llllllx4", 8|16|128|256, $base_wd, $base_ht,
136			3, 2, 1000, 1, $base_wd, $base_ht));
137$X->ChangeProperty($main_win, $X->atom('WM_HINTS'), $X->atom('WM_HINTS'),
138		   32, Replace, pack("LLLx24", 1|2, 1, 1));
139$X->ChangeProperty($main_win, $X->atom('WM_PROTOCOLS'), $X->atom('ATOM'),
140		   32, Replace, pack("L", $delete_atom));
141
142$prog_win = $X->new_rsrc;
143$X->CreateWindow($prog_win, $main_win, InputOutput, CopyFromParent,
144		 CopyFromParent, ($padding, $padding), $length, $thickness, 0,
145		 'background_pixel' => $trough, 'event_mask' => Exposure_m);
146
147$sbar_win = $X->new_rsrc;
148$X->CreateWindow($sbar_win, $main_win, InputOutput, CopyFromParent,
149		 CopyFromParent, ($padding, 2*$padding + $thickness),
150		 $length, $thickness, 0,
151		 'background_pixel' => $trough, 'event_mask' => Exposure_m);
152
153$bg_gc = $X->new_rsrc;
154$X->CreateGC($bg_gc, $main_win, 'foreground' => $bg);
155
156$shadow_gc = $X->new_rsrc;
157$X->CreateGC($shadow_gc, $main_win, 'foreground' => $shadow);
158
159$hilite_gc = $X->new_rsrc;
160$X->CreateGC($hilite_gc, $main_win, 'foreground' => $hilite);
161
162# floor : ceil :: int : away
163sub away { sign($_[0]) * int(abs($_[0]) + .9999) }
164
165sub draw_slope_poly {
166    my($win, $relief, $dep, $fill, @p) = @_;
167    if ($relief > 1) {
168	draw_slope_poly($win, $relief ^ 3,  $dep,      $fill,     @p);
169	                      $relief &= 1; $dep /= 2; $fill = 0;
170    }
171    my($tl, $br) = ($hilite_gc, $shadow_gc)[$relief, !$relief];
172    my(@gc, @ip); $#gc = $#ip = $#p;
173    my $j;
174    for $j (-2 .. $#p - 2) {
175	my($ix, $iy) = ($p[$j+1][0] - $p[$j][0], $p[$j+1][1] - $p[$j][1]);
176	$gc[$j] = $ix > $iy ? $tl : $ix < $iy ? $br : $ix > 0 ? $tl : $br;
177	my($ox, $oy) = ($p[$j+2][0] - $p[$j+1][0], $p[$j+2][1] - $p[$j+1][1]);
178	if ($ix*$oy > $iy*$ox) {
179	    $ix = -$ix; $iy = -$iy;
180	} else {
181	    $ox = -$ox; $oy = -$oy;
182	}
183	my($in) = sqrt($ix*$ix + $iy*$iy); $ix /= $in; $iy /= $in;
184	my($on) = sqrt($ox*$ox + $oy*$oy); $ox /= $on; $oy /= $on;
185	my($mx, $my) = (($ix + $ox)/2, ($iy + $oy)/2);
186	my($mn) = max(abs($mx), abs($my)); $mx /= $mn; $my /= $mn;
187	$ip[$j+1][0] = $p[$j+1][0] + away(($dep - 1) * $mx);
188	$ip[$j+1][1] = $p[$j+1][1] + away(($dep - 1) * $my);
189    }
190    $X->FillPoly($win, $fill, Nonconvex, Origin, map(@{$ip[$_]}, 0 .. $#p))
191      if $fill;
192    for $j (-1 .. $#p - 1) {
193	$X->FillPoly($win, $gc[$j], Convex, Origin, @{$p[$j]}, @{$ip[$j]},
194		     @{$ip[$j + 1]}, @{$p[$j + 1]});
195	$X->PolySegment($win, $gc[$j], @{$p[$j]} => @{$p[$j+1]},
196			@{$ip[$j]} => @{$ip[$j+1]});
197    }
198    for $j (-1 .. $#p - 1) {
199	$X->PolySegment($win, $bg_gc, @{$p[$j+1]}, @{$ip[$j+1]})
200	  if $gc[$j] != $gc[$j + 1];
201    }
202}
203
204sub draw_slope {
205    my($win, $x, $y, $wd, $ht, $relief) = @_;
206    draw_slope_poly($win, $relief, $depth, 0, [$x, $y], [$x + $wd - 1, $y],
207		    [$x + $wd - 1, $y + $ht - 1], [$x, $y + $ht - 1]);
208}
209
210sub paint_arrow {
211    my($win, $x, $y, $s, $dir, $relief) = @_;
212    my @s = ($s / 2, $s, $s / 2, 0);
213    my @p = ([$x + $s[$dir], $y + $s[$dir - 1]],
214	     ($dir & 1 xor $dir & 2) ? [$x, $y] : [$x + $s, $y + $s],
215	     ($dir & 2) ? [$x + $s, $y] : [$x, $y + $s]);
216    @p[1,2] = @p[2,1] if $dir & 1;
217    draw_slope_poly($win, $relief, $depth, $bg_gc, @p);
218}
219
220sub paint_slope_circle {
221    my($win, $x, $y, $s, $dep, $relief) = @_;
222    my($tl, $br) = ($hilite_gc, $shadow_gc)[$relief & 1, !($relief & 1)];
223    my @outer = ($x, $y, $s, $s);
224    my @inner = ($x + $dep, $y + $dep, $s - 2*$dep, $s - 2*$dep);
225    my @tl = (35*64, 160*64);
226    my @br = (215*64, 160*64);
227    $X->PolyFillArc($win, $bg_gc, [@outer, 0, 360*64]);
228    $X->PolyFillArc($win, $tl, [@outer, @tl]);
229    $X->PolyArc($win, $tl, [@outer, @tl], [@inner, @tl]);
230    $X->PolyFillArc($win, $br, [@outer, @br]);
231    $X->PolyArc($win, $br, [@outer, @br], [@inner, @br]);
232    if ($relief & 2) {
233	my @middle = ($x + $depth/2, $y + $depth/2, $s - $depth, $s - $depth);
234	$X->PolyFillArc($win, $br, [@middle, @tl]);
235	$X->PolyFillArc($win, $tl, [@middle, @br]);
236    }
237    $X->PolyFillArc($win, $bg_gc, [@inner, 0, 360*64]);
238}
239
240my $inner_thick = $thickness - 2 * $depth;
241my $slider_pos = $depth;
242my $pos_min = $depth;
243my $pos_max = $length - $thumb - $depth - 2 * $inner_thick;
244
245$slider_win = $X->new_rsrc;
246$X->CreateWindow($slider_win, $sbar_win, InputOutput, CopyFromParent,
247		 CopyFromParent, ($slider_pos, $depth),
248		 $thumb + 2 * $inner_thick, $inner_thick, 0,
249		 'background_pixel' => $bg,
250		 'event_mask' => Exposure_m | ButtonPress_m | ButtonMotion_m
251		                 | PointerMotionHint_m);
252
253$lt_win = $X->new_rsrc;
254$X->CreateWindow($lt_win, $slider_win, InputOutput, CopyFromParent,
255		 CopyFromParent, (0, 0), $inner_thick, $inner_thick, 0,
256		 'background_pixel' => $trough,
257		 'event_mask' => Exposure_m | ButtonPress_m | ButtonRelease_m);
258
259$rt_win = $X->new_rsrc;
260$X->CreateWindow($rt_win, $slider_win, InputOutput, CopyFromParent,
261		 CopyFromParent, ($thumb + $inner_thick, 0),
262		 $inner_thick, $inner_thick, 0,
263		 'background_pixel' => $trough,
264		 'event_mask' => Exposure_m | ButtonPress_m | ButtonRelease_m);
265
266my $lt_state = 0;
267my $rt_state = 0;
268$X->MapWindow($lt_win);
269$X->MapWindow($rt_win);
270
271$X->MapWindow($slider_win);
272
273sub slider_update {
274    my($delta, $warp) = @_;
275    my $old_pos = $slider_pos;
276    $slider_pos = clamp($pos_min, $slider_pos + $delta, $pos_max);
277    $X->WarpPointer(0, 0, 0, 0, 0, 0, $slider_pos - $old_pos, 0) if $warp;
278    $X->ConfigureWindow($slider_win, 'x' => $slider_pos);
279    prog_update(($slider_pos - $pos_min) / ($pos_max - $pos_min), 1);
280}
281
282
283my %extents = $X->QueryTextExtents($font, "\0001\0000\0000\0%");
284my $text_wd = $extents{'overall_width'} + 4+2;
285my $text_x = int(($length - $text_wd) / 2);
286my $text_baseline = int(($thickness + $extents{'font_ascent'}
287			 - $extents{'font_descent'}) / 2) - $depth;
288
289my $prog_pixmap = $X->new_rsrc;
290$X->CreatePixmap($prog_pixmap, $prog_win, $X->root_depth,
291		 $text_wd, $inner_thick);
292
293$trough_gc = $X->new_rsrc;
294$X->CreateGC($trough_gc, $prog_pixmap, 'font' => $font,
295	     'foreground' => $trough);
296
297$fill_gc = $X->new_rsrc;
298my($fill_pixel,) = $X->AllocColor($cmap, (@$fill_rgb));
299$X->CreateGC($fill_gc, $prog_pixmap, 'font' => $font,
300	     'foreground' => $fill_pixel);
301
302$X->ChangeGC($shadow_gc, 'font' => $font);
303$X->ChangeGC($hilite_gc, 'font' => $font);
304$X->ChangeGC($bg_gc, 'font' => $font);
305
306sub paint_shaded_text {
307    my($drawable, $x, $y, $text) = @_;
308    my($br_gc, $tl_gc) = ($shadow_gc, $hilite_gc);
309    $X->PolyText8($drawable, $br_gc, ($x + 1, $y + 1), @$text)
310      if $text_shading_style;
311    $X->PolyText8($drawable, $br_gc, ($x, $y + 1), @$text);
312    $X->PolyText8($drawable, $br_gc, ($x + 1, $y), @$text);
313
314    $X->PolyText8($drawable, $tl_gc, ($x - 1, $y - 1), @$text)
315      if $text_shading_style;
316    $X->PolyText8($drawable, $tl_gc, ($x, $y - 1), @$text);
317    $X->PolyText8($drawable, $tl_gc, ($x - 1, $y), @$text);
318
319    $X->PolyText8($drawable, $bg_gc, ($x, $y), @$text);
320}
321
322my $font_height = $extents{'font_ascent'} + $extents{'font_descent'};
323
324sub prog_update {
325    my($newfrac, $increm) = @_;
326    my $oldfrac = $frac;
327    $frac = $newfrac;
328    my $str = int(100 * $frac) . "%";
329    my $text = [map([1, $_], split(//, $str))];
330    $text->[1][0] = -$font_height/10 if $text->[0][1] eq "1"; # kerning
331    my $realend = int($frac * ($length - 2 * $depth)) + $depth;
332    if ($increm) {
333	my $newend = $realend;
334	my $oldend = int($oldfrac * ($length - 2 * $depth)) + $depth;
335	my $x;
336	my($left, $right);
337	my $count = 0;
338	if ($newend > $oldend) {
339	    $right = \$newend; $left = \$oldend;
340	} else {
341	    $right = \$oldend; $left = \$newend;
342	}
343	if ($$left >= $text_x and $$left < $text_x + $text_wd) {
344	    $$left = $text_x + $text_wd - 1;
345	    $count++;
346	}
347	if ($$right >= $text_x and $$right < $text_x + $text_wd) {
348	    $$right = $text_x;
349	    $count++;
350	}
351	if ($count == 2) {
352	    # do nothing
353	} elsif ($newend > $oldend) {
354	    if ($smooth_progress) {
355		for ($x = $oldend; $x < $newend; $x++) {
356		    $X->PolySegment($prog_win, $fill_gc, ($x, $depth) =>
357				    ($x, $thickness - $depth - 1));
358		}
359	    } else {
360		$X->PolyFillRectangle($prog_win, $fill_gc, [($oldend, $depth),
361				      $newend - $oldend, $inner_thick]);
362	    }
363	} elsif ($newend < $oldend) {
364	    if ($smooth_progress) {
365		for ($x = $oldend - 1; $x >= $newend; $x--) {
366		    $X->PolySegment($prog_win, $trough_gc, ($x, $depth) =>
367				    ($x, $thickness - $depth - 1));
368		}
369	    } else {
370		$X->PolyFillRectangle($prog_win, $trough_gc,
371				      [($newend, $depth), $oldend - $newend,
372				       $inner_thick]);
373	    }
374	}
375    } else {
376	$X->PolyFillRectangle($prog_win, $fill_gc, [($depth, $depth),
377			      $realend - $depth, $inner_thick]);
378    }
379    my $end = clamp(0, $realend - $text_x, $text_wd);
380    $X->PolyFillRectangle($prog_pixmap, $fill_gc, [0, 0, $end, $inner_thick])
381      if $end > 0;
382    $X->PolyFillRectangle($prog_pixmap, $trough_gc, [$end, 0,
383			  $text_wd - $end, $inner_thick])
384      if $end < $text_wd;
385    $str =~ s/(.)/\0$1/g;
386    my $wd = {$X->QueryTextExtents($font, $str)}->{'overall_width'};
387    paint_shaded_text($prog_pixmap, 1 + int(($text_wd - $wd) / 2),
388		      $text_baseline, $text);
389    $X->CopyArea($prog_pixmap, $prog_win, $bg_gc, (0, 0),
390		 $text_wd, $inner_thick, ($text_x, $depth));
391}
392
393$X->MapWindow($prog_win);
394$X->MapWindow($sbar_win);
395$X->MapWindow($main_win);
396
397my $fds = IO::Select->new($X->connection->fh);
398my $timeout = 0;
399
400my($slider_speed, $pointer_pos, $last_pos);
401
402my(%dirty); my $resize_pending = 0;
403
404# Since this program can't necessarily handle events as fast as the X
405# server can generate them, it's important to use some sort of `flow
406# control' to throw out excess events when we're behind.
407
408# For pointer motion events, this is accomplished by selecting
409# PointerMotionHint on the slider (see above), so that the server
410# never sends a sequence of motion events -- instead, it sends one,
411# which we throw away but use as our cue to query the pointer
412# position. The query_pointer is then a sign to the server that we'd
413# be willing to accept one more event, and so on. Notice that this
414# requires several round trips between the server and the client for
415# each motion, which in C programs is a source of performance
416# problems, but here the difference is lost in the noise (we also do a
417# round trip to calculate the width of the text when updating the
418# progress bar, which could be done on the client side the way Xlib
419# does).
420
421# Expose and ConfigureNotify (resize) events have the same problem,
422# though it's only noticeable if your window manager supports opaque
423# window movement or opaque resize, respectively (the latter is fairly
424# rare in X, perhaps because average X clients handle it fairly
425# poorly; I for one am quite envious of how smoothly windows resize in
426# Windows NT). We can't do anything to tell the server to only send us
427# one of these events, but the next best thing is to just ignore them
428# until there aren't any other events pending. (In some toolkits this
429# would be called `idle-loop' processing). It's always safe to ignore
430# intermediate resizes, but with expose events we can only do this
431# because we always redraw the whole window, instead of just the
432# newly-visible part. A more sophisticated approach would keep track
433# of the exposed region, either with a bounding box or some more
434# precise data structure, and then clip the drawing to that (either
435# client-side or using a clip mask in the GC). Of course, that almost
436# certainly wouldn't be a speed win, because it would be doing a lot
437# of work in perl to save a few iterations of highly optimized C in
438# the server.
439
440$X->{'event_handler'} = "queue";
441
442for (;;) {
443    if ($timeout) {
444	while (not $fds->can_read($timeout)) {
445	    slider_update(int $slider_speed, 1);
446	    $slider_speed += sign($slider_speed) * $accel;
447	    if ($slider_pos == $pos_min or $slider_pos == $pos_max) {
448		$timeout = 0;
449		last;
450	    } else {
451		$timeout = $delay;
452	    }
453	}
454    }
455    if (not $fds->can_read(0.001)) {
456	if ($resize_pending) {
457	    $resize_pending = 0;
458	    $total_ht = max($total_ht, $base_ht);
459	    $length = $total_wd - 2 * $padding;
460	    $thickness = int(($total_ht - 3 * $padding) / 2 + 0.5);
461	    $depth = int($relief_frac * $thickness) if $relief_frac;
462	    $inner_thick = $thickness - 2*$depth;
463	    $thumb = $length / 3;
464	    $X->ConfigureWindow($prog_win, 'width' => $length,
465				'height' => $thickness);
466	    $fontsize = int($font_frac * $thickness);
467	    $X->CloseFont($font);
468	    $X->OpenFont($font, sprintf($fontname, $fontsize));
469	    map($X->ChangeGC($_, 'font' => $font),
470		$bg_gc, $hilite_gc, $shadow_gc);
471
472	    %extents = $X->QueryTextExtents($font, "\0001\0000\0000\0%");
473	    $text_wd = $extents{'overall_width'} + 4+2;
474	    $text_x = int(($length - $text_wd) / 2);
475	    $text_baseline = int(($thickness + $extents{'font_ascent'}
476				  - $extents{'font_descent'}) / 2) - $depth;
477	    $font_height = $extents{'font_ascent'} + $extents{'font_descent'};
478
479	    $X->FreePixmap($prog_pixmap);
480	    $X->CreatePixmap($prog_pixmap, $prog_win, $X->root_depth,
481			     $text_wd, $inner_thick);
482	    $X->ConfigureWindow($sbar_win, 'x' => $padding,
483				'y' => 2 * $padding + $thickness,
484				'width' => $length, 'height' => $thickness);
485	    $pos_min = $depth;
486	    $pos_max = $length - $thumb - $depth - 2 * $inner_thick;
487	    $slider_pos = $pos_min + $frac * ($pos_max - $pos_min);
488	    $X->ConfigureWindow($slider_win, 'x' => $slider_pos, 'y' => $depth,
489				'width' => $thumb + 2 * $inner_thick,
490				'height' => $inner_thick);
491	    $X->ConfigureWindow($lt_win, 'width' => $inner_thick,
492				'height' => $inner_thick);
493	    $X->ConfigureWindow($rt_win, 'x' => $thumb + $inner_thick,
494				'width' => $inner_thick,
495				'height' => $inner_thick)
496	}
497	if ($dirty{$prog_win}) {
498	    draw_slope($prog_win, 0, 0, $length, $thickness, $prog_relief);
499	    prog_update($frac, 0);
500	    $dirty{$prog_win} = 0;
501	}
502	if ($dirty{$sbar_win}) {
503	    draw_slope($sbar_win, 0, 0, $length, $thickness, $sbar_relief);
504	    $dirty{$sbar_win} = 0;
505	}
506	if ($dirty{$slider_win}) {
507	    draw_slope($slider_win, $inner_thick, 0, $thumb,
508		       $inner_thick, $slider_relief);
509	    paint_slope_circle($slider_win,
510			       $thumb / 2 + (2 - $dimple)/2*$inner_thick,
511			       (1 - $dimple) * $inner_thick / 2,
512			       $dimple * $inner_thick,
513			       $depth, $dimple_relief) if $dimple;
514	    $dirty{$slider_win} = 0;
515	}
516	if ($dirty{$lt_win}) {
517	    paint_arrow($lt_win, 0, 0, $inner_thick - 1, 3,
518			$arrow_relief ^ $lt_state);
519	    $dirty{$lt_win} = 0;
520	}
521	if ($dirty{$rt_win}) {
522	    paint_arrow($rt_win, 0, 0, $inner_thick - 1, 1,
523			$arrow_relief ^ $rt_state);
524	    $dirty{$rt_win} = 0;
525	}
526    }
527    my %e = $X->next_event;
528    if ($e{code} == ClientMessage and unpack("L", $e{data}) == $delete_atom) {
529	exit;
530    } elsif ($e{code} == ConfigureNotify) {
531	if ($e{width} != $total_wd or $e{height} != $total_ht) {
532	    $resize_pending++;
533 	    ($total_wd, $total_ht) = ($e{width}, $e{height});
534	}
535    } elsif ($e{code} == Expose) {
536	next unless $e{count} == 0;
537	my $id = $e{window};
538	if ($id == $sbar_win) {
539	    if ($e{'x'} < $depth or $e{'y'} < $depth
540		or $e{'x'} + $e{width} > $length - $depth
541		or $e{'y'} + $e{height} > $thickness - $depth)
542	    {
543		# In the scrollbar, we throw out exposures that don't
544		# include the border (including all the ones caused by
545		# moving the slider), since the server fills the
546		# trough in with the window's background color
547		# automatically.
548		$dirty{$sbar_win}++;
549	    }
550	} else {
551	    $dirty{$id}++;
552	}
553    } elsif ($e{code} == ButtonPress) {
554	my $id = $e{event};
555	if ($id == $slider_win) {
556	    $pointer_pos = $slider_pos;
557	    $last_pos = $e{root_x};
558	} elsif ($id == $lt_win) {
559	    next if 2*abs($e{event_y} - $inner_thick / 2) > $e{event_x};
560	    $lt_state = $arrow_change;
561	    slider_update(-1, 1);
562	    paint_arrow($lt_win, 0, 0, $inner_thick - 1, 3,
563			$arrow_relief ^ $lt_state);
564	    $slider_speed = -1;
565	    $timeout = $initial_delay;
566	} elsif ($id == $rt_win) {
567	    next if 2*abs($e{event_y} - $inner_thick / 2)
568	      > $inner_thick - $e{event_x};
569	    $rt_state = $arrow_change;
570	    slider_update(1, 1);
571	    paint_arrow($rt_win, 0, 0, $inner_thick - 1, 1,
572			$arrow_relief ^ $rt_state);
573	    $slider_speed = 1;
574	    $timeout = $initial_delay;
575	}
576    } elsif ($e{code} == MotionNotify) {
577	my $id = $e{event};
578	if ($id == $slider_win and defined $last_pos) {
579	    my %e2 = $X->QueryPointer($slider_win);
580	    $pointer_pos += $e2{'root_x'} - $last_pos;
581	    slider_update($pointer_pos - $slider_pos, 0);
582	    $last_pos = $e2{'root_x'};
583	}
584    } elsif ($e{code} == ButtonRelease) {
585	my $id = $e{event};
586	if ($id == $slider_win and defined $last_pos) {
587	    slider_update($e{root_x} - $last_pos, 0);
588	    undef $last_pos;
589	} elsif ($id == $lt_win) {
590	    $lt_state = 0;
591	    paint_arrow($lt_win, 0, 0, $inner_thick - 1, 3,
592			$arrow_relief ^ $lt_state);
593	    $timeout = 0;
594	} elsif ($id == $rt_win) {
595	    $rt_state = 0;
596	    paint_arrow($rt_win, 0, 0, $inner_thick - 1, 1,
597			$arrow_relief ^ $rt_state);
598	    $timeout = 0;
599	}
600    }
601}
602