1# ---------------------------------------------------------------------- 2# Curses::UI::Widget 3# 4# (c) 2001-2002 by Maurice Makaay. All rights reserved. 5# This file is part of Curses::UI. Curses::UI is free software. 6# You can redistribute it and/or modify it under the same terms 7# as perl itself. 8# 9# Currently maintained by Marcus Thiesen 10# e-mail: marcus@cpan.thiesenweb.de 11# ---------------------------------------------------------------------- 12 13package Curses::UI::Widget; 14 15use strict; 16use Carp qw(confess); 17use Term::ReadKey; 18use Curses; 19use Curses::UI::Common; 20require Exporter; 21 22use vars qw( 23 $VERSION 24 @ISA 25 @EXPORT 26); 27 28$VERSION = '1.12'; 29 30@ISA = qw( 31 Curses::UI::Common 32 Exporter 33); 34 35@EXPORT = qw( 36 height_by_windowscrheight 37 width_by_windowscrwidth 38 process_padding 39 loose_focus 40 lose_focus 41); 42 43sub new () 44{ 45 my $class = shift; 46 47 my %userargs = @_; 48 keys_to_lowercase(\%userargs); 49 50 my %args = ( 51 -parent => undef, # the parent object 52 -x => 0, # horizontal position (rel. to -parent) 53 -y => 0, # vertical position (rel. to -parent) 54 -width => undef, # horizontal size 55 -height => undef, # vertical size 56 -border => 0, # add a border? 57 -sbborder => 0, # add square bracket border? 58 -nocursor => 0, # Show a cursor? 59 -titlefullwidth => 0, # full width for title? 60 -titlereverse => 1, # reverse chars for title? 61 -title => undef, # A title to add to the widget (only for 62 # -border = 1) 63 # padding outside widget 64 -pad => undef, # all over padding 65 -padright => undef, # free space on the right side 66 -padleft => undef, # free space on the left side 67 -padtop => undef, # free space above 68 -padbottom => undef, # free space below 69 70 # padding inside widget 71 -ipad => undef, # all over padding 72 -ipadright => undef, # free space on the right side 73 -ipadleft => undef, # free space on the left side 74 -ipadtop => undef, # free space above 75 -ipadbottom => undef, # free space below 76 77 # scrollbars 78 -vscrollbar => 0, # vert. scrollbar (top/bottom) 79 -vscrolllen => 0, # total number of rows 80 -vscrollpos => 0, # current row position 81 -hscrollbar => 0, # hor. scrollbar (left/right) 82 -hscrolllen => 0, # total number of columns 83 -hscrollpos => 0, # current column position 84 85 -onfocus => undef, # onFocus event handler 86 -onblur => undef, # onBlur event handler 87 -intellidraw => 1, # Support intellidraw()? 88 -focusable => 1, # This widget can get focus 89 -htmltext => 1, # Recognize HTML tags in drawn text 90 91 #user data 92 -userdata => undef, #user internal data 93 94 #color 95 # Border 96 -bfg => -1, 97 -bbg => -1, 98 # Scrollbar 99 -sfg => -1, 100 -sbg => -1, 101 # Titlebar 102 -tfg => -1, 103 -tbg => -1, 104 105 %userargs, 106 107 -focus => 0, # has the widget focus? 108 ); 109 110 # Allow the value -1 for using the full width and/or 111 # height for the widget. 112 $args{-width} = undef 113 if defined $args{-width} and $args{-width} == -1; 114 $args{-height} = undef 115 if defined $args{-height} and $args{-height} == -1; 116 117 &Curses::UI::fatalerror( 118 "Missing or illegal parameter: -parent\n" 119 . "while creating " . caller() . "object" 120 ) unless defined $args{-parent} and ref $args{-parent}; 121 122 # Allow a square bracket border only if 123 # a normal border (-border) is disabled. 124 $args{-sbborder} = 0 if $args{-sbborder} and $args{-border}; 125 126 # Bless you! (so we can call the layout function). 127 my $this = bless \%args, $class; 128 129 $this->layout; 130 131 if ($Curses::UI::ncurses_mouse) { 132 $this->set_mouse_binding(\&mouse_button1, BUTTON1_CLICKED()) 133 unless $this->{-mousebindings}->{BUTTON1_CLICKED()}; 134 } 135 136 return $this; 137} 138 139sub DESTROY() 140{ 141 my $this = shift; 142 $this->delete_subwindows(); 143} 144 145sub userdata 146{ 147 my $this = shift; 148 if (defined $_[0]) 149 { 150 $this->{-userdata} = $_[0]; 151 } 152 return $this->{-userdata}; 153} 154 155sub focusable(;$) { 156 my $this = shift; 157 my $focusable = shift; 158 159 if (defined $focusable) 160 { 161 $this->accessor('-focusable', $focusable); 162 163 # Let the parent find another widget to focus 164 # if this widget is not focusable anymore. 165 if ($this->{-focus} and not $focusable) { 166 $this->parent->focus($this); 167 } 168 } 169 170 return $this->{-focusable}; 171} 172 173sub layout() 174{ 175 cbreak(); 176 177 my $this = shift; 178 179 return if $Curses::UI::screen_too_small; 180 181 $this->process_padding; 182 183 # ------------------------------------------------------- 184 # Compute the space that we have for the widget. 185 # ------------------------------------------------------- 186 187 $this->{-parentdata} = $this->{-parent}->windowparameters; 188 189 foreach (qw(x y)) { 190 if (not defined $this->{"-$_"}) {$this->{"-$_"} = 0} 191 if ($this->{"-$_"} >= 0) { 192 $this->{"-real$_"} = $this->{"-$_"}; 193 } else { 194 my $pv = ($_ eq 'x' ? '-w' : '-h'); 195 $this->{"-real$_"} = $this->{-parentdata}->{$pv} 196 + $this->{"-$_"} + 1; 197 } 198 } 199 200 my $w = $this->{-parentdata}->{-w}; 201 my $h = $this->{-parentdata}->{-h}; 202 203 my $cor_h = $this->{-y}; 204 $cor_h = abs($this->{-y}+1) if $cor_h < 0; 205 my $cor_w = $this->{-x}; 206 $cor_w = abs($this->{-x}+1) if $cor_w < 0; 207 208 my $avail_h = $h - $cor_h; 209 my $avail_w = $w - $cor_w; 210 211 # Compute horizontal widget size and adjust if neccessary. 212 my $min_w = ($this->{-border} ? 2 : 0) 213 + ($this->{-sbborder} ? 2 : 0) 214 + (defined $this->{-vscrollbar} ? 1 : 0) 215 + $this->{-padleft} 216 + $this->{-padright}; 217 my $width = (defined $this->{-width} ? $this->{-width} : $avail_w); 218 $width = $min_w if $width < $min_w; 219 $width = $avail_w if $width > $avail_w; 220 221 # Compute vertical widget size and adjust if neccessary. 222 my $min_h = ($this->{-border} ? 2 : 0) 223 + ($this->{-hscrollbar} ? 1 : 0) 224 + (defined $this->{-hscrollbar} ? 1 : 0) 225 + $this->{-padtop} 226 + $this->{-padbottom}; 227 my $height = (defined $this->{-height} ? $this->{-height} : $avail_h); 228 $height = $min_h if $height < $min_h; 229 $height = $avail_h if $height > $avail_h; 230 231 # Check if the widget fits in the window. 232 if ($width > $avail_w or $height > $avail_h or 233 $width == 0 or 234 $height == 0) { 235 $Curses::UI::screen_too_small++; 236 return $this; 237 } 238 239 $this->{-w} = $width; 240 $this->{-h} = $height; 241 242 if ($this->{-x} < 0) { $this->{-realx} -= $width } 243 if ($this->{-y} < 0) { $this->{-realy} -= $height } 244 245 # Take care of padding for the border. 246 $this->{-bw} = $width - $this->{-padleft} - $this->{-padright}; 247 $this->{-bh} = $height - $this->{-padtop} - $this->{-padbottom}; 248 $this->{-bx} = $this->{-realx} + $this->{-padleft}; 249 $this->{-by} = $this->{-realy} + $this->{-padtop}; 250 251 # ------------------------------------------------------- 252 # Create a window for the widget border, if a border 253 # and/or scrollbars are wanted. 254 # ------------------------------------------------------- 255 256 if ($this->{-border} or 257 $this->{-sbborder} or 258 $this->{-vscrollbar} or 259 $this->{-hscrollbar}) 260 { 261 my @args = ($this->{-bh}, $this->{-bw}, 262 $this->{-by}, $this->{-bx}); 263 264 $this->{-borderscr} = 265 $this->{-parent}->{-canvasscr}->derwin(@args); 266 267 unless (defined $this->{-borderscr}) 268 { 269 $Curses::UI::screen_too_small++; 270 return $this; 271 } 272 } 273 274 # ------------------------------------------------------- 275 # Create canvas screen region 276 # ------------------------------------------------------- 277 278 $this->{-sh} = $this->{-bh} 279 - $this->{-ipadtop} 280 - $this->{-ipadbottom} 281 - ($this->{-border}? 2 : 0) 282 - (not $this->{-border} and $this->{-hscrollbar} ? 1 : 0); 283 284 $this->{-sw} = $this->{-bw} 285 - $this->{-ipadleft} 286 - $this->{-ipadright} 287 - ($this->{-border}? 2 : 0) 288 - ($this->{-sbborder}? 2 : 0) 289 - (not $this->{-border} and $this->{-vscrollbar} ? 1 : 0); 290 291 $this->{-sy} = $this->{-by} 292 + $this->{-ipadtop} 293 + ($this->{-border}?1:0) 294 + (not $this->{-border} and 295 $this->{-hscrollbar} eq 'top' ? 1 : 0); 296 297 $this->{-sx} = $this->{-bx} 298 + $this->{-ipadleft} 299 + ($this->{-border}?1:0) 300 + ($this->{-sbborder}?1:0) 301 + (not $this->{-border} and 302 $this->{-vscrollbar} eq 'left' ? 1 : 0); 303 304 # Check if there is room left for the screen. 305 if ($this->{-sw} <= 0 or $this->{-sh} <= 0) { 306 $Curses::UI::screen_too_small++; 307 return $this; 308 } 309 310 # Create a window for the data. 311 my @args = ($this->{-sh}, $this->{-sw}, 312 $this->{-sy}, $this->{-sx}); 313 314 $this->{-canvasscr} = 315 $this->{-parent}->{-canvasscr}->derwin(@args); 316 317 unless (defined $this->{-canvasscr}) 318 { 319 $Curses::UI::screen_too_small++; 320 return $this; 321 } 322 323 unless (defined $this->{-borderscr}) 324 { 325 $this->{-bw} = $this->{-sw}; 326 $this->{-bh} = $this->{-sh}; 327 $this->{-bx} = $this->{-sx}; 328 $this->{-by} = $this->{-sy}; 329 } 330 331 return $this; 332} 333 334 335sub process_padding($;) 336{ 337 my $this = shift; 338 339 # Process the padding arguments. 340 foreach my $type ('-pad','-ipad') { 341 if (defined $this->{$type}) { 342 foreach my $side ('right','left','top','bottom') { 343 $this->{$type . $side} = $this->{$type} 344 unless defined $this->{$type . $side}; 345 } 346 } 347 } 348 foreach my $type ('-pad','-ipad') { 349 foreach my $side ('right','left','top','bottom') { 350 $this->{$type . $side} = 0 351 unless defined $this->{$type . $side}; 352 } 353 } 354} 355 356sub width_by_windowscrwidth($@) 357{ 358 my $width = shift || 0; 359 $width = shift if ref $width; # make $this->width... possible. 360 my %args = @_; 361 362 $width += 2 if $args{-border}; # border 363 $width += 2 if $args{-sbborder}; # sbborder 364 $width += 1 if (not $args{-border} and # scrollbar and no border 365 not $args{-sbborder} and 366 $args{-vscrollbar}); 367 368 foreach my $t ("-ipad", "-pad") # internal + external padding 369 { 370 if ($args{$t}) { 371 $width += 2*$args{$t}; 372 } else { 373 $width += $args{$t . "left"} if defined $args{$t . "left"}; 374 $width += $args{$t . "right"} if defined $args{$t . "right"}; 375 } 376 } 377 return $width; 378} 379 380sub height_by_windowscrheight($@) 381{ 382 my $height = shift || 0; 383 $height = shift if ref $height; # make $this->height... possible. 384 my %args = @_; 385 386 $height += 2 if $args{-border}; # border 387 $height += 1 if (not $args{-border} and $args{-hscrollbar}); 388 foreach my $t ("-ipad", "-pad") # internal + external padding 389 { 390 if ($args{$t}) 391 { 392 $height += 2*$args{$t}; 393 } else { 394 $height += $args{$t . "top"} if defined $args{$t . "top"}; 395 $height += $args{$t . "bottom"} if defined $args{$t . "bottom"}; 396 } 397 } 398 return $height; 399} 400 401sub width { shift->{-w} } 402sub height { shift->{-h} } 403sub borderwidth { shift->{-bw} } 404sub borderheight { shift->{-bh} } 405sub canvaswidth { shift->{-sw} } 406sub canvasheight { shift->{-sh} } 407 408sub title ($;) 409{ 410 my $this = shift; 411 my $title = shift; 412 413 if (defined $title) 414 { 415 $this->{-title} = $title; 416 $this->intellidraw; 417 } 418 419 return $this->{-title} 420} 421 422sub windowparameters() 423{ 424 my $this = shift; 425 my $scr = shift; 426 427 $scr = "-canvasscr" unless defined $scr; 428 my $s = $this->{$scr}; 429 my ($x,$y,$w,$h); 430 431 $s->getbegyx($y, $x); 432 $s->getmaxyx($h, $w); 433 434 return { 435 -w => $w, 436 -h => $h, 437 -x => $x, 438 -y => $y, 439 }; 440} 441 442# 443# Actually, the focus is not loose but the widget should 444# lose the focus: 445 446sub lose_focus() 447{ 448 my $this = shift; 449 $this->loose_focus(@_); 450} 451 452 453sub loose_focus() 454{ 455 my $this = shift; 456 my $key = shift; 457 458 # The focus change will draw $this anyhow and this 459 # will reset the schedule if somewhere in the middle of 460 # a binding routine loose_focus() is called (else 461 # first the focus would shift and after that $this 462 # would be redrawn). 463 # 464 $this->schedule_draw(0); 465 466 if ($this->{-has_modal_focus}) { 467 $this->{-has_modal_focus} = 0; 468 } else { 469 my $parent = $this->parent; 470 471 # If $this is not focused anymore, then it most probably 472 # has shifted focus itself using a callback routine. 473 # In that case, do not go to the next or previous object, 474 # but honour the current focus_path. 475 # 476 if ($this->root->focus_path(-1) ne $this) { 477 return $this; 478 } 479 480 if (defined $key and $key eq KEY_BTAB()) { 481 $this->parent->focus_prev(); 482 } else { 483 $this->parent->focus_next(); 484 } 485 } 486 487 return $this; 488} 489 490sub focus() 491{ 492 my $this = shift; 493 494 # Let the parent focus this object. 495 my $parent = $this->parent; 496 $parent->focus($this) if defined $parent; 497 498 $this->draw(1) if ($this->root->overlapping); 499 return $this; 500} 501 502sub modalfocus () 503{ 504 my $this = shift; 505 506 # "Fake" focus for this object. 507 $this->{-has_modal_focus} = 1; 508 $this->focus; 509 $this->draw; 510 511 # Event loop ((too?) much like Curses::UI->mainloop) 512 while ( $this->{-has_modal_focus} ) { 513 $this->root->do_one_event($this); 514 } 515 516 $this->{-focus} = 0; 517 $this->{-has_modal_focus} = 0; 518 519 return $this; 520} 521 522 523sub draw(;$) 524{ 525 my $this = shift; 526 my $no_doupdate = shift || 0; 527 528 # Return immediately if this object is hidden of if 529 # the screen is currently too small. 530 return if $Curses::UI::screen_too_small; 531 return if $this->hidden; 532 533 eval { curs_set(0) }; # not available on every system. 534 535 # Clear the contents of the window. 536 my $scr = defined $this->{-borderscr} 537 ? $this->{-borderscr} 538 : $this->{-canvasscr}; 539 if ($Curses::UI::color_support) { 540 my $co = $Curses::UI::color_object; 541 my $pair = $co->get_color_pair( $this->{-fg}, $this->{-bg} ); 542 $scr->bkgdset(COLOR_PAIR($pair) | 32) if (defined $scr and $pair); 543 } 544 return unless defined $scr; 545 $scr->erase; 546 $scr->noutrefresh(); 547 548 # Do borderstuff? 549 if (defined $this->{-borderscr}) 550 { 551 552 if ($Curses::UI::color_support) { 553 my $co = $Curses::UI::color_object; 554 my $pair = $co->get_color_pair( 555 $this->{-bfg}, 556 $this->{-bbg} ); 557 558 $this->{-borderscr}->attron(COLOR_PAIR($pair)); 559 } 560 561 # Draw a border if needed. 562 if ($this->{-sbborder}) # Square bracket ([,]) border 563 { 564 $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; 565 my $offset = 1; 566 $offset++ if $this->{-vscrollbar}; 567 for my $y (0 .. $this->{-sh}-1) 568 { 569 my $rel_y = $y + $this->{-sy} - $this->{-by}; 570 $this->{-borderscr}->addstr($rel_y, 0, '['); 571 $this->{-borderscr}->addstr($rel_y, $this->{-bw}-$offset, ']'); 572 } 573 $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; 574 } 575 elsif ($this->{-border}) # Normal border 576 { 577 $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; 578 if ($this->root->compat) { 579 $this->{-borderscr}->border( 580 '|','|','-','-', 581 '+','+','+','+' 582 ); 583 } else { 584 $this->{-borderscr}->box(ACS_VLINE, ACS_HLINE); 585 } 586 $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; 587 588 # Draw a title if needed. 589 if (defined $this->{-title}) 590 { 591 if ($Curses::UI::color_support) { 592 my $co = $Curses::UI::color_object; 593 my $pair = $co->get_color_pair( 594 $this->{-tfg}, 595 $this->{-tbg} ); 596 597 $this->{-borderscr}->attron(COLOR_PAIR($pair)); 598 } 599 600 $this->{-borderscr}->attron(A_REVERSE) 601 if $this->{-titlereverse}; 602 if ($this->{-titlefullwidth} 603 and $this->{-titlereverse}) { 604 $this->{-borderscr}->attron(A_BOLD); 605 $this->{-borderscr}->addstr(0, 1, " "x($this->{-bw}-2)); 606 $this->{-borderscr}->attroff(A_BOLD); 607 } 608 my $t = $this->{-title}; 609 my $l = $this->{-bw}-4; 610 if ($l < length($t)) 611 { 612 $t = substr($t, 0, $l) if $l < length($t); 613 $t =~ s/.$/\$/; 614 } 615 $this->{-borderscr}->attron(A_BOLD); 616 $this->{-borderscr}->addstr(0, 1, " $t "); 617 $this->{-borderscr}->attroff(A_REVERSE); 618 $this->{-borderscr}->attroff(A_BOLD); 619 } 620 } 621 622 $this->draw_scrollbars(); 623 $this->{-borderscr}->noutrefresh(); 624 } 625 626 doupdate() unless $no_doupdate; 627 return $this; 628} 629 630sub draw_scrollbars() 631{ 632 my $this = shift; 633 634 return $this unless defined $this->{-borderscr}; 635 636 if ($this->{-vscrollbar} and defined $this->{-vscrolllen}) 637 { 638 639 # Compute the drawing range for the scrollbar. 640 my $xpos = $this->{-vscrollbar} eq 'left' 641 ? 0 642 : $this->borderwidth-1; 643 644 my $ypos_min = $this->{-sy}-$this->{-by}; 645 my $ypos_max = $ypos_min + $this->canvasheight - 1; 646 my $scrlen = $ypos_max - $ypos_min + 1; 647 my $actlen = $this->{-vscrolllen} 648 ? int($scrlen * ($scrlen/($this->{-vscrolllen}))+0.5) 649 : 0; 650 $actlen = 1 if not $actlen and $this->{-vscrolllen}; 651 my $actpos = ($this->{-vscrolllen} and $this->{-vscrollpos}) 652 ? int($scrlen*($this->{-vscrollpos}/$this->{-vscrolllen})) 653 + $ypos_min + 1 654 : $ypos_min; 655 656 # Only let the marker be at the end if the 657 # scrollpos is too. 658 if ($this->{-vscrollpos}+$scrlen >= $this->{-vscrolllen}) { 659 $actpos = $scrlen - $actlen + $ypos_min; 660 } else { 661 if ($actpos + $actlen >= $scrlen) { 662 $actpos--; 663 } 664 } 665 666 # Only let the marker be at the beginning if the 667 # scrollpos is too. 668 if ($this->{-vscrollpos} == 0) { 669 $actpos = $ypos_min; 670 } else { 671 if ($this->{-vscrollpos} and $actpos <= 0) { 672 $actpos = $ypos_min+1; 673 } 674 } 675 676 # Draw the base of the scrollbar, in case 677 # there is no border. 678 $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; 679 $this->{-borderscr}->move($ypos_min, $xpos); 680 $this->{-borderscr}->vline(ACS_VLINE,$scrlen); 681 if ($this->root->compat) { 682 $this->{-borderscr}->vline('|',$scrlen); 683 } else { 684 $this->{-borderscr}->vline(ACS_VLINE,$scrlen); 685 } 686 $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; 687 688 if ($Curses::UI::color_support) { 689 my $co = $Curses::UI::color_object; 690 my $pair = $co->get_color_pair( 691 $this->{-sfg}, 692 $this->{-sbg} ); 693 694 $this->{-borderscr}->attron(COLOR_PAIR($pair)); 695 } 696 697 # Should an active region be drawn? 698 my $scroll_active = ($this->{-vscrolllen} > $scrlen); 699 # Draw scrollbar base, in case there is 700 # Draw active region. 701 if ($scroll_active) 702 { 703 $this->{-borderscr}->attron(A_REVERSE); 704 for my $i (0 .. $actlen-1) { 705 $this->{-borderscr}->addch($i+$actpos,$xpos," "); 706 } 707 $this->{-borderscr}->attroff(A_REVERSE); 708 } 709 710 if ($Curses::UI::color_support) { 711 my $co = $Curses::UI::color_object; 712 my $pair = $co->get_color_pair( 713 $this->{-bfg}, 714 $this->{-bbg} ); 715 716 $this->{-borderscr}->attron(COLOR_PAIR($pair)); 717 } 718 719 } 720 721 if ($this->{-hscrollbar} and defined $this->{-hscrolllen}) 722 { 723 # Compute the drawing range for the scrollbar. 724 my $ypos = $this->{-hscrollbar} eq 'top' 725 ? 0 726 : $this->borderheight-1; 727 728 my $xpos_min = $this->{-sx}-$this->{-bx}; 729 my $xpos_max = $xpos_min + $this->canvaswidth - 1; 730 my $scrlen = $xpos_max - $xpos_min + 1; 731 my $actlen = $this->{-hscrolllen} 732 ? int($scrlen * ($scrlen/($this->{-hscrolllen}))+0.5) 733 : 0; 734 $actlen = 1 if not $actlen and $this->{-hscrolllen}; 735 my $actpos = ($this->{-hscrolllen} and $this->{-hscrollpos}) 736 ? int($scrlen*($this->{-hscrollpos}/$this->{-hscrolllen})) 737 + $xpos_min + 1 738 : $xpos_min; 739 740 # Only let the marker be at the end if the 741 # scrollpos is too. 742 if ($this->{-hscrollpos}+$scrlen >= $this->{-hscrolllen}) { 743 $actpos = $scrlen - $actlen + $xpos_min; 744 } else { 745 if ($actpos + $actlen >= $scrlen) { 746 $actpos--; 747 } 748 } 749 750 # Only let the marker be at the beginning if the 751 # scrollpos is too. 752 if ($this->{-hscrollpos} == 0) { 753 $actpos = $xpos_min; 754 } else { 755 if ($this->{-hscrollpos} and $actpos <= 0) { 756 $actpos = $xpos_min+1; 757 } 758 } 759 760 # Draw the base of the scrollbar, in case 761 # there is no border. 762 $this->{-borderscr}->attron(A_BOLD) if $this->{-focus}; 763 $this->{-borderscr}->move($ypos, $xpos_min); 764 if ($this->root->compat) { 765 $this->{-borderscr}->hline('-',$scrlen); 766 } else { 767 $this->{-borderscr}->hline(ACS_HLINE,$scrlen); 768 } 769 $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus}; 770 771 # Should an active region be drawn? 772 773 if ($Curses::UI::color_support) { 774 my $co = $Curses::UI::color_object; 775 my $pair = $co->get_color_pair( 776 $this->{-sfg}, 777 $this->{-sbg} ); 778 779 $this->{-borderscr}->attron(COLOR_PAIR($pair)); 780 } 781 782 my $scroll_active = ($this->{-hscrolllen} > $scrlen); 783 # Draw active region. 784 if ($scroll_active) 785 { 786 $this->{-borderscr}->attron(A_REVERSE); 787 for my $i (0 .. $actlen-1) { 788 $this->{-borderscr}->addch($ypos, $i+$actpos," "); 789 } 790 $this->{-borderscr}->attroff(A_REVERSE); 791 } 792 } 793 794 return $this; 795} 796 797sub beep_on() { my $this = shift; $this->{-nobeep} = 0; return $this } 798sub beep_off() { my $this = shift; $this->{-nobeep} = 1; return $this } 799sub dobeep() 800{ 801 my $this = shift; 802 beep() unless $this->{-nobeep}; 803 return $this; 804} 805 806 807# TODO: work out hiding of objects. 808sub hidden() { shift()->{-hidden} } 809sub hide() { shift()->{-hidden} = 1 } 810sub show() { shift()->{-hidden} = 0 } 811 812sub intellidraw(;$) 813{ 814 my $this = shift; 815 816 if ( $this->{-intellidraw} and 817 not $this->hidden and 818 $this->in_topwindow ) { 819 $this->draw(1); 820 } 821 822 return $this; 823} 824 825sub delete_subwindows() 826{ 827 my $this = shift; 828 delete $this->{-scr}; 829 foreach my $win (qw(-borderscr -canvasscr)) 830 { 831 if (defined $this->{$win}) 832 { 833 $this->{$win}->delwin; 834 delete $this->{$win}; 835 } 836 } 837} 838 839sub parentwindow() 840{ 841 my $object = shift; 842 843 until (not defined $object or 844 $object->isa('Curses::UI::Window')) { 845 $object = $object->parent 846 } 847 848 return $object; 849} 850 851sub in_topwindow() 852{ 853 my $this = shift; 854 855 # Get the parent window of this widget. 856 my $win = $this->parentwindow(); 857 return unless defined $win; 858 859 # A modal window should always be the topwindow. 860 return 1 if $win->{-has_modal_focus}; 861 862 # Get the current focus path (the list of objects 863 # from the Curses::UI root up which currently 864 # have the focus). Strip non Window object from 865 # it, to find the topmost window. 866 my @path = $this->root->focus_path; 867 while (defined $path[-1] and 868 not $path[-1]->isa('Curses::UI::Window')) { 869 pop @path; 870 } 871 872 # Check if the parent window is on top. 873 return (@path and ($win eq $path[-1])); 874} 875 876# ---------------------------------------------------------------------- 877# Binding 878# ---------------------------------------------------------------------- 879 880sub clear_binding($;) 881{ 882 my $this = shift; 883 my $binding = shift; 884 my @delete = (); 885 while (my ($k,$v) = each %{$this->{-bindings}}) { 886 push @delete, $k if $v eq $binding; 887 } 888 foreach (@delete) { 889 delete $this->{-bindings}->{$_}; 890 } 891 return $this; 892} 893 894sub set_routine($$;) 895{ 896 my $this = shift; 897 my $binding = shift; 898 my $routine = shift; 899 $this->{-routines}->{$binding} = $routine; 900 return $this; 901} 902 903sub set_binding($@) 904{ 905 my $this = shift; 906 my $routine = shift; 907 my @keys = @_; 908 909 # Create a routine entry if the routine that was 910 # passed is a code reference instead of a 911 # routine name. 912 if (ref $routine eq 'CODE') 913 { 914 my $name = "__routine_$routine"; 915 $this->set_routine($name, $routine); 916 $routine = $name; 917 } 918 919 $this->root->fatalerror("set_binding(): $routine: no such routine") 920 unless defined $this->{-routines}->{$routine}; 921 922 foreach my $key (@keys) { 923 $this->{-bindings}->{$key} = $routine; 924 } 925 926 return $this; 927} 928 929sub set_mouse_binding($@) 930{ 931 my $this = shift; 932 my $routine = shift; 933 my @mouse_events = @_; 934 935 # Create a routine entry if the routine that was 936 # passed is a code reference instead of a 937 # routine name. 938 if (ref $routine eq 'CODE') 939 { 940 my $name = "__routine_$routine"; 941 $this->set_routine($name, $routine); 942 $routine = $name; 943 } 944 945 $this->root->fatalerror("set_binding(): $routine: no such routine") 946 unless defined $this->{-routines}->{$routine}; 947 948 foreach my $mouse_event (@mouse_events) { 949 $this->{-mousebindings}->{$mouse_event} = $routine; 950 } 951 952 return $this; 953} 954 955sub schedule_draw(;$) { shift()->accessor('-schedule_draw', shift()) } 956 957sub process_bindings($;$@) 958{ 959 my $this = shift; 960 my $key = shift; 961 my $is_mouse_event = shift || 0; 962 my @extra = @_; 963 964 # Reset draw schedule. 965 $this->schedule_draw(0); 966 967 # Find the binding to use. 968 my $binding; 969 if ($is_mouse_event) 970 { 971 $binding = $this->{-mousebindings}->{$key->{-bstate}}; 972 if (not defined $binding) { 973 # Check for default routine. 974 $binding = $this->{-mousebindings}->{''}; 975 } 976 } else { 977 $binding = $this->{-bindings}->{$key}; 978 if (not defined $binding) { 979 # Check for default routine. 980 $binding = $this->{-bindings}->{''}; 981 } 982 } 983 984 if (defined $binding) { 985 my $return = $this->do_routine($binding, $key, @extra); 986 # Redraw if draw schedule is set. 987 $this->intellidraw if $this->schedule_draw; 988 return $return; 989 } else { 990 return 'DELEGATE'; 991 } 992} 993 994sub do_routine($;$) 995{ 996 my $this = shift; 997 my $binding = shift; 998 my @arguments = @_; 999 1000 # Find the routine to call. 1001 my $routine = $this->{-routines}->{$binding}; 1002 1003 if (defined $routine) 1004 { 1005 if (ref $routine eq 'CODE') { 1006 my $return = $routine->($this, @arguments); 1007 return $return; 1008 } else { 1009 return $routine; 1010 } 1011 } else { 1012 $this->root->fatalerror( 1013 "No routine defined for keybinding \"$binding\"!" 1014 ); 1015 } 1016} 1017 1018sub onFocus($;$) { shift()->set_event('-onfocus', shift()) } 1019sub onBlur($;$) { shift()->set_event('-onblur', shift()) } 1020 1021sub event_onfocus() 1022{ 1023 my $this = shift; 1024 1025 # Let the parent find another widget to focus 1026 # if this widget is not focusable. 1027 unless ($this->focusable) { 1028 return $this->parent->focus($this); 1029 } 1030 1031 $this->{-focus} = 1; 1032 1033 $this->run_event('-onfocus'); 1034 1035 # Set cursor mode 1036 my $show_cursor = $this->{-nocursor} ? 0 : 1; 1037 $this->root->cursor_mode($show_cursor); 1038 1039 $this->draw(1) if (not $this->root->overlapping); 1040 1041 return $this; 1042} 1043 1044sub event_onblur() 1045{ 1046 my $this = shift; 1047 $this->{-focus} = 0; 1048 $this->run_event('-onblur'); 1049 $this->draw(1) if (not $this->root->overlapping); 1050 return $this; 1051} 1052 1053sub event_keypress($;) 1054{ 1055 my $this = shift; 1056 my $key = shift; 1057 $this->process_bindings($key); 1058} 1059 1060sub event_mouse($;) 1061{ 1062 my $this = shift; 1063 my $MEVENT = shift; 1064 1065 my $winp = $this->windowparameters; 1066 my $abs_x = $MEVENT->{-x} - $winp->{-x}; 1067 my $abs_y = $MEVENT->{-y} - $winp->{-y}; 1068 1069 $this->process_bindings($MEVENT, 1, $abs_x, $abs_y); 1070} 1071 1072sub mouse_button1($$$$;) 1073{ 1074 my $this = shift; 1075 my $event = shift; 1076 my $x = shift; 1077 my $y = shift; 1078 1079 $this->focus() if not $this->{-focus} and $this->focusable; 1080} 1081 1082# ---------------------------------------------------------------------- 1083# Event handling 1084# ---------------------------------------------------------------------- 1085 1086sub clear_event($;) 1087{ 1088 my $this = shift; 1089 my $event = shift; 1090 $this->set_event($event, undef); 1091 return $this; 1092} 1093 1094sub set_event($;$) 1095{ 1096 my $this = shift; 1097 my $event = shift; 1098 my $callback = shift; 1099 1100 if (defined $callback) 1101 { 1102 if (ref $callback eq 'CODE') { 1103 $this->{$event} = $callback; 1104 } else { 1105 $this->root->fatalerror( 1106 "$event callback for $this " 1107 . "($callback) is no CODE reference" 1108 ); 1109 } 1110 } else { 1111 $this->{$event} = undef; 1112 } 1113 return $this; 1114} 1115 1116sub run_event($;) 1117{ 1118 my $this = shift; 1119 my $event = shift; 1120 1121 my $callback = $this->{$event}; 1122 if (defined $callback) { 1123 if (ref $callback eq 'CODE') { 1124 return $callback->($this); 1125 } else { 1126 $this->root->fatalerror( 1127 "$event callback for $this " 1128 . "($callback) is no CODE reference" 1129 ); 1130 } 1131 } 1132 return; 1133} 1134 1135### 1136### Color attribute functions 1137### 1138 1139sub set_color_fg{ 1140 my $this = shift; 1141 $this->{-fg} = shift; 1142 $this->intellidraw; 1143} 1144 1145sub set_color_bg{ 1146 my $this = shift; 1147 $this->{-bg} = shift; 1148 $this->intellidraw; 1149} 1150 1151sub set_color_tfg{ 1152 my $this = shift; 1153 $this->{-tfg} = shift; 1154 $this->intellidraw; 1155} 1156 1157sub set_color_tbg{ 1158 my $this = shift; 1159 $this->{-tbg} = shift; 1160 $this->intellidraw; 1161} 1162 1163sub set_color_bfg{ 1164 my $this = shift; 1165 $this->{-bfg} = shift; 1166 $this->intellidraw; 1167} 1168 1169sub set_color_bbg{ 1170 my $this = shift; 1171 $this->{-bbg} = shift; 1172 $this->intellidraw; 1173} 1174 1175sub set_color_sfg{ 1176 my $this = shift; 1177 $this->{-sfg} = shift; 1178 $this->intellidraw; 1179} 1180 1181sub set_color_sbg{ 1182 my $this = shift; 1183 $this->{-sbg} = shift; 1184 $this->intellidraw; 1185} 1186 1187package Curses::UI::ContainerWidget; 1188 1189# Not special at all. This class is especially used as a flag for 1190# container based widgets, so that we can detect these using 1191# $object->isa('Curses::UI::ContainerWidget'). 1192 1193use Curses::UI::Container; 1194use Curses::UI::Widget; 1195use vars qw( 1196 @ISA 1197 $VERSION 1198); 1199 1200$VERSION = '1.10'; 1201 1202@ISA = qw( 1203 Curses::UI::Container 1204 Curses::UI::Widget 1205); 1206 1207sub new () { shift()->SUPER::new(@_) }; 1208 12091; 1210 1211 1212=pod 1213 1214=head1 NAME 1215 1216Curses::UI::Widget - The base class for all widgets 1217 1218=head1 CLASS HIERARCHY 1219 1220 Curses::UI::Widget - base class 1221 1222 1223 1224=head1 SYNOPSIS 1225 1226This class is not used directly by somebody who is building an application 1227using Curses::UI. It's a base class that is expanded by the Curses::UI widgets. 1228See WIDGET STRUCTURE below for a basic widget framework. 1229 1230 use Curses::UI::Widget; 1231 my $widget = new Curses::UI::Widget( 1232 -width => 15, 1233 -height => 5, 1234 -border => 1, 1235 ); 1236 1237 1238 1239 1240=head1 STANDARD OPTIONS 1241 1242The standard options for (most) widgets are the options that are enabled 1243by this class. So this class doesn't really have standard options. 1244 1245 1246 1247 1248 1249=head1 WIDGET-SPECIFIC OPTIONS 1250 1251=head2 GENERAL: 1252 1253=over 4 1254 1255=item * B<-parent> < OBJECTREF > 1256 1257This option specifies parent of the object. This parent is 1258the object (Curses::UI, Window, Widget(descendant), etc.) 1259in which the widget is drawn. 1260 1261=item * B<-intellidraw> < BOOLEAN > 1262 1263If BOOLEAN has a true value (which is the default), the 1264B<intellidraw> method (see below) will be suported. This 1265option is mainly used in widget building. 1266 1267=item * B<-userdata> < SCALAR > 1268 1269This option specifies a user data that can be retrieved with 1270the B<userdata>() method. It is useful to store application's 1271internal data that otherwise would not be accessible in callbacks. 1272 1273=item * B<-border> < BOOLEAN > 1274 1275Each widget can be drawn with or without a border. To enable 1276the border use a true value and to disable it use a 1277false value for BOOLEAN. The default is not to use a border. 1278 1279=item * B<-sbborder> < BOOLEAN > 1280 1281If no border is used, a square bracket border may be used. 1282This is a border which is constructed from '[' and ']' 1283characters. This type of border is especially useful for 1284single line widgets (like text entries and popup boxes). 1285A square bracket border can only be enabled if -border 1286is false. The default is not to use a square bracket border. 1287 1288=back 1289 1290 1291 1292=head2 POSITIONING: 1293 1294 +---------------------------------------------------+ 1295 | parent ^ | 1296 | | | 1297 | y | 1298 | | | 1299 | v | 1300 | ^ | 1301 | | | 1302 | padtop | 1303 | | | 1304 | v | 1305 | +- TITLE -------+ | 1306 | | widget ^ | | 1307 | | | | | 1308 | | | | | 1309 |<--x--><--padleft-->|<----width---->|<--padright-->| 1310 | | | | | 1311 | | | | | 1312 | | height | | 1313 | | v | | 1314 | +---------------+ | 1315 | ^ | 1316 | | | 1317 | padbottom | 1318 | | | 1319 | v | 1320 +---------------------------------------------------+ 1321 1322 1323=over 4 1324 1325=item * B<-x> < VALUE > 1326 1327The x-position of the widget, relative to the parent. The default 1328is 0. 1329 1330=item * B<-y> < VALUE > 1331 1332The y-position of the widget, relative to the parent. The default 1333is 0. 1334 1335=item * B<-width> < VALUE > 1336 1337The width of the widget. If the width is undefined or -1, 1338the maximum available width will be used. By default the widget 1339will use the maximum available width. 1340 1341=item * B<-height> < VALUE > 1342 1343The height of the widget. If the height is undefined or -1, 1344the maximum available height will be used. By default the widget 1345will use the maximum available height. 1346 1347=back 1348 1349 1350 1351=head2 PADDING: 1352 1353=over 4 1354 1355=item * B<-pad> < VALUE > 1356 1357=item * B<-padtop> < VALUE > 1358 1359=item * B<-padbottom> < VALUE > 1360 1361=item * B<-padleft> < VALUE > 1362 1363=item * B<-padright> < VALUE > 1364 1365With -pad you can specify the default padding outside the widget 1366(the default value for -pad is 0). Using one of the -pad... options 1367that have a direction in them, you can override the default 1368padding. 1369 1370=item * B<-ipad> < VALUE > 1371 1372=item * B<-ipadtop> < VALUE > 1373 1374=item * B<-ipadbottom> < VALUE > 1375 1376=item * B<-ipadleft> < VALUE > 1377 1378=item * B<-ipadright> < VALUE > 1379 1380These are almost the same as the -pad... options, except these options 1381specify the padding _inside_ the widget. Normally the available 1382effective drawing area for a widget will be the complete area 1383if no border is used or else the area within the border. 1384 1385=back 1386 1387 1388 1389=head2 TITLE: 1390 1391Remark: 1392 1393A title is drawn in the border of a widget. So a title will only 1394be available if -border is true. 1395 1396=over 4 1397 1398=item * B<-title> < TEXT > 1399 1400Set the title of the widget to TEXT. If the text is longer then the 1401available width, it will be clipped. 1402 1403=item * B<-titlereverse> < BOOLEAN > 1404 1405The title can be drawn in normal or in reverse type. If -titlereverse 1406is true, the text will be drawn in reverse type. The default is to 1407use reverse type. 1408 1409=item * B<-titlefullwidth> < BOOLEAN > 1410 1411If -titlereverse is true, the title can be stretched to fill the 1412complete width of the widget by giving -titlefullwidth a true value. 1413By default this option is disabled. 1414 1415=back 1416 1417 1418 1419=head2 SCROLLBARS: 1420 1421Remark: 1422 1423Since the user of a Curses::UI program has no real control over 1424the so called "scrollbars", they aren't really scrollbars. A 1425better name would be something like "document location indicators". 1426But since they look so much like scrollbars I decided I could get 1427away with this naming convention. 1428 1429=over 4 1430 1431=item * B<-vscrollbar> < VALUE > 1432 1433VALUE can be 'left', 'right', another true value or false. 1434 1435If -vscrollbar has a true value, a vertical scrollbar will 1436be drawn by the widget. If this true value happens to be "left", 1437the scrollbar will be drawn on the left side of the widget. In 1438all other cases it will be drawn on the right side. The default 1439is not to draw a vertical scrollbar. 1440 1441For widget programmers: To control the scrollbar, the widget 1442data -vscrolllen (the total length of the content of the widget) 1443and -vscrollpos (the current position in the document) should 1444be set. If Curses::UI::Widget::draw is called, the scrollbar 1445will be drawn. 1446 1447=item * B<-hscrollbar> < VALUE > 1448 1449VALUE can be 'top', 'bottom', another true value or false. 1450 1451If -hscrollbar has a true value, a horizontal scrollbar will 1452be drawn by the widget. If this true value happens to be "top", 1453the scrollbar will be drawn at the top of the widget. In 1454all other cases it will be drawn at the bottom. The default 1455is not to draw a horizontal scrollbar. 1456 1457For widget programmers: To control the scrollbar, the widget 1458data -hscrolllen (the maximum width of the content of the widget) 1459and -hscrollpos (the current horizontal position in the document) 1460should be set. If Curses::UI::Widget::draw is called, 1461the scrollbar will be drawn. 1462 1463=back 1464 1465 1466 1467=head2 EVENTS 1468 1469=over 4 1470 1471=item * B<-onfocus> < CODEREF > 1472 1473This sets the onFocus event handler for the widget. 1474If the widget gets the focus, the code in CODEREF will 1475be executed. It will get the widget reference as its 1476argument. 1477 1478=item * B<-onblur> < CODEREF > 1479 1480This sets the onBlur event handler for the widget. 1481If the widget loses the focus, the code in CODEREF will 1482be executed. It will get the widget reference as its 1483argument. 1484 1485 1486=back 1487 1488 1489=head1 METHODS 1490 1491=over 4 1492 1493=item * B<new> ( OPTIONS ) 1494 1495Create a new Curses::UI::Widget instance using the options in HASH. 1496 1497=item * B<layout> ( ) 1498 1499Layout the widget. Compute the size the widget needs and see 1500if it fits. Create the curses windows that are needed for 1501the widget (the border and the effective drawing area). 1502 1503=item * B<draw> ( BOOLEAN ) 1504 1505Draw the Curses::UI::Widget. If BOOLEAN is true, the screen 1506will not update after drawing. By default this argument is 1507false, so the screen will update after drawing the widget. 1508 1509=item * B<intellidraw> ( ) 1510 1511If the widget is visible (it is not hidden and it is in the 1512window that is currently on top) and if intellidraw is not 1513disabled for it (B<-intellidraw> has a true value) it is drawn 1514and the curses routine doupdate() will be called to update 1515the screen. 1516 1517This is useful if you change something in a widget and want 1518it to update its state. If you simply call draw() and 1519doupdate() yourself, then the widget will also be drawn if 1520it is on a window that is currently not on top. This would 1521result in the widget being drawn right through the contents 1522of the window that is currently on top. 1523 1524=item * B<focus> ( ) 1525 1526Give focus to the widget. In Curses::UI::Widget, this method 1527immediately returns, so the widget will not get focused. 1528A derived class that needs focus, must override this method. 1529 1530=item * B<focusable> ( [BOOLEAN] ) 1531 1532If BOOLEAN is set to a true value the widget will be focusable, 1533false will make it unfocusable. If not argument is given, 1534it will return the current state. 1535 1536=item * B<lose_focus> ( ) 1537 1538This method makes the current widget lose it's focus. 1539It returns the current widget. 1540 1541=item * B<modalfocus> ( ) 1542 1543Gives the widget a modal focus, i.e. no other widget can be active 1544till this widget is removed. 1545 1546=item * B<title> ( TEXT ) 1547 1548Change the title that is shown in the border of the widget 1549to TEXT. 1550 1551=item * B<width> ( ) 1552 1553=item * B<height> ( ) 1554 1555These methods return the total width and height of the widget. 1556This is the space that the widget itself uses plus the space that 1557is used by the outside padding. 1558 1559=item * B<borderwidth> ( ) 1560 1561=item * B<borderheight> ( ) 1562 1563These methods return the width and the height of the border of the 1564widget. 1565 1566=item * B<canvaswidth> ( ) 1567 1568=item * B<canvasheight> ( ) 1569 1570These methods return the with and the height of the effective 1571drawing area of the widget. This is the area where the 1572draw() method of a widget may draw the contents of the widget 1573(BTW: the curses window that is associated to this drawing 1574area is $this->{-canvasscr}). 1575 1576=item * B<width_by_windowscrwidth> ( NEEDWIDTH, OPTIONS ) 1577 1578=item * B<height_by_windowscrheight> ( NEEDHEIGHT, OPTIONS ) 1579 1580These methods are exported by this module. These can be used 1581in child classes to easily compute the total width/height the widget 1582needs in relation to the needed width/height of the effective drawing 1583area ($this->{-canvasscr}). The OPTIONS contains the options that 1584will be used to create the widget. So if we want a widget that 1585has a drawing area height of 1 and that has a border, the -height 1586option can be computed using something like: 1587 1588 my $height = height_by_windowscrheight(1, -border => 1); 1589 1590=item * B<generic_focus> ( BLOCKTIME, CTRLKEYS, CURSOR, PRECALLBACK ) 1591 1592For most widgets the B<generic_focus> method will be enough to 1593handle focusing. This method will do the following: 1594 1595It starts a loop for reading keyboard input from the user. 1596At the start of this loop the PRECALLBACK is called. This callback 1597can for example be used for layouting the widget. Then, the widget 1598is drawn. 1599 1600Now a key is read or if the DO_KEY:<key> construction was used, 1601the <key> will be used as if it was read from the keyboard (you 1602can find more on this construction below). If the DO_KEY:<key> 1603construction was not used, a key is read using the B<get_key> 1604method which is in L<Curses::UI::Common|Curses::UI::Common>. 1605The arguments BLOCKTIME, CTRLKEYS and CURSOR are passed to 1606B<get_key>. 1607 1608Now the key is checked. If the value of the key is -1, B<get_key> 1609did not read a key at all. In that case, the program will go back 1610to the start of the loop. 1611 1612As soon as a key is read, this key will be handed to the 1613B<process_bindings> method (see below). The returnvalue of this 1614method (called RETURN from now on) will be used to determine 1615what to do next. We have the following cases: 1616 1617* B<RETURN matches DO_KEY:<key>> 1618 1619The <key> is extracted from RETURN. The loop is restarted and 1620<key> will be used as if it was entered using the keyboard. 1621 1622* B<RETURN is a CODE reference> 1623 1624RETURN will be returned to the caller of B<generic_focus>. 1625This will have the widget lose its focus. The caller then can 1626execute the code. 1627 1628* B<RETURN is a SCALAR value> 1629 1630RETURN will be returned to the caller of B<generic_focus>. 1631This will have the widget lose its focus. 1632 1633* B<anything else> 1634 1635The widget will keep its focus. The loop will be restarted all 1636over again. So, if you are writing a binding routine for a widget, 1637you can have the focus to stay at the widget by returning the 1638widget instance itself. Example: 1639 1640 sub myroutine() { 1641 my $this = shift; 1642 .... do your thing .... 1643 return $this; 1644 } 1645 1646 1647=item * B<process_bindings> ( KEY ) 1648 1649KEY -> maps via binding to -> ROUTINE -> maps to -> VALUE 1650 1651This method will try to find out if there is a binding defined 1652for the KEY. If no binding is found, the method will return 1653the widget object itself. 1654If a binding is found, the method will check if there is 1655an corresponding ROUTINE. If the ROUTINE can be found it 1656will check if it's VALUE is a code reference. If it is, the 1657code will be executed and the returnvalue of this code will 1658be returned. Else the VALUE will directly be returned. 1659 1660=item * B<clear_binding> ( ROUTINE ) 1661 1662Clear all keybindings for routine ROUTINE. 1663 1664=item * B<set_routine> ( ROUTINE, VALUE ) 1665 1666Set the routine ROUTINE to the VALUE. The VALUE may either be a 1667scalar value or a code reference. If B<process_bindings> (see above) 1668sees a scalar value, it will return this value. If it sees a 1669coderef, it will execute the code and return the returnvalue of 1670this code. 1671 1672=item * B<set_binding> ( ROUTINE, KEYLIST ) 1673 1674Bind the keys in the list KEYLIST to the ROUTINE. If you use an 1675empty string for a key, then this routine will become the default 1676routine (in case no other keybinding could be found). This 1677is for example used in the TextEditor widget. 1678 1679=item * B<set_event> ( EVENT, [CODEREF] ) 1680 1681This routine will set the callback for event EVENT to 1682CODEREF. If CODEREF is omitted or undefined, the event will 1683be cleared. 1684 1685=item * B<clear_event> ( EVENT ) 1686 1687This will clear the callback for event EVENT. 1688 1689=item * B<run_event> ( EVENT ) 1690 1691This routine will check if a callback for the event EVENT 1692is set and if is a code reference. If this is the case, 1693it will run the code and return its return value. 1694 1695=item * B<onFocus> ( CODEREF ) 1696 1697This method can be used to set the B<-onfocus> event handler 1698(see above) after initialization of the widget. 1699 1700=item * B<onBlur> ( CODEREF ) 1701 1702This method can be used to set the B<-onblur> event handler 1703(see above) after initialization of the widget. 1704 1705=item * B<parentwindow> ( ) 1706 1707Returns this parent window for the widget or undef if 1708no parent window can be found (this should not happen). 1709 1710=item * B<in_topwindow> ( ) 1711 1712Returns true if the widget is in the window that is 1713currently on top. 1714 1715=item * B<userdata> ( [ SCALAR ] ) 1716 1717This method will return the user internal data stored in this widget. 1718If a SCALAR parameter is specified it will also set the current user 1719data to it. 1720 1721=item * B<beep_on> ( ) 1722 1723This sets the data member $this->{B<-nobeep>} of the class instance 1724to a false value. 1725 1726=item * B<beep_off> ( ) 1727 1728This sets the data member $this->{B<-nobeep>} of the class instance 1729to a true value. 1730 1731=item * B<dobeep> ( ) 1732 1733This will call the curses beep() routine, but only if B<-nobeep> 1734is false. 1735 1736=back 1737 1738 1739=head1 WIDGET STRUCTURE 1740 1741Here's a basic framework for creating a new widget. You do not have 1742to follow this framework. As long as your widget has the methods 1743new(), layout(), draw() and focus(), it can be used in Curses::UI. 1744 1745 package Curses::UI::YourWidget 1746 1747 use Curses; 1748 use Curses::UI::Widget; 1749 use Curses::UI::Common; # some common widget routines 1750 1751 use vars qw($VERSION @ISA); 1752 $VERSION = '0.01'; 1753 @ISA = qw(Curses::UI::Widget Curses::UI::Common); 1754 1755 # For a widget that can get focus, you should define 1756 # the routines that are used to control the widget. 1757 # Each routine has a name. This name is used in 1758 # the definition of the bindings. 1759 # The value can be a string or a subroutine reference. 1760 # A string will make the widget return from focus. 1761 # 1762 my %routines = ( 1763 'return' => 'LOSE_FOCUS', 1764 'key-a' => \&key_a, 1765 'key-other' => \&other_key 1766 ); 1767 1768 # Using the bindings, the routines can be binded to key- 1769 # presses. If the keypress is an empty string, this means 1770 # that this is the default binding. If the key is not 1771 # handled by any other binding, it's handled by this 1772 # default binding. 1773 # 1774 my %bindings = ( 1775 KEY_DOWN() => 'return', # down arrow will make the 1776 # widget lose it's focus 1777 'a' => 'key-a', # a-key will trigger key_a() 1778 '' => 'key-other' # any other key will trigger other_key() 1779 ); 1780 1781 # The creation of the widget. When doing it this way, 1782 # it's easy to make optional and forced arguments 1783 # possible. A forced argument could for example be 1784 # -border => 1, which would mean that the widget 1785 # always has a border, which can't be disabled by the 1786 # programmer. The arguments can of course be used 1787 # for storing the current state of the widget. 1788 # 1789 sub new () { 1790 my $class = shift; 1791 my %args = ( 1792 -optional_argument_1 => "default value 1", 1793 -optional_argument_2 => "default value 2", 1794 ....etc.... 1795 @_, 1796 -forced_argument_1 => "forced value 1", 1797 -forced_argument_2 => "forced value 2", 1798 ....etc.... 1799 -bindings => {%bindings}, 1800 -routines => {%routines}, 1801 ); 1802 1803 # Create the widget and do the layout of it. 1804 my $this = $class->SUPER::new( %args ); 1805 $this->layout; 1806 1807 return $this; 1808 } 1809 1810 # Each widget should have a layout() routine. Here, 1811 # the widget itself and it's contents can be layouted. 1812 # In case of a very simple widget, this will only mean 1813 # that the Widget has to be layouted (in which case the 1814 # routine could be left out, since it's in the base 1815 # class already). In other cases you will have to add 1816 # your own layout code. This routine is very important, 1817 # since it will enable the resizeability of the widget! 1818 # 1819 sub layout () { 1820 my $this = shift; 1821 1822 $this->SUPER::layout; 1823 return $this if $Curses::UI::screen_too_small; 1824 1825 ....your own layout stuff.... 1826 1827 # If you decide that the widget does not fit on the 1828 # screen, then set $Curses::UI::screen_too_small 1829 # to a true value and return. 1830 if ( ....the widget does not fit.... ) { 1831 $Curses::UI::screen_too_small++; 1832 return $this; 1833 } 1834 1835 return $this; 1836 } 1837 1838 # The widget is drawn by the draw() routine. The 1839 # $no_update part is used to disable screen flickering 1840 # if a lot of widgets have to be drawn at once (for 1841 # example on resizing or redrawing). The curses window 1842 # which you can use for drawing the widget's contents 1843 # is $this->{-canvasscr}. 1844 # 1845 sub draw(;$) { 1846 my $this = shift; 1847 my $no_doupdate = shift || 0; 1848 return $this if $this->hidden; 1849 $this->SUPER::draw(1); 1850 1851 ....your own draw stuff.... 1852 $this->{-canvasscr}->addstr(0, 0, "Fixed string"); 1853 ....your own draw stuff.... 1854 1855 $this->{-canvasscr}->noutrefresh; 1856 doupdate() unless $no_doupdate; 1857 return $this; 1858 } 1859 1860 # Focus the widget. If you do not override this routine 1861 # from Curses::UI::Widget, the widget will not be 1862 # focusable. Mostly you will use the generic_focus() method. 1863 # 1864 sub focus() 1865 { 1866 my $this = shift; 1867 $this->show; # makes the widget visible if it was invisible 1868 return $this->generic_focus( 1869 undef, # delaytime, default = 2 (1/10 second). 1870 NO_CONTROLKEYS, # disable controlkeys like CTRL+C. To enable 1871 # them use CONTROLKEYS instead. 1872 CURSOR_INVISIBLE, # do not show the cursor (if supported). To 1873 # show the cursor use CURSOR_VISIBLE. 1874 \&pre_key_routine, # optional callback routine to execute 1875 # before a key is read. Mostly unused. 1876 ); 1877 } 1878 1879 ....your own widget handling routines.... 1880 1881 1882 1883 1884=head1 SEE ALSO 1885 1886L<Curses::UI|Curses::UI> 1887 1888 1889 1890 1891 1892 1893=head1 AUTHOR 1894 1895Copyright (c) 2001-2002 Maurice Makaay. All rights reserved. 1896 1897Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de) 1898 1899 1900This package is free software and is provided "as is" without express 1901or implied warranty. It may be used, redistributed and/or modified 1902under the same terms as perl itself. 1903 1904