1package Prima::Notebooks; 2 3use strict; 4use warnings; 5use Prima::Const; 6use Prima::Classes; 7use Prima::IntUtils; 8use Prima::ScrollWidget; 9 10package Prima::TabSet; 11use vars qw(@ISA); 12@ISA = qw(Prima::Widget Prima::MouseScroller); 13 14 15{ 16my %RNT = ( 17 %{Prima::Widget-> notification_types()}, 18 DrawTab => nt::Action, 19 MeasureTab => nt::Action, 20); 21 22sub notification_types { return \%RNT; } 23} 24 25use constant DefGapX => 10; 26use constant DefGapY => 5; 27use constant DefLeftX => 5; 28use constant DefArrowX => 25; 29 30my @warpColors = ( 31 0x50d8f8, 0x80d8a8, 0x8090f8, 0xd0b4a8, 0xf8fca8, 32 0xa890a8, 0xf89050, 0xf8d850, 0xf8b4a8, 0xf8d8a8, 33); 34 35sub profile_default 36{ 37 my $def = $_[ 0]-> SUPER::profile_default; 38 my $font = $_[ 0]-> get_default_font; 39 my %prf = ( 40 colored => 1, 41 firstTab => 0, 42 focusedTab => 0, 43 height => $font-> { height} > 14 ? $font-> { height} * 2 : 28, 44 ownerBackColor => 1, 45 selectable => 1, 46 selectingButtons => 0, 47 tabStop => 1, 48 topMost => 1, 49 tabIndex => 0, 50 tabs => [], 51 ); 52 @$def{keys %prf} = values %prf; 53 return $def; 54} 55 56 57sub init 58{ 59 my $self = shift; 60 $self-> {tabIndex} = -1; 61 for ( qw( colored firstTab focusedTab topMost lastTab arrows)) { $self-> {$_} = 0; } 62 $self-> {tabs} = []; 63 $self-> {widths} = []; 64 my %profile = $self-> SUPER::init(@_); 65 for ( qw( colored topMost tabs focusedTab firstTab tabIndex)) { $self-> $_( $profile{ $_}); } 66 $self-> recalc_widths; 67 $self-> reset; 68 return %profile; 69} 70 71 72sub reset 73{ 74 my $self = $_[0]; 75 my @size = $self-> size; 76 my $s = $::application-> uiScaling; 77 my $w = $s * (DefLeftX * 2 + DefGapX); 78 for ( @{$self-> {widths}}) { $w += $_ + $s * DefGapX; } 79 $self-> {arrows} = (( $w > $size[0]) and ( scalar( @{$self-> {widths}}) > 1)); 80 if ( $self-> {arrows}) { 81 my $ft = $self-> {firstTab}; 82 $w = $s * DefLeftX * 2 + $s * DefGapX; 83 $w += $s * DefArrowX if $ft > 0; 84 my $w2 = $w; 85 my $la = $ft > 0; 86 my $i; 87 my $ra = 0; 88 my $ww = $self-> {widths}; 89 for ( $i = $ft; $i < scalar @{$ww}; $i++) { 90 $w += $s * DefGapX + $$ww[$i]; 91 if ( $w + $s * (DefGapX + DefLeftX) >= $size[0]) { 92 $ra = 1; 93 $i-- if 94 $i > $ft && 95 $w - $$ww[$i] >= $size[0] - $s * (DefLeftX + DefArrowX + DefGapX); 96 last; 97 } 98 } 99 $i = scalar @{$self-> {widths}} - 1 100 if $i >= scalar @{$self-> {widths}}; 101 $self-> {lastTab} = $i; 102 $self-> {arrows} = ( $la ? 1 : 0) | ( $ra ? 2 : 0); 103 } else { 104 $self-> {lastTab} = scalar @{$self-> {widths}} - 1; 105 } 106} 107 108sub recalc_widths 109{ 110 my $self = $_[0]; 111 my @w; 112 my $i; 113 my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureTab)); 114 $self-> begin_paint_info; 115 $self-> push_event; 116 117 for ( $i = 0; $i < scalar @{$self-> {tabs}}; $i++) { 118 my $iw = 0; 119 $notifier-> ( @notifyParms, $i, \$iw); 120 push ( @w, $iw); 121 } 122 123 $self-> pop_event; 124 $self-> end_paint_info; 125 $self-> {widths} = [@w]; 126} 127 128sub x2pos 129{ 130 my ( $self, $x ) = @_; 131 132 my ( $ar, $ww, $ft, $lt) = ( 133 $self-> {arrows}, $self-> {widths}, $self-> {firstTab}, $self-> {lastTab} 134 ); 135 136 my $s = $::application-> uiScaling; 137 return -1 if ( $ar & 1) and ( $x < $s * (DefLeftX + DefGapX * 2 + DefArrowX)); 138 139 my @size = $self-> size; 140 return -2 if ( $ar & 2) and ( $x >= $size[0] - $s * ( DefLeftX + DefGapX * 2 + DefArrowX )); 141 142 my $w = DefLeftX; 143 $w += DefGapX + DefArrowX if $ar & 1; 144 $w *= $s; 145 my $i; 146 my $found = undef; 147 for ( $i = $ft; $i <= $lt; $i++) { 148 $found = $i, last if $x < $w + $$ww[$i] + $s * DefGapX; 149 $w += $$ww[$i] + $s * DefGapX; 150 } 151 return $found; 152} 153 154sub on_mousedown 155{ 156 my ( $self, $btn, $mod, $x, $y) = @_; 157 return if $self-> {mouseTransaction}; 158 $self-> clear_event; 159 160 my $pos = $self-> x2pos($x); 161 return unless defined $pos; 162 163 if ($pos == -1) { 164 $self-> firstTab( $self-> firstTab - 1); 165 $self-> capture(1); 166 $self-> {mouseTransaction} = -1; 167 $self-> scroll_timer_start; 168 $self-> scroll_timer_semaphore(0); 169 return; 170 } 171 172 if ($pos == -2) { 173 $self-> firstTab( $self-> firstTab + 1); 174 $self-> capture(1); 175 $self-> {mouseTransaction} = 1; 176 $self-> scroll_timer_start; 177 $self-> scroll_timer_semaphore(0); 178 return; 179 } 180 181 if ( $pos == $self-> {tabIndex}) { 182 $self-> focusedTab( $pos); 183 $self-> focus; 184 } else { 185 $self-> tabIndex( $pos); 186 } 187} 188 189sub on_mousewheel 190{ 191 my ( $self, $mod, $x, $y, $z) = @_; 192 $self-> tabIndex( $self-> tabIndex + (( $z < 0) ? -1 : 1)); 193 $self-> clear_event; 194} 195 196sub on_mouseup 197{ 198 my ( $self, $btn, $mod, $x, $y) = @_; 199 return unless $self-> {mouseTransaction}; 200 201 $self-> capture(0); 202 $self-> scroll_timer_stop; 203 $self-> {mouseTransaction} = undef; 204} 205 206 207sub on_mousemove 208{ 209 my ( $self, $mod, $x, $y) = @_; 210 unless ($self-> {mouseTransaction}) { 211 if ( $self-> enabled ) { 212 my $prelight = $self-> x2pos($x); 213 if (( $prelight // '') ne ($self->{prelight} // '')) { 214 $self->{prelight} = $prelight; 215 $self-> repaint; 216 } 217 } 218 return; 219 } 220 return unless $self-> scroll_timer_semaphore; 221 222 $self-> scroll_timer_semaphore(0); 223 my $ft = $self-> firstTab; 224 $self-> firstTab( $ft + $self-> {mouseTransaction}); 225 $self-> notify(q(MouseUp),1,0,0,0) if $ft == $self-> firstTab; 226} 227 228sub on_mouseleave 229{ 230 my $self = shift; 231 $self-> repaint if defined( delete $self->{prelight} ); 232} 233 234sub on_mouseclick 235{ 236 my $self = shift; 237 $self-> clear_event; 238 return unless pop; 239 240 $self-> clear_event unless $self-> notify( "MouseDown", @_); 241} 242 243sub on_keydown 244{ 245 my ( $self, $code, $key, $mod) = @_; 246 247 if ( $key == kb::Left || $key == kb::Right) { 248 $self-> focusedTab( $self-> focusedTab + (( $key == kb::Left) ? -1 : 1)); 249 $self-> clear_event; 250 return; 251 } 252 253 if ( $key == kb::PgUp || $key == kb::PgDn) { 254 $self-> tabIndex( $self-> tabIndex + (( $key == kb::PgUp) ? -1 : 1)); 255 $self-> clear_event; 256 return; 257 } 258 259 if ( $key == kb::Home || $key == kb::End) { 260 $self-> tabIndex(( $key == kb::Home) ? 0 : scalar @{$self-> {tabs}}); 261 $self-> clear_event; 262 return; 263 } 264 if ( $key == kb::Space || $key == kb::Enter) { 265 $self-> tabIndex( $self-> focusedTab); 266 $self-> clear_event; 267 return; 268 } 269} 270 271sub on_paint 272{ 273 my ($self,$canvas) = @_; 274 my @clr; 275 if ( $self-> enabled ) { 276 @clr = ( $self-> color, $self-> backColor); 277 } else { 278 @clr = ( $self-> disabledColor, $self-> disabledBackColor); 279 } 280 my @c3d = ( $self-> dark3DColor, $self-> light3DColor); 281 my @size = $canvas-> size; 282 283 $canvas-> color( $clr[1]); 284 $canvas-> bar( 0, 0, @size); 285 my ( $ft, $lt, $ar, $ti, $ww, $tm) = 286 ( $self-> {firstTab}, $self-> {lastTab}, $self-> {arrows}, $self-> {tabIndex}, 287 $self-> {widths}, $self-> {topMost} 288 ); 289 my $i; 290 291 my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawTab)); 292 $self-> push_event; 293 294 295 my $s = $::application-> uiScaling; 296 my $atX = DefLeftX; 297 $atX += DefArrowX + DefGapX if $ar & 1; 298 $atX *= $s; 299 my $atXti = undef; 300 for ( $i = $ft; $i <= $lt; $i++) { 301 $atX += $$ww[$i] + $s * DefGapX; 302 } 303 my @colorSet = ( @clr, @c3d); 304 305 $canvas-> clipRect( 0, 0, $size[0] - $s * (DefArrowX + DefGapX + DefLeftX), $size[1]) if $ar & 2; 306 307 for ( $i = $lt; $i >= $ft; $i--) { 308 $atX -= $$ww[$i] + $s * DefGapX; 309 $atXti = $atX, next if $i == $ti; 310 my @poly = ( 311 $atX, $s * DefGapY, 312 $atX + $s * DefGapX, $size[1] - $s * DefGapY - 1, 313 $atX + $s * DefGapX + $$ww[$i], $size[1] - $s * DefGapY - 1, 314 $atX + $s * DefGapX * 2 + $$ww[$i], $s * DefGapY 315 ); 316 @poly[1,3,5,7] = @poly[3,1,7,5] unless $tm; 317 $notifier-> ( @notifyParms, $canvas, $i, \@colorSet, \@poly); 318 } 319 320 my $swapDraw = ( $ti == $lt) && ( $ar & 2); 321 322 goto PaintSelTabBefore if $swapDraw; 323PaintEarsThen: 324 $canvas-> clipRect( 0, 0, @size) if $ar & 2; 325 if ( $ar & 1) { 326 my $x = $s * DefLeftX; 327 my @poly = ( 328 $x, $s * DefGapY, 329 $x + $s * DefGapX, $size[1] - $s * DefGapY - 1, 330 $x + $s * DefGapX + $s * DefArrowX, $size[1] - $s * DefGapY - 1, 331 $x + $s * DefGapX * 2 + $s * DefArrowX, $s * DefGapY 332 ); 333 @poly[1,3,5,7] = @poly[3,1,7,5] unless $tm; 334 $notifier-> ( @notifyParms, $canvas, -1, \@colorSet, \@poly); 335 } 336 if ( $ar & 2) { 337 my $x = $size[0] - $s * (DefLeftX + DefArrowX + DefGapX * 2); 338 my @poly = ( 339 $x, $s * DefGapY, 340 $x + $s * DefGapX, $size[1] - $s * DefGapY - 1, 341 $x + $s * (DefGapX + DefArrowX), $size[1] - $s * DefGapY - 1, 342 $x + $s * (DefGapX * 2 + DefArrowX), $s * DefGapY 343 ); 344 @poly[1,3,5,7] = @poly[3,1,7,5] unless $tm; 345 $notifier-> ( @notifyParms, $canvas, -2, \@colorSet, \@poly); 346 } 347 348 $canvas-> color( $c3d[0]); 349 my @ld = $tm ? ( 0, $s * DefGapY) : ( $size[1] - 0, $size[1] - $s * DefGapY - 1); 350 $canvas-> line( $size[0] - 1, $ld[0], $size[0] - 1, $ld[1]); 351 352 if ($tm) { 353 $canvas-> color( $c3d[1]); 354 $canvas-> line( 0, $ld[1], $size[0] - 1, $ld[1]); 355 $canvas-> line( 0, $ld[0], 0, $ld[1]); 356 } else { 357 $canvas-> line( 0, $ld[1], $size[0] - 1, $ld[1]); 358 $canvas-> color( $c3d[1]); 359 $canvas-> line( 0, $ld[0], 0, $ld[1]); 360 } 361 362 $canvas-> color( $clr[0]); 363 364 goto EndOfSwappedPaint if $swapDraw; 365 366PaintSelTabBefore: 367 if ( defined $atXti) { 368 my @poly = ( 369 $atXti, $s * DefGapY, 370 $atXti + $s * DefGapX, $size[1] - $s * DefGapY - 1, 371 $atXti + $s * DefGapX + $$ww[$ti], $size[1] - $s * DefGapY - 1, 372 $atXti + $s * DefGapX * 2 + $$ww[$ti], $s * DefGapY 373 ); 374 @poly[1,3,5,7] = @poly[3,1,7,5] unless $tm; 375 376 my @poly2 = $tm ? ( 377 $atXti, $s * DefGapY, 378 $atXti + $s * DefGapX * 2 + $$ww[$ti], $s * DefGapY, 379 $atXti + $s * DefGapX * 2 + $$ww[$ti] - 4, 0, 380 $atXti + 4, 0 381 ) : ( 382 $atXti, $size[1] - 1 - $s * DefGapY, 383 $atXti + $s * DefGapX * 2 + $$ww[$ti], $size[1] - 1 - $s * DefGapY, 384 $atXti + DefGapX * 2 + $$ww[$ti] - 4, $size[1]-1, 385 $atXti + 4, $size[1]-1 386 ); 387 $canvas-> clipRect( 388 0, 0, 389 $size[0] - $s * (DefArrowX + DefGapX + DefLeftX), $size[1] 390 ) if $ar & 2; 391 $notifier-> ( 392 @notifyParms, $canvas, $ti, \@colorSet, \@poly, 393 $swapDraw ? undef : \@poly2 394 ); 395 } 396 goto PaintEarsThen if $swapDraw; 397 398EndOfSwappedPaint: 399 $self-> pop_event; 400} 401 402sub on_size 403{ 404 my ( $self, $ox, $oy, $x, $y) = @_; 405 406 my $s = $::application-> uiScaling; 407 if ( $x > $ox && (( $self-> {arrows} & 2) == 0)) { 408 my $w = $s * (DefLeftX * 2 + DefGapX); 409 my $ww = $self-> {widths}; 410 $w += $s * (DefArrowX + DefGapX) if $self-> {arrows} & 1; 411 my $i; 412 my $set = 0; 413 414 for ( $i = scalar @{$ww} - 1; $i >= 0; $i--) { 415 $w += $$ww[$i] + $s * DefGapX; 416 $set = 1, $self-> firstTab( $i + 1), last if $w >= $x; 417 } 418 $self-> firstTab(0) unless $set; 419 } 420 $self-> reset; 421} 422 423sub on_fontchanged { $_[0]-> reset; $_[0]-> recalc_widths; } 424sub on_enter { $_[0]-> repaint; } 425sub on_leave { $_[0]-> repaint; } 426 427sub on_measuretab 428{ 429 my ( $self, $index, $sref) = @_; 430 $$sref = $self-> get_text_width( $self-> {tabs}-> [$index]) + $::application-> uiScaling * DefGapX * 4; 431} 432 433# see L<DrawTab> below for more info 434 435sub on_drawtab 436{ 437 my ( $self, $canvas, $i, $clr, $poly, $poly2) = @_; 438 439 my $color = ( $self-> {colored} && ( $i >= 0)) ? 440 ( $warpColors[ $i % scalar @warpColors]) : $$clr[1]; 441 $color = $self-> prelight_color($color) if ($self->{prelight} // '') eq ($i // ''); 442 $canvas-> color($color); 443 $canvas-> fillpoly( $poly); 444 $canvas-> fillpoly( $poly2) if $poly2; 445 $canvas-> color( $$clr[3]); 446 $canvas-> polyline( [@{$poly}[0..($self-> {topMost}?5:3)]]); 447 $canvas-> color( $$clr[2]); 448 $canvas-> polyline( [@{$poly}[($self-> {topMost}?4:2)..7]]); 449 $canvas-> line( $$poly[4]+1, $$poly[5], $$poly[6]+1, $$poly[7]); 450 $canvas-> color( $$clr[0]); 451 my $s = $::application-> uiScaling; 452 453 if ( $i >= 0) { 454 my @tx = ( 455 $$poly[0] + ( $$poly[6] - $$poly[0] - $self-> {widths}-> [$i]) / 2 + $s * DefGapX * 2, 456 $$poly[1] + ( $$poly[3] - $$poly[1] - $canvas-> font-> height) / 2 457 ); 458 $canvas-> text_shape_out( $self-> {tabs}-> [$i], @tx); 459 $canvas-> rect_focus( $tx[0] - 1, $tx[1] - 1, 460 $tx[0] + $self-> {widths}-> [$i] - $s * DefGapX * 4 + 1, $tx[1] + $canvas-> font-> height + 1) 461 if ( $i == $self-> {focusedTab}) && $self-> focused; 462 } elsif ( $i == -1) { 463 $canvas-> fillpoly([ 464 $$poly[0] + ( $$poly[6] - $$poly[0]) * 0.6, 465 $$poly[1] + ( $$poly[3] - $$poly[1]) * 0.2, 466 $$poly[0] + ( $$poly[6] - $$poly[0]) * 0.6, 467 $$poly[1] + ( $$poly[3] - $$poly[1]) * 0.6, 468 $$poly[0] + ( $$poly[6] - $$poly[0]) * 0.4, 469 $$poly[1] + ( $$poly[3] - $$poly[1]) * 0.4, 470 ]); 471 } elsif ( $i == -2) { 472 $canvas-> fillpoly([ 473 $$poly[0] + ( $$poly[6] - $$poly[0]) * 0.4, 474 $$poly[1] + ( $$poly[3] - $$poly[1]) * 0.2, 475 $$poly[0] + ( $$poly[6] - $$poly[0]) * 0.4, 476 $$poly[1] + ( $$poly[3] - $$poly[1]) * 0.6, 477 $$poly[0] + ( $$poly[6] - $$poly[0]) * 0.6, 478 $$poly[1] + ( $$poly[3] - $$poly[1]) * 0.4, 479 ]); 480 } 481} 482 483sub get_item_width 484{ 485 return $_[0]-> {widths}-> [$_[1]]; 486} 487 488sub tab2firstTab 489{ 490 my ( $self, $ti) = @_; 491 492 my $s = $::application-> uiScaling; 493 if ( 494 ( $ti >= $self-> {lastTab}) and 495 ( $self-> {arrows} & 2) and 496 ( $ti != $self-> {firstTab}) 497 ) { 498 my $w = DefLeftX; 499 $w += DefArrowX + DefGapX if $self-> {arrows} & 1; 500 $w *= $s; 501 my $i; 502 my $W = $self-> width; 503 my $ww = $self-> {widths}; 504 my $moreThanOne = ( $ti - $self-> {firstTab}) > 0; 505 506 for ( $i = $self-> {firstTab}; $i <= $ti; $i++) { 507 $w += $$ww[$i] + $s * DefGapX; 508 } 509 510 my $lim = $W - $s * (DefLeftX + DefArrowX + DefGapX) * 2; 511 $lim -= $s * DefGapX * 2 if $moreThanOne; 512 513 if ( $w >= $lim) { 514 my $leftw = $s * ( DefLeftX * 2 + DefGapX + DefArrowX ); 515 $leftw += $s * (DefArrowX + DefGapX) if $self-> {arrows} & 1; 516 $leftw = $W - $leftw; 517 $leftw -= $$ww[$ti] if $moreThanOne; 518 $w = 0; 519 for ( $i = $ti; $i >= 0; $i--) { 520 $w += $$ww[$i] + $s * DefGapX; 521 last if $w > $leftw; 522 } 523 return $i + 1; 524 } 525 } elsif ( $ti < $self-> {firstTab}) { 526 return $ti; 527 } 528 return undef; 529} 530 531sub set_tab_index 532{ 533 my ( $self, $ti) = @_; 534 $ti = 0 if $ti < 0; 535 my $mx = scalar @{$self-> {tabs}} - 1; 536 $ti = $mx if $ti > $mx; 537 return if $ti == $self-> {tabIndex}; 538 539 $self-> {tabIndex} = $ti; 540 $self-> {focusedTab} = $ti; 541 my $newFirstTab = $self-> tab2firstTab( $ti); 542 543 defined $newFirstTab ? 544 $self-> firstTab( $newFirstTab) : 545 $self-> repaint; 546 $self-> notify(q(Change)); 547} 548 549sub set_first_tab 550{ 551 my ( $self, $ft) = @_; 552 $ft = 0 if $ft < 0; 553 unless ( $self-> {arrows}) { 554 $ft = 0; 555 } else { 556 my $s = $::application-> uiScaling; 557 my $w = DefLeftX * 2 + DefGapX * 2; 558 $w += DefArrowX if $ft > 0; 559 $w *= $s; 560 my $haveRight = 0; 561 my $i; 562 my @size = $self-> size; 563 for ( $i = $ft; $i < scalar @{$self-> {widths}}; $i++) { 564 $w += $s * DefGapX + $self-> {widths}-> [$i]; 565 $haveRight = 1, last if $w >= $size[0]; 566 } 567 unless ( $haveRight) { 568 $w += $s * DefGapX; 569 for ( $i = $ft - 1; $i >= 0; $i--) { 570 $w += $s * DefGapX + $self-> {widths}-> [$i]; 571 if ( $w >= $size[0]) { 572 $i++; 573 $ft = $i if $ft > $i; 574 last; 575 } 576 } 577 } 578 } 579 return if $self-> {firstTab} == $ft; 580 $self-> {firstTab} = $ft; 581 $self-> reset; 582 $self-> repaint; 583} 584 585sub set_focused_tab 586{ 587 my ( $self, $ft) = @_; 588 $ft = 0 if $ft < 0; 589 my $mx = scalar @{$self-> {tabs}} - 1; 590 $ft = $mx if $ft > $mx; 591 $self-> {focusedTab} = $ft; 592 593 my $newFirstTab = $self-> tab2firstTab( $ft); 594 defined $newFirstTab ? 595 $self-> firstTab( $newFirstTab) : 596 ( $self-> focused ? $self-> repaint : 0); 597} 598 599sub set_tabs 600{ 601 my $self = shift; 602 my @tabs = ( scalar @_ == 1 && ref( $_[0]) eq q(ARRAY)) ? @{$_[0]} : @_; 603 $self-> {tabs} = \@tabs; 604 $self-> recalc_widths; 605 $self-> reset; 606 $self-> lock; 607 $self-> firstTab( $self-> firstTab); 608 $self-> tabIndex( $self-> tabIndex); 609 $self-> unlock; 610 $self-> update_view; 611} 612 613sub insert_tab 614{ 615 my ( $self, $text, $at ) = @_; 616 617 $at = -1 unless defined $at; 618 619 my $t = $self->{tabs}; 620 $at = @$t - $at + 1 if $at < 0; 621 return if $at > @$t || $at < 0; 622 splice( @$t, $at, 0, $text ); 623 624 my $iw = 0; 625 my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureTab)); 626 $self-> begin_paint_info; 627 $self-> push_event; 628 $notifier-> ( @notifyParms, $at, \$iw); 629 $self-> pop_event; 630 $self-> end_paint_info; 631 632 splice( @{$self->{widths}}, $at, 0, $iw); 633 634 $self-> reset; 635 $self-> tabIndex( $self-> tabIndex); 636 $self-> repaint; 637 638 return $at; 639} 640 641sub delete_tab 642{ 643 my ( $self, $at ) = @_; 644 my $t = $self->{tabs}; 645 $at = @$t - $at if $at < 0; 646 return if $at > $#$t || $at < 0; 647 splice( @$t, $at, 1 ); 648 splice( @{$self->{widths}}, $at, 1 ); 649 650 $self-> reset; 651 $self-> lock; 652 $self-> firstTab( $self-> firstTab); 653 $self-> tabIndex( $self-> tabIndex); 654 $self-> unlock; 655 $self-> update_view; 656} 657 658sub set_top_most 659{ 660 my ( $self, $tm) = @_; 661 return if $tm == $self-> {topMost}; 662 $self-> {topMost} = $tm; 663 $self-> repaint; 664} 665 666sub colored {($#_)?($_[0]-> {colored}=$_[1],$_[0]-> repaint) :return $_[0]-> {colored}} 667sub focusedTab {($#_)?($_[0]-> set_focused_tab( $_[1])) :return $_[0]-> {focusedTab}} 668sub firstTab {($#_)?($_[0]-> set_first_tab( $_[1])) :return $_[0]-> {firstTab}} 669sub tabIndex {($#_)?($_[0]-> set_tab_index( $_[1])) :return $_[0]-> {tabIndex}} 670sub topMost {($#_)?($_[0]-> set_top_most ( $_[1])) :return $_[0]-> {topMost}} 671sub tabs {($#_)?(shift-> set_tabs ( @_ )) :return $_[0]-> {tabs}} 672 673package Prima::Notebook; 674use vars qw(@ISA); 675@ISA = qw(Prima::Widget); 676 677sub profile_default 678{ 679 my $def = $_[ 0]-> SUPER::profile_default; 680 my %prf = ( 681 defaultInsertPage => undef, 682 pageCount => 0, 683 pageIndex => 0, 684 tabStop => 0, 685 ownerBackColor => 1, 686 ); 687 @$def{keys %prf} = values %prf; 688 return $def; 689} 690 691sub init 692{ 693 my $self = shift; 694 $self-> {pageIndex} = -1; 695 $self-> {pageCount} = 0; 696 697 my %profile = $self-> SUPER::init(@_); 698 699 $self-> {pageCount} = $profile{pageCount}; 700 $self-> {pageCount} = 0 if $self-> {pageCount} < 0; 701 my $j = $profile{pageCount}; 702 push (@{$self-> {widgets}},[]) while $j--; 703 for ( qw( pageIndex defaultInsertPage)) { $self-> $_( $profile{ $_}); } 704 return %profile; 705} 706 707sub set_page_index 708{ 709 my ( $self, $pi) = @_; 710 $pi = 0 if $pi < 0; 711 $pi = $self-> {pageCount} - 1 if $pi > $self-> {pageCount} - 1; 712 my $sel = $self-> selected; 713 return if $pi == $self-> {pageIndex}; 714 715 $self-> lock; 716 717 my $cp = $self-> {widgets}-> [$self-> {pageIndex}]; 718 if ( defined $cp) { 719 for ( @$cp) { 720 $$_[1] = $$_[0]-> enabled; 721 $$_[2] = $$_[0]-> visible; 722 $$_[3] = $$_[0]-> current; 723 $$_[4] = $$_[0]-> geometry; 724 $$_[0]-> visible(0); 725 $$_[0]-> enabled(0); 726 $$_[0]-> geometry(gt::Default); 727 } 728 } 729 730 $cp = $self-> {widgets}-> [$pi]; 731 if ( defined $cp) { 732 my $hasSel; 733 for ( @$cp) { 734 $$_[0]-> geometry($$_[4]); 735 $$_[0]-> enabled($$_[1]); 736 $$_[0]-> visible($$_[2]); 737 if ( !defined $hasSel && $$_[3]) { 738 $hasSel = 1; 739 $$_[0]-> select if $sel; 740 } 741 $$_[0]-> current($$_[3]); 742 } 743 } 744 745 my $i = $self-> {pageIndex}; 746 $self-> {pageIndex} = $pi; 747 $self-> notify(q(Change), $i, $pi); 748 $self-> unlock; 749 $self-> update_view; 750} 751 752sub insert_page 753{ 754 my ( $self, $at) = @_; 755 756 $at = -1 unless defined $at; 757 $at = $self-> {pageCount} if $at < 0 || $at > $self-> {pageCount}; 758 759 splice( @{$self-> {widgets}}, $at, 0, []); 760 $self-> {pageCount}++; 761 $self-> pageIndex(0) if $self-> {pageCount} == 1; 762 763 return $at; 764} 765 766sub delete_page 767{ 768 my ( $self, $at, $removeChildren) = @_; 769 770 return unless $self->{pageCount}; 771 772 $removeChildren = 1 unless defined $removeChildren; 773 $at = -1 unless defined $at; 774 $at = $self-> {pageCount} - 1 if $at < 0 || $at >= $self-> {pageCount}; 775 776 my $idx = $self->pageIndex; 777 if ($at == $idx && $self->{pageCount} > 1) { 778 # switch away to record widget states properly 779 if ( $at > 0 ) { 780 $self->pageIndex( --$idx ); 781 } else { 782 $self->pageIndex( 1 ); 783 $idx = 0; 784 } 785 } elsif ( $idx > $at) { 786 $idx--; 787 } 788 $idx = 0 if $idx < 0; 789 790 my $r = splice( @{$self-> {widgets}}, $at, 1); 791 $self-> {pageCount}--; 792 $self-> {pageIndex} = $idx; 793 794 if ( $removeChildren) { 795 $_-> [0]-> destroy for @$r; 796 } 797} 798 799sub attach_to_page 800{ 801 my $self = shift; 802 my $page = shift; 803 804 $self-> insert_page if $self-> {pageCount} == 0; 805 $page = $self-> {pageCount} - 1 if $page > $self-> {pageCount} - 1 || $page < 0; 806 my $cp = $self-> {widgets}-> [$page]; 807 808 for ( @_) { 809 next unless $_-> isa('Prima::Widget'); 810 # $_->add_notification( Enable => \&_enable => $self); 811 # $_->add_notification( Disable => \&_disable => $self); 812 # $_->add_notification( Show => \&_show => $self); 813 # $_->add_notification( Hide => \&_hide => $self); 814 my @rec = ( $_, $_-> enabled, $_-> visible, $_-> current, $_-> geometry); 815 push( @{$cp}, [@rec]); 816 next if $page == $self-> {pageIndex}; 817 $_-> visible(0); 818 $_-> autoEnableChildren(0); 819 $_-> enabled(0); 820 $_-> geometry(gt::Default); 821 } 822} 823 824sub insert 825{ 826 my $self = shift; 827 my $page = defined $self-> {defaultInsertPage} ? 828 $self-> {defaultInsertPage} : 829 $self-> pageIndex; 830 831 return $self-> insert_to_page( $page, @_); 832} 833 834sub insert_to_page 835{ 836 my $self = shift; 837 my $page = shift; 838 my $sel = $self-> selected; 839 $page = $self-> {pageCount} - 1 if $page > $self-> {pageCount} - 1 || $page < 0; 840 841 $self-> lock; 842 my @ctrls = $self-> SUPER::insert( @_); 843 844 $self-> attach_to_page( $page, @ctrls); 845 $ctrls[0]-> select if $sel && scalar @ctrls && $page == $self-> {pageIndex} && 846 $ctrls[0]-> isa('Prima::Widget'); 847 $self-> unlock; 848 849 return wantarray ? @ctrls : $ctrls[0]; 850} 851 852sub insert_transparent 853{ 854 shift-> SUPER::insert( @_); 855} 856 857sub contains_widget 858{ 859 my ( $self, $ctrl) = @_; 860 my $i; 861 my $j; 862 my $cptr = $self-> {widgets}; 863 864 for ( $i = 0; $i < $self-> {pageCount}; $i++) { 865 my $cp = $$cptr[$i]; 866 my $j = 0; 867 for ( @$cp) { 868 return ( $i, $j) if $$_[0] == $ctrl; 869 $j++; 870 } 871 } 872 return; 873} 874 875sub widgets_from_page 876{ 877 my ( $self, $page) = @_; 878 return if $page < 0 or $page >= $self-> {pageCount}; 879 880 my @r; 881 push( @r, $$_[0]) for @{$self-> {widgets}-> [$page]}; 882 return @r; 883} 884 885sub on_childleave 886{ 887 my ( $self, $widget) = @_; 888 $self-> detach_from_page( $widget); 889} 890 891sub detach_from_page 892{ 893 my ( $self, $ctrl) = @_; 894 my ( $page, $number) = $self-> contains_widget( $ctrl); 895 return unless defined $page; 896 splice( @{$self-> {widgets}-> [$page]}, $number, 1); 897} 898 899sub delete_widget 900{ 901 my ( $self, $ctrl) = @_; 902 my ( $page, $number) = $self-> contains_widget( $ctrl); 903 return unless defined $page; 904 $ctrl-> destroy; 905} 906 907sub move_widget 908{ 909 my ( $self, $widget, $newPage) = @_; 910 my ( $page, $number) = $self-> contains_widget( $widget); 911 return unless defined $page and $page != $newPage; 912 push @{$self-> {widgets}-> [$newPage]}, splice( @{$self-> {widgets}-> [$page]}, $number, 1); 913 $self-> repaint if $self-> {pageIndex} == $page || $self-> {pageIndex} == $newPage; 914} 915 916 917sub set_page_count 918{ 919 my ( $self, $pageCount) = @_; 920 $pageCount = 0 if $pageCount < 0; 921 return if $pageCount == $self-> {pageCount}; 922 923 if ( $pageCount < $self-> {pageCount}) { 924 splice(@{$self-> {widgets}}, $pageCount); 925 $self-> {pageCount} = $pageCount; 926 $self-> pageIndex($pageCount - 1) if $self-> {pageIndex} < $pageCount - 1; 927 } else { 928 my $i = $pageCount - $self-> {pageCount}; 929 push (@{$self-> {widgets}},[]) while $i--; 930 $self-> {pageCount} = $pageCount; 931 $self-> pageIndex(0) if $self-> {pageIndex} < 0; 932 } 933} 934 935my %virtual_properties = ( 936 enabled => 1, 937 visible => 2, 938 current => 3, 939 geometry => 4, 940); 941 942sub widget_get 943{ 944 my ( $self, $widget, $property) = @_; 945 return $widget-> $property() if ! $virtual_properties{$property}; 946 947 my ( $page, $number) = $self-> contains_widget( $widget); 948 return $widget-> $property() 949 if ! defined $page || $page == $self-> {pageIndex}; 950 951 return $self-> {widgets}-> [$page]-> [$number]-> [$virtual_properties{$property}]; 952} 953 954sub widget_set 955{ 956 my ( $self, $widget) = ( shift, shift ); 957 my ( $page, $number) = $self-> contains_widget( $widget); 958 959 if ( ! defined $page || $page == $self-> {pageIndex} ) { 960 $widget-> set( @_ ); 961 return; 962 } 963 $number = $self-> {widgets}-> [$page]-> [$number]; 964 my %profile; 965 my $clear_current_flag = 0; 966 967 while ( @_ ) { 968 my ( $property, $value) = ( shift, shift ); 969 if ( $virtual_properties{$property} ) { 970 $number-> [ $virtual_properties{ $property } ] = ( $value ? 1 : 0 ); 971 $clear_current_flag = 1 if $property eq 'current' && $value; 972 } else { 973 $profile{$property} = $value; 974 } 975 } 976 977 if ( $clear_current_flag) { 978 for ( @{$self-> {widgets}-> [$page]} ) { 979 $$_[3] = 0 if $$_[0] != $widget; 980 } 981 } 982 $widget-> set( %profile ) if scalar keys %profile; 983} 984 985sub defaultInsertPage 986{ 987 $_[0]-> {defaultInsertPage} = $_[1]; 988} 989 990sub pageIndex {($#_)?($_[0]-> set_page_index ( $_[1])) :return $_[0]-> {pageIndex}} 991sub pageCount {($#_)?($_[0]-> set_page_count ( $_[1])) :return $_[0]-> {pageCount}} 992 993# TabbedNotebook styles 994package 995 tns; 996use constant Simple => 0; 997use constant Standard => 1; 998 999# TabbedNotebook orientations 1000package 1001 tno; 1002use constant Top => 0; 1003use constant Bottom => 1; 1004 1005package Prima::TabbedNotebook; 1006use vars qw(@ISA %notebookProps); 1007@ISA = qw(Prima::Widget); 1008 1009use constant DefBorderX => 11; 1010use constant DefBookmarkX => 32; 1011 1012%notebookProps = ( 1013 pageCount => 1, defaultInsertPage=> 1, 1014 attach_to_page => 1, insert_to_page => 1, insert => 1, insert_transparent => 1, 1015 delete_widget => 1, detach_from_page => 1, move_widget => 1, contains_widget => 1, 1016 widget_get => 1, widget_set => 1, widgets_from_page => 1, 1017); 1018 1019for ( keys %notebookProps) { 1020 eval <<GENPROC; 1021 sub $_ { return shift-> {notebook}-> $_(\@_); } 1022GENPROC 1023} 1024 1025sub profile_default 1026{ 1027 return { 1028 %{Prima::Notebook-> profile_default}, 1029 %{$_[ 0]-> SUPER::profile_default}, 1030 ownerBackColor => 1, 1031 tabs => [], 1032 tabIndex => 0, 1033 style => tns::Standard, 1034 orientation => tno::Top, 1035 tabsetClass => 'Prima::TabSet', 1036 tabsetProfile => {}, 1037 tabsetDelegations => ['Change'], 1038 notebookClass => 'Prima::Notebook', 1039 notebookProfile => {}, 1040 notebookDelegations => ['Change'], 1041 } 1042} 1043 1044sub init 1045{ 1046 my $self = shift; 1047 my %profile = @_; 1048 1049 my $visible = $profile{visible}; 1050 my $scaleChildren = $profile{scaleChildren}; 1051 $profile{visible} = 0; 1052 $self-> {style} = tns::Standard; 1053 $self-> {orientation} = tno::Top; 1054 $self-> {tabs} = []; 1055 1056 %profile = $self-> SUPER::init(%profile); 1057 1058 my @size = $self-> size; 1059 my $maxh = $self-> font-> height * 2; 1060 1061 $self-> {tabSet} = $profile{tabsetClass}-> create( 1062 owner => $self, 1063 name => 'TabSet', 1064 left => 0, 1065 width => $size[0], 1066 top => $size[1] - 1, 1067 growMode => gm::Ceiling, 1068 height => $maxh > 28 ? $maxh : 28, 1069 buffered => 1, 1070 designScale => undef, 1071 delegations => $profile{tabsetDelegations}, 1072 %{$profile{tabsetProfile}}, 1073 ); 1074 1075 $self-> {notebook} = $profile{notebookClass}-> create( 1076 owner => $self, 1077 name => 'Notebook', 1078 growMode => gm::Client, 1079 scaleChildren => $scaleChildren, 1080 (map { $_ => $profile{$_}} keys %notebookProps), 1081 pageCount => scalar @{$profile{tabs}}, 1082 delegations => $profile{notebookDelegations}, 1083 %{$profile{notebookProfile}}, 1084 packPropagate => 0, 1085 ); 1086 1087 $self-> $_( $profile{$_}) for qw(tabs pageIndex style orientation); 1088 $self-> visible( $visible); 1089 1090 return %profile; 1091} 1092 1093sub Notebook_Change 1094{ 1095 my ( $self, $book) = @_; 1096 return if $self-> {changeLock}; 1097 $self-> pageIndex( $book-> pageIndex); 1098} 1099 1100sub on_paint 1101{ 1102 my ($self,$canvas) = @_; 1103 my @clr = ( $self-> color, $self-> backColor); 1104 @clr = ( $self-> disabledColor, $self-> disabledBackColor) if ( !$self-> enabled); 1105 my @c3d = ( $self-> dark3DColor, $self-> light3DColor); 1106 my @size = $canvas-> size; 1107 my $on_top = ($self-> {orientation} == tno::Top); 1108 $canvas-> color( $clr[1]); 1109 $canvas-> bar( 0, 0, @size); 1110 1111 my $s = $::application-> uiScaling; 1112 if ($self-> {style} == tns::Standard) { 1113 if ($on_top) { 1114 $size[1] -= $self-> {tabSet}-> height; 1115 } else { 1116 $size[1] -= 5; 1117 } 1118 1119 $canvas-> rect3d( 1120 0, 0, $size[0] - 1, $size[1] - 1 + $s * Prima::TabSet::DefGapY, 1121 1, reverse @c3d 1122 ); 1123 $canvas-> rect3d( 1124 $s * DefBorderX, $on_top ? 1125 $s * DefBorderX : $self-> {notebook}-> bottom - 1, 1126 $size[0] - 1 - $s * DefBorderX, 1127 $size[1] - $s * DefBorderX + $s * Prima::TabSet::DefGapY, 1128 1, @c3d 1129 ); 1130 1131 my $y = $size[1] - $s * DefBorderX + $s * Prima::TabSet::DefGapY; 1132 my $x = $size[0] - $s * DefBorderX - $s * DefBookmarkX; 1133 return if $y < $s * DefBorderX * 2 + $s * DefBookmarkX; 1134 1135 my $ar = 0; 1136 my ($pi, $mpi) = ( 1137 $self-> {notebook}-> pageIndex, 1138 $self-> {notebook}-> pageCount - 1 1139 ); 1140 $ar |= 1 if $pi > 0; 1141 $ar |= 2 if $pi < $mpi; 1142 1143 if ( my $p = $self->{prelight}) { 1144 $canvas-> color( $self-> prelight_color($c3d[1])); 1145 if ( $p < 0 && $ar & 1) { 1146 $canvas->fillpoly([ 1147 $x - 2, $y - 2, 1148 $x + $s * DefBookmarkX - 4, $y - $s * DefBookmarkX, 1149 $x - 2, $y - $s * DefBookmarkX, 1150 ]); 1151 } elsif ( $p > 0 && $ar & 2 ) { 1152 $canvas->fillpoly([ 1153 $x - 2, $y - 2, 1154 $x + $s * DefBookmarkX - 4, $y - $s * DefBookmarkX, 1155 $x + $s * DefBookmarkX - 4, $y - 2, 1156 ]); 1157 } 1158 } 1159 my $fh = $canvas-> font-> height + 8; 1160 1161 if ( $size[0] - $s * 2 * DefBorderX - $s * DefBookmarkX - 10 > 0 ) { 1162 $canvas-> color( $c3d[0]); 1163 $canvas-> line( 1164 $s * DefBorderX + 2, $y - 2, 1165 $x - 2, $y - 2 1166 ); 1167 $canvas-> line( 1168 $x + $s * DefBookmarkX - 4, $y - $s * DefBookmarkX + 1, 1169 $x + $s * DefBookmarkX - 4, $on_top ? 1170 ($s * DefBorderX + 2) : 1171 ($self-> {notebook}-> bottom + 1) 1172 ); 1173 1174 $canvas-> line( 1175 $s * DefBorderX + 4, $y - $fh * 1.6, 1176 $x - 6, $y - $fh * 1.6 1177 ); 1178 $canvas-> polyline([ 1179 $x - 2, $y - 2, 1180 $x - 2, $y - $s * DefBookmarkX, 1181 $x + $s * DefBookmarkX - 4, $y - $s * DefBookmarkX 1182 ]); 1183 $canvas-> line( $x - 1, $y - 3, $x + $s * DefBookmarkX - 5, $y - $s * DefBookmarkX + 1); 1184 $canvas-> line( $x - 1, $y - 4, $x + $s * DefBookmarkX - 6, $y - $s * DefBookmarkX + 1); 1185 $canvas-> line( $x - 0, $y - 2, $x + $s * DefBookmarkX - 4, $y - $s * DefBookmarkX + 2); 1186 $canvas-> line( $x + 5, $y - $s * DefBookmarkX - 2, $x + $s * DefBookmarkX - 5, $y - $s * DefBookmarkX - 2); 1187 1188 $canvas-> polyline([ 1189 $x + $s * 4, $y - $s * DefBookmarkX + $s * 6, 1190 $x + $s * 10, $y - $s * DefBookmarkX + $s * 6, 1191 $x + $s * 10, $y - $s * DefBookmarkX + $s * 8]) if $ar & 1; 1192 1193 my $S = int($s); 1194 my $dx = $s * DefBookmarkX / 2; 1195 my ( $x1, $y1) = ( $x + $dx, $y - $dx); 1196 if ( $ar & 2 ) { 1197 $canvas-> line( $x1 + $S * 1, $y1 + $S * 4, $x1 + $S * 3, $y1 + $S * 4); 1198 $canvas-> line( $x1 + $S * 5, $y1 + $S * 6, $x1 + $S * 5, $y1 + $S * 8); 1199 $canvas-> polyline([ $x1 + $S * 3, $y1 + $S * 2, $x1 + $S * 5, $y1 + $S * 2, 1200 $x1 + $S * 5, $y1 + $S * 4, $x1 + $S * 7, $y1 + $S * 4, $x1 + $S * 7, $y1 + $S * 6]); 1201 } 1202 $canvas-> color( $c3d[1]); 1203 $canvas-> line( $x - 1, $y - 7, $x + $s * DefBookmarkX - 9, $y - $s * DefBookmarkX + 1); 1204 $canvas-> line( $s * DefBorderX + 4, $y - $fh * 1.6 - 1, $x - $s * 6, $y - $fh * 1.6 - 1); 1205 $canvas-> polyline([ $x + $s * 4, $y1 - $s * 9, $x + $s * 4, $y1 - $s * 8, $x + $s * 10, $y1 - $s * 8]) if $ar & 1; 1206 if ( $ar & 2 ) { 1207 $canvas-> line( $x1 + $S * 3, $y1 + $S * 2, $x1 + $S * 3, $y1 + $S * 3); 1208 $canvas-> line( $x1 + $S * 6, $y1 + $S * 6, $x1 + $S * 7, $y1 + $S * 6); 1209 $canvas-> polyline([ $x1 + $S * 1, $y1 + $S * 4, $x1 + $S * 1, $y1 + $S * 6, 1210 $x1 + $S * 3, $y1 + $S * 6, $x1 + $S * 3, $y1 + $S * 8, $x1 + $S * 5, $y1 + $S * 8]); 1211 } 1212 $canvas-> color( cl::Black); 1213 $canvas-> line( $x - 1, $y - 2, $x + $s * DefBookmarkX - 4, $y - $s * DefBookmarkX + 1); 1214 $canvas-> line( $x + 5, $y - $s * DefBookmarkX - 1, $x + $s * DefBookmarkX - 5, $y - $s * DefBookmarkX - 1); 1215 $canvas-> color( $clr[0]); 1216 } 1217 1218 my $t = $self-> {tabs}; 1219 if ( scalar @{$t}) { 1220 my $tx = $self-> {tabSet}-> tabIndex; 1221 my $t1 = $$t[ $tx * 2]; 1222 my $yh = $y - $fh * 0.8 - $self-> font-> height / 2; 1223 $canvas-> clipRect( $s * DefBorderX + 1, $y - $fh * 1.6 + 1, $x - 4, $y - 3); 1224 $canvas-> text_shape_out( $t1, $s * DefBorderX + 4, $yh); 1225 if ( $$t[ $tx * 2 + 1] > 1) { 1226 $t1 = sprintf("Page %d of %d ", $self-> pageIndex - $self-> tab2page( $tx) + 1, $$t[ $tx * 2 + 1]); 1227 my $tl1 = $size[0] - $s * DefBorderX - 3 - $s * DefBookmarkX - $self-> get_text_width( $t1); 1228 $canvas-> text_out( $t1, $tl1, $yh) if $tl1 > 4 + $s * DefBorderX + $fh * 3; 1229 } 1230 } 1231 } else { 1232 # tns::Simple 1233 $canvas-> rect3d(0, 0, $size[0]-1, $size[1]-1, 1, reverse @c3d); 1234 } 1235} 1236 1237sub event_in_page_flipper 1238{ 1239 my ( $self, $x, $y) = @_; 1240 1241 return if $self-> {style} != tns::Standard; 1242 1243 my @size = $self-> size; 1244 my $s = $::application->uiScaling; 1245 return if $size[0] - $s * 2 * DefBorderX - $s * DefBookmarkX - 10 <= 0; 1246 1247 my $th = ($self-> {orientation} == tno::Top) ? $self-> {tabSet}-> height : 5; 1248 $x -= $size[0] - $s * DefBorderX - $s * DefBookmarkX - 1; 1249 $y -= $size[1] - $s * DefBorderX - $th - $s * DefBookmarkX + 4; 1250 return if $x < 0 || $x > $s * DefBookmarkX || $y < 0 || $y > $s * DefBookmarkX; 1251 1252 return ( $x, $y); 1253} 1254 1255sub on_mousedown 1256{ 1257 my ( $self, $btn, $mod, $x, $y) = @_; 1258 $self-> clear_event; 1259 return unless ( $x, $y) = $self-> event_in_page_flipper( $x, $y); 1260 my $s = $::application->uiScaling; 1261 $self-> pageIndex( $self-> pageIndex + (( -$x + $s * DefBookmarkX < $y) ? 1 : -1)); 1262} 1263 1264sub on_mousemove 1265{ 1266 my ( $self, $mod, $x, $y) = @_; 1267 my $prelight; 1268 1269 if (( $x, $y) = $self-> event_in_page_flipper( $x, $y)) { 1270 my $s = $::application->uiScaling; 1271 if (-$x + $s * DefBookmarkX < $y && $self->pageIndex < $self->pageCount - 1) { 1272 $prelight = 1; 1273 } elsif (-$x + $s * DefBookmarkX >= $y && $self->pageIndex > 0 ){ 1274 $prelight = -1; 1275 } 1276 } 1277 if (( $self->{prelight} // 0) != ($prelight // 0)) { 1278 $self->{prelight} = $prelight; 1279 $self->repaint; 1280 } 1281} 1282 1283sub on_mouseleave 1284{ 1285 my $self = shift; 1286 $self->repaint if delete $self->{prelight}; 1287} 1288 1289sub on_mousewheel 1290{ 1291 my ( $self, $mod, $x, $y, $z) = @_; 1292 $self-> clear_event; 1293 return unless ( $x, $y) = $self-> event_in_page_flipper( $x, $y); 1294 $self-> pageIndex( $self-> pageIndex + (( $z < 0) ? -1 : 1)); 1295} 1296 1297sub on_mouseclick 1298{ 1299 my $self = shift; 1300 $self-> clear_event; 1301 return unless pop; 1302 $self-> clear_event unless $self-> notify( "MouseDown", @_); 1303} 1304 1305 1306sub page2tab 1307{ 1308 my ( $self, $index) = @_; 1309 my $t = $self-> {tabs}; 1310 return 0 unless scalar @$t; 1311 my $i = $$t[1] - 1; 1312 my $j = 0; 1313 while( $i < $index) { 1314 $j++; 1315 my $n = $$t[ $j*2 + 1]; 1316 last unless defined $n; 1317 $i += $n; 1318 } 1319 return $j; 1320} 1321 1322sub tab2page 1323{ 1324 my ( $self, $index) = @_; 1325 my $t = $self-> {tabs}; 1326 my $i; 1327 my $j = 0; 1328 for ( $i = 0; $i < $index; $i++) { $j += $$t[ $i * 2 + 1]; } 1329 return $j; 1330} 1331 1332sub TabSet_Change 1333{ 1334 my ( $self, $tabset) = @_; 1335 return if $self-> {changeLock}; 1336 $self-> pageIndex( $self-> tab2page( $tabset-> tabIndex)); 1337} 1338 1339sub set_tabs 1340{ 1341 my $self = shift; 1342 my @tabs = ( scalar @_ == 1 && ref( $_[0]) eq q(ARRAY)) ? @{$_[0]} : @_; 1343 my @nTabs; 1344 my @loc; 1345 my $prev = undef; 1346 for ( @tabs) { 1347 if ( defined $prev && $_ eq $prev) { 1348 $loc[-1]++; 1349 } else { 1350 push( @loc, $_); 1351 push( @loc, 1); 1352 push( @nTabs, $_); 1353 } 1354 $prev = $_; 1355 } 1356 my $pages = $self-> {notebook}-> pageCount; 1357 $self-> {tabs} = \@loc; 1358 $self-> {tabSet}-> tabs( \@nTabs); 1359 my $i; 1360 if ( $pages > scalar @tabs) { 1361 for ( $i = scalar @tabs; $i < $pages; $i++) { 1362 $self-> {notebook}-> delete_page( $i); 1363 } 1364 } elsif ( $pages < scalar @tabs) { 1365 for ( $i = $pages; $i < scalar @tabs; $i++) { 1366 $self-> {notebook}-> insert_page; 1367 } 1368 } 1369} 1370 1371sub get_tabs 1372{ 1373 my $self = $_[0]; 1374 my $i; 1375 my $t = $self-> {tabs}; 1376 my @ret; 1377 for ( $i = 0; $i < scalar @{$t} / 2; $i++) { 1378 my $j; 1379 for ( $j = 0; $j < $$t[$i*2+1]; $j++) { push( @ret, $$t[$i*2]); } 1380 } 1381 return \@ret; 1382} 1383 1384sub set_page_index 1385{ 1386 my ( $self, $pi) = @_; 1387 1388 my ($pix, $mpi) = ( $self-> {notebook}-> pageIndex, $self-> {notebook}-> pageCount - 1); 1389 $self-> {changeLock} = 1; 1390 $self-> {notebook}-> pageIndex( $pi); 1391 $self-> {tabSet}-> tabIndex( $self-> page2tab( $self-> {notebook}-> pageIndex)); 1392 delete $self-> {changeLock}; 1393 1394 my @size = $self-> size; 1395 my $th = ($self-> {orientation} == tno::Top) ? $self-> {tabSet}-> height : 5; 1396 my $ar = 0; 1397 $ar |= 1 if $pix > 0; 1398 $ar |= 2 if $pix < $mpi; 1399 my $newA = 0; 1400 $pi = $self-> {notebook}-> pageIndex; 1401 $newA |= 1 if $pi > 0; 1402 $newA |= 2 if $pi < $mpi; 1403 1404 my $s = $::application->uiScaling; 1405 $self-> invalidate_rect( 1406 $s * DefBorderX + 1, $size[1] - $s * DefBorderX - $th - $s * DefBookmarkX - 1, 1407 $size[0] - $s * DefBorderX - (( $ar == $newA) ? $s * DefBookmarkX + 2 : 0), 1408 $size[1] - $s * DefBorderX - $th + 3 1409 ); 1410 $self-> notify(q(Change), $pix, $pi); 1411} 1412 1413sub orientation 1414{ 1415 my ($self, $tno) = @_; 1416 return $self-> {orientation} unless (defined $tno); 1417 1418 $self-> {orientation} = $tno; 1419 $self-> {tabSet}-> topMost($tno == tno::Top); 1420 $self-> {tabSet}-> growMode(($tno == tno::Top) ? gm::Ceiling : gm::Floor); 1421 $self-> adjust_widgets; 1422 1423 return $tno; 1424} 1425 1426sub style 1427{ 1428 my ($self, $style) = @_; 1429 return $self-> {style} unless (defined $style); 1430 1431 $self-> {style} = $style; 1432 $self-> adjust_widgets; 1433 1434 return $style; 1435} 1436 1437sub adjust_widgets 1438{ 1439 my ($self) = @_; 1440 my $nb = $self-> {notebook}; 1441 my $ts = $self-> {tabSet}; 1442 1443 my @size = $self-> size; 1444 my @pos = (0,0); 1445 1446 $size[1] -= $ts-> height; 1447 my $s = $::application->uiScaling; 1448 if ($self-> {style} == tns::Standard) { 1449 $size[0] -= 2 * $s * DefBorderX + 6; 1450 $size[1] -= 2 * $s * DefBorderX + $s * DefBookmarkX + 4; 1451 $pos[0] += $s * DefBorderX + 1; 1452 $pos[1] += $s * DefBorderX + 1; 1453 } 1454 else { 1455 $size[0] -= 2; 1456 $size[1] -= 2; 1457 $pos[0]++; 1458 $pos[1]++; 1459 } 1460 1461 if ($self-> {orientation} == tno::Top) { 1462 $ts-> top($self-> height); 1463 } 1464 else { 1465 $ts-> bottom(0); 1466 $pos[1] += $ts-> height - 5; 1467 } 1468 1469 $nb-> rect(@pos, $pos[0] + $size[0], $pos[1] + $size[1]); 1470 1471 $self-> repaint; 1472} 1473 1474sub insert_page 1475{ 1476 my ( $self, $tabName, $at ) = @_; 1477 1478 my $book = $self->{notebook}; 1479 $at = -1 unless defined $at; 1480 $at = $book->pageCount + $at + 1 if $at < 0; 1481 return if $at > $book->pageCount || $at < 0; 1482 1483 local $self-> {changeLock} = 1; 1484 $self-> {notebook}->insert_page($at); 1485 1486 my $ctab = $self->page2tab($at); 1487 my $tabs = $self->{tabs}; 1488 if ( defined($tabs->[$ctab * 2]) && $tabs->[$ctab * 2] eq $tabName) { 1489 $tabs->[$ctab * 2 + 1]++; 1490 } elsif ( $ctab > 0 && defined($tabs->[$ctab * 2 - 2]) && $tabs->[$ctab * 2 - 2] eq $tabName) { 1491 $tabs->[$ctab * 2 - 1]++; 1492 } else { 1493 splice( @$tabs, $ctab * 2, 0, $tabName, 1 ); 1494 $self-> {tabSet}->insert_tab($tabName, $ctab); 1495 } 1496 1497 $self->repaint if $self->{style} != tns::Simple; 1498 1499 return $at; 1500} 1501 1502sub delete_page 1503{ 1504 my ( $self, $at, $removeChildren ) = @_; 1505 1506 my $book = $self->{notebook}; 1507 $at = -1 unless defined $at; 1508 $at = $book->pageCount + $at if $at < 0; 1509 return if $at >= $book->pageCount || $at < 0; 1510 1511 local $self-> {changeLock} = 1; 1512 my $ctab = $self->page2tab($at); 1513 my $tabs = $self->{tabs}; 1514 1515 # stay on page within same tab, if possible 1516 if ( $tabs->[$ctab * 2 + 1] > 1 && $at == $self->pageIndex && $at > 0 ) { 1517 $book->pageIndex( $book->pageIndex + 1 ); 1518 } 1519 $book->delete_page($at, $removeChildren); 1520 $ctab = $self->page2tab($at); 1521 1522 unless ( --$tabs->[$ctab * 2 + 1] ) { 1523 splice(@$tabs, $ctab * 2, 2 ); 1524 $self->{tabSet}->delete_tab( $ctab ); 1525 1526 # further collapse? 1527 while ( 4 < @$tabs && $ctab * 2 < @$tabs && $tabs->[$ctab * 2] eq $tabs->[$ctab * 2 - 2]) { 1528 my ( undef, $n) = splice(@$tabs, $ctab * 2, 2 ); 1529 $tabs->[$ctab * 2 - 1] += $n; 1530 $self->{tabSet}->delete_tab( $ctab ); 1531 } 1532 } 1533 $self->repaint if $self->{style} != tns::Simple; 1534 1535 # futher collapse 1536} 1537 1538sub tabIndex {($#_)?($_[0]-> {tabSet}-> tabIndex( $_[1])) :return $_[0]-> {tabSet}-> tabIndex} 1539sub pageIndex {($#_)?($_[0]-> set_page_index ( $_[1])) :return $_[0]-> {notebook}-> pageIndex} 1540sub tabs {($#_)?(shift-> set_tabs ( @_ )) :return $_[0]-> get_tabs} 1541 1542package Prima::ScrollNotebook::Client; 1543use vars qw(@ISA); 1544@ISA = qw(Prima::Notebook); 1545 1546sub profile_default 1547{ 1548 my $def = $_[0]-> SUPER::profile_default; 1549 my %prf = ( 1550 geometry => gt::Pack, 1551 packInfo => { expand => 1, fill => 'both'}, 1552 ); 1553 @$def{keys %prf} = values %prf; 1554 return $def; 1555} 1556 1557sub geomSize 1558{ 1559 return $_[0]-> SUPER::geomSize unless $#_; 1560 1561 my $self = shift; 1562 $self-> SUPER::geomSize( @_); 1563 $self-> owner-> owner-> ClientWindow_geomSize( $self, @_); 1564} 1565 1566package Prima::ScrollNotebook; 1567use vars qw(@ISA); 1568@ISA = qw(Prima::ScrollGroup); 1569 1570for ( qw(pageIndex insert_page delete_page), 1571 keys %Prima::TabbedNotebook::notebookProps) { 1572 eval <<GENPROC; 1573 sub $_ { return shift-> {client}-> $_(\@_); } 1574GENPROC 1575} 1576 1577sub profile_default 1578{ 1579 return { 1580 %{Prima::Notebook-> profile_default}, 1581 %{$_[ 0]-> SUPER::profile_default}, 1582 clientClass => 'Prima::ScrollNotebook::Client', 1583 } 1584} 1585 1586package Prima::TabbedScrollNotebook::Client; 1587use vars qw(@ISA); 1588@ISA = qw(Prima::ScrollNotebook); 1589 1590sub update_geom_size 1591{ 1592 my ( $self, $x, $y) = @_; 1593 my $owner = $self-> owner; 1594 return unless $owner-> packPropagate; 1595 my @o = $owner-> size; 1596 my @s = $self-> get_virtual_size; 1597 $owner-> geomSize( $o[0] - $s[0] + $x, $o[1] - $s[1] + $y); 1598} 1599 1600package Prima::TabbedScrollNotebook; 1601use vars qw(@ISA); 1602@ISA = qw(Prima::TabbedNotebook); 1603 1604sub profile_default 1605{ 1606 return { 1607 %{$_[ 0]-> SUPER::profile_default}, 1608 1609 notebookClass => 'Prima::TabbedScrollNotebook::Client', 1610 clientProfile => {}, 1611 clientDelegations => [], 1612 clientSize => [ 100, 100], 1613 } 1614} 1615 1616sub profile_check_in 1617{ 1618 my ( $self, $p, $default) = @_; 1619 $self-> SUPER::profile_check_in( $p, $default); 1620 $p-> {notebookProfile}-> {clientSize} = $p-> {clientSize} 1621 if exists $p-> {clientSize} and not exists $p-> {notebookProfile}-> {clientSize}; 1622 if ( exists $p-> {clientProfile}) { 1623 %{$p-> {notebookProfile}-> {clientProfile}} = ( 1624 ($default-> {notebookProfile}-> {clientProfile} ? 1625 %{$default-> {notebookProfile}-> {clientProfile}} : ()), 1626 %{$p-> {clientProfile}}, 1627 ); 1628 } 1629 if ( exists $p-> {clientDelegations}) { 1630 @{$p-> {notebookProfile}-> {clientDelegations}} = ( 1631 ( $default-> {notebookProfile}-> {clientDelegations} ? 1632 @{$default-> {notebookProfile}-> {clientDelegations}} : ()), 1633 @{$p-> {clientDelegations}}, 1634 ); 1635 } 1636} 1637 1638sub client { shift-> {notebook}-> client } 1639 1640sub packPropagate 1641{ 1642 return shift-> SUPER::packPropagate unless $#_; 1643 my ( $self, $pack_propagate) = @_; 1644 $self-> SUPER::packPropagate( $pack_propagate); 1645 $self-> propagate_size if $pack_propagate; 1646} 1647 1648sub propagate_size 1649{ 1650 my $self = $_[0]; 1651 $self-> {notebook}-> propagate_size 1652 if $self-> {notebook}; 1653} 1654 1655sub clientSize 1656{ 1657 return $_[0]-> {notebook}-> clientSize unless $#_; 1658 shift-> {notebook}-> clientSize(@_); 1659} 1660 1661sub use_current_size 1662{ 1663 $_[0]-> {notebook}-> use_current_size; 1664} 1665 16661; 1667 1668=pod 1669 1670=head1 NAME 1671 1672Prima::Notebooks - multipage widgets 1673 1674=head1 DESCRIPTION 1675 1676The module contains several widgets useful for organizing multipage ( notebook ) 1677containers. C<Prima::Notebook> provides basic functionality of a widget container. 1678C<Prima::TabSet> is a page selector control, and C<Prima::TabbedNotebook> combines 1679these two into a ready-to-use multipage control with interactive navigation. 1680 1681=head1 SYNOPSIS 1682 1683 use Prima qw(Notebooks Buttons Application); 1684 my $nb = Prima::TabbedNotebook-> new( 1685 tabs => [ 'First page', 'Second page', 'Second page' ], 1686 size => [ 300, 200 ], 1687 ); 1688 $nb-> insert_to_page( 1, 'Prima::Button' ); 1689 $nb-> insert_to_page( 2, 1690 [ 'Prima::Button', bottom => 10 ], 1691 [ 'Prima::Button', bottom => 150 ], 1692 ); 1693 $nb-> Notebook-> backColor( cl::Green ); 1694 run Prima; 1695 1696=for podview <img src="notebook.gif"> 1697 1698=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/notebook.gif"> 1699 1700=head1 Prima::Notebook 1701 1702=head2 Properties 1703 1704Provides basic widget container functionality. Acts as merely 1705a grouping widget, hiding and showing the children widgets when 1706C<pageIndex> property is changed. 1707 1708=over 1709 1710=item defaultInsertPage INTEGER 1711 1712Selects the page where widgets, attached by C<insert> 1713call are assigned to. If set to C<undef>, the default 1714page is the current page. 1715 1716Default value: C<undef>. 1717 1718=item pageCount INTEGER 1719 1720Selects number of pages. If the number of pages is reduced, 1721the widgets that belong to the rejected pages are removed 1722from the notebook's storage. 1723 1724=item pageIndex INTEGER 1725 1726Selects the index of the current page. Valid values are 1727from 0 to C<pageCount - 1>. 1728 1729=back 1730 1731=head2 Methods 1732 1733=over 1734 1735=item attach_to_page INDEX, @WIDGETS 1736 1737Attaches list of WIDGETS to INDEXth page. The widgets are not 1738necessarily must be children of the notebook widget. If the 1739page is not current, the widgets get hidden and disabled; 1740otherwise their state is not changed. 1741 1742=item contains_widget WIDGET 1743 1744Searches for WIDGET in the attached widgets list. If 1745found, returns two integers: location page index and 1746widget list index. Otherwise returns an empty list. 1747 1748=item delete_page [ INDEX = -1, REMOVE_CHILDREN = 1 ] 1749 1750Deletes INDEXth page, and detaches the widgets associated with 1751it. If REMOVE_CHILDREN is 1, the detached widgets are 1752destroyed. 1753 1754=item delete_widget WIDGET 1755 1756Detaches WIDGET from the widget list and destroys the widget. 1757 1758=item detach_from_page WIDGET 1759 1760Detaches WIDGET from the widget list. 1761 1762=item insert CLASS, %PROFILE [[ CLASS, %PROFILE], ... ] 1763 1764Creates one or more widgets with C<owner> property set to the 1765caller widget, and returns the list of references to the newly 1766created widgets. 1767 1768See L<Prima::Widget/insert> for details. 1769 1770=item insert_page [ INDEX = -1 ] 1771 1772Inserts a new empty page at INDEX. Valid range 1773is from 0 to C<pageCount>; setting INDEX equal 1774to C<pageCount> is equivalent to appending a page 1775to the end of the page list. 1776 1777=item insert_to_page INDEX, CLASS, %PROFILE, [[ CLASS, %PROFILE], ... ] 1778 1779Inserts one ore more widgets to INDEXth page. The semantics 1780of setting CLASS and PROFILE, as well as the return values 1781are fully equivalent to C<insert> method. 1782 1783See L<Prima::Widget/insert> for details. 1784 1785=item insert_transparent CLASS, %PROFILE, [[ CLASS, %PROFILE], ... ] 1786 1787Inserts one or more widgets to the notebook widget, but does not 1788add widgets to the widget list, so the widgets are not flipped 1789together with pages. Useful for setting omnipresent ( or 1790transparent ) widgets, visible on all pages. 1791 1792The semantics of setting CLASS and PROFILE, as well as 1793the return values are fully equivalent to C<insert> method. 1794 1795See L<Prima::Widget/insert> for details. 1796 1797=item move_widget WIDGET, INDEX 1798 1799Moves WIDGET from its old page to INDEXth page. 1800 1801=item widget_get WIDGET, PROPERTY 1802 1803Returns PROPERTY value of WIDGET. If PROPERTY is 1804affected by the page flipping mechanism, the internal 1805flag value is returned instead. 1806 1807=item widget_set WIDGET, %PROFILE 1808 1809Calls C<set> on WIDGET with PROFILE and 1810updates the internal C<visible>, C<enabled>, C<current>, and C<geometry> properties 1811if these are present in PROFILE. 1812 1813See L<Prima::Object/set>. 1814 1815=item widgets_from_page INDEX 1816 1817Returns list of widgets, associated with INDEXth page. 1818 1819=back 1820 1821=head2 Events 1822 1823=over 1824 1825=item Change OLD_PAGE_INDEX, NEW_PAGE_INDEX 1826 1827Called when C<pageIndex> value is changed from 1828OLD_PAGE_INDEX to NEW_PAGE_INDEX. Current implementation 1829invokes this notification while the notebook widget 1830is in locked state, so no redraw requests are honored during 1831the notification execution. 1832 1833=back 1834 1835=head2 Bugs 1836 1837Since the notebook operates directly on children widgets' 1838C<::visible> and C<::enable> properties, there is a problem when 1839a widget associated with a non-active page must be explicitly hidden 1840or disabled. As a result, such a widget would become visible and enabled anyway. 1841This happens because Prima API does not cache property requests. For example, 1842after execution of the following code 1843 1844 $notebook-> pageIndex(1); 1845 my $widget = $notebook-> insert_to_page( 0, ... ); 1846 $widget-> visible(0); 1847 $notebook-> pageIndex(0); 1848 1849C<$widget> will still be visible. As a workaround, C<widget_set> method 1850can be suggested, to be called together with the explicit state calls. 1851Changing 1852 1853 $widget-> visible(0); 1854 1855code to 1856 1857 $notebook-> widget_set( $widget, visible => 0); 1858 1859solves the problem, but introduces an inconsistency in API. 1860 1861=head1 Prima::TabSet 1862 1863C<Prima::TabSet> class implements functionality of an interactive 1864page switcher. A widget is presented as a set of horizontal 1865bookmark-styled tabs with text identifiers. 1866 1867=head2 Properties 1868 1869=over 1870 1871=item colored BOOLEAN 1872 1873A boolean property, selects whether each tab uses unique color 1874( OS/2 Warp 4 style ), or all tabs are drawn with C<backColor>. 1875 1876Default value: 1 1877 1878=item firstTab INTEGER 1879 1880Selects the first ( leftmost ) visible tab. 1881 1882=item focusedTab INTEGER 1883 1884Selects the currently focused tab. This property value is almost 1885always equals to C<tabIndex>, except when the widget is navigated 1886by arrow keys, and tab selection does not occur until the user 1887presses the return key. 1888 1889=item topMost BOOLEAN 1890 1891Selects the way the widget is oriented. If 1, the widget is drawn 1892as if it resides on top of another widget. If 0, it is drawn as 1893if it is at bottom. 1894 1895Default value: 1 1896 1897=item tabIndex INDEX 1898 1899Selects the INDEXth tab. When changed, C<Change> notification 1900is triggered. 1901 1902=item tabs ARRAY 1903 1904Anonymous array of text scalars. Each scalar corresponds to 1905a tab and is displayed correspondingly. The class supports 1906single-line text strings only; newline characters are not respected. 1907 1908=back 1909 1910=head2 Methods 1911 1912=over 1913 1914=item get_item_width INDEX 1915 1916Returns width in pixels of INDEXth tab. 1917 1918=item tab2firstTab INDEX 1919 1920Returns the index of a tab, that will be drawn leftmost if 1921INDEXth tab is to be displayed. 1922 1923=item insert_tab TEXT, [ POSITION = -1 ] 1924 1925Inserts a new tab text at the given position, which is at the end by default 1926 1927=item delete_tab POSITION 1928 1929Removes a tab from the given position 1930 1931=back 1932 1933=head2 Events 1934 1935=over 1936 1937=item Change 1938 1939Triggered when C<tabIndex> property is changed. 1940 1941=item DrawTab CANVAS, INDEX, COLOR_SET, POLYGON1, POLYGON2 1942 1943Called when INDEXth tab is to be drawn on CANVAS. COLOR_SET is an array 1944reference, and consists of the four cached color values: foreground, background, 1945dark 3d color, and light 3d color. POLYGON1 and POLYGON2 are array references, 1946and contain four points as integer pairs in (X,Y)-coordinates. POLYGON1 1947keeps coordinates of the larger polygon of a tab, while POLYGON2 of the smaller. Text is 1948displayed inside the larger polygon: 1949 1950 1951 POLYGON1 1952 1953 [2,3] [4,5] 1954 o..........o 1955 . . 1956 [0,1]. TAB_TEXT . [6,7] 1957 o................o 1958 1959 POLYGON2 1960 1961 [0,1] [2,3] 1962 o................o 1963 [6,7]o..............o[4,5] 1964 1965Depending on C<topMost> property value, POLYGON1 and POLYGON2 change 1966their mutual vertical orientation. 1967 1968The notification is always called from within C<begin_paint/end_paint> block. 1969 1970=item MeasureTab INDEX, REF 1971 1972Puts width of INDEXth tab in pixels into REF scalar value. 1973This notification must be called from within C<begin_paint_info/end_paint_info> 1974block. 1975 1976=back 1977 1978=head1 Prima::TabbedNotebook 1979 1980The class combines functionality of C<Prima::TabSet> and C<Prima::Notebook>, 1981providing the interactive multipage widget functionality. The page indexing 1982scheme is two-leveled: the first level is equivalent to the C<Prima::TabSet> - 1983provided tab scheme. Each first-level tab, in turn, contains one or more second-level 1984pages, which can be switched using native C<Prima::TabbedNotebook> controls. 1985 1986First-level tab is often referred as I<tab>, and second-level as I<page>. 1987 1988=head2 Properties 1989 1990=over 1991 1992=item defaultInsertPage INTEGER 1993 1994Selects the page where widgets, attached by C<insert> 1995call are assigned to. If set to C<undef>, the default 1996page is the current page. 1997 1998Default value: C<undef>. 1999 2000=item notebookClass STRING 2001 2002Assigns the notebook widget class. 2003 2004Create-only property. 2005 2006Default value: C<Prima::Notebook> 2007 2008=item notebookProfile HASH 2009 2010Assigns hash of properties, passed to the notebook widget during the creation. 2011 2012Create-only property. 2013 2014=item notebookDelegations ARRAY 2015 2016Assigns list of delegated notifications to the notebook widget. 2017 2018Create-only property. 2019 2020=item orientation INTEGER 2021 2022Selects one of the following tno::XXX constants 2023 2024=over 2025 2026=item tno::Top 2027 2028The TabSet will be drawn at the top of the widget. 2029 2030=item tno::Bottom 2031 2032The TabSet will be drawn at the bottom of the widget. 2033 2034=back 2035 2036Default value: tno::Top 2037 2038=item pageIndex INTEGER 2039 2040Selects the INDEXth page or a tabset widget ( the second-level tab ). 2041When this property is triggered, C<tabIndex> can change its value, 2042and C<Change> notification is triggered. 2043 2044=item style INTEGER 2045 2046Selects one of the following tns::XXX constants 2047 2048=over 2049 2050=item tns::Standard 2051 2052The widget will have a raised border surrounding it and a +/- control 2053at the top for moving between pages. 2054 2055=item tns::Simple 2056 2057The widget will have no decorations (other than a standard border). It 2058is recommended to have only one second-level page per tab with this style. 2059 2060=back 2061 2062Default value: tns::Standard 2063 2064=item tabIndex INTEGER 2065 2066Selects the INDEXth tab on a tabset widget using the first-level tab numeration. 2067 2068=item tabs ARRAY 2069 2070Governs number and names of notebook pages. ARRAY is an anonymous array 2071of text scalars, where each corresponds to a single first-level tab 2072and a single notebook page, with the following exception. To define second-level 2073tabs, the same text string must be repeated as many times as many second-level 2074tabs are desired. For example, the code 2075 2076 $nb-> tabs('1st', ('2nd') x 3); 2077 2078results in creation of a notebook of four pages and two first-level 2079tabs. The tab C<'2nd'> contains three second-level pages. 2080 2081The property implicitly operates the underlying notebook's C<pageCount> property. 2082When changed at run-time, its effect on the children widgets is therefore the same. 2083See L<pageCount> for more information. 2084 2085=item tabsetClass STRING 2086 2087Assigns the tab set widget class. 2088 2089Create-only property. 2090 2091Default value: C<Prima::TabSet> 2092 2093=item tabsetProfile HASH 2094 2095Assigns hash of properties, passed to the tab set widget during the creation. 2096 2097Create-only property. 2098 2099=item tabsetDelegations ARRAY 2100 2101Assigns list of delegated notifications to the tab set widget. 2102 2103Create-only property. 2104 2105=back 2106 2107=head2 Methods 2108 2109The class forwards the following methods of C<Prima::Notebook>, which are 2110described in L<Prima::Notebook>: C<attach_to_page>, C<insert_to_page>, 2111C<insert>, C<insert_transparent>, C<delete_widget>, C<detach_from_page>, 2112C<move_widget>, C<contains_widget>, C<widget_get>, C<widget_set>, 2113C<widgets_from_page>. 2114 2115=over 2116 2117=item tab2page INDEX 2118 2119Returns second-level tab index, that corresponds to the INDEXth first-level tab. 2120 2121=item page2tab INDEX 2122 2123Returns first-level tab index, that corresponds to the INDEXth second-level 2124tab. 2125 2126=item insert_page TEXT, [ POSITION = -1 ] 2127 2128Inserts a new page with text at the given position, which is at the end by default. 2129If TEXT is same as the existing tab left or right from POSITION, the page is joined 2130the existing tab; otherwise a new tab is created. 2131 2132=item delete_page POSITION 2133 2134Removes a page from the given position. 2135 2136=back 2137 2138=head2 Events 2139 2140=over 2141 2142=item Change OLD_PAGE_INDEX, NEW_PAGE_INDEX 2143 2144Triggered when C<pageIndex> property is changes it s value from OLD_PAGE_INDEX 2145to NEW_PAGE_INDEX. 2146 2147=back 2148 2149=head1 AUTHORS 2150 2151Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>. 2152Teo Sankaro, E<lt>teo_sankaro@hotmail.comE<gt>. 2153 2154=head1 SEE ALSO 2155 2156L<Prima>, L<Prima::Widget>, F<examples/notebook.pl>. 2157 2158=cut 2159