1# You may distribute under the terms of either the GNU General Public License 2# or the Artistic License (the same terms as Perl itself) 3# 4# (C) Paul Evans, 2009-2021 -- leonerd@leonerd.org.uk 5 6package Tickit 0.72; 7 8use v5.14; 9use warnings; 10 11use Carp; 12 13use IO::Handle; 14 15use Scalar::Util qw( weaken ); 16use Time::HiRes qw( time ); 17 18BEGIN { 19 require XSLoader; 20 XSLoader::load( __PACKAGE__, our $VERSION ); 21} 22 23# We export some constants 24use Exporter 'import'; 25 26use Tickit::Event; 27use Tickit::Term; 28use Tickit::Window; 29 30=head1 NAME 31 32C<Tickit> - Terminal Interface Construction KIT 33 34=head1 SYNOPSIS 35 36 use Tickit; 37 use Tickit::Widget::Box; 38 use Tickit::Widget::Static; 39 40 my $box = Tickit::Widget::Box->new( 41 h_border => 4, 42 v_border => 2, 43 bg => "green", 44 child => Tickit::Widget::Static->new( 45 text => "Hello, world!", 46 bg => "black", 47 align => "centre", 48 valign => "middle", 49 ), 50 ); 51 52 Tickit->new( root => $box )->run; 53 54=head1 DESCRIPTION 55 56C<Tickit> is a high-level toolkit for creating full-screen terminal-based 57interactive programs. It allows programs to be written in an abstracted way, 58working with a tree of widget objects, to represent the layout of the 59interface and implement its behaviours. 60 61Its supported terminal features includes a rich set of rendering attributes 62(bold, underline, italic, 256-colours, etc), support for mouse including wheel 63and position events above the 224th column and arbitrary modified key input 64via F<libtermkey> (all of these will require a supporting terminal as well). 65It also supports having multiple instances and non-blocking or asynchronous 66control. 67 68=cut 69 70=head1 CONSTRUCTOR 71 72=cut 73 74=head2 new 75 76 $tickit = Tickit->new( %args ) 77 78Constructs a new C<Tickit> framework container object. 79 80Takes the following named arguments at construction time: 81 82=over 8 83 84=item term_in => IO 85 86IO handle for terminal input. Will default to C<STDIN>. 87 88=item term_out => IO 89 90IO handle for terminal output. Will default to C<STDOUT>. 91 92=item UTF8 => BOOL 93 94If defined, overrides locale detection to enable or disable UTF-8 mode. If not 95defined then this will be detected from the locale by using Perl's 96C<${^UTF8LOCALE}> variable. 97 98=item root => Tickit::Widget 99 100If defined, sets the root widget using C<set_root_widget> to the one 101specified. 102 103=item use_altscreen => BOOL 104 105If defined but false, disables the use of altscreen, even if supported by the 106terminal. This will mean that the screen contents are stll available after the 107program has finished. 108 109=back 110 111=cut 112 113sub new 114{ 115 my $class = shift; 116 my %args = @_; 117 118 my $root = delete $args{root}; 119 my $term = delete $args{term}; 120 121 my $self = bless { 122 use_altscreen => $args{use_altscreen} // 1, 123 }, $class; 124 125 if( $args{term_in} or $args{term_out} ) { 126 my $in = delete $args{term_in} || \*STDIN; 127 my $out = delete $args{term_out} || \*STDOUT; 128 129 my $writer = $self->_make_writer( $out ); 130 131 require Tickit::Term; 132 133 $term = Tickit::Term->new( 134 writer => $writer, 135 input_handle => $in, 136 output_handle => $out, 137 UTF8 => delete $args{UTF8}, 138 ); 139 } 140 141 $self->{term} = $term; 142 143 $self->set_root_widget( $root ) if $root; 144 145 return $self; 146} 147 148=head1 METHODS 149 150=cut 151 152sub _make_writer 153{ 154 my $self = shift; 155 my ( $out ) = @_; 156 157 $out->autoflush( 1 ); 158 159 return $out; 160} 161 162sub _tickit 163{ 164 my $self = shift; 165 return $self->{_tickit} //= do { 166 my $tickit = $self->_make_tickit( $self->{term} ); 167 168 $tickit->setctl( 'use-altscreen' => $self->{use_altscreen} ); 169 170 $tickit; 171 }; 172} 173 174sub _make_tickit 175{ 176 my $self = shift; 177 return Tickit::_Tickit->new( @_ ); 178} 179 180=head2 watch_io 181 182 $id = $tickit->watch_io( $fh, $cond, $code ) 183 184I<Since version 0.71.> 185 186Runs the given CODE reference at some point in the future, when IO operations 187are possible on the given filehandle. C<$cond> should be a bitmask of at least 188one of the C<IO_IN>, C<IO_OUT> or C<IO_HUP> constants describing which kinds 189of IO operation the callback is interested in. 190 191Returns an opaque integer value that may be passed to L</watch_cancel>. This 192value is safe to ignore if not required. 193 194When invoked, the callback will receive an event parameter which will be an 195instances of a type with a field called C<cond>. This will contain the kinds 196of IO operation that are currently possible. 197 198 $code->( $info ) 199 200 $current_cond = $info->cond; 201 202For example, to watch for both input and hangup conditions and respond to each 203individually: 204 205 $tickit->watch_io( $fh, Tickit::IO_IN|Tickit::IO_HUP, 206 sub { 207 my ( $info ) = @_; 208 if( $info->cond & Tickit::IO_IN ) { 209 ... 210 } 211 if( $info->cond & Tickit::IO_HUP ) { 212 ... 213 } 214 } 215 ); 216 217=cut 218 219sub watch_io 220{ 221 my $self = shift; 222 my ( $fh, $cond, $code ) = @_; 223 224 return $self->_tickit->watch_io( $fh->fileno, $cond, $code ); 225} 226 227=head2 watch_later 228 229 $id = $tickit->watch_later( $code ) 230 231I<Since version 0.70.> 232 233Runs the given CODE reference at some time soon in the future. It will not be 234invoked yet, but will be invoked at some point before the next round of input 235events are processed. 236 237Returns an opaque integer value that may be passed to L</watch_cancel>. This 238value is safe to ignore if not required. 239 240=head2 later 241 242 $tickit->later( $code ) 243 244For back-compatibility this method is a synonym for L</watch_later>. 245 246=cut 247 248sub watch_later 249{ 250 my $self = shift; 251 my ( $code ) = @_; 252 253 return $self->_tickit->watch_later( $code ) 254} 255 256sub later { shift->watch_later( @_ ); return } 257 258=head2 watch_timer_at 259 260 $id = $tickit->watch_timer_at( $epoch, $code ) 261 262I<Since version 0.70.> 263 264Runs the given CODE reference at the given absolute time expressed as an epoch 265number. Fractions are supported to a resolution of microseconds. 266 267Returns an opaque integer value that may be passed to L</watch_cancel>. This 268value is safe to ignore if not required. 269 270=cut 271 272sub watch_timer_at 273{ 274 my $self = shift; 275 my ( $epoch, $code ) = @_; 276 277 return $self->_tickit->watch_timer_at( $epoch, $code ); 278} 279 280=head2 watch_timer_after 281 282 $id = $tickit->watch_timer_after( $delay, $code ) 283 284I<Since version 0.70.> 285 286Runs the given CODE reference at the given relative time expressed as a number 287of seconds hence. Fractions are supported to a resolution of microseconds. 288 289Returns an opaque integer value that may be passed to L</watch_cancel>. This 290value is safe to ignore if not required. 291 292=cut 293 294sub watch_timer_after 295{ 296 my $self = shift; 297 my ( $delay, $code ) = @_; 298 299 return $self->_tickit->watch_timer_after( $delay, $code ); 300} 301 302=head2 timer 303 304 $id = $tickit->timer( at => $epoch, $code ) 305 306 $id = $tickit->timer( after => $delay, $code ) 307 308For back-compatibility this method is a wrapper for either L</watch_timer_at> 309or L</watch_timer_after> depending on the first argument. 310 311Returns an opaque integer value that may be passed to L</cancel_timer>. This 312value is safe to ignore if not required. 313 314=cut 315 316sub timer 317{ 318 my $self = shift; 319 my ( $mode, $amount, $code ) = @_; 320 321 return $self->watch_timer_at ( $amount, $code ) if $mode eq "at"; 322 return $self->watch_timer_after( $amount, $code ) if $mode eq "after"; 323 croak "Mode should be 'at' or 'after'"; 324} 325 326=head2 watch_signal 327 328 $id = $tickit->watch_signal( $signum, $code ) 329 330I<Since version 0.72.> 331 332Runs the given CODE reference whenever the given POSIX signal is received. 333Signals are given by number, not name. 334 335Returns an opaque integer value that may be passed to L</watch_cancel>. This 336value is safe to ignore if not required. 337 338=cut 339 340sub watch_signal 341{ 342 my $self = shift; 343 my ( $signum, $code ) = @_; 344 345 return $self->_tickit->watch_signal( $signum, $code ); 346} 347 348=head2 watch_process 349 350 $id = $tickit->watch_process( $pid, $code ) 351 352I<Since version 0.72.> 353 354Runs the given CODE reference when the given child process terminates. 355 356Returns an opaque integer value that may be passed to L</watch_cancel>. This 357value is safe to ignore if not required. 358 359When invoked, the callback will receive an event parameter which will be an 360instance of a type with a field called C<wstatus>. This will contain the exit 361status of the terminated child process. 362 363 $code->( $info ) 364 365 $pid = $info->pid; 366 $status = $info->wstatus; 367 368=cut 369 370sub watch_process 371{ 372 my $self = shift; 373 my ( $pid, $code ) = @_; 374 375 return $self->_tickit->watch_process( $pid, $code ); 376} 377 378=head2 watch_cancel 379 380 $tickit->watch_cancel( $id ) 381 382I<Since version 0.70.> 383 384Removes an idle or timer watch previously installed by one of the other 385C<watch_*> methods. After doing so the code will no longer be invoked. 386 387=head2 cancel_timer 388 389 $tickit->cancel_timer( $id ) 390 391For back-compatibility this method is a synonym for L</watch_cancel>. 392 393=cut 394 395sub watch_cancel 396{ 397 my $self = shift; 398 my ( $id ) = @_; 399 400 $self->_tickit->watch_cancel( $id ); 401} 402 403sub cancel_timer { shift->watch_cancel( @_ ) } 404 405=head2 term 406 407 $term = $tickit->term 408 409Returns the underlying L<Tickit::Term> object. 410 411=cut 412 413sub term { shift->_tickit->term } 414 415=head2 cols 416 417=head2 lines 418 419 $cols = $tickit->cols 420 421 $lines = $tickit->lines 422 423Query the current size of the terminal. Will be cached and updated on receipt 424of C<SIGWINCH> signals. 425 426=cut 427 428sub lines { shift->term->lines } 429sub cols { shift->term->cols } 430 431=head2 bind_key 432 433 $tickit->bind_key( $key, $code ) 434 435Installs a callback to invoke if the given key is pressed, overwriting any 436previous callback for the same key. The code block is invoked as 437 438 $code->( $tickit, $key ) 439 440If C<$code> is missing or C<undef>, any existing callback is removed. 441 442As a convenience for the common application use case, the C<Ctrl-C> key is 443bound to the C<stop> method. 444 445To remove this binding, simply bind another callback, or remove the binding 446entirely by setting C<undef>. 447 448=cut 449 450sub bind_key 451{ 452 my $self = shift; 453 my ( $key, $code ) = @_; 454 455 my $keybinds = $self->{key_binds} //= {}; 456 457 if( $code ) { 458 if( !%$keybinds ) { 459 weaken( my $weakself = $self ); 460 461 # Need to ensure a root window exists before this so it gets its 462 # key bind event first 463 $self->rootwin; 464 465 $self->{key_bind_id} = $self->term->bind_event( key => sub { 466 my $self = $weakself or return; 467 my ( $term, $ev, $info ) = @_; 468 my $str = $info->str; 469 470 if( my $code = $self->{key_binds}{$str} ) { 471 $code->( $self, $str ); 472 } 473 474 return 0; 475 } ); 476 } 477 478 $keybinds->{$key} = $code; 479 } 480 else { 481 delete $keybinds->{$key}; 482 483 if( !%$keybinds ) { 484 $self->term->unbind_event_id( $self->{key_bind_id} ); 485 undef $self->{key_bind_id}; 486 } 487 } 488} 489 490=head2 rootwin 491 492 $tickit->rootwin 493 494Returns the root L<Tickit::Window>. 495 496=cut 497 498# root window needs to know where the toplevel "tickit" instance is 499sub rootwin { $_[0]->_tickit->rootwin( $_[0] ) } 500 501=head2 set_root_widget 502 503 $tickit->set_root_widget( $widget ) 504 505Sets the root widget for the application's display. This must be a subclass of 506L<Tickit::Widget>. 507 508=cut 509 510sub set_root_widget 511{ 512 my $self = shift; 513 ( $self->{root_widget} ) = @_; 514} 515 516=head2 tick 517 518 $tickit->tick( $flags ) 519 520Run a single round of IO events. Does not call C<setup_term> or 521C<teardown_term>. 522 523C<$flags> may optionally be a bitmask of the following exported constants: 524 525=over 4 526 527=item RUN_NOHANG 528 529Does not block waiting for IO; simply process whatever is available then 530return immediately. 531 532=item RUN_NOSETUP 533 534Do not perform initial terminal setup before waiting on IO events. 535 536=back 537 538=cut 539 540sub tick 541{ 542 my $self = shift; 543 544 # TODO: Consider root widget 545 546 $self->_tickit->tick( @_ ); 547} 548 549=head2 run 550 551 $tickit->run 552 553Calls the C<setup_term> method, then processes IO events until stopped, by the 554C<stop> method, C<SIGINT>, C<SIGTERM> or the C<Ctrl-C> key. Then runs the 555C<teardown_term> method, and returns. 556 557=cut 558 559sub run 560{ 561 my $self = shift; 562 563 if( my $widget = $self->{root_widget} ) { 564 $widget->set_window( $self->rootwin ); 565 } 566 567 my $term = $self->_tickit->term; 568 $SIG{__DIE__} = sub { 569 return if $^S; 570 my ( $err ) = @_; 571 572 # Teardown before application exit so the message appears properly 573 $term->teardown; 574 die $err; 575 }; 576 577 $self->_tickit->run; 578 579 if( my $widget = $self->{root_widget} ) { 580 $widget->set_window( undef ); 581 } 582} 583 584=head2 stop 585 586 $tickit->stop 587 588Causes a currently-running C<run> method to stop processing events and return. 589 590=cut 591 592sub stop { shift->_tickit->stop( @_ ) } 593 594=head1 MISCELLANEOUS FUNCTIONS 595 596=head2 version_major 597 598=head2 version_minor 599 600=head2 version_patch 601 602 $major = Tickit::version_major() 603 $minor = Tickit::version_minor() 604 $patch = Tickit::version_patch() 605 606These non-exported functions query the version of the F<libtickit> library 607that the module is linked to. 608 609=cut 610 611=head1 AUTHOR 612 613Paul Evans <leonerd@leonerd.org.uk> 614 615=cut 616 6170x55AA; 618