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