Tickit-0.73000755001750001750 014302155253 11413 5ustar00leoleo000000000000Tickit-0.73/Build.PL000444001750001750 145514302155253 13051 0ustar00leoleo000000000000use v5; use strict; use warnings; use Module::Build::Using::PkgConfig; my $build = Module::Build::Using::PkgConfig->new( module_name => 'Tickit', requires => { 'Exporter' => '5.57', 'perl' => '5.014', # PL_phase 'Struct::Dumb' => '0.04', }, configure_requires => { 'Module::Build' => '0.4004', # test_requires }, test_requires => { 'Test::Builder::Tester' => 0, 'Test::Fatal' => 0, 'Test::HexString' => 0, 'Test::More' => '0.88', # done_testing 'Test::Refcount' => 0, }, license => 'perl', create_license => 1, create_readme => 1, ); $build->use_pkgconfig( "tickit", atleast_version => "0.4.3", alien => "Alien::libtickit", alien_version => "0.13", # includes 0.4.2a bugfix ); $build->create_build_script; Tickit-0.73/Changes000444001750001750 7303014302155253 13066 0ustar00leoleo000000000000Revision history for Changes 0.73 2022-08-26 [CHANGES] * Use libtickit 0.4.3 * Use `eval {}` instead of `$SIG{__DIE__}` for exception trapping * Use core perl's `mPUSHpvs()` where available 0.72 2021-08-18 [CHANGES] * Use libtickit 0.4.2 * Wrap tickit_term_teardown() * Wrap tickit_watch_signal() and tickit_watch_process() * Added Tickit::Test::is_termctl() * Improved API shape for tickit_new_with_evloop() * Improved performance by setting PERL_NO_GET_CONTEXT [BUGFIXES] * Use $SIG{__DIE__} to teardown the terminal before reporting fatal exception messages 0.71 2020-05-25 [CHANGES] * Use libtickit 0.4.0 * Requires perl 5.14+ because of PL_phase 0.70 2020-01-27 13:00:17 [CHANGES] * Construct a new Tickit::Term proxy object during callbacks rather than relying on weakrefs to still be alive * Give Tickit::Term proxy objects numify and stringify overloading so that proxies to the same underlying object compare equal * Added toplevel methods Tickit->watch_later and ->watch_timer_* * Added Tickit::Test::mk_tickit * Implement timers and watch cancellation in Tickit::Test instance * Provide accessors for library version query * Requires libtickit 0.3.4 0.69 2019-12-30 10:24:44 [CHANGES] * Provide a wrapping of tickit_new_with_evloop(3) for modules like Tickit::Async or POEx::Tickit to use 0.68 2019-11-18 16:27:52 [CHANGES] * Wrap toplevel Tickit objects from C library; use C library's event loop 0.67 2019-04-10 19:42:06 [CHANGES] * Use libtickit 0.3 * Build against installed library but do not bundle C source any more * Provide generic ->setctl / ->getctl attribute methods [BUGFIXES] * Remember to EXTEND() the argument stack appropriately 0.66 2019-02-20 22:20:39 [CHANGES] * Switch build system to Module::Build::Using::PkgConfig * Clean up C code in XS file for various gcc warnings * Prepare for new integer type of pen 'u' attribute in tests [BUGFIXES] * Spelling fixes (thanks gregor herrmann) (RT125958) 0.65 2018-01-05 15:59:18 [CHANGES] * Updated for libtickit 0.2: + RGB8 pen attributes + tickit_renderbuffer_{skiprect,copyrect,moverect} + tickit_term_{pause,resume} [BUGFIXES] * Provide $term->pause+resume methods (RT107131) 0.64 2017-11-30 01:42:26 [CHANGES] * Perform Tickit 0.64 deprecations: + Remove now-dead methods in Term and Window * Bundled libtickit is now 0.2-beta1 * Fix up example demo scripts for current APIs 0.63 2017/06/13 14:38:01 [CHANGES] * Perform Tickit 0.63 deprecations: + Die in HASHification overloads on Tickit::Event::* + Die in $term->bind_event_default + Adjust wording of non-guarantee of object same-identity for $win->term + Warn in old-API boolean-returning $info->type for focus events * Have $tickit->timer return an ID value suitable for cancellation * Added $tickit->cancel_timer * Added $win->is_steal_focus and ->set_steal_focus [BUGFIXES] * Fix for $rb->text methods sometimes failing to convert numerical values (RT120630) 0.62 2017/02/23 18:54:35 [CHANGES] * Complete reïmplementation of Tickit::Window using libtickit * No other deprecations - they have all been deferred a release 0.61 2016/12/05 00:28:00 [CHANGES] * Documentation updates: + Better description of EVENTS + Update module synopses to use current APIs * Perform Tickit 0.61 deprecations: + Die in $win->set_on_* + Die in $term->bind_event_with_flags + Make $win->clear* methods die since they've actually been broken for ages anyway and nobody noticed 0.60 2016/11/05 13:28:12 [CHANGES] * Strict type checking when constructing key or mouse event structures * Perform Tickit 0.60 deprecations: + Add warnings to HASHification overloads on Tickit::Event::* + Add warning to $term->bind_event_default + No longer guarantee $win->term object identity + Delete $term->set_on_* methods 0.59 2016/10/22 21:15:57 [CHANGES] * Define new layer-neutral Tickit::Event::* classes * Perform Tickit 0.59 deprecations: + Warn in calls to $win->set_on_* + Warn in calls to $term->bind_event_with_flags() * Bundled libtickit changes: + Add refcounting to all object types + Deprecate the _destroy() functions in favour of _unref() 0.58 2016/09/30 20:08:32 [CHANGES] * Added new Tickit::Event instances for Tickit::Term event info * Perform Tickit 0.58 deprecations: + Die on attempt to set Tickit::Term ->set_on_* event handlers + Perl-level IO handles no longer preserved by term instances + Announce deprecation of term event info as HASH references [BUGFIXES] * Back-compat for perl 5.10.0 lacking mPUSHs - (RT98983) 0.57 2016/08/07 17:05:21 [CHANGES] * Add $win->bind_event; announce the legacy $win->set_on_* as deprecated * Define new flags-taking ->bind_event methods that check argument types; avoid needing $term->bind_event_with_flags 0.56 2016/05/10 18:02:02 [CHANGES] * Perform Tickit 0.56 deprecations: + Remove pen observers + Remove guarantee that perl-level IO handles are preserved by Tickit::Term + Add deprecations warnings to Tickit::Term ->set_on_* event handlers * Removed Tickit::Term->find_for_term * Bundled libtickit changes: + Added TICKIT_EV_DESTROY + Give EOF-style signal to term output function 0.55 2016/02/09 23:32:13 [CHANGES] * Wrap tickit_term_emit_{key,mouse} * Perform Tickit 0.55 deprecations: + window set_expose_after_scroll immediately dies * Actually honour return values of term event handlers * Added $term->bind_event_with_flags and BIND_FIRST * Updated documentation to barename =head2 function style [BUGFIXES] * Older perls need 'use IO::Handle' before we can ->binmode things 0.54 2015/09/14 10:36:50 [CHANGES] * Allow $window->raise immediately after construction (RT105582) * Added more Window unit-test cases * Removed remaining Tickit::Widget-based examples and demos * Renamed TICKIT_CURSORSHAPE_* constants * Tickit::Debug is now backed by libtickit [BUGFIXES] * Make destroyed child windows reëxpose their client area in the parent * Fix for rb_get_cell_active() returning -1 on failure (RT101716) 0.53 2015/06/28 12:39:41 [BUGFIXES] * Don't "use_ok" Tickit::Widget or subclasses in unit tests 0.52 2015/06/27 00:28:49 [CHANGES] * Split out Tickit::Widget and friends into the Tickit-Widgets distribution * Perform 0.52 deprecations: + Warn on attempt to disable window expose_after_scroll [BUGFIXES] * Remember to add 'return 0' in int-returning event handler function 0.51 2015/03/27 14:01:43 [CHANGES] * Perform 0.51 deprecations: + Die on Widgets that don't have WIDGET_PEN_FROM_STYLE + Warn on Pen observers * Allow #-style comments in style files * Added Tickit::Style->load_style_from_DATA shortcut * Configuration to not use ALTSCREEN [BUGFIXES] * Ensure that raw bte writes to testing pipe don't break under PERL_UNICODE (RT102028) * Remember to SvGETMAGIC() before looking at SvCUR() 0.50 2015/02/03 23:34:49 [CHANGES] * Perform 0.50 deprecations: + Die on Window direct-drawing methods and flushing RenderBuffer to a Window * Use textn() functions in RenderBuffer instead of text() * Use new tickit_term_scrollrect() API * Delete various bits of dead code 0.49 2014/12/16 21:11:15 [CHANGES] * Perform 0.49 deprecations: + Announce deprecation of Tickit::Pen observers + Warn on Widgets that don't have WIDGET_PEN_FROM_STYLE set + Die on attempts to disable CHILD_WINDOWS_LATER * Allow chaining return of ContainerWidget->{add,remove} 0.48 2014/09/18 20:55:38 [CHANGES] * Perform 0.48 removal deprecations * Added Tickit::Test::clear_term * Print deprecation warnings from Tickit::Window direct draw methods [BUGFIXES] * Test for presence of T:W:HBox at BEGIN time during unit test, to avoid error * Fix for Tickit::Utils::distribute() with fixed=0 when in overallocation mode * Ensure that child window on_expose handler is run before containing parent, to ensure RB holes are set correctly for underprint * Hidden child windows should not count during $win->scroll* * Ensure child window key handler propagation doesn't continue after a key event has been handled 0.47 2014/09/05 23:22:29 [CHANGES] * Moved Tickit::Widget::HBox/VBox to the Tickit-Widgets dist * Remove Tickit::WidgetRole::Penable * Support the new 'blink' Pen attribute [BUGFIXES] * Bundled libtickit bugfixes: + Improved handling of some missing terminfo attributes + Respect renderbuffer offset and limits in get_* functions 0.46 2014/05/02 20:16:37 [CHANGES] * Move RenderBuffer and MockTerm entirely into libtickit C library * Added $rb->char * Add Tickit::Debug support to RenderBuffer [BUGFIXES] * Ensure that $rb->skip/skip_at obey masking regions 0.45 2014/04/15 02:47:45 [CHANGES] * Move RenderBuffer's linemask-to-character conversion code into XS/C to prepare for RB-in-C * Implement most of Tickit::Test::MockTerm logic in C * Don't emit INSERTCH or DELETECH events from MockTerm * Announce $rb->flush_to_window as deprecated * Announce Window direct drawing methods as deprecated * Emit deprecation warnings from $term->mode_* and $win->*penattrs methods * Remove the Tickit::WidgetRole::Penable code; replace with a simple die message 0.44 2014/04/07 02:03:37 [CHANGES] * Deprecation warnings for pre-0.42-style Window expose/key/mouse event handlers * Provide $ev->mod_is_{shift,ctrl,alt} shortcut tests * Added $rb->linebox_at() * Allow ContainerWidgets to provide a method to return only those children it wants to focus search on * Added Tickit::Debug logging * Added focus_child_notify Window ability and :focus-child ContainerWidget style tag * Use a single RenderBuffer for the entire window/widget tree rendering * Added $rb->get_cell accessor for inspecting cell state [BUGFIXES] * Ensure that focus searching ability only considers children with visible windows * Ensure that $rb->mask won't crash with over-sized or negative- offset mask rects * Clip $win->scroll rect to the actual window bounds * Correct explanation of tagged vs. untagges style in docs * Fix $win->scrollrect when moving chunks a distance larger than their own size * Fix $rb->DESTROY with content to not print warnings of unreferenced scalars 0.43 2014/04/01 16:29:58 [CHANGES] * Default TICKIT_CHILD_WINDOWS_LATER on; with env. var to disable it * Allow optional $pen argument to $term->{print,clear,erasech} * Support flushing of RenderBuffer directly to a Tickit::Term * Store pending 'later' geometry changes separately from expose logic to ensure correct output * Rewrite of Window rendering logic: + accumulate damage and run expose logic only on root window * Provide a more robust associative version of is_termlog() to avoid test logic that depends on exact rendering order [BUGFIXES] * Ensure that $win->subwindows works on windows with no subs * $win->restore should remember to flush the actual terminal buffer * Ensure that RB masks are correctly interpreted during translations 0.42 2014/01/12 13:40:39 [CHANGES] * Added Window on_expose callback type with RenderBuffer * Added legacy-detecting $win->set_on_* methods to set new-style Window callbacks * Perform Widget rendering onto Window using new with_rb expose event * Deprecate legacy versions of Window on_expose, on_key, on_mouse * Removed CLEAR_BEFORE_RENDER 0.41 2013/12/19 19:17:07 [CHANGES] * Allow cursors to be entirely hidden on a Window * Return $text width in columns from $rb->text and $rb->text_at * Document that Tickit::Style->load_style* are methods, not functions (RT89235) [BUGFIXES] * Fix for T:W:Box - set 'dir' of T:WR:Alignable, not 'style' * Fix double-nested container focus management 0.40 2013/09/29 19:08:09 [CHANGES] * New size model; ->requested_{size,lines,cols} which cache * Lazy $parent->resize only when required * Updated all examples/docs for new ->render_to_rb * Print a legacy deprecation warning when constructing a ->render-based widget * Allow Styled widgets to copy their base class * Allow HBox/VBox to take a 'children' ARRAY to constructor [BUGFIXES] * Specify minimum required version of Alien::libtermkey to get libtermkey >= 0.16 * Need to force TERM=xterm during sequence testing 0.39 CHANGES: * Default expose_after_scroll true * Don't ->resize a ::Static if its size hasn't actually changed * Allow $win->scrollrect to take a Tickit::Rect instead of 4 ints * Added $win->scroll_with_children BUGFIXES: * Fix for libtickit ICH/DCH * Bundled libtickit bugfixes: + Implement tickit_term_scrollrect ICH/DCH correctly **NOTE**: These changes will break Tickit::Widget::Entry prior to Tickit-Widgets version 0.11, and so will need updating. 0.38 CHANGES: * Added 'drag_stop' and 'drag_outside' mouse events * More helpful error message if Tickit::Term constructor fails * Support multiple mouse tracking modes in latest libtickit * Bundled libtickit updates: BUGFIXES: * Disable experimental smartmatch warnings on recent perls * Fixed examples/demo-dragndrop.pl for recent API changes * Avoid GNU C99 anonymous unions in RenderBuffer cell struct (RT87724) * Bugfix to MockTerm's ICH/DCH emulation of horisontal scrollrect 0.37 CHANGES: * Allow Style files to use :: in widget type names * Added an experiment to test making child window list changes asynchronously "later" BUGFIXES: * API fixes in demos * Recognise (and truncate) non-integer cursor positions to RenderBuffer * Ensure that RenderBuffer->setpen can alter already-set attributes 0.36 CHANGES: * Added bounds arguments to $rect->linerange * Added $rb->eraserect * Updated *Box container widgets to use ->render_to_rb BUGFIXES: * Avoid calling $win->clear when using ->render_to_rb * Handle $rb->text entirely outside of clipping region 0.35 CHANGES: * Give the terminal up to 100msec to initialise before running * Added ContainerWidget->find_child and ->focus_next * Implement Tab/Shift-Tab as focus movement keys * Added style_redraw_keys * Keybindings from Style * Added ->render_to_rb alternative to ->render method BUGFIXES: * Clean up focus chain when removing a child window that has focus * Make sure that RenderBuffer stores UTF-8 text bytes 0.34 CHANGES: * Added timeout to Term->input_wait * Added Tickit->timer * Many internal updates to Window focus code * Added Window->cursor_at, ->cursor_shape and ->take_focus * Added Widget focus integration, including automatic ':focus' style tag * Added Window->subwindows 0.33 CHANGES: * Added Tickit::RenderBuffer; a renamed copy of Tickit::RenderContext from CPAN. Re-implemented more in XS/C code * Removed Tickit::WidgetRole::Borderable * Added 'bool' override for pens, rects and windows, because they are all always true 0.32 CHANGES: * Allow widgets to declare style keys to cause ->reshape calls * Allow Windows to be re-ordered within their parent, better document the behaviour of Window ordering * Handle mouse drag/drop events at the rootwin level * Pass key/mouse event arguments as a structure as well as positional arguments * Implement HBox/VBox spacing as style keys * Wrap tickit_term_getctl_int() * Bundled libtickit updates: + Down-convert colours to 8 or 16 colour palettes when on non- 256color-aware terminals 0.31 CHANGES: * Define the behaviour of Tickit::Style on subclasses, allowing for transparent or independent subclass types * Declare the particular version of Alien::unibilium required * Split pens into mutable and immutable forms; deprecate ->clone method * Added $pen->equiv and ->equiv_attr comparison methods 0.30 CHANGES: * Allow modification of widget direct-applied style * Split Tickit::Pen into mutable and immutable subclasses * Return immutable pens from Tickit::Widget style * Cache style pens * Added opt-in optional feature to set widget pen from default style pen * Use default style pen as widget pen in built-in widget classes * Pass keyboard modifier state through to key/mouse event handlers * Avoid floating-point in Tickit::Utils::distribute() * Avoid a memory leak bug in Tickit::Pen and Tickit::Term XS code * Set TERM=xterm for whole-system unit testing so we get reliable terminal initialisation sequence * Bundled libtickit updates: + Split implementation of real xterm and other terminfo-driven terminal drivers + Now requires unibilium for the terminfo-driven driver * Currently requires unibilium version v1.1.0, which can be found at https://github.com/mauke/unibilium 0.29 CHANGES: * Added Tickit::Style, and the ability to set state-sensitive style information on widgets * Added on_click event to Tickit::Widget::Static * Redraw a widget after pen change * Added Tickit::Utils::distribute() * Improvements and modifications to the way ContainerWidget works + can ->set_child directly + more abstract container logic that doesn't enforce an ordering + just stores per-child options * Return a Tickit::StringPos from $win->erasech * Abort if $win->print is given non-Unicode text * Warn if CLEAR_BEFORE_RENDER is still set 0.28 CHANGES: * Added $window->close method * Make FLOAT_ALL_THE_WINDOWS behaviour default BUGFIXES: * Ensure HBox can handle out-of-space * Correctly convert mouse wheel direction in args hash 0.27 BUGFIXES: * Important bugfix to bundled libtickit: + Fix resize logic in tickit_rectset_add() so it doesn't grow the object arbitrarily until it fails VERSION 0.26 IS CRITICALLY BROKEN. DO NOT USE IT. 0.26 CHANGES: * Re-implement Tickit::RectSet as a libtickit-backed object * Expose Tickit::Term->setctl_{int,str} methods * New Tickit::Term->bind_event API 0.25 CHANGES: * Removed Tickit::Widget::Frame and Tickit::Widget::Box, now they have been moved to Tickit-Widgets dist. * Added a new, better idea for Tickit::Widget::Box * Allow Tickit->new( root => ... ) * Re-implement Tickit::Rect as a libtickit-backed structure object 0.24 CHANGES: * Many improvements to Window scroll logic; allow scroll with terminal scrollrect even with obscuring floats * Added Rect->add and ->subtract methods * Added RectSet->subtract method BUGFIXES: * Correctly adjust pending window damage after ->scrollrect 0.23 CHANGES: * Many improvements to Window float logic; beginning of merging float and non-float implementations * Added $win->bottom and $win->right 0.22 CHANGES: * Window focus in/out events, $win->is_focused accessor * Added Tickit::RectSet object class * Allow Window to store a set of expose regions rather than just a boolean flag * Added Window expose-after-scroll behaviour 0.21 CHANGES: * Wrap tickit_string_count and tickit_string_countmore; provide a Tickit::StringPos counter object * Have $win->print return a Tickit::StringPos BUGFIXES: * Don't use_ok Tickit::Widget::Entry 0.20 CHANGES: * Allow $win->goto outside of its edges, apply clipping * Removed Tickit::Widget::Entry; now found in the Tickit-Widgets distribution * Updated for latest libtickit BUGFIXES: * Ensure that Static widgets with empty text still behave correctly * Fix test skip counts in t/02utils.t 0.19 CHANGES: * Allow multi-line Static text * Added a stringification overload to Pen to make unit testing easier BUGFIXES: * Better terminal flushing * Force TERM=xterm during t/0term-output.t 0.18 CHANGES: * Re-implement Term and Pen in XS/C using libtickit (bundled source pkg-config driven build) * Defined a new Tickit::WidgetRole::Penable * Added $rect->linerange * Added $win->clearrect * Added $win->make_popup to create on-top floating input-stealing Windows BUGFIXES: * Disallow $win->scrollrect if there are any floating windows in the way * Perform $win->erasech with the entire pen in case 'rv' is set 0.17 CHANGES: * $win->hide, $win->show and the concept of hidden windows * $win->make_float and the concept of floating windows * A better clipping model to handle the above * $pen->hasattr * Tickit::Test::drain_termlog() * Set the CANON_DELBS termkey flag in case of misconfigured terminals * Make $tickit->stop a user-visible method BUGFIXES: * Ensure Tickit::Widget::Entry keybindings consume key press events * Ensure Tickit::Widget::Static->set_text actually calls ->redraw * Pass UTF8 => 1 to unit tests that test Unicode functionality 0.16 CHANGES: * Represent mouse wheel events as 'wheel'/'up' or 'wheel'/'down' * Fix argument order for Tickit::Rect->translate * Allow $term->chpen/->setpen to take a Tickit::Pen object * Added Pen->clone, ->copy_from and ->default_from methods * Deprecated the pen attribute list returning methods of Tickit::Window BUGFIXES: * Account for inter-child spacing when calculating minimum size requirements for Tickit::Widget::{H,V}Box 0.15 CHANGES: * $term->eraseline is now removed * Provide a $tickit->tick method to finer-grained event handling * Removed Tickit::RootWindow; the root window is now a regular Tickit::Window BUGFIXES: * Force terminal size in t/80tickit.t so it doesn't cause failures on oddly-sized terminals 0.14 CHANGES: * $term->insertch and ->deletech are now removed * Move key input behaviours into Tickit::Term; many other refactorings between Tickit and Tickit::Term * Renamed $tickit->start / ->stop to ->setup_term / ->teardown_term 0.13 CHANGES: * Allow Widget subclasses to disable the clear-before-render behaviour * Avoid harmless warning about undef during global destruction BUGFIXES: * Skip Unicode-requiring tests unless we know we have a Unicode-aware locale 0.12 CHANGES: * Pass an opaque 'id' value through Pen->add_on_changed into $observer->on_pen_changed * Extend is_display() unit testing function to allow asserting pen attributes as well as text-on-display * Rewrote many unit tests to use only is_display() and not is_termlog() * Deleted now-deprecated Window methods of ->penprint, ->insertch and ->deletech 0.11 CHANGES: * Allow Windows to be created overlapping their parent boundaries; clip output - Work In Progress, so far only handles ->print and ->erasech, not the scrolling operations * Represent on-screen rectangles as first-class Tickit::Rect object, pass a 'rect' argument to Window on_expose event * More diagnostic output from Tickit::Test::is_termlog failures * Support (rarely-used) strikethrough pen attribute * No longer depends on Term::TermKey::Async unnecessarily 0.10 CHANGES: * Use Perl's ${^UTF8LOCALE} to detect UTF-8ness rather than relying on libtermkey's flags. Avoids fragile dependency * Use Term::TermKey 0.09's EINTR ability to simplify the main run loop * Split Tickit::Async out into its own distribution 0.09 CHANGES: * Move IO::Async-based code out of Tickit into Tickit::Async, reimplement a simple IO framework in Tickit itself. * Added Window on_expose event that cascades down the Window tree * Implement Widget drawing using Window on_expose events rather than cascading logic down th Widget tree * Print proper deprecation warnings from deprecated Window methods penprint, insertch, deletech 0.08 CHANGES: * More efficient XS implementation of low-level string length handling utilities in Tickit::Util * Allow forcing size of child widgets in Tickit::Widget::VBox and ::HBox * Pass region information into Widget->render methods; even if currently it is a fixed 0/0/$lines/$cols * Accept a pen argmuent to Window->print; deprecate ->penprint * Implement Window->scrollrect; deprecate ->insertch and ->deletech * Print a deprecation warning if a plain Tickit object is used as an IO::Async::Notifier 0.07 CHANGES: * Provide (trivial) Tickit::Async subclass for users to prepare for IO::Async split * Try to find $TERM-specific subclass of Tickit::Term for terminal- specific optimisations or abilities * Support 256 colour xterm * Unit test in more generic SCROLLRECT operation BUGFIXES: * Ensure Tickit::Test and Tickit::Test::MockTerm have a $VERSION 0.06 CHANGES: * Shut down terminal state before $SIG{__DIE__}'ing * Cope correctly with zero-sized children in {V,H,}Box and Frame * Broadcast unhandled keypresses out to sibling windows around the widget tree * Neater unit testing functions * Rearranged code to prepare for abstract/IO::Async split 0.05 CHANGES: * Added mouse support * Switchable insert/overwrite mode in Entry * Markers at beginning/end of Entry to indicate scrolling * Reduced API dependency on IO::Async; lazily construct a containing Loop in ->run * Reduced test-time dependency on IO::Async * Export Tickit::Test as real code for out-of-distribution tests * Miscellaneous bugfixes and improvements 0.04 CHANGES: * Added Tickit::Widget::Frame and ::Box * Support text scrolling in Entry * Support renderable containers * Updated Pen model; first-class objects, observers for updates * Support high-intensity colours * Entry->text_delete/_splice return the deleted text 0.03 CHANGES: * Added Tickit::Widget::Entry * Tickit::Pen as first-class object * Support more pen attributes - reverse video, alternate font 0.02 CHANGES: * Bind Ctrl-C to $loop->loop_stop by default * Neater root widget and run API * Added SYNOPSIS examples to most widget types; added examples/ directory * Window 'on_key' event handling * Keep cursor hidden unless it's on a focused window 0.01 First version, released on an unsuspecting world. Tickit-0.73/LICENSE000444001750001750 4375514302155253 12613 0ustar00leoleo000000000000This software is copyright (c) 2022 by Paul Evans . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2022 by Paul Evans . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2022 by Paul Evans . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Tickit-0.73/MANIFEST000444001750001750 250514302155253 12703 0ustar00leoleo000000000000Build.PL Changes examples/capture-keys.pl examples/demo-allkeys.pl examples/demo-clickanddrag.pl examples/demo-clicker.pl examples/demo-colorwidget.pl examples/demo-dragndrop.pl examples/demo-expose.pl examples/demo-float.pl examples/demo-input.pl examples/demo-lines.pl examples/demo-pen.pl examples/demo-showkey.pl examples/demo-timer.pl examples/demo-xterm256.pl lib/Tickit.pm lib/Tickit.xs lib/Tickit/Debug.pm lib/Tickit/Event.pm lib/Tickit/Pen.pm lib/Tickit/Rect.pm lib/Tickit/RectSet.pm lib/Tickit/RenderBuffer.pm lib/Tickit/StringPos.pm lib/Tickit/Term.pm lib/Tickit/Test.pm lib/Tickit/Test/MockTerm.pm lib/Tickit/Utils.pm lib/Tickit/Window.pm MANIFEST This list of files t/00use.t t/01rect.t t/02rectset.t t/03utils.t t/04pen.t t/05term-output.t t/06term-resize.t t/07term-input.t t/08mockterm.t t/09test.t t/10renderbuffer-span.t t/11renderbuffer-line.t t/12renderbuffer-char.t t/13renderbuffer-clip.t t/14renderbuffer-stack.t t/15renderbuffer-mask.t t/20rootwin.t t/21window.t t/22window-expose.t t/23window-scrolling.t t/26window-focus.t t/27window-input.t t/28window-float.t t/29window-dragndrop.t t/30tickit.t t/31tickit-io.t t/32tickit-timer.t t/33tickit-later.t t/34tickit-signal.t t/35tickit-process.t t/84tickit-term-input.t t/85tickit-widget.t t/89tickit-test.t t/90rt101716.t t/99pod.t typemap README LICENSE META.yml META.json Tickit-0.73/META.json000444001750001750 550114302155253 13172 0ustar00leoleo000000000000{ "abstract" : "Terminal Interface Construction KIT", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4231", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Tickit", "prereqs" : { "build" : { "requires" : { "ExtUtils::CBuilder" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.4004", "Module::Build::Using::PkgConfig" : "0" } }, "runtime" : { "requires" : { "Exporter" : "5.57", "Struct::Dumb" : "0.04", "perl" : "5.014" } }, "test" : { "requires" : { "Test::Builder::Tester" : "0", "Test::Fatal" : "0", "Test::HexString" : "0", "Test::More" : "0.88", "Test::Refcount" : "0" } } }, "provides" : { "Tickit" : { "file" : "lib/Tickit.pm", "version" : "0.73" }, "Tickit::Debug" : { "file" : "lib/Tickit/Debug.pm", "version" : "0.73" }, "Tickit::Event" : { "file" : "lib/Tickit/Event.pm", "version" : "0.73" }, "Tickit::Pen" : { "file" : "lib/Tickit/Pen.pm", "version" : "0.73" }, "Tickit::Pen::Immutable" : { "file" : "lib/Tickit/Pen.pm", "version" : "0.73" }, "Tickit::Pen::Mutable" : { "file" : "lib/Tickit/Pen.pm", "version" : "0.73" }, "Tickit::Rect" : { "file" : "lib/Tickit/Rect.pm", "version" : "0.73" }, "Tickit::RectSet" : { "file" : "lib/Tickit/RectSet.pm", "version" : "0.73" }, "Tickit::RenderBuffer" : { "file" : "lib/Tickit/RenderBuffer.pm", "version" : "0.73" }, "Tickit::StringPos" : { "file" : "lib/Tickit/StringPos.pm", "version" : "0.73" }, "Tickit::Term" : { "file" : "lib/Tickit/Term.pm", "version" : "0.73" }, "Tickit::Test" : { "file" : "lib/Tickit/Test.pm", "version" : "0.73" }, "Tickit::Test::MockTerm" : { "file" : "lib/Tickit/Test/MockTerm.pm", "version" : "0.73" }, "Tickit::Utils" : { "file" : "lib/Tickit/Utils.pm", "version" : "0.73" }, "Tickit::Window" : { "file" : "lib/Tickit/Window.pm", "version" : "0.73" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.73", "x_serialization_backend" : "JSON::PP version 4.06" } Tickit-0.73/META.yml000444001750001750 341714302155253 13026 0ustar00leoleo000000000000--- abstract: 'Terminal Interface Construction KIT' author: - 'Paul Evans ' build_requires: ExtUtils::CBuilder: '0' Test::Builder::Tester: '0' Test::Fatal: '0' Test::HexString: '0' Test::More: '0.88' Test::Refcount: '0' configure_requires: Module::Build: '0.4004' Module::Build::Using::PkgConfig: '0' dynamic_config: 1 generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Tickit provides: Tickit: file: lib/Tickit.pm version: '0.73' Tickit::Debug: file: lib/Tickit/Debug.pm version: '0.73' Tickit::Event: file: lib/Tickit/Event.pm version: '0.73' Tickit::Pen: file: lib/Tickit/Pen.pm version: '0.73' Tickit::Pen::Immutable: file: lib/Tickit/Pen.pm version: '0.73' Tickit::Pen::Mutable: file: lib/Tickit/Pen.pm version: '0.73' Tickit::Rect: file: lib/Tickit/Rect.pm version: '0.73' Tickit::RectSet: file: lib/Tickit/RectSet.pm version: '0.73' Tickit::RenderBuffer: file: lib/Tickit/RenderBuffer.pm version: '0.73' Tickit::StringPos: file: lib/Tickit/StringPos.pm version: '0.73' Tickit::Term: file: lib/Tickit/Term.pm version: '0.73' Tickit::Test: file: lib/Tickit/Test.pm version: '0.73' Tickit::Test::MockTerm: file: lib/Tickit/Test/MockTerm.pm version: '0.73' Tickit::Utils: file: lib/Tickit/Utils.pm version: '0.73' Tickit::Window: file: lib/Tickit/Window.pm version: '0.73' requires: Exporter: '5.57' Struct::Dumb: '0.04' perl: '5.014' resources: license: http://dev.perl.org/licenses/ version: '0.73' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Tickit-0.73/README000444001750001750 2033714302155253 12455 0ustar00leoleo000000000000NAME Tickit - Terminal Interface Construction KIT SYNOPSIS use Tickit; use Tickit::Widget::Box; use Tickit::Widget::Static; my $box = Tickit::Widget::Box->new( h_border => 4, v_border => 2, bg => "green", child => Tickit::Widget::Static->new( text => "Hello, world!", bg => "black", align => "centre", valign => "middle", ), ); Tickit->new( root => $box )->run; DESCRIPTION Tickit is a high-level toolkit for creating full-screen terminal-based interactive programs. It allows programs to be written in an abstracted way, working with a tree of widget objects, to represent the layout of the interface and implement its behaviours. Its supported terminal features includes a rich set of rendering attributes (bold, underline, italic, 256-colours, etc), support for mouse including wheel and position events above the 224th column and arbitrary modified key input via libtermkey (all of these will require a supporting terminal as well). It also supports having multiple instances and non-blocking or asynchronous control. CONSTRUCTOR new $tickit = Tickit->new( %args ) Constructs a new Tickit framework container object. Takes the following named arguments at construction time: term_in => IO IO handle for terminal input. Will default to STDIN. term_out => IO IO handle for terminal output. Will default to STDOUT. UTF8 => BOOL If defined, overrides locale detection to enable or disable UTF-8 mode. If not defined then this will be detected from the locale by using Perl's ${^UTF8LOCALE} variable. root => Tickit::Widget If defined, sets the root widget using set_root_widget to the one specified. use_altscreen => BOOL If defined but false, disables the use of altscreen, even if supported by the terminal. This will mean that the screen contents are stll available after the program has finished. METHODS watch_io $id = $tickit->watch_io( $fh, $cond, $code ) Since version 0.71. Runs the given CODE reference at some point in the future, when IO operations are possible on the given filehandle. $cond should be a bitmask of at least one of the IO_IN, IO_OUT or IO_HUP constants describing which kinds of IO operation the callback is interested in. Returns an opaque integer value that may be passed to "watch_cancel". This value is safe to ignore if not required. When invoked, the callback will receive an event parameter which will be an instances of a type with a field called cond. This will contain the kinds of IO operation that are currently possible. $code->( $info ) $current_cond = $info->cond; For example, to watch for both input and hangup conditions and respond to each individually: $tickit->watch_io( $fh, Tickit::IO_IN|Tickit::IO_HUP, sub { my ( $info ) = @_; if( $info->cond & Tickit::IO_IN ) { ... } if( $info->cond & Tickit::IO_HUP ) { ... } } ); watch_later $id = $tickit->watch_later( $code ) Since version 0.70. Runs the given CODE reference at some time soon in the future. It will not be invoked yet, but will be invoked at some point before the next round of input events are processed. Returns an opaque integer value that may be passed to "watch_cancel". This value is safe to ignore if not required. later $tickit->later( $code ) For back-compatibility this method is a synonym for "watch_later". watch_timer_at $id = $tickit->watch_timer_at( $epoch, $code ) Since version 0.70. Runs the given CODE reference at the given absolute time expressed as an epoch number. Fractions are supported to a resolution of microseconds. Returns an opaque integer value that may be passed to "watch_cancel". This value is safe to ignore if not required. watch_timer_after $id = $tickit->watch_timer_after( $delay, $code ) Since version 0.70. Runs the given CODE reference at the given relative time expressed as a number of seconds hence. Fractions are supported to a resolution of microseconds. Returns an opaque integer value that may be passed to "watch_cancel". This value is safe to ignore if not required. timer $id = $tickit->timer( at => $epoch, $code ) $id = $tickit->timer( after => $delay, $code ) For back-compatibility this method is a wrapper for either "watch_timer_at" or "watch_timer_after" depending on the first argument. Returns an opaque integer value that may be passed to "cancel_timer". This value is safe to ignore if not required. watch_signal $id = $tickit->watch_signal( $signum, $code ) Since version 0.72. Runs the given CODE reference whenever the given POSIX signal is received. Signals are given by number, not name. Returns an opaque integer value that may be passed to "watch_cancel". This value is safe to ignore if not required. watch_process $id = $tickit->watch_process( $pid, $code ) Since version 0.72. Runs the given CODE reference when the given child process terminates. Returns an opaque integer value that may be passed to "watch_cancel". This value is safe to ignore if not required. When invoked, the callback will receive an event parameter which will be an instance of a type with a field called wstatus. This will contain the exit status of the terminated child process. $code->( $info ) $pid = $info->pid; $status = $info->wstatus; watch_cancel $tickit->watch_cancel( $id ) Since version 0.70. Removes an idle or timer watch previously installed by one of the other watch_* methods. After doing so the code will no longer be invoked. cancel_timer $tickit->cancel_timer( $id ) For back-compatibility this method is a synonym for "watch_cancel". term $term = $tickit->term Returns the underlying Tickit::Term object. cols lines $cols = $tickit->cols $lines = $tickit->lines Query the current size of the terminal. Will be cached and updated on receipt of SIGWINCH signals. bind_key $tickit->bind_key( $key, $code ) Installs a callback to invoke if the given key is pressed, overwriting any previous callback for the same key. The code block is invoked as $code->( $tickit, $key ) If $code is missing or undef, any existing callback is removed. As a convenience for the common application use case, the Ctrl-C key is bound to the stop method. To remove this binding, simply bind another callback, or remove the binding entirely by setting undef. rootwin $tickit->rootwin Returns the root Tickit::Window. set_root_widget $tickit->set_root_widget( $widget ) Sets the root widget for the application's display. This must be a subclass of Tickit::Widget. tick $tickit->tick( $flags ) Run a single round of IO events. Does not call setup_term or teardown_term. $flags may optionally be a bitmask of the following exported constants: RUN_NOHANG Does not block waiting for IO; simply process whatever is available then return immediately. RUN_NOSETUP Do not perform initial terminal setup before waiting on IO events. run $tickit->run Calls the setup_term method, then processes IO events until stopped, by the stop method, SIGINT, SIGTERM or the Ctrl-C key. Then runs the teardown_term method, and returns. stop $tickit->stop Causes a currently-running run method to stop processing events and return. MISCELLANEOUS FUNCTIONS version_major version_minor version_patch $major = Tickit::version_major() $minor = Tickit::version_minor() $patch = Tickit::version_patch() These non-exported functions query the version of the libtickit library that the module is linked to. AUTHOR Paul Evans Tickit-0.73/typemap000444001750001750 275414302155253 13162 0ustar00leoleo000000000000Tickit::Event::Key T_PTROBJ Tickit::Event::Mouse T_PTROBJ Tickit::Pen T_PTROBJ_OR_NULL Tickit::Rect T_PTROBJ Tickit::Rect_MAYBE T_PTROBJ_MAYBE Tickit::RectSet T_PTROBJ Tickit::RenderBuffer T_PTROBJ Tickit::StringPos T_PTROBJ_OR_NULL Tickit::Term T_PTROBJ Tickit::Term_MAYBE T_PTROBJ_MAYBE Tickit::Window T_PTROBJ Tickit::_Tickit T_PTROBJ INPUT T_PTROBJ_MAYBE if (!SvOK($arg)) { $var = NULL; } else if (SvROK($arg) && sv_derived_from($arg, \"${\do { my $tmp = $ntype; $tmp =~ s/_MAYBE$//; $tmp }}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"${\do{ my $tmp = $ntype; $tmp =~ s/_MAYBE$//; $tmp }}\") INPUT T_PTROBJ_OR_NULL if (!SvOK($arg)) { $var = NULL; } else if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\") OUTPUT T_PTROBJ_OR_NULL if ($var) sv_setref_pv($arg, \"${ntype}\", (void*)$var); else sv_setsv($arg, &PL_sv_undef); Tickit-0.73/examples000755001750001750 014302155253 13231 5ustar00leoleo000000000000Tickit-0.73/examples/capture-keys.pl000444001750001750 63514302155253 16323 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit::Term; my $term = Tickit::Term->open_stdio; $term->await_started( 0.05 ); my @keys; $term->bind_event( key => sub { my ( $term, $ev, $info ) = @_; push @keys, $info; }); sub get_next_key { while(1) { return shift @keys if @keys; $term->input_wait; } } while( my $key = get_next_key ) { print "Pressed key ", $key->str, "\n"; } Tickit-0.73/examples/demo-allkeys.pl000444001750001750 273114302155253 16314 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Widget::Static; use Tickit::Widget::VBox; use Tickit::Widget::HBox; my $tickit = Tickit->new(); my @basekeys = qw( a h i Space Backspace Tab Enter Up Escape ); my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); my $hbox; $vbox->add( $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ); $hbox->add( Tickit::Widget::Static->new( text => "Modifier" ) ); foreach my $basekey (@basekeys) { $hbox->add( Tickit::Widget::Static->new( text => sprintf "%-6s", $basekey ) ); } foreach my $mbits ( 0 .. 7 ) { my $modifier = ""; $modifier .= "M-" if $mbits & 4; $modifier .= "C-" if $mbits & 2; $modifier .= "S-" if $mbits & 1; $vbox->add( $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ); $hbox->add( Tickit::Widget::Static->new( text => sprintf "%-8s", "$modifier*" ) ); foreach ( @basekeys ) { my $basekey = $_; # avoid alias my $static = Tickit::Widget::Static->new( text => "-- " ); my $thismod = $modifier; # Keybindings are weirder if( length( $basekey ) == 1 ) { $thismod =~ s/S-// and $basekey = uc $basekey; } elsif( $basekey eq "Space" ) { $basekey = " "; } $tickit->bind_key( "$thismod$basekey" => sub { $static->set_style( fg => "green" ); $static->set_text( "OK " ); } ); $hbox->add( $static ); } } $tickit->set_root_widget( $vbox ); $tickit->run; Tickit-0.73/examples/demo-clickanddrag.pl000444001750001750 244114302155253 17254 0ustar00leoleo000000000000#!/usr/bin/perl package ClickAndDragWidget; use base 'Tickit::Widget'; use v5.14; use warnings; use Tickit; use Tickit::Widget::Placegrid; use List::Util qw( min max ); sub lines { 1 } sub cols { 1 } sub render_to_rb { shift; my ( $rb, $rect ) = @_; $rb->eraserect( $rect ); } # In a real Widget these would be stored in an attribute of $self my @start; my $dragframe; sub on_mouse { my $self = shift; my ( $args ) = @_; if( $args->type eq "release" ) { $dragframe->window->close if $dragframe; undef $dragframe; return; } return unless $args->button == 1; if( $args->type eq "press" ) { @start = ( $args->line, $args->col ); return; } my $top = min( $start[0], $args->line ); my $left = min( $start[1], $args->col ); my $lines = max( $start[0], $args->line ) - $top + 1; my $cols = max( $start[1], $args->col ) - $left + 1; return if( $lines == 0 or $cols == 0 ); $self->window->expose; if( $dragframe ) { $dragframe->window->change_geometry( $top, $left, $lines, $cols ); } else { $dragframe = Tickit::Widget::Placegrid->new; $dragframe->set_window( $self->window->make_sub( $top, $left, $lines, $cols ) ); } } Tickit->new( root => ClickAndDragWidget->new )->run; Tickit-0.73/examples/demo-clicker.pl000444001750001750 131314302155253 16257 0ustar00leoleo000000000000#!/usr/bin/perl package ClickerWidget; use base 'Tickit::Widget'; use v5.14; use warnings; use Tickit; # In a real Widget this would be stored in an attribute of $self my @points; sub lines { 1 } sub cols { 1 } sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; my $win = $self->window; $rb->eraserect( $rect ); foreach my $point ( @points ) { $rb->text_at( $point->[0], $point->[1], "X" ); } } sub on_mouse { my $self = shift; my ( $args ) = @_; return unless $args->type eq "press" and $args->button == 1; push @points, [ $args->line, $args->col ]; shift @points while @points > 10; $self->redraw; } Tickit->new( root => ClickerWidget->new )->run; Tickit-0.73/examples/demo-colorwidget.pl000444001750001750 130014302155253 17161 0ustar00leoleo000000000000#!/usr/bin/perl package ColourWidget; use base 'Tickit::Widget'; use v5.14; use warnings; use Tickit; my $text = "Press 0 to 7 to change the colour of this text"; sub lines { 1 } sub cols { length $text } sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; my $win = $self->window; $rb->eraserect( $rect ); $rb->text_at( ( $win->lines - $self->lines ) / 2, ( $win->cols - $self->cols ) / 2, $text ); } sub on_key { my $self = shift; my ( $args ) = @_; if( $args->type eq "text" and $args->str =~ m/[0-7]/ ) { $self->set_style( fg => $args->str ); $self->redraw; return 1; } return 0; } Tickit->new( root => ColourWidget->new )->run; Tickit-0.73/examples/demo-dragndrop.pl000444001750001750 632614302155253 16634 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Widgets qw( GridBox ); package DndArea; use base qw( Tickit::Widget ); use Tickit::RenderBuffer; sub lines { 1 } sub cols { 1 } sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; my $win = $self->window or return; $rb->clear; my $centreline = int( $win->lines / 2 ); if( $self->{dragging} ) { $rb->text_at( $centreline-1, int( ($win->cols - 10) / 2 ), $self->{dragging} == 2 ? "*dragging*" : "*DRAGGING*", Tickit::Pen->new( fg => "red" ) ); } $rb->text_at( $centreline, int( $win->cols / 2 ) - 5, ref $self ); $rb->text_at( $centreline+1, int( ($win->cols - length $self->{latest_mouse}) / 2 ), $self->{latest_mouse} ) if defined $self->{latest_mouse}; if( $self->can( "render_rb" ) ) { $self->render_rb( $rb ); } } package SourceArea; use base qw( DndArea ); sub render_rb { my $self = shift; my ( $rb ) = @_; if( defined $self->{start_line} ) { $rb->text_at( $self->{start_line}, $self->{start_col}, "S", Tickit::Pen->new( fg => "red" ) ); } if( defined $self->{over_line} ) { $rb->text_at( $self->{over_line}-1, $self->{over_col} , "|", Tickit::Pen->new ( fg => "black" ) ); $rb->text_at( $self->{over_line}+1, $self->{over_col} , "|", Tickit::Pen->new ( fg => "black" ) ); $rb->text_at( $self->{over_line} , $self->{over_col}-1, "-", Tickit::Pen->new ( fg => "black" ) ); $rb->text_at( $self->{over_line} , $self->{over_col}+1, "-", Tickit::Pen->new ( fg => "black" ) ); } if( defined $self->{end_line} ) { $rb->text_at( $self->{end_line}, $self->{end_col}, "E", Tickit::Pen->new ( fg => "magenta" ) ); } } sub on_mouse { my $self = shift; my ( $args ) = @_; $self->{latest_mouse} = sprintf "%s button %d at (%d,%d)", $args->type, $args->button, $args->line, $args->col; if( $args->type eq "press" ) { undef $_ for @{$self}{qw( start_line start_col over_line over_col end_line end_col )}; } if( $args->type eq "drag_start" ) { ( $self->{start_line}, $self->{start_col} ) = ( $args->line, $args->col ); } if( $args->type eq "drag" ) { ( $self->{over_line}, $self->{over_col} ) = ( $args->line, $args->col ); $self->{dragging} = 1; } if( $args->type eq "drag_outside" ) { $self->{dragging} = 2; } if( $args->type eq "drag_drop" ) { ( $self->{end_line}, $self->{end_col} ) = ( $args->line, $args->col ); } if( $args->type eq "drag_stop" ) { undef $_ for @{$self}{qw( over_line over_col )}; $self->{dragging} = 0; } $self->redraw; return 1; } package DestArea; use base qw( DndArea ); sub on_mouse { my $self = shift; my ( $args ) = @_; $self->{latest_mouse} = sprintf "%s button %d at (%d,%d)", $args->type, $args->button, $args->line, $args->col; $self->redraw; return 1; } package main; my $gridbox = Tickit::Widget::GridBox->new( col_spacing => 2, row_spacing => 1, ); $gridbox->add( 0, 0, SourceArea->new( bg => "green" ), col_expand => 1, row_expand => 1 ); $gridbox->add( 1, 1, DestArea->new( bg => "blue" ), col_expand => 1, row_expand => 1 ); Tickit->new( root => $gridbox )->run; Tickit-0.73/examples/demo-expose.pl000444001750001750 276414302155253 16161 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Rect; use List::Util qw( min max ); my $fillchar = "1"; sub fillwin { my ( $win, undef, $info ) = @_; my $rb = $info->rb; my $rect = $info->rect; foreach my $line ( $rect->linerange ) { $rb->text_at( $line, $rect->left, $fillchar x $rect->cols ); } } my $tickit = Tickit->new(); foreach ( 1 .. 9 ) { my $key = $_; $tickit->bind_key( $key => sub { $fillchar = $key } ); } my $rootwin = $tickit->rootwin; my @start; $rootwin->bind_event( mouse => sub { my ( $self, undef, $info ) = @_; @start = ( $info->line, $info->col ) and return if $info->type eq "press"; return unless $info->type eq "release"; my $top = min( $start[0], $info->line ); my $left = min( $start[1], $info->col ); my $bottom = max( $start[0], $info->line ) + 1; my $right = max( $start[1], $info->col ) + 1; $rootwin->expose( Tickit::Rect->new( top => $top, left => $left, bottom => $bottom, right => $right, ) ); }); my $win = $rootwin->make_sub( 5, 10, 15, 60 ); $win->pen->chattr( fg => 1 ); $win->bind_event( expose => \&fillwin ); my @subwins; push @subwins, $win->make_sub( 0, 0, 4, 4 ); $subwins[-1]->pen->chattr( fg => 2 ); $subwins[-1]->bind_event( expose => \&fillwin ); push @subwins, $win->make_sub( 6, 40, 2, 15 ); $subwins[-1]->pen->chattr( fg => 3 ); $subwins[-1]->bind_event( expose => \&fillwin ); $tickit->watch_later( sub { $rootwin->expose; } ); $tickit->run; Tickit-0.73/examples/demo-float.pl000444001750001750 447114302155253 15760 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use List::Util qw( min max ); use Tickit::Async; use IO::Async::Loop; use IO::Async::Timer::Periodic; my $loop = IO::Async::Loop->new; my $tickit = Tickit::Async->new; my $colour_offset = 0; my $rootwin = $tickit->rootwin; my $win = $rootwin->make_sub( 5, 5, $rootwin->lines - 10, $rootwin->cols - 10 ); $win->bind_event( expose => sub { my ( $self, undef, $info ) = @_; my $rb = $info->rb; foreach my $line ( $info->rect->linerange ) { $rb->text_at( $line, 0, "Here is some content for line $line " . "X" x ( $self->cols - 30 ), Tickit::Pen->new( fg => 1 + ( $line + $colour_offset ) % 6 ), ); } } ); # Logic to erase the borders $rootwin->bind_event( expose => sub { my ( $self, undef, $info ) = @_; my $rb = $info->rb; my $rect = $info->rect; foreach my $line ( $rect->top .. 4 ) { $rb->erase_at( $line, 0, $self->cols ); } foreach my $line ( $self->lines-5 .. $rect->bottom-1 ) { $rb->erase_at( $line, 0, $self->cols ); } if( $rect->left < 5 ) { foreach my $line ( max( $rect->top, 4 ) .. min( $self->lines-5, $rect->bottom-1 ) ) { $rb->erase_at( $line, 0, 5 ); } } if( $rect->right > $self->cols-5 ) { foreach my $line ( max( $rect->top, 4 ) .. min( $self->lines-5, $rect->bottom-1 ) ) { $rb->erase_at( $line, $self->cols - 5, 5 ); } } } ); $loop->add( IO::Async::Timer::Periodic->new( interval => 0.5, on_tick => sub { $colour_offset++; $colour_offset %= 6; $win->expose; } )->start ); my $popup_win; $rootwin->bind_event( mouse => sub { my ( $self, undef, $info ) = @_; return unless $info->type eq "press"; if( $info->button == 3 ) { $popup_win->hide if $popup_win; $popup_win = $rootwin->make_float( $info->line, $info->col, 3, 21 ); $popup_win->pen->chattr( bg => 4 ); $popup_win->bind_event( expose => sub { my ( $self, undef, $info ) = @_; my $rb = $info->rb; $rb->text_at( 0, 0, "+-------------------+" ); $rb->text_at( 1, 0, "| Popup Window Here |" ); $rb->text_at( 2, 0, "+-------------------+" ); } ); $popup_win->show; } else { $popup_win->hide if $popup_win; undef $popup_win; } }); $rootwin->expose; $tickit->run; Tickit-0.73/examples/demo-input.pl000444001750001750 223614302155253 16007 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Widget::Static; use Tickit::Widget::VBox; use Tickit::Widget::HBox; my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); my $keydisplay; $vbox->add( Tickit::Widget::Static->new( text => "Key:" ) ); $vbox->add( $keydisplay = Tickit::Widget::Static->new( text => "" ) ); my $mousedisplay; $vbox->add( Tickit::Widget::Static->new( text => "Mouse:" ) ); $vbox->add( $mousedisplay = Tickit::Widget::Static->new( text => "" ) ); my $tickit = Tickit->new(); sub _modstr { my ( $mod ) = @_; return join "-", ( $mod & 2 ? "A" : () ), ( $mod & 4 ? "C" : () ), ( $mod & 1 ? "S" : () ); } # Mass hackery $tickit->term->bind_event( key => sub { my ( undef, $ev, $info ) = @_; $keydisplay->set_text( sprintf "%s %s (mod=%s)", $info->type, $info->str, _modstr( $info->mod ) ); return 1; } ); $tickit->term->bind_event( mouse => sub { my ( undef, $ev, $info ) = @_; $mousedisplay->set_text( sprintf "%s button %s at (%d,%d) (mod=%s)", $info->type, $info->button, $info->line, $info->col, _modstr( $info->mod ) ); return 1; } ); $tickit->set_root_widget( $vbox ); $tickit->run; Tickit-0.73/examples/demo-lines.pl000444001750001750 660014302155253 15761 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; Tickit->new( root => RenderBufferDemo->new )->run; package RenderBufferDemo; use base qw( Tickit::Widget ); use Tickit::RenderBuffer qw( LINE_SINGLE LINE_DOUBLE LINE_THICK CAP_START CAP_END CAP_BOTH ); sub lines { 1 } sub cols { 1 } sub grid_at { my ( $rb, $line, $col, $style, $pen ) = @_; # A 2x2 grid of cells $rb->hline_at( $line + 0, $col, $col + 12, $style, $pen ); $rb->hline_at( $line + 3, $col, $col + 12, $style, $pen ); $rb->hline_at( $line + 6, $col, $col + 12, $style, $pen ); $rb->vline_at( $line + 0, $line + 6, $col + 0, $style, $pen ); $rb->vline_at( $line + 0, $line + 6, $col + 6, $style, $pen ); $rb->vline_at( $line + 0, $line + 6, $col + 12, $style, $pen ); } sub corner_at { my ( $rb, $line, $col, $style_horiz, $style_vert, $pen ) = @_; $rb->hline_at( $line, $col, $col + 2, $style_horiz, $pen, CAP_END ); $rb->vline_at( $line, $line + 1, $col, $style_vert, $pen, CAP_END ); } sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; $rb->text_at( 1, 2, "Single", $self->pen ); grid_at( $rb, 2, 2, LINE_SINGLE, Tickit::Pen->new( fg => "red" ) ); $rb->text_at( 1, 22, "Double", $self->pen ); grid_at( $rb, 2, 22, LINE_DOUBLE, Tickit::Pen->new( fg => "green" ) ); $rb->text_at( 1, 42, "Thick", $self->pen ); grid_at( $rb, 2, 42, LINE_THICK, Tickit::Pen->new( fg => "blue" ) ); my $pen; # Possible line interactions: crosses $pen = Tickit::Pen->new( fg => "cyan" ); $rb->text_at( 10, 2, "Crossings", $self->pen ); $rb->hline_at( 12, 4, 14, LINE_SINGLE, $pen, CAP_BOTH ); $rb->hline_at( 15, 4, 14, LINE_DOUBLE, $pen, CAP_BOTH ); $rb->hline_at( 18, 4, 14, LINE_THICK, $pen, CAP_BOTH ); $rb->vline_at( 12, 18, 5, LINE_SINGLE, $pen, CAP_BOTH ); $rb->vline_at( 12, 18, 9, LINE_DOUBLE, $pen, CAP_BOTH ); $rb->vline_at( 12, 18, 13, LINE_THICK, $pen, CAP_BOTH ); # T-junctions $pen = Tickit::Pen->new( fg => "magenta" ); $rb->text_at( 10, 24, "T junctions", $self->pen ); $rb->hline_at( 11, 25, 35, LINE_SINGLE, $pen, CAP_BOTH ); $rb->hline_at( 14, 25, 35, LINE_DOUBLE, $pen, CAP_BOTH ); $rb->hline_at( 17, 25, 35, LINE_THICK, $pen, CAP_BOTH ); $rb->vline_at( 11, 12, 26, LINE_SINGLE, $pen, CAP_END ); $rb->vline_at( 11, 12, 30, LINE_DOUBLE, $pen, CAP_END ); $rb->vline_at( 11, 12, 34, LINE_THICK, $pen, CAP_END ); $rb->vline_at( 14, 15, 26, LINE_SINGLE, $pen, CAP_END ); $rb->vline_at( 14, 15, 30, LINE_DOUBLE, $pen, CAP_END ); $rb->vline_at( 14, 15, 34, LINE_THICK, $pen, CAP_END ); $rb->vline_at( 17, 18, 26, LINE_SINGLE, $pen, CAP_END ); $rb->vline_at( 17, 18, 30, LINE_DOUBLE, $pen, CAP_END ); $rb->vline_at( 17, 18, 34, LINE_THICK, $pen, CAP_END ); # Corners $pen = Tickit::Pen->new( fg => "yellow" ); $rb->text_at( 10, 42, "Corners", $self->pen ); corner_at( $rb, 11, 44, LINE_SINGLE, LINE_SINGLE, $pen ); corner_at( $rb, 11, 50, LINE_SINGLE, LINE_DOUBLE, $pen ); corner_at( $rb, 11, 56, LINE_SINGLE, LINE_THICK, $pen ); corner_at( $rb, 14, 44, LINE_DOUBLE, LINE_SINGLE, $pen ); corner_at( $rb, 14, 50, LINE_DOUBLE, LINE_DOUBLE, $pen ); corner_at( $rb, 14, 56, LINE_DOUBLE, LINE_THICK, $pen ); corner_at( $rb, 17, 44, LINE_THICK, LINE_SINGLE, $pen ); corner_at( $rb, 17, 50, LINE_THICK, LINE_DOUBLE, $pen ); corner_at( $rb, 17, 56, LINE_THICK, LINE_THICK, $pen ); } Tickit-0.73/examples/demo-pen.pl000444001750001750 307314302155253 15432 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Widget::Static; use Tickit::Widget::VBox; use Tickit::Widget::HBox; my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); my $hbox; $vbox->add( $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ); for (qw( red blue green yellow )) { $hbox->add( Tickit::Widget::Static->new( text => "fg $_ ", fg => $_ ) ); } $vbox->add( $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ); for (qw( red blue green yellow )) { $hbox->add( Tickit::Widget::Static->new( text => "fg hi-$_", fg => "hi-$_" ) ); } $vbox->add( $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ); for (qw( red blue green yellow )) { $hbox->add( Tickit::Widget::Static->new( text => "bg $_ ", bg => $_, fg => "black" ) ); } $vbox->add( $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ); for (qw( red blue green yellow )) { $hbox->add( Tickit::Widget::Static->new( text => "bg hi-$_", bg => "hi-$_", fg => "black" ) ); } $vbox->add( Tickit::Widget::Static->new( text => "bold", b => 1 ) ); $vbox->add( Tickit::Widget::Static->new( text => "underline", u => 1 ) ); $vbox->add( Tickit::Widget::Static->new( text => "italic", i => 1 ) ); $vbox->add( Tickit::Widget::Static->new( text => "strikethrough", strike => 1 ) ); $vbox->add( Tickit::Widget::Static->new( text => "reverse video", rv => 1 ) ); $vbox->add( Tickit::Widget::Static->new( text => "blink", blink => 1 ) ); $vbox->add( Tickit::Widget::Static->new( text => "alternate font", af => 1 ) ); my $t = Tickit->new( root => $vbox ); $t->bind_key( q => sub { $t->stop } ); $t->run; Tickit-0.73/examples/demo-showkey.pl000444001750001750 116314302155253 16337 0ustar00leoleo000000000000#!/usr/bin/perl package ShowKeyWidget; use base 'Tickit::Widget'; use v5.14; use warnings; use Tickit; my $text; sub lines { 1 } sub cols { 10 } sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; my $win = $self->window; $rb->goto( ( $win->lines - $self->lines ) / 2, ( $win->cols - $self->cols ) / 2 ); $rb->text( $text ) if defined $text; $rb->erase_to( $win->cols ); $win->cursor_at( 0, 0 ); } sub on_key { my $self = shift; my ( $args ) = @_; $text = join ": ", $args->type, $args->str; $self->redraw; return 0; } Tickit->new( root => ShowKeyWidget->new )->run; Tickit-0.73/examples/demo-timer.pl000444001750001750 61614302155253 15750 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Widget::Static; my $static = Tickit::Widget::Static->new( text => "temporary", align => 0.5, valign => 0.5, ); my $tickit = Tickit->new( root => $static ); my $counter = 0; sub timer { $static->set_text( "Counter: $counter" ); $counter++; $tickit->watch_timer_after( 1, \&timer ); } timer(); $tickit->run; Tickit-0.73/examples/demo-xterm256.pl000444001750001750 223514302155253 16243 0ustar00leoleo000000000000#!/usr/bin/perl use v5.14; use warnings; use Tickit; use Tickit::Widget::Static; use Tickit::Widget::VBox; use Tickit::Widget::HBox; my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); my $hbox; $vbox->add( Tickit::Widget::Static->new( text => "ANSI" ) ); $vbox->add( $hbox = Tickit::Widget::HBox->new ); foreach my $col ( 0 .. 15 ) { $hbox->add( Tickit::Widget::Static->new( text => sprintf( "[%02d]", $col ), bg => $col, ) ); } $vbox->add( Tickit::Widget::Static->new( text => "216 RGB cube" ) ); $vbox->add( my $vbox256 = Tickit::Widget::VBox->new ); foreach my $y ( 0 .. 5 ) { $vbox256->add( $hbox = Tickit::Widget::HBox->new ); foreach my $x ( 0 .. 35 ) { my $col = $y * 36 + $x + 16; $hbox->add( Tickit::Widget::Static->new( text => " ", bg => $col, ) ); } } $vbox->add( Tickit::Widget::Static->new( text => "24 Greyscale ramp" ) ); $vbox->add( $hbox = Tickit::Widget::HBox->new ); foreach my $g ( 0 .. 23 ) { $hbox->add( Tickit::Widget::Static->new( text => sprintf( "g%02d", $g ), bg => $g + 232, fg => ( $g > 12 ) ? 0 : 7, ) ); } Tickit->new( root => $vbox )->run; Tickit-0.73/lib000755001750001750 014302155253 12161 5ustar00leoleo000000000000Tickit-0.73/lib/Tickit.pm000444001750001750 3126114302155253 14126 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2009-2022 -- leonerd@leonerd.org.uk package Tickit 0.73; use v5.14; use warnings; use Carp; use IO::Handle; use Scalar::Util qw( weaken ); use Time::HiRes qw( time ); BEGIN { require XSLoader; XSLoader::load( __PACKAGE__, our $VERSION ); } # We export some constants use Exporter 'import'; use Tickit::Event; use Tickit::Term; use Tickit::Window; =head1 NAME C - Terminal Interface Construction KIT =head1 SYNOPSIS use Tickit; use Tickit::Widget::Box; use Tickit::Widget::Static; my $box = Tickit::Widget::Box->new( h_border => 4, v_border => 2, bg => "green", child => Tickit::Widget::Static->new( text => "Hello, world!", bg => "black", align => "centre", valign => "middle", ), ); Tickit->new( root => $box )->run; =head1 DESCRIPTION C is a high-level toolkit for creating full-screen terminal-based interactive programs. It allows programs to be written in an abstracted way, working with a tree of widget objects, to represent the layout of the interface and implement its behaviours. Its supported terminal features includes a rich set of rendering attributes (bold, underline, italic, 256-colours, etc), support for mouse including wheel and position events above the 224th column and arbitrary modified key input via F (all of these will require a supporting terminal as well). It also supports having multiple instances and non-blocking or asynchronous control. =cut =head1 CONSTRUCTOR =cut =head2 new $tickit = Tickit->new( %args ) Constructs a new C framework container object. Takes the following named arguments at construction time: =over 8 =item term_in => IO IO handle for terminal input. Will default to C. =item term_out => IO IO handle for terminal output. Will default to C. =item UTF8 => BOOL If defined, overrides locale detection to enable or disable UTF-8 mode. If not defined then this will be detected from the locale by using Perl's C<${^UTF8LOCALE}> variable. =item root => Tickit::Widget If defined, sets the root widget using C to the one specified. =item use_altscreen => BOOL If defined but false, disables the use of altscreen, even if supported by the terminal. This will mean that the screen contents are stll available after the program has finished. =back =cut sub new { my $class = shift; my %args = @_; my $root = delete $args{root}; my $term = delete $args{term}; my $self = bless { use_altscreen => $args{use_altscreen} // 1, }, $class; if( $args{term_in} or $args{term_out} ) { my $in = delete $args{term_in} || \*STDIN; my $out = delete $args{term_out} || \*STDOUT; my $writer = $self->_make_writer( $out ); require Tickit::Term; $term = Tickit::Term->new( writer => $writer, input_handle => $in, output_handle => $out, UTF8 => delete $args{UTF8}, ); } $self->{term} = $term; $self->set_root_widget( $root ) if $root; return $self; } =head1 METHODS =cut sub _make_writer { my $self = shift; my ( $out ) = @_; $out->autoflush( 1 ); return $out; } sub _tickit { my $self = shift; return $self->{_tickit} //= do { my $tickit = $self->_make_tickit( $self->{term} ); $tickit->setctl( 'use-altscreen' => $self->{use_altscreen} ); $tickit; }; } sub _make_tickit { my $self = shift; return Tickit::_Tickit->new( @_ ); } =head2 watch_io $id = $tickit->watch_io( $fh, $cond, $code ) I Runs the given CODE reference at some point in the future, when IO operations are possible on the given filehandle. C<$cond> should be a bitmask of at least one of the C, C or C constants describing which kinds of IO operation the callback is interested in. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. When invoked, the callback will receive an event parameter which will be an instances of a type with a field called C. This will contain the kinds of IO operation that are currently possible. $code->( $info ) $current_cond = $info->cond; For example, to watch for both input and hangup conditions and respond to each individually: $tickit->watch_io( $fh, Tickit::IO_IN|Tickit::IO_HUP, sub { my ( $info ) = @_; if( $info->cond & Tickit::IO_IN ) { ... } if( $info->cond & Tickit::IO_HUP ) { ... } } ); =cut sub watch_io { my $self = shift; my ( $fh, $cond, $code ) = @_; return $self->_tickit->watch_io( $fh->fileno, $cond, $code ); } =head2 watch_later $id = $tickit->watch_later( $code ) I Runs the given CODE reference at some time soon in the future. It will not be invoked yet, but will be invoked at some point before the next round of input events are processed. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. =head2 later $tickit->later( $code ) For back-compatibility this method is a synonym for L. =cut sub watch_later { my $self = shift; my ( $code ) = @_; return $self->_tickit->watch_later( $code ) } sub later { shift->watch_later( @_ ); return } =head2 watch_timer_at $id = $tickit->watch_timer_at( $epoch, $code ) I Runs the given CODE reference at the given absolute time expressed as an epoch number. Fractions are supported to a resolution of microseconds. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. =cut sub watch_timer_at { my $self = shift; my ( $epoch, $code ) = @_; return $self->_tickit->watch_timer_at( $epoch, $code ); } =head2 watch_timer_after $id = $tickit->watch_timer_after( $delay, $code ) I Runs the given CODE reference at the given relative time expressed as a number of seconds hence. Fractions are supported to a resolution of microseconds. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. =cut sub watch_timer_after { my $self = shift; my ( $delay, $code ) = @_; return $self->_tickit->watch_timer_after( $delay, $code ); } =head2 timer $id = $tickit->timer( at => $epoch, $code ) $id = $tickit->timer( after => $delay, $code ) For back-compatibility this method is a wrapper for either L or L depending on the first argument. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. =cut sub timer { my $self = shift; my ( $mode, $amount, $code ) = @_; return $self->watch_timer_at ( $amount, $code ) if $mode eq "at"; return $self->watch_timer_after( $amount, $code ) if $mode eq "after"; croak "Mode should be 'at' or 'after'"; } =head2 watch_signal $id = $tickit->watch_signal( $signum, $code ) I Runs the given CODE reference whenever the given POSIX signal is received. Signals are given by number, not name. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. =cut sub watch_signal { my $self = shift; my ( $signum, $code ) = @_; return $self->_tickit->watch_signal( $signum, $code ); } =head2 watch_process $id = $tickit->watch_process( $pid, $code ) I Runs the given CODE reference when the given child process terminates. Returns an opaque integer value that may be passed to L. This value is safe to ignore if not required. When invoked, the callback will receive an event parameter which will be an instance of a type with a field called C. This will contain the exit status of the terminated child process. $code->( $info ) $pid = $info->pid; $status = $info->wstatus; =cut sub watch_process { my $self = shift; my ( $pid, $code ) = @_; return $self->_tickit->watch_process( $pid, $code ); } =head2 watch_cancel $tickit->watch_cancel( $id ) I Removes an idle or timer watch previously installed by one of the other C methods. After doing so the code will no longer be invoked. =head2 cancel_timer $tickit->cancel_timer( $id ) For back-compatibility this method is a synonym for L. =cut sub watch_cancel { my $self = shift; my ( $id ) = @_; $self->_tickit->watch_cancel( $id ); } sub cancel_timer { shift->watch_cancel( @_ ) } =head2 term $term = $tickit->term Returns the underlying L object. =cut sub term { shift->_tickit->term } =head2 cols =head2 lines $cols = $tickit->cols $lines = $tickit->lines Query the current size of the terminal. Will be cached and updated on receipt of C signals. =cut sub lines { shift->term->lines } sub cols { shift->term->cols } =head2 bind_key $tickit->bind_key( $key, $code ) Installs a callback to invoke if the given key is pressed, overwriting any previous callback for the same key. The code block is invoked as $code->( $tickit, $key ) If C<$code> is missing or C, any existing callback is removed. As a convenience for the common application use case, the C key is bound to the C method. To remove this binding, simply bind another callback, or remove the binding entirely by setting C. =cut sub bind_key { my $self = shift; my ( $key, $code ) = @_; my $keybinds = $self->{key_binds} //= {}; if( $code ) { if( !%$keybinds ) { weaken( my $weakself = $self ); # Need to ensure a root window exists before this so it gets its # key bind event first $self->rootwin; $self->{key_bind_id} = $self->term->bind_event( key => sub { my $self = $weakself or return; my ( $term, $ev, $info ) = @_; my $str = $info->str; if( my $code = $self->{key_binds}{$str} ) { $code->( $self, $str ); } return 0; } ); } $keybinds->{$key} = $code; } else { delete $keybinds->{$key}; if( !%$keybinds ) { $self->term->unbind_event_id( $self->{key_bind_id} ); undef $self->{key_bind_id}; } } } =head2 rootwin $tickit->rootwin Returns the root L. =cut # root window needs to know where the toplevel "tickit" instance is sub rootwin { $_[0]->_tickit->rootwin( $_[0] ) } =head2 set_root_widget $tickit->set_root_widget( $widget ) Sets the root widget for the application's display. This must be a subclass of L. =cut sub set_root_widget { my $self = shift; ( $self->{root_widget} ) = @_; } =head2 tick $tickit->tick( $flags ) Run a single round of IO events. Does not call C or C. C<$flags> may optionally be a bitmask of the following exported constants: =over 4 =item RUN_NOHANG Does not block waiting for IO; simply process whatever is available then return immediately. =item RUN_NOSETUP Do not perform initial terminal setup before waiting on IO events. =back =cut sub tick { my $self = shift; # TODO: Consider root widget $self->_tickit->tick( @_ ); } =head2 run $tickit->run Calls the C method, then processes IO events until stopped, by the C method, C, C or the C key. Then runs the C method, and returns. =cut sub run { my $self = shift; if( my $widget = $self->{root_widget} ) { $widget->set_window( $self->rootwin ); } my $term = $self->_tickit->term; my $err = (defined eval { $self->_tickit->run; 1; }) ? undef : $@; if( my $widget = $self->{root_widget} ) { $widget->set_window( undef ); } if( defined $err ) { # Teardown before application exit so the message appears properly $term->teardown; die $err; } } =head2 stop $tickit->stop Causes a currently-running C method to stop processing events and return. =cut sub stop { shift->_tickit->stop( @_ ) } =head1 MISCELLANEOUS FUNCTIONS =head2 version_major =head2 version_minor =head2 version_patch $major = Tickit::version_major() $minor = Tickit::version_minor() $patch = Tickit::version_patch() These non-exported functions query the version of the F library that the module is linked to. =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit.xs000444001750001750 26576614302155253 14207 0ustar00leoleo000000000000/* You may distribute under the terms of either the GNU General Public License * or the Artistic License (the same terms as Perl itself) * * (C) Paul Evans, 2011-2021 -- leonerd@leonerd.org.uk */ #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include #include #define streq(a,b) (strcmp(a,b)==0) // UVs also have the IOK flag set #define SvIsNumeric(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK)) // back-compat for 5.10.0 since it's easy #ifndef mPUSHs # define mPUSHs(sv) PUSHs(sv_2mortal(sv)) #endif #ifndef newSVivpv # define newSVivpv(i,p) S_newSVivpv(aTHX_ i, p) static SV *S_newSVivpv(pTHX_ int iv, const char *pv) { SV *sv = newSViv(iv); if(pv) { sv_setpv(sv, pv); SvIOK_on(sv); } return sv; } #endif #ifndef mPUSHpvs # define mPUSHpvs(s) mPUSHp("" s "", sizeof(s)-1) #endif // A handy helper for setting PL_curcop #define SET_PL_curcop \ do { \ static COP *cop; \ if(!cop) { \ SAVEVPTR(PL_parser); \ Newxz(PL_parser, 1, yy_parser); \ SAVEFREEPV(PL_parser); \ \ cop = (COP *)newSTATEOP(0, NULL, NULL); \ CopFILE_set(cop, __FILE__); \ CopLINE_set(cop, __LINE__); \ } \ PL_curcop = cop; \ } while(0) #define cv_from_sv(sv, name) S_cv_from_sv(aTHX_ sv, name) static CV *S_cv_from_sv(pTHX_ SV *sv, const char *name) { HV *hv; GV *gvp; SvGETMAGIC(sv); CV *cv = sv_2cv(sv, &hv, &gvp, 0); if(!cv) croak("Expected CODE reference for %s", name); return cv; } #define tickit_focusevtype2sv(type) S_tickit_focusevtype2sv(aTHX_ type) static SV *S_tickit_focusevtype2sv(pTHX_ TickitFocusEventType type) { const char *name = NULL; switch(type) { case TICKIT_FOCUSEV_IN: name = "in"; break; case TICKIT_FOCUSEV_OUT: name = "out"; break; } return newSVivpv(type, name); } #define tickit_name2focusev(name) S_tickit_name2focusev(aTHX_ name) static TickitFocusEventType S_tickit_name2focusev(pTHX_ const char *name) { switch(name[0]) { case 'i': return streq(name+1, "n") ? TICKIT_FOCUSEV_IN : -1; case 'o': return streq(name+1, "ut") ? TICKIT_FOCUSEV_OUT : -1; } return -1; } #define tickit_keyevtype2sv(type) S_tickit_keyevtype2sv(aTHX_ type) static SV *S_tickit_keyevtype2sv(pTHX_ int type) { const char *name = NULL; switch(type) { case TICKIT_KEYEV_KEY: name = "key"; break; case TICKIT_KEYEV_TEXT: name = "text"; break; } return newSVivpv(type, name); } #define tickit_name2keyev(name) S_tickit_name2keyev(aTHX_ name) static TickitKeyEventType S_tickit_name2keyev(pTHX_ const char *name) { switch(name[0]) { case 'k': return streq(name+1, "ey") ? TICKIT_KEYEV_KEY : -1; case 't': return streq(name+1, "ext") ? TICKIT_KEYEV_TEXT : -1; } return -1; } #define tickit_mouseevtype2sv(type) S_tickit_mouseevtype2sv(aTHX_ type) static SV *S_tickit_mouseevtype2sv(pTHX_ int type) { const char *name = NULL; switch(type) { case TICKIT_MOUSEEV_PRESS: name = "press"; break; case TICKIT_MOUSEEV_DRAG: name = "drag"; break; case TICKIT_MOUSEEV_RELEASE: name = "release"; break; case TICKIT_MOUSEEV_WHEEL: name = "wheel"; break; case TICKIT_MOUSEEV_DRAG_START: name = "drag_start"; break; case TICKIT_MOUSEEV_DRAG_DROP: name = "drag_drop"; break; case TICKIT_MOUSEEV_DRAG_STOP: name = "drag_stop"; break; case TICKIT_MOUSEEV_DRAG_OUTSIDE: name = "drag_outside"; break; } return newSVivpv(type, name); } #define tickit_name2mouseev(name) S_tickit_name2mouseev(aTHX_ name) static TickitMouseEventType S_tickit_name2mouseev(pTHX_ const char *name) { switch(name[0]) { case 'd': return streq(name+1, "rag") ? TICKIT_MOUSEEV_DRAG : streq(name+1, "rag_start") ? TICKIT_MOUSEEV_DRAG_START : streq(name+1, "rag_drop") ? TICKIT_MOUSEEV_DRAG_DROP : streq(name+1, "rag_stop") ? TICKIT_MOUSEEV_DRAG_STOP : streq(name+1, "rag_outside") ? TICKIT_MOUSEEV_DRAG_OUTSIDE : -1; case 'p': return streq(name+1, "ress") ? TICKIT_MOUSEEV_PRESS : -1; case 'r': return streq(name+1, "elease") ? TICKIT_MOUSEEV_RELEASE : -1; case 'w': return streq(name+1, "heel") ? TICKIT_MOUSEEV_WHEEL : -1; } return -1; } #define tickit_mouseevbutton2sv(type, button) S_tickit_mouseevbutton2sv(aTHX_ type, button) static SV *S_tickit_mouseevbutton2sv(pTHX_ int type, int button) { const char *name = NULL; if(type == TICKIT_MOUSEEV_WHEEL) switch(button) { case TICKIT_MOUSEWHEEL_UP: name = "up"; break; case TICKIT_MOUSEWHEEL_DOWN: name = "down"; break; } return newSVivpv(button, name); } #define tickit_name2mousewheel(name) S_tickit_name2mousewheel(aTHX_ name) static int S_tickit_name2mousewheel(pTHX_ const char *name) { switch(name[0]) { case 'd': return streq(name+1, "own") ? TICKIT_MOUSEWHEEL_DOWN : -1; case 'u': return streq(name+1, "p") ? TICKIT_MOUSEWHEEL_UP : -1; } return -1; } struct GenericEventData { #ifdef tTHX tTHX myperl; #endif int ev; SV *self; // only for window bindings; unused for term CV *code; SV *data; }; #define new_eventdata(ev, data, code) S_new_eventdata(aTHX_ ev, data, code) #define new_eventdata_codeonly(code) S_new_eventdata(aTHX_ 0, NULL, code) static struct GenericEventData *S_new_eventdata(pTHX_ int ev, SV *data, CV *code) { struct GenericEventData *ret; Newx(ret, 1, struct GenericEventData); #ifdef tTHX ret->myperl = aTHX; #endif ret->ev = ev; ret->data = data; ret->code = code ? (CV *)SvREFCNT_inc(code) : NULL; return ret; } typedef TickitKeyEventInfo *Tickit__Event__Key; typedef TickitMouseEventInfo *Tickit__Event__Mouse; /*************** * Tickit::Pen * ***************/ typedef TickitPen *Tickit__Pen; #define newSVpen_noinc(pen, package) S_newSVpen_noinc(aTHX_ pen, package) static SV *S_newSVpen_noinc(pTHX_ TickitPen *pen, char *package) { SV *sv = newSV(0); sv_setref_pv(sv, package ? package : "Tickit::Pen::Immutable", pen); return sv; } #define newSVpen(pen, package) S_newSVpen_noinc(aTHX_ tickit_pen_ref(pen), package) enum { TICKIT_PEN_FG_RGB8 = 0x100 | TICKIT_PEN_FG, TICKIT_PEN_BG_RGB8 = 0x100 | TICKIT_PEN_BG, }; static int pen_parse_attrname(const char *name) { const char *end = strchr(name, ':'); TickitPenAttr ret; if(!end) return tickit_penattr_lookup(name); if(!strEQ(end+1, "rgb8")) return -1; name = strndup(name, end - name); ret = tickit_penattr_lookup(name); free((void *)name); switch(ret) { case TICKIT_PEN_FG: return TICKIT_PEN_FG_RGB8; case TICKIT_PEN_BG: return TICKIT_PEN_BG_RGB8; default: return -1; } } #define pen_get_attr(pen, attr) S_pen_get_attr(aTHX_ pen, attr) static SV *S_pen_get_attr(pTHX_ TickitPen *pen, int attr) { switch(attr) { case TICKIT_PEN_FG_RGB8: case TICKIT_PEN_BG_RGB8: { TickitPenRGB8 val; val = tickit_pen_get_colour_attr_rgb8(pen, attr & 0xFF); return newSVpvf("#%02X%02X%02X", val.r, val.g, val.b); } } switch(tickit_penattr_type(attr)) { case TICKIT_PENTYPE_BOOL: return tickit_pen_get_bool_attr(pen, attr) ? &PL_sv_yes : &PL_sv_no; case TICKIT_PENTYPE_INT: return newSViv(tickit_pen_get_int_attr(pen, attr)); case TICKIT_PENTYPE_COLOUR: return newSViv(tickit_pen_get_colour_attr(pen, attr)); } croak("Unreachable: unknown pen type"); } #define pen_set_attr(pen, attr, val) S_pen_set_attr(aTHX_ pen, attr, val) static void S_pen_set_attr(pTHX_ TickitPen *pen, int attr, SV *val) { switch(attr) { case TICKIT_PEN_FG_RGB8: case TICKIT_PEN_BG_RGB8: { TickitPenRGB8 v; if(sscanf(SvPV_nolen(val), "#%02hhx%02hhx%02hhx", &v.r, &v.g, &v.b) < 3) return; tickit_pen_set_colour_attr_rgb8(pen, attr & 0xFF, v); return; } } switch(tickit_penattr_type(attr)) { case TICKIT_PENTYPE_INT: tickit_pen_set_int_attr(pen, attr, SvOK(val) ? SvIV(val) : -1); break; case TICKIT_PENTYPE_BOOL: tickit_pen_set_bool_attr(pen, attr, SvOK(val) ? SvIV(val) : 0); break; case TICKIT_PENTYPE_COLOUR: if(!SvPOK(val) && SvIsNumeric(val)) tickit_pen_set_colour_attr(pen, attr, SvIV(val)); else if(SvPOK(val)) tickit_pen_set_colour_attr_desc(pen, attr, SvPV_nolen(val)); else tickit_pen_set_colour_attr(pen, attr, -1); break; } } #define pen_from_args(args, argcount) S_pen_from_args(aTHX_ args, argcount) static TickitPen *S_pen_from_args(pTHX_ SV **args, int argcount) { int i; TickitPen *pen = tickit_pen_new(); for(i = 0; i < argcount; i += 2) { const char *name = SvPV_nolen(args[i]); SV *value = args[i+1]; TickitPenAttr attr = tickit_penattr_lookup(name); if(attr != -1) pen_set_attr(pen, attr, value); } return pen; } #define pen_set_attrs(pen, attrs) S_pen_set_attrs(aTHX_ pen, attrs) static void S_pen_set_attrs(pTHX_ TickitPen *pen, HV *attrs) { TickitPenAttr a; SV *val; for(a = 1; a < TICKIT_N_PEN_ATTRS; a++) { const char *name = tickit_penattr_name(a); val = hv_delete(attrs, name, strlen(name), 0); if(!val) continue; if(!SvOK(val)) tickit_pen_clear_attr(pen, a); else pen_set_attr(pen, a, val); } if((val = hv_delete(attrs, "fg:rgb8", 7, 0))) { if(SvOK(val)) { pen_set_attr(pen, TICKIT_PEN_FG_RGB8, val); } else tickit_pen_set_colour_attr(pen, TICKIT_PEN_FG, tickit_pen_get_colour_attr(pen, TICKIT_PEN_FG)); } if((val = hv_delete(attrs, "bg:rgb8", 7, 0))) { if(SvOK(val)) { pen_set_attr(pen, TICKIT_PEN_BG_RGB8, val); } else tickit_pen_set_colour_attr(pen, TICKIT_PEN_BG, tickit_pen_get_colour_attr(pen, TICKIT_PEN_BG)); } } /**************** * Tickit::Rect * ****************/ typedef TickitRect *Tickit__Rect, *Tickit__Rect_MAYBE; /* Really cheating and treading on Perl's namespace but hopefully it will be OK */ #define newSVrect(rect) S_newSVrect(aTHX_ rect) static SV *S_newSVrect(pTHX_ TickitRect *rect) { TickitRect *self; Newx(self, 1, TickitRect); *self = *rect; return sv_setref_pv(newSV(0), "Tickit::Rect", self); } #define mPUSHrect(rect) PUSHs(sv_2mortal(newSVrect(rect))) /******************* * Tickit::RectSet * *******************/ typedef TickitRectSet *Tickit__RectSet; /************************ * Tickit::RenderBuffer * ************************/ typedef TickitRenderBuffer *Tickit__RenderBuffer; #define newSVrb_noinc(rb) S_newSVrb_noinc(aTHX_ rb) static SV *S_newSVrb_noinc(pTHX_ TickitRenderBuffer *rb) { SV *sv = newSV(0); sv_setref_pv(sv, "Tickit::RenderBuffer", rb); return sv; } #define newSVrb(rb) S_newSVrb_noinc(aTHX_ tickit_renderbuffer_ref(rb)) /**************** * Tickit::Term * ****************/ typedef TickitTerm *Tickit__Term, *Tickit__Term_MAYBE; #define newSVterm_noinc(tt, package) S_newSVterm_noinc(aTHX_ tt, package) static SV *S_newSVterm_noinc(pTHX_ TickitTerm *tt, char *package) { SV *sv = newSV(0); sv_setref_pv(sv, package, tt); return sv; } #define newSVterm(tt, package) S_newSVterm_noinc(aTHX_ tickit_term_ref(tt), package) static int term_userevent_fn(TickitTerm *tt, TickitEventFlags flags, void *_info, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); SET_PL_curcop; int ret = 0; if(flags & TICKIT_EV_FIRE) { SV *info_sv = newSV(0); char *evname = NULL; switch((TickitTermEvent)data->ev) { case TICKIT_TERM_ON_DESTROY: croak("TICKIT_TERM_ON_DESTROY should not be TICKIT_EV_FIRE'd"); break; case TICKIT_TERM_ON_KEY: { TickitKeyEventInfo *info = _info, *self; Newx(self, 1, TickitKeyEventInfo); *self = *info; self->str = savepv(info->str); evname = "key"; sv_setref_pv(info_sv, "Tickit::Event::Key", self); break; } case TICKIT_TERM_ON_MOUSE: { TickitMouseEventInfo *info = _info, *self; Newx(self, 1, TickitMouseEventInfo); *self = *info; evname = "mouse"; sv_setref_pv(info_sv, "Tickit::Event::Mouse", self); break; } case TICKIT_TERM_ON_RESIZE: { TickitResizeEventInfo *info = _info, *self; Newx(self, 1, TickitResizeEventInfo); *self = *info; evname = "resize"; sv_setref_pv(info_sv, "Tickit::Event::Resize", self); break; } } dSP; ENTER; SAVETMPS; PUSHMARK(SP); EXTEND(SP, 4); mPUSHs(newSVterm(tt, "Tickit::Term")); mPUSHs(newSVivpv(data->ev, evname)); mPUSHs(info_sv); mPUSHs(newSVsv(data->data)); PUTBACK; call_sv((SV*)(data->code), G_SCALAR); CopLINE_set(PL_curcop, __LINE__); SPAGAIN; ret = POPi; PUTBACK; FREETMPS; LEAVE; } if(flags & TICKIT_EV_UNBIND) { SvREFCNT_dec(data->code); SvREFCNT_dec(data->data); Safefree(data); ret = 1; } return ret; } static void term_outputwriter_fn(TickitTerm *tt, const char *bytes, size_t len, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); if(!len) { SvREFCNT_dec(data->data); Safefree(data); return; } dSP; ENTER; SAVETMPS; PUSHMARK(SP); EXTEND(SP, 2); PUSHs(data->data); mPUSHp(bytes, len); PUTBACK; call_method("write", G_VOID); FREETMPS; LEAVE; } /********************* * Tickit::StringPos * *********************/ typedef TickitStringPos *Tickit__StringPos; #define new_stringpos(svp) S_new_stringpos(aTHX_ svp) static Tickit__StringPos S_new_stringpos(pTHX_ SV **svp) { TickitStringPos *pos; Newx(pos, 1, TickitStringPos); *svp = newSV(0); sv_setref_pv(*svp, "Tickit::StringPos", pos); return pos; } /****************** * Tickit::Window * ******************/ typedef struct Tickit__Window { TickitWindow *win; SV *tickit; } *Tickit__Window; /* * We want to wrap every TickitWindow* instance in theabove structure. But we * can't necessarily always do that at construction time, because we don't * necessarily construct all windows. Plus how would we find the structure * wrapping related windows - t_w_root(), _parent(), etc... */ static HV *sv_for_window; static int window_destroyed(TickitWindow *win, TickitEventFlags flags, void *info, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); SV *key = newSViv(PTR2UV(win)); hv_delete_ent(sv_for_window, key, G_DISCARD, 0); SvREFCNT_dec(key); Safefree(data); return 0; } #define newSVwin_noinc(win) S_newSVwin_noinc(aTHX_ win) static SV *S_newSVwin_noinc(pTHX_ TickitWindow *win) { if(!sv_for_window) sv_for_window = newHV(); SV *key = newSViv(PTR2UV(win)); HE *he = hv_fetch_ent(sv_for_window, key, 1, 0); SvREFCNT_dec(key); if(SvOK(HeVAL(he))) return newSVsv(HeVAL(he)); struct Tickit__Window *self; Newx(self, 1, struct Tickit__Window); sv_setref_pv(HeVAL(he), "Tickit::Window", self); self->win = win; self->tickit = NULL; tickit_window_bind_event(win, TICKIT_WINDOW_ON_DESTROY, 0, &window_destroyed, new_eventdata(0, NULL, NULL)); SV *ret = newSVsv(HeVAL(he)); sv_rvweaken(HeVAL(he)); return ret; } #define newSVwin(win) S_newSVwin_noinc(aTHX_ tickit_window_ref(win)) static int window_userevent_fn(TickitWindow *win, TickitEventFlags flags, void *_info, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); SET_PL_curcop; int ret = 0; if(flags & TICKIT_EV_FIRE) { SV *info_sv = newSV(0); char *evname = NULL; switch((TickitWindowEvent)data->ev) { case TICKIT_WINDOW_ON_DESTROY: croak("TICKIT_WINDOW_ON_DESTROY should not be TICKIT_EV_FIRE'd"); break; case TICKIT_WINDOW_ON_EXPOSE: { TickitExposeEventInfo *info = _info, *self; Newx(self, 1, TickitExposeEventInfo); *self = *info; self->rb = tickit_renderbuffer_ref(info->rb); evname = "expose"; sv_setref_pv(info_sv, "Tickit::Event::Expose", self); break; } case TICKIT_WINDOW_ON_GEOMCHANGE: { /* TODO: shouldn't we unpack some arguments? */ evname = "geomchange"; break; } case TICKIT_WINDOW_ON_FOCUS: { TickitFocusEventInfo *info = _info, *self; Newx(self, 1, TickitFocusEventInfo); *self = *info; self->win = tickit_window_ref(info->win); evname = "focus"; sv_setref_pv(info_sv, "Tickit::Event::Focus", self); break; } case TICKIT_WINDOW_ON_KEY: { TickitKeyEventInfo *info = _info, *self; Newx(self, 1, TickitKeyEventInfo); *self = *info; self->str = savepv(info->str); evname = "key"; sv_setref_pv(info_sv, "Tickit::Event::Key", self); break; } case TICKIT_WINDOW_ON_MOUSE: { TickitMouseEventInfo *info = _info, *self; Newx(self, 1, TickitMouseEventInfo); *self = *info; evname = "mouse"; sv_setref_pv(info_sv, "Tickit::Event::Mouse", self); break; } } dSP; ENTER; SAVETMPS; PUSHMARK(SP); EXTEND(SP, 4); mPUSHs(newSVsv(data->self)); mPUSHs(newSVivpv(data->ev, evname)); mPUSHs(info_sv); mPUSHs(newSVsv(data->data)); PUTBACK; call_sv((SV*)(data->code), G_SCALAR); CopLINE_set(PL_curcop, __LINE__); SPAGAIN; SV *retsv = POPs; ret = SvOK(retsv) ? SvIV(retsv) : 0; PUTBACK; FREETMPS; LEAVE; } if(flags & TICKIT_EV_UNBIND) { SvREFCNT_dec(data->self); SvREFCNT_dec(data->code); SvREFCNT_dec(data->data); Safefree(data); ret = 1; } return ret; } /******************* * toplevel Tickit * *******************/ typedef Tickit *Tickit___Tickit; typedef struct { #ifdef tTHX tTHX myperl; #endif CV *cb_init; CV *cb_destroy; CV *cb_run; CV *cb_stop; CV *cb_io; CV *cb_cancel_io; CV *cb_timer; CV *cb_cancel_timer; CV *cb_later; CV *cb_cancel_later; CV *cb_signal; CV *cb_cancel_signal; CV *cb_process; CV *cb_cancel_process; } EventLoopData; #define newSVio_rdonly(fd) S_newSVio_rdonly(aTHX_ fd) static SV *S_newSVio_rdonly(pTHX_ int fd) { /* inspired by * https://metacpan.org/source/LEONT/Linux-Epoll-0.016/lib/Linux/Epoll.xs#L192 */ PerlIO *pio = PerlIO_fdopen(fd, "r"); GV *gv = newGVgen("Tickit::Async"); SV *ret = newRV_noinc((SV *)gv); IO *io = GvIOn(gv); IoTYPE(io) = '<'; IoIFP(io) = pio; sv_bless(ret, gv_stashpv("IO::Handle", TRUE)); return ret; } static XS(invoke_watch); static XS(invoke_watch) { dXSARGS; TickitWatch *watch = XSANY.any_ptr; tickit_evloop_invoke_watch(watch, TICKIT_EV_FIRE); XSRETURN(0); } #define newSVcallback_tickit_invoke(watch) S_newSVcallback_tickit_invoke(aTHX_ watch) static SV *S_newSVcallback_tickit_invoke(pTHX_ TickitWatch *watch) { CV *cv = newXS(NULL, invoke_watch, __FILE__); CvXSUBANY(cv).any_ptr = watch; return newRV_noinc((SV *)cv); } static XS(invoke_iowatch); static XS(invoke_iowatch) { dXSARGS; TickitWatch *watch = XSANY.any_ptr; TickitIOCondition cond = POPi; tickit_evloop_invoke_iowatch(watch, TICKIT_EV_FIRE, cond); XSRETURN(0); } #define newSVcallback_tickit_invokeio(watch) S_newSVcallback_tickit_invokeio(aTHX_ watch) static SV *S_newSVcallback_tickit_invokeio(pTHX_ TickitWatch *watch) { CV *cv = newXS(NULL, invoke_iowatch, __FILE__); CvXSUBANY(cv).any_ptr = watch; return newRV_noinc((SV *)cv); } static XS(invoke_processwatch); static XS(invoke_processwatch) { dXSARGS; TickitWatch *watch = XSANY.any_ptr; int wstatus = POPi; tickit_evloop_invoke_processwatch(watch, TICKIT_EV_FIRE, wstatus); XSRETURN(0); } #define newSVcallback_tickit_invokeprocess(watch) S_newSVcallback_tickit_invokeprocess(aTHX_ watch) static SV *S_newSVcallback_tickit_invokeprocess(pTHX_ TickitWatch *watch) { CV *cv = newXS(NULL, invoke_processwatch, __FILE__); CvXSUBANY(cv).any_ptr = watch; return newRV_noinc((SV *)cv); } static XS(invoke_sigwinch); static XS(invoke_sigwinch) { Tickit *t = XSANY.any_ptr; tickit_evloop_sigwinch(t); } static void *evloop_init(Tickit *t, void *initdata) { EventLoopData *evdata = initdata; dTHXa(evdata->myperl); SET_PL_curcop; CV *invoke_sigwinch_cv = newXS(NULL, invoke_sigwinch, __FILE__); CvXSUBANY(invoke_sigwinch_cv).any_ptr = t; dSP; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); mPUSHs(newRV_noinc((SV *)invoke_sigwinch_cv)); PUTBACK; call_sv((SV *)evdata->cb_init, G_VOID); FREETMPS; return initdata; } static void evloop_destroy(void *data) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SvREFCNT_dec(evdata->cb_init); SvREFCNT_dec(evdata->cb_destroy); SvREFCNT_dec(evdata->cb_run); SvREFCNT_dec(evdata->cb_stop); SvREFCNT_dec(evdata->cb_io); SvREFCNT_dec(evdata->cb_cancel_io); SvREFCNT_dec(evdata->cb_timer); SvREFCNT_dec(evdata->cb_cancel_timer); SvREFCNT_dec(evdata->cb_later); SvREFCNT_dec(evdata->cb_cancel_later); SvREFCNT_dec(evdata->cb_signal); SvREFCNT_dec(evdata->cb_cancel_signal); SvREFCNT_dec(evdata->cb_process); SvREFCNT_dec(evdata->cb_cancel_process); } static void evloop_run(void *data, TickitRunFlags flags) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; dSP; SAVETMPS; PUSHMARK(SP); PUTBACK; call_sv((SV *)evdata->cb_run, G_VOID); FREETMPS; } static void evloop_stop(void *data) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; dSP; SAVETMPS; PUSHMARK(SP); PUTBACK; call_sv((SV *)evdata->cb_stop, G_VOID); FREETMPS; } static bool evloop_io(void *data, int fd, TickitIOCondition cond, TickitBindFlags flags, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; SV *fh = newSVio_rdonly(fd); dSP; SAVETMPS; EXTEND(SP, 3); PUSHMARK(SP); PUSHs(fh); mPUSHi(cond); mPUSHs(newSVcallback_tickit_invokeio(watch)); PUTBACK; call_sv((SV *)evdata->cb_io, G_VOID); FREETMPS; tickit_evloop_set_watch_data(watch, fh); return true; } static void evloop_cancel_io(void *data, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; SV *fh = tickit_evloop_get_watch_data(watch); /* Don't bother during global destruction, as the perl object we're about to * call methods on might not be in a good state any more */ if(PL_phase == PERL_PHASE_DESTRUCT) return; dSP; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); PUSHs(fh); PUTBACK; call_sv((SV *)evdata->cb_cancel_io, G_VOID); FREETMPS; SvREFCNT_dec(fh); tickit_evloop_set_watch_data(watch, NULL); } static bool evloop_timer(void *data, const struct timeval *at, TickitBindFlags flags, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; NV at_time = at->tv_sec + ((NV)at->tv_usec / 1E6); dSP; SAVETMPS; EXTEND(SP, 2); PUSHMARK(SP); mPUSHn(at_time); mPUSHs(newSVcallback_tickit_invoke(watch)); PUTBACK; call_sv((SV *)evdata->cb_timer, G_SCALAR); SPAGAIN; SV *id = SvREFCNT_inc(POPs); FREETMPS; tickit_evloop_set_watch_data(watch, id); return true; } static void evloop_cancel_timer(void *data, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; SV *id = tickit_evloop_get_watch_data(watch); /* Don't bother during global destruction, as the perl object we're about to * call methods on might not be in a good state any more */ if(PL_phase == PERL_PHASE_DESTRUCT) return; dSP; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); PUSHs(id); PUTBACK; call_sv((SV *)evdata->cb_cancel_timer, G_VOID); FREETMPS; SvREFCNT_dec(id); tickit_evloop_set_watch_data(watch, NULL); } static bool evloop_later(void *data, TickitBindFlags flags, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; dSP; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); mPUSHs(newSVcallback_tickit_invoke(watch)); PUTBACK; call_sv((SV *)evdata->cb_later, G_VOID); FREETMPS; return true; } static void evloop_cancel_later(void *data, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; /* Don't bother during global destruction, as the perl object we're about to * call methods on might not be in a good state any more */ if(PL_phase == PERL_PHASE_DESTRUCT) return; fprintf(stderr, "Should cancel later here\n"); } static bool evloop_signal(void *data, int signum, TickitBindFlags flags, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; if(!evdata->cb_signal) return false; dSP; SAVETMPS; EXTEND(SP, 2); PUSHMARK(SP); mPUSHi(signum); mPUSHs(newSVcallback_tickit_invoke(watch)); PUTBACK; call_sv((SV *)evdata->cb_signal, G_SCALAR); SPAGAIN; SV *id = SvREFCNT_inc(POPs); FREETMPS; tickit_evloop_set_watch_data(watch, id); return true; } static void evloop_cancel_signal(void *data, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; if(!evdata->cb_cancel_signal) return; SV *id = tickit_evloop_get_watch_data(watch); /* Don't bother during global destruction, as the perl object we're about to * call methods on might not be in a good state any more */ if(PL_phase == PERL_PHASE_DESTRUCT) return; dSP; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); PUSHs(id); PUTBACK; call_sv((SV *)evdata->cb_cancel_signal, G_VOID); FREETMPS; SvREFCNT_dec(id); tickit_evloop_set_watch_data(watch, NULL); } static bool evloop_process(void *data, pid_t pid, TickitBindFlags flags, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; if(!evdata->cb_process) return false; dSP; SAVETMPS; EXTEND(SP, 2); PUSHMARK(SP); mPUSHi(pid); mPUSHs(newSVcallback_tickit_invokeprocess(watch)); PUTBACK; call_sv((SV *)evdata->cb_process, G_SCALAR); SPAGAIN; SV *processid = SvREFCNT_inc(POPs); FREETMPS; tickit_evloop_set_watch_data(watch, processid); return true; } static void evloop_cancel_process(void *data, TickitWatch *watch) { EventLoopData *evdata = data; dTHXa(evdata->myperl); SET_PL_curcop; if(!evdata->cb_cancel_process) return; SV *id = tickit_evloop_get_watch_data(watch); /* Don't bother during global destruction, as the perl object we're about to * call methods on might not be in a good state any more */ if(PL_phase == PERL_PHASE_DESTRUCT) return; dSP; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); PUSHs(id); PUTBACK; call_sv((SV *)evdata->cb_cancel_process, G_VOID); FREETMPS; SvREFCNT_dec(id); tickit_evloop_set_watch_data(watch, NULL); } static int invoke_callback(Tickit *t, TickitEventFlags flags, void *info, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); dSP; SET_PL_curcop; if(flags & TICKIT_EV_FIRE) { ENTER; SAVETMPS; /* No args */ PUSHMARK(SP); PUTBACK; call_sv((SV*)data->code, G_VOID); FREETMPS; LEAVE; } if(flags & TICKIT_EV_UNBIND) { SvREFCNT_dec((SV*)data->code); Safefree(data); } } static int invoke_iocallback(Tickit *t, TickitEventFlags flags, void *_info, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); dSP; SET_PL_curcop; if(flags & TICKIT_EV_FIRE) { SV *info_sv = newSV(0); TickitIOWatchInfo *info; Newx(info, 1, TickitIOWatchInfo); *info = *(TickitIOWatchInfo *)(_info); sv_setref_pv(info_sv, "Tickit::Event::IOWatch", info); ENTER; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); mPUSHs(info_sv); PUTBACK; call_sv((SV*)data->code, G_VOID); FREETMPS; LEAVE; } if(flags & TICKIT_EV_UNBIND) { SvREFCNT_dec((SV*)data->code); Safefree(data); } } static int invoke_processcallback(Tickit *t, TickitEventFlags flags, void *_info, void *user) { struct GenericEventData *data = user; dTHXa(data->myperl); dSP; SET_PL_curcop; if(flags & TICKIT_EV_FIRE) { SV *info_sv = newSV(0); TickitProcessWatchInfo *info; Newx(info, 1, TickitProcessWatchInfo); *info = *(TickitProcessWatchInfo *)(_info); sv_setref_pv(info_sv, "Tickit::Event::ProcessWatch", info); ENTER; SAVETMPS; EXTEND(SP, 1); PUSHMARK(SP); mPUSHs(info_sv); PUTBACK; call_sv((SV *)data->code, G_VOID); FREETMPS; LEAVE; } if(flags & TICKIT_EV_UNBIND) { SvREFCNT_dec((SV *)data->code); Safefree(data); } return 0; } static TickitEventHooks evhooks = { .init = evloop_init, .destroy = evloop_destroy, .run = evloop_run, .stop = evloop_stop, .io = evloop_io, .cancel_io = evloop_cancel_io, .timer = evloop_timer, .cancel_timer = evloop_cancel_timer, .later = evloop_later, .cancel_later = evloop_cancel_later, .signal = evloop_signal, .cancel_signal = evloop_cancel_signal, .process = evloop_process, .cancel_process = evloop_cancel_process, }; static void S_setup_constants(pTHX) { HV *stash; AV *export; #define DO_CONSTANT(c) \ newCONSTSUB(stash, #c+7, newSViv(c)); \ av_push(export, newSVpv(#c+7, 0)); stash = gv_stashpvn("Tickit", 6, TRUE); export = get_av("Tickit::EXPORT_OK", TRUE); DO_CONSTANT(TICKIT_MOD_SHIFT) DO_CONSTANT(TICKIT_MOD_ALT) DO_CONSTANT(TICKIT_MOD_CTRL) DO_CONSTANT(TICKIT_RUN_NOHANG) DO_CONSTANT(TICKIT_RUN_NOSETUP) DO_CONSTANT(TICKIT_BIND_FIRST) DO_CONSTANT(TICKIT_BIND_ONESHOT) DO_CONSTANT(TICKIT_IO_IN) DO_CONSTANT(TICKIT_IO_OUT) DO_CONSTANT(TICKIT_IO_HUP) DO_CONSTANT(TICKIT_IO_ERR) DO_CONSTANT(TICKIT_IO_INVAL) DO_CONSTANT(TICKIT_FOCUSEV_IN); DO_CONSTANT(TICKIT_FOCUSEV_OUT); DO_CONSTANT(TICKIT_KEYEV_KEY); DO_CONSTANT(TICKIT_KEYEV_TEXT); DO_CONSTANT(TICKIT_MOUSEEV_PRESS); DO_CONSTANT(TICKIT_MOUSEEV_DRAG); DO_CONSTANT(TICKIT_MOUSEEV_RELEASE); DO_CONSTANT(TICKIT_MOUSEEV_WHEEL); DO_CONSTANT(TICKIT_MOUSEEV_DRAG_START); DO_CONSTANT(TICKIT_MOUSEEV_DRAG_DROP); DO_CONSTANT(TICKIT_MOUSEEV_DRAG_STOP); DO_CONSTANT(TICKIT_MOUSEEV_DRAG_OUTSIDE); DO_CONSTANT(TICKIT_MOUSEWHEEL_UP); DO_CONSTANT(TICKIT_MOUSEWHEEL_DOWN); stash = gv_stashpvn("Tickit::Term", 12, TRUE); export = get_av("Tickit::Term::EXPORT_OK", TRUE); DO_CONSTANT(TICKIT_TERMCTL_ALTSCREEN) DO_CONSTANT(TICKIT_TERMCTL_COLORS) DO_CONSTANT(TICKIT_TERMCTL_CURSORBLINK) DO_CONSTANT(TICKIT_TERMCTL_CURSORSHAPE) DO_CONSTANT(TICKIT_TERMCTL_CURSORVIS) DO_CONSTANT(TICKIT_TERMCTL_ICON_TEXT) DO_CONSTANT(TICKIT_TERMCTL_ICONTITLE_TEXT) DO_CONSTANT(TICKIT_TERMCTL_KEYPAD_APP) DO_CONSTANT(TICKIT_TERMCTL_MOUSE) DO_CONSTANT(TICKIT_TERMCTL_TITLE_TEXT) DO_CONSTANT(TICKIT_CURSORSHAPE_BLOCK) DO_CONSTANT(TICKIT_CURSORSHAPE_UNDER) DO_CONSTANT(TICKIT_CURSORSHAPE_LEFT_BAR) DO_CONSTANT(TICKIT_TERM_MOUSEMODE_OFF) DO_CONSTANT(TICKIT_TERM_MOUSEMODE_CLICK) DO_CONSTANT(TICKIT_TERM_MOUSEMODE_DRAG) DO_CONSTANT(TICKIT_TERM_MOUSEMODE_MOVE) stash = gv_stashpvn("Tickit::Window", 14, TRUE); export = get_av("Tickit::Window::EXPORT_OK", TRUE); DO_CONSTANT(TICKIT_WINDOW_HIDDEN); DO_CONSTANT(TICKIT_WINDOW_LOWEST); DO_CONSTANT(TICKIT_WINDOW_ROOT_PARENT); DO_CONSTANT(TICKIT_WINDOW_STEAL_INPUT); DO_CONSTANT(TICKIT_WINDOW_POPUP); DO_CONSTANT(TICKIT_WINCTL_CURSORBLINK); DO_CONSTANT(TICKIT_WINCTL_CURSORSHAPE); DO_CONSTANT(TICKIT_WINCTL_CURSORVIS); DO_CONSTANT(TICKIT_WINCTL_FOCUS_CHILD_NOTIFY); DO_CONSTANT(TICKIT_WINCTL_STEAL_INPUT); } MODULE = Tickit PACKAGE = Tickit::Debug bool _enabled() CODE: RETVAL = tickit_debug_enabled; OUTPUT: RETVAL void _log(flag, message) char *flag char *message CODE: tickit_debug_logf(flag, "%s", message); MODULE = Tickit PACKAGE = Tickit::Event::Expose SV * _new(package,rb,rect) char *package Tickit::RenderBuffer rb Tickit::Rect rect INIT: TickitExposeEventInfo *info; CODE: Newx(info, 1, TickitExposeEventInfo); info->rb = tickit_renderbuffer_ref(rb); info->rect = *rect; RETVAL = newSV(0); sv_setref_pv(RETVAL, package, info); OUTPUT: RETVAL void DESTROY(self) SV *self INIT: TickitExposeEventInfo *info = INT2PTR(TickitExposeEventInfo *, SvIV((SV*)SvRV(self))); CODE: tickit_renderbuffer_unref(info->rb); Safefree(info); SV * rb(self) SV *self ALIAS: rb = 0 rect = 1 INIT: TickitExposeEventInfo *info = INT2PTR(TickitExposeEventInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = newSVrb(info->rb); break; case 1: RETVAL = newSVrect(&info->rect); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Event::Focus SV * _new(package,type,win) char *package SV *type SV *win INIT: TickitFocusEventInfo *info; CODE: Newx(info, 1, TickitFocusEventInfo); if(SvPOK(type)) { info->type = tickit_name2focusev(SvPV_nolen(type)); if(info->type == -1) croak("Unrecognised focus event type '%s'", SvPV_nolen(type)); } else info->type = SvTRUE(type) ? TICKIT_FOCUSEV_IN : TICKIT_FOCUSEV_OUT; if(win && SvOK(win)) info->win = tickit_window_ref( (INT2PTR(Tickit__Window, SvIV((SV*)SvRV(win))))->win ); else info->win = NULL; RETVAL = newSV(0); sv_setref_pv(RETVAL, package, info); OUTPUT: RETVAL void DESTROY(self) SV *self INIT: TickitFocusEventInfo *info = INT2PTR(TickitFocusEventInfo *, SvIV((SV*)SvRV(self))); CODE: if(info->win) tickit_window_unref(info->win); Safefree(info); SV * type(self,newapi=&PL_sv_undef) SV *self SV *newapi ALIAS: type = 0 win = 1 INIT: TickitFocusEventInfo *info = INT2PTR(TickitFocusEventInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = tickit_focusevtype2sv(info->type); break; case 1: RETVAL = newSVwin(tickit_window_ref(info->win)); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Event::IOWatch void DESTROY(self) SV *self INIT: TickitIOWatchInfo *info = INT2PTR(TickitIOWatchInfo *, SvIV((SV*)SvRV(self))); CODE: Safefree(info); SV * fd(self) SV *self ALIAS: fd = 0 cond = 1 INIT: TickitIOWatchInfo *info = INT2PTR(TickitIOWatchInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = newSVuv(info->fd); break; case 1: RETVAL = newSVuv(info->cond); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Event::ProcessWatch void DESTROY(self) SV *self INIT: TickitProcessWatchInfo *info = INT2PTR(TickitProcessWatchInfo *, SvIV((SV*)SvRV(self))); CODE: Safefree(info); SV * pid(self) SV *self ALIAS: pid = 0 wstatus = 1 INIT: TickitProcessWatchInfo *info = INT2PTR(TickitProcessWatchInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = newSVuv(info->pid); break; case 1: RETVAL = newSVuv(info->wstatus); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Event::Key SV * _new(package,type,str,mod=0) char *package char *type char *str int mod INIT: TickitKeyEventInfo *info; CODE: Newx(info, 1, TickitKeyEventInfo); info->type = tickit_name2keyev(type); if(info->type == -1) croak("Unrecognised key event type '%s'", type); info->str = savepv(str); info->mod = mod; RETVAL = newSV(0); sv_setref_pv(RETVAL, package, info); OUTPUT: RETVAL void DESTROY(self) SV *self INIT: TickitKeyEventInfo *info = INT2PTR(TickitKeyEventInfo *, SvIV((SV*)SvRV(self))); CODE: Safefree(info->str); Safefree(info); SV * type(self) SV *self ALIAS: type = 0 str = 1 mod = 2 INIT: TickitKeyEventInfo *info = INT2PTR(TickitKeyEventInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = tickit_keyevtype2sv(info->type); break; case 1: RETVAL = newSVpvn_utf8(info->str, strlen(info->str), 1); break; case 2: RETVAL = newSViv(info->mod); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Event::Mouse SV * _new(package,type,button,line,col,mod=0) char *package char *type SV *button int line int col int mod INIT: TickitMouseEventInfo *info; CODE: Newx(info, 1, TickitMouseEventInfo); info->type = tickit_name2mouseev(type); if(info->type == -1) croak("Unrecognised mouse event type '%s'", type); if(info->type == TICKIT_MOUSEEV_WHEEL) { info->button = tickit_name2mousewheel(SvPV_nolen(button)); if(info->button == -1) croak("Unrecognised mouse wheel name '%s'", SvPV_nolen(button)); } else info->button = SvIV(button); info->line = line; info->col = col; info->mod = mod; RETVAL = newSV(0); sv_setref_pv(RETVAL, package, info); OUTPUT: RETVAL void DESTROY(self) SV *self CODE: Safefree(INT2PTR(void *, SvIV((SV*)SvRV(self)))); SV * type(self) SV *self ALIAS: type = 0 button = 1 line = 2 col = 3 mod = 4 INIT: TickitMouseEventInfo *info = INT2PTR(TickitMouseEventInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = tickit_mouseevtype2sv(info->type); break; case 1: RETVAL = tickit_mouseevbutton2sv(info->type, info->button); break; case 2: RETVAL = newSViv(info->line); break; case 3: RETVAL = newSViv(info->col); break; case 4: RETVAL = newSViv(info->mod); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Event::Resize void DESTROY(self) SV *self CODE: Safefree(INT2PTR(void *, SvIV((SV*)SvRV(self)))); SV * lines(self) SV *self ALIAS: lines = 0 cols = 1 INIT: TickitResizeEventInfo *info = INT2PTR(TickitResizeEventInfo *, SvIV((SV*)SvRV(self))); CODE: switch(ix) { case 0: RETVAL = newSViv(info->lines); break; case 1: RETVAL = newSViv(info->cols); break; default: croak("Unreachable"); } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Pen SV * _new(package, attrs) char *package HV *attrs INIT: TickitPen *pen; CODE: pen = tickit_pen_new(); if(!pen) XSRETURN_UNDEF; pen_set_attrs(pen, attrs); RETVAL = newSVpen_noinc(pen, package); OUTPUT: RETVAL void DESTROY(self) Tickit::Pen self CODE: tickit_pen_unref(self); bool hasattr(self,attr) Tickit::Pen self char *attr INIT: int a; CODE: if((a = pen_parse_attrname(attr)) == -1) XSRETURN_UNDEF; switch(a) { case TICKIT_PEN_FG_RGB8: case TICKIT_PEN_BG_RGB8: RETVAL = tickit_pen_has_colour_attr_rgb8(self, a & 0xff); break; default: RETVAL = tickit_pen_has_attr(self, a); break; } OUTPUT: RETVAL SV * getattr(self,attr) Tickit::Pen self char *attr INIT: int a; CODE: if((a = pen_parse_attrname(attr)) == -1) XSRETURN_UNDEF; switch(a) { case TICKIT_PEN_FG_RGB8: case TICKIT_PEN_BG_RGB8: if(!tickit_pen_has_colour_attr_rgb8(self, a & 0xff)) XSRETURN_UNDEF; break; default: if(!tickit_pen_has_attr(self, a)) XSRETURN_UNDEF; break; } RETVAL = pen_get_attr(self, a); OUTPUT: RETVAL void getattrs(self) Tickit::Pen self INIT: TickitPenAttr a; int count = 0; PPCODE: for(a = 1; a < TICKIT_N_PEN_ATTRS; a++) { if(!tickit_pen_has_attr(self, a)) continue; EXTEND(SP, 2); count += 2; /* Because mPUSHp(str,0) creates a 0-length string */ mPUSHs(newSVpv(tickit_penattr_name(a), 0)); mPUSHs(pen_get_attr(self, a)); } if(tickit_pen_has_colour_attr_rgb8(self, TICKIT_PEN_FG)) { EXTEND(SP, 2); count += 2; mPUSHpvs("fg:rgb8"); mPUSHs(pen_get_attr(self, TICKIT_PEN_FG_RGB8)); } if(tickit_pen_has_colour_attr_rgb8(self, TICKIT_PEN_BG)) { EXTEND(SP, 2); count += 2; mPUSHpvs("bg:rgb8"); mPUSHs(pen_get_attr(self, TICKIT_PEN_BG_RGB8)); } XSRETURN(count); bool equiv_attr(self,other,attr) Tickit::Pen self Tickit::Pen other char *attr INIT: TickitPenAttr a; CODE: if((a = tickit_penattr_lookup(attr)) == -1) XSRETURN_UNDEF; RETVAL = tickit_pen_equiv_attr(self, other, a); OUTPUT: RETVAL bool equiv(self,other) Tickit::Pen self Tickit::Pen other CODE: RETVAL = tickit_pen_equiv(self, other); OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Pen::Mutable void chattr(self,attr,value) Tickit::Pen self char *attr SV *value INIT: int a; CODE: if((a = pen_parse_attrname(attr)) == -1) XSRETURN_UNDEF; if(!SvOK(value)) { switch(a) { case TICKIT_PEN_FG_RGB8: case TICKIT_PEN_BG_RGB8: tickit_pen_set_colour_attr(self, a & 0xFF, tickit_pen_get_colour_attr(self, a & 0xFF)); break; default: tickit_pen_clear_attr(self, a); } XSRETURN_UNDEF; } pen_set_attr(self, a, value); void chattrs(self,attrs) Tickit::Pen self HV *attrs CODE: pen_set_attrs(self, attrs); void delattr(self,attr) Tickit::Pen self char *attr INIT: TickitPenAttr a; CODE: if((a = tickit_penattr_lookup(attr)) == -1) XSRETURN_UNDEF; tickit_pen_clear_attr(self, a); void copy(self,other,overwrite) Tickit::Pen self Tickit::Pen other int overwrite CODE: tickit_pen_copy(self, other, overwrite); MODULE = Tickit PACKAGE = Tickit::Rect Tickit::Rect _new(package,top,left,lines,cols) char *package int top int left int lines int cols CODE: Newx(RETVAL, 1, TickitRect); tickit_rect_init_sized(RETVAL, top, left, lines, cols); OUTPUT: RETVAL void DESTROY(self) Tickit::Rect self CODE: Safefree(self); Tickit::Rect intersect(self,other) Tickit::Rect self Tickit::Rect other INIT: TickitRect ret; CODE: if(!tickit_rect_intersect(&ret, self, other)) XSRETURN_UNDEF; Newx(RETVAL, 1, TickitRect); *RETVAL = ret; OUTPUT: RETVAL Tickit::Rect translate(self,downward,rightward) Tickit::Rect self int downward int rightward CODE: Newx(RETVAL, 1, TickitRect); tickit_rect_init_sized(RETVAL, self->top + downward, self->left + rightward, self->lines, self->cols); OUTPUT: RETVAL int top(self) Tickit::Rect self CODE: RETVAL = self->top; OUTPUT: RETVAL int left(self) Tickit::Rect self CODE: RETVAL = self->left; OUTPUT: RETVAL int lines(self) Tickit::Rect self CODE: RETVAL = self->lines; OUTPUT: RETVAL int cols(self) Tickit::Rect self CODE: RETVAL = self->cols; OUTPUT: RETVAL int bottom(self) Tickit::Rect self CODE: RETVAL = tickit_rect_bottom(self); OUTPUT: RETVAL int right(self) Tickit::Rect self CODE: RETVAL = tickit_rect_right(self); OUTPUT: RETVAL bool equals(self,other,swap=0) Tickit::Rect self Tickit::Rect other int swap CODE: RETVAL = (self->top == other->top) && (self->lines == other->lines) && (self->left == other->left) && (self->cols == other->cols); OUTPUT: RETVAL bool intersects(self,other) Tickit::Rect self Tickit::Rect other CODE: RETVAL = tickit_rect_intersects(self, other); OUTPUT: RETVAL bool contains(large,small) Tickit::Rect large Tickit::Rect small CODE: RETVAL = tickit_rect_contains(large, small); OUTPUT: RETVAL void add(x,y) Tickit::Rect x Tickit::Rect y INIT: int n_rects, i; TickitRect rects[3]; PPCODE: n_rects = tickit_rect_add(rects, x, y); for(i = 0; i < n_rects; i++) mPUSHrect(rects + i); XSRETURN(n_rects); void subtract(self,hole) Tickit::Rect self Tickit::Rect hole INIT: int n_rects, i; TickitRect rects[4]; PPCODE: n_rects = tickit_rect_subtract(rects, self, hole); EXTEND(SP, n_rects); for(i = 0; i < n_rects; i++) mPUSHrect(rects + i); XSRETURN(n_rects); MODULE = Tickit PACKAGE = Tickit::RectSet Tickit::RectSet new(package) char *package CODE: RETVAL = tickit_rectset_new(); OUTPUT: RETVAL void DESTROY(self) Tickit::RectSet self CODE: tickit_rectset_destroy(self); void clear(self) Tickit::RectSet self CODE: tickit_rectset_clear(self); void rects(self) Tickit::RectSet self INIT: int n; int i; PPCODE: n = tickit_rectset_rects(self); if(GIMME_V != G_ARRAY) { mPUSHi(n); XSRETURN(1); } EXTEND(SP, n); for(i = 0; i < n; i++) { TickitRect rect; tickit_rectset_get_rect(self, i, &rect); mPUSHrect(&rect); } XSRETURN(n); void add(self,rect) Tickit::RectSet self Tickit::Rect rect CODE: tickit_rectset_add(self, rect); void subtract(self,rect) Tickit::RectSet self Tickit::Rect rect CODE: tickit_rectset_subtract(self, rect); bool intersects(self,r) Tickit::RectSet self Tickit::Rect r CODE: RETVAL = tickit_rectset_intersects(self, r); OUTPUT: RETVAL bool contains(self,r) Tickit::RectSet self Tickit::Rect r CODE: RETVAL = tickit_rectset_contains(self, r); OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::RenderBuffer SV * _xs_new(class,lines,cols) char *class int lines int cols CODE: RETVAL = newSVrb_noinc(tickit_renderbuffer_new(lines, cols)); OUTPUT: RETVAL void DESTROY(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_unref(self); int lines(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_get_size(self, &RETVAL, NULL); OUTPUT: RETVAL int cols(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_get_size(self, NULL, &RETVAL); OUTPUT: RETVAL SV * line(self) Tickit::RenderBuffer self INIT: TickitRenderBuffer *rb; CODE: rb = self; if(tickit_renderbuffer_has_cursorpos(rb)) { int line; tickit_renderbuffer_get_cursorpos(rb, &line, NULL); RETVAL = newSViv(line); } else RETVAL = &PL_sv_undef; OUTPUT: RETVAL SV * col(self) Tickit::RenderBuffer self INIT: TickitRenderBuffer *rb; CODE: rb = self; if(tickit_renderbuffer_has_cursorpos(rb)) { int col; tickit_renderbuffer_get_cursorpos(rb, NULL, &col); RETVAL = newSViv(col); } else RETVAL = &PL_sv_undef; OUTPUT: RETVAL void translate(self,downward,rightward) Tickit::RenderBuffer self int downward int rightward PPCODE: tickit_renderbuffer_translate(self, downward, rightward); void clip(self,rect) Tickit::RenderBuffer self Tickit::Rect rect CODE: tickit_renderbuffer_clip(self, rect); void mask(self,rect) Tickit::RenderBuffer self Tickit::Rect rect CODE: tickit_renderbuffer_mask(self, rect); void goto(self,line,col) Tickit::RenderBuffer self SV *line SV *col CODE: if(SvIsNumeric(line) && SvIsNumeric(col)) tickit_renderbuffer_goto(self, SvIV(line), SvIV(col)); else tickit_renderbuffer_ungoto(self); void setpen(self,pen) Tickit::RenderBuffer self Tickit::Pen pen CODE: tickit_renderbuffer_setpen(self, pen); void reset(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_reset(self); void clear(self,pen=NULL) Tickit::RenderBuffer self Tickit::Pen pen CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_clear(self); if(pen) tickit_renderbuffer_restore(self); void save(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_save(self); void savepen(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_savepen(self); void restore(self) Tickit::RenderBuffer self CODE: tickit_renderbuffer_restore(self); void _xs_get_cell(self,line,col) Tickit::RenderBuffer self int line int col INIT: TickitRenderBuffer *rb; STRLEN len; SV *text; TickitRenderBufferLineMask mask; PPCODE: rb = self; if(tickit_renderbuffer_get_cell_active(rb, line, col) != 1) { XPUSHs(&PL_sv_undef); XPUSHs(&PL_sv_undef); XSRETURN(2); } EXTEND(SP, 6); len = tickit_renderbuffer_get_cell_text(rb, line, col, NULL, 0); text = newSV(len + 1); tickit_renderbuffer_get_cell_text(rb, line, col, SvPVX(text), len + 1); SvPOK_on(text); SvUTF8_on(text); SvCUR_set(text, len); mPUSHs(text); mPUSHs(newSVpen_noinc(tickit_pen_clone(tickit_renderbuffer_get_cell_pen(rb, line, col)), NULL)); mask = tickit_renderbuffer_get_cell_linemask(rb, line, col); if(!mask.north && !mask.south && !mask.east && !mask.west) XSRETURN(2); mPUSHi(mask.north); mPUSHi(mask.south); mPUSHi(mask.east); mPUSHi(mask.west); XSRETURN(6); void skip_at(self,line,col,len) Tickit::RenderBuffer self int line int col int len CODE: tickit_renderbuffer_skip_at(self, line, col, len); void skip(self,len) Tickit::RenderBuffer self int len CODE: if(!tickit_renderbuffer_has_cursorpos(self)) croak("Cannot ->skip without a virtual cursor position"); tickit_renderbuffer_skip(self, len); void skip_to(self,col) Tickit::RenderBuffer self int col CODE: if(!tickit_renderbuffer_has_cursorpos(self)) croak("Cannot ->skip_to without a virtual cursor position"); tickit_renderbuffer_skip_to(self, col); void skiprect(self,rect) Tickit::RenderBuffer self Tickit::Rect rect CODE: tickit_renderbuffer_skiprect(self, rect); int text_at(self,line,col,text,pen=NULL) Tickit::RenderBuffer self int line int col SV *text Tickit::Pen pen INIT: char *bytes; STRLEN len; CODE: bytes = SvPVutf8(text, len); if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } RETVAL = tickit_renderbuffer_textn_at(self, line, col, bytes, len); if(pen) tickit_renderbuffer_restore(self); OUTPUT: RETVAL int text(self,text,pen=NULL) Tickit::RenderBuffer self SV *text Tickit::Pen pen INIT: char *bytes; STRLEN len; CODE: if(!tickit_renderbuffer_has_cursorpos(self)) croak("Cannot ->text without a virtual cursor position"); bytes = SvPVutf8(text, len); if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } RETVAL = tickit_renderbuffer_textn(self, bytes, len); if(pen) tickit_renderbuffer_restore(self); OUTPUT: RETVAL void erase_at(self,line,col,len,pen=NULL) Tickit::RenderBuffer self int line int col int len Tickit::Pen pen CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_erase_at(self, line, col, len); if(pen) tickit_renderbuffer_restore(self); void erase(self,len,pen=NULL) Tickit::RenderBuffer self int len Tickit::Pen pen CODE: if(!tickit_renderbuffer_has_cursorpos(self)) croak("Cannot ->erase without a virtual cursor position"); if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_erase(self, len); if(pen) tickit_renderbuffer_restore(self); void erase_to(self,col,pen=NULL) Tickit::RenderBuffer self int col Tickit::Pen pen CODE: if(!tickit_renderbuffer_has_cursorpos(self)) croak("Cannot ->erase_to without a virtual cursor position"); if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_erase_to(self, col); if(pen) tickit_renderbuffer_restore(self); void eraserect(self,rect,pen=NULL) Tickit::RenderBuffer self Tickit::Rect rect Tickit::Pen pen CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_eraserect(self, rect); if(pen) tickit_renderbuffer_restore(self); void char_at(self,line,col,codepoint,pen=NULL) Tickit::RenderBuffer self int line int col int codepoint Tickit::Pen pen CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_char_at(self, line, col, codepoint); if(pen) tickit_renderbuffer_restore(self); void char(self,codepoint,pen=NULL) Tickit::RenderBuffer self int codepoint Tickit::Pen pen CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_char(self, codepoint); if(pen) tickit_renderbuffer_restore(self); void hline_at(self,line,startcol,endcol,style,pen=NULL,caps=0) Tickit::RenderBuffer self int line int startcol int endcol int style Tickit::Pen pen int caps CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_hline_at(self, line, startcol, endcol, style, caps); if(pen) tickit_renderbuffer_restore(self); void vline_at(self,startline,endline,col,style,pen=NULL,caps=0) Tickit::RenderBuffer self int startline int endline int col int style Tickit::Pen pen int caps CODE: if(pen) { tickit_renderbuffer_savepen(self); tickit_renderbuffer_setpen(self, pen); } tickit_renderbuffer_vline_at(self, startline, endline, col, style, caps); if(pen) tickit_renderbuffer_restore(self); void flush_to_term(self,term) Tickit::RenderBuffer self Tickit::Term term CODE: tickit_renderbuffer_flush_to_term(self, term); void copyrect(self,dest,src) Tickit::RenderBuffer self Tickit::Rect dest Tickit::Rect src ALIAS: copyrect = 0 moverect = 1 CODE: switch(ix) { case 0: tickit_renderbuffer_copyrect(self, dest, src); break; case 1: tickit_renderbuffer_moverect(self, dest, src); break; } MODULE = Tickit PACKAGE = Tickit::StringPos SV * zero(package) char *package; INIT: TickitStringPos *pos; CODE: pos = new_stringpos(&RETVAL); tickit_stringpos_zero(pos); OUTPUT: RETVAL SV * limit_bytes(package,bytes) char *package; size_t bytes; INIT: TickitStringPos *pos; CODE: pos = new_stringpos(&RETVAL); tickit_stringpos_limit_bytes(pos, bytes); OUTPUT: RETVAL SV * limit_codepoints(package,codepoints) char *package; int codepoints; INIT: TickitStringPos *pos; CODE: pos = new_stringpos(&RETVAL); tickit_stringpos_limit_codepoints(pos, codepoints); OUTPUT: RETVAL SV * limit_graphemes(package,graphemes) char *package; int graphemes; INIT: TickitStringPos *pos; CODE: pos = new_stringpos(&RETVAL); tickit_stringpos_limit_graphemes(pos, graphemes); OUTPUT: RETVAL SV * limit_columns(package,columns) char *package; int columns; INIT: TickitStringPos *pos; CODE: pos = new_stringpos(&RETVAL); tickit_stringpos_limit_columns(pos, columns); OUTPUT: RETVAL void DESTROY(self) Tickit::StringPos self CODE: Safefree(self); size_t bytes(self) Tickit::StringPos self; CODE: RETVAL = self->bytes; OUTPUT: RETVAL int codepoints(self) Tickit::StringPos self; CODE: RETVAL = self->codepoints; OUTPUT: RETVAL int graphemes(self) Tickit::StringPos self; CODE: RETVAL = self->graphemes; OUTPUT: RETVAL int columns(self) Tickit::StringPos self; CODE: RETVAL = self->columns; OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Term SV * _new(package,termtype,input_handle,output_handle,writer,utf8) char *package; char *termtype; SV *input_handle SV *output_handle SV *writer SV *utf8 INIT: struct TickitTermBuilder builder = { 0 }; TickitTerm *tt; CODE: builder.termtype = termtype; builder.open = TICKIT_OPEN_FDS; builder.input_fd = -1; builder.output_fd = -1; if(SvOK(input_handle)) builder.input_fd = PerlIO_fileno(IoIFP(sv_2io(input_handle))); if(SvOK(output_handle)) builder.output_fd = PerlIO_fileno(IoOFP(sv_2io(output_handle))); if(SvOK(writer)) { builder.output_func = term_outputwriter_fn; builder.output_func_user = new_eventdata(0, SvREFCNT_inc(writer), NULL); } tt = tickit_term_build(&builder); if(!tt) XSRETURN_UNDEF; if(SvOK(utf8)) tickit_term_set_utf8(tt, SvTRUE(utf8)); RETVAL = newSVterm_noinc(tt, package); OUTPUT: RETVAL SV * open_stdio(package) char *package INIT: TickitTerm *tt; CODE: tt = tickit_term_open_stdio(); if(!tt) XSRETURN_UNDEF; RETVAL = newSVterm_noinc(tt, package); OUTPUT: RETVAL void DESTROY(self) Tickit::Term self CODE: /* * destroy TickitTerm first in case it's still using output_handle/func */ tickit_term_unref(self); UV _xs_addr(self, ...) Tickit::Term self CODE: RETVAL = (UV)self; OUTPUT: RETVAL int get_input_fd(self) Tickit::Term self CODE: RETVAL = tickit_term_get_input_fd(self); OUTPUT: RETVAL int get_output_fd(self) Tickit::Term self CODE: RETVAL = tickit_term_get_output_fd(self); OUTPUT: RETVAL void await_started(self,timeout) Tickit::Term self double timeout CODE: tickit_term_await_started_msec(self, timeout * 1000); void pause(self) Tickit::Term self CODE: tickit_term_pause(self); void resume(self) Tickit::Term self CODE: tickit_term_resume(self); void teardown(self) Tickit::Term self CODE: tickit_term_teardown(self); void flush(self) Tickit::Term self CODE: tickit_term_flush(self); void set_output_buffer(self,len) Tickit::Term self size_t len CODE: tickit_term_set_output_buffer(self, len); void get_size(self) Tickit::Term self INIT: int lines, cols; PPCODE: tickit_term_get_size(self, &lines, &cols); EXTEND(SP, 2); mPUSHi(lines); mPUSHi(cols); XSRETURN(2); void set_size(self,lines,cols) Tickit::Term self int lines int cols CODE: tickit_term_set_size(self, lines, cols); void refresh_size(self) Tickit::Term self CODE: tickit_term_refresh_size(self); int _bind_event(self,ev,flags,code,data = &PL_sv_undef) Tickit::Term self char *ev int flags CV *code SV *data INIT: TickitTermEvent _ev = -1; struct GenericEventData *user; CODE: switch(ev[0]) { case 'k': if(strEQ(ev, "key")) _ev = TICKIT_TERM_ON_KEY; break; case 'm': if(strEQ(ev, "mouse")) _ev = TICKIT_TERM_ON_MOUSE; break; case 'r': if(strEQ(ev, "resize")) _ev = TICKIT_TERM_ON_RESIZE; break; } if(_ev == -1) croak("Unrecognised event name '%s'", ev); user = new_eventdata(_ev, newSVsv(data), code); RETVAL = tickit_term_bind_event(self, _ev, flags|TICKIT_EV_UNBIND, term_userevent_fn, user); OUTPUT: RETVAL void unbind_event_id(self,id) Tickit::Term self int id CODE: tickit_term_unbind_event_id(self, id); void input_push_bytes(self,bytes) Tickit::Term self SV *bytes INIT: char *str; STRLEN len; CODE: str = SvPV(bytes, len); tickit_term_input_push_bytes(self, str, len); void input_readable(self) Tickit::Term self CODE: tickit_term_input_readable(self); void input_wait(self,timeout=&PL_sv_undef) Tickit::Term self SV *timeout CODE: if(SvIsNumeric(timeout)) tickit_term_input_wait_msec(self, SvNV(timeout) * 1000); else tickit_term_input_wait_msec(self, -1); SV * check_timeout(self) Tickit::Term self INIT: int msec; CODE: msec = tickit_term_input_check_timeout_msec(self); RETVAL = newSV(0); if(msec >= 0) sv_setnv(RETVAL, msec / 1000.0); OUTPUT: RETVAL bool goto(self,line,col) Tickit::Term self SV *line SV *col CODE: RETVAL = tickit_term_goto(self, SvOK(line) ? SvIV(line) : -1, SvOK(col) ? SvIV(col) : -1); OUTPUT: RETVAL void move(self,downward,rightward) Tickit::Term self SV *downward SV *rightward CODE: tickit_term_move(self, SvOK(downward) ? SvIV(downward) : 0, SvOK(rightward) ? SvIV(rightward) : 0); int scrollrect(self,top,left,lines,cols,downward,rightward) Tickit::Term self int top int left int lines int cols int downward int rightward INIT: TickitRect rect; CODE: rect.top = top; rect.left = left; rect.lines = lines; rect.cols = cols; RETVAL = tickit_term_scrollrect(self, rect, downward, rightward); OUTPUT: RETVAL void chpen(self,...) Tickit::Term self INIT: TickitPen *pen; int pen_temp = 0; CODE: if(items == 2 && SvROK(ST(1)) && sv_derived_from(ST(1), "Tickit::Pen")) { IV tmp = SvIV((SV*)SvRV(ST(1))); Tickit__Pen self = INT2PTR(Tickit__Pen, tmp); pen = self; } else { pen = pen_from_args(SP-items+2, items-1); pen_temp = 1; } tickit_term_chpen(self, pen); if(pen_temp) tickit_pen_unref(pen); void setpen(self,...) Tickit::Term self INIT: TickitPen *pen; int pen_temp = 0; CODE: if(items == 2 && SvROK(ST(1)) && sv_derived_from(ST(1), "Tickit::Pen")) { IV tmp = SvIV((SV*)SvRV(ST(1))); Tickit__Pen self = INT2PTR(Tickit__Pen, tmp); pen = self; } else { pen = pen_from_args(SP-items+2, items-1); pen_temp = 1; } tickit_term_setpen(self, pen); if(pen_temp) tickit_pen_unref(pen); void print(self,text,pen=NULL) Tickit::Term self SV *text Tickit::Pen pen INIT: char *utf8; STRLEN len; CODE: if(pen) tickit_term_setpen(self, pen); utf8 = SvPVutf8(text, len); tickit_term_printn(self, utf8, len); void clear(self,pen=NULL) Tickit::Term self Tickit::Pen pen CODE: if(pen) tickit_term_setpen(self, pen); tickit_term_clear(self); void erasech(self,count,moveend,pen=NULL) Tickit::Term self int count SV *moveend Tickit::Pen pen CODE: if(pen) tickit_term_setpen(self, pen); tickit_term_erasech(self, count, SvOK(moveend) ? SvIV(moveend) : -1); int getctl_int(self,ctl) Tickit::Term self SV *ctl INIT: TickitTermCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_termctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); if(!tickit_term_getctl_int(self, ctl_e, &RETVAL)) XSRETURN_UNDEF; OUTPUT: RETVAL void setctl_int(self,ctl,value) Tickit::Term self SV *ctl int value INIT: TickitTermCtl ctl_e; PPCODE: if(SvPOK(ctl)) { ctl_e = tickit_termctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); if(tickit_term_setctl_int(self, ctl_e, value)) XSRETURN_YES; else XSRETURN_NO; int setctl_str(self,ctl,value) Tickit::Term self SV *ctl char *value INIT: TickitTermCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_termctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); RETVAL = tickit_term_setctl_str(self, ctl_e, value); OUTPUT: RETVAL SV * getctl(self,ctl) Tickit::Term self SV *ctl INIT: TickitTermCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_termctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); switch(tickit_termctl_type(ctl_e)) { case TICKIT_TYPE_BOOL: { int value; if(!tickit_term_getctl_int(self, ctl_e, &value)) XSRETURN_UNDEF; RETVAL = value ? &PL_sv_yes : &PL_sv_no; break; } case TICKIT_TYPE_INT: { int value; if(!tickit_term_getctl_int(self, ctl_e, &value)) XSRETURN_UNDEF; RETVAL = newSViv(value); break; } case TICKIT_TYPE_STR: case TICKIT_TYPE_NONE: RETVAL = &PL_sv_undef; break; } OUTPUT: RETVAL int setctl(self,ctl,value) Tickit::Term self SV *ctl SV *value INIT: TickitTermCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_termctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); RETVAL = 0; switch(tickit_termctl_type(ctl_e)) { case TICKIT_TYPE_BOOL: case TICKIT_TYPE_INT: RETVAL = tickit_term_setctl_int(self, ctl_e, SvIV(value)); break; case TICKIT_TYPE_STR: RETVAL = tickit_term_setctl_str(self, ctl_e, SvPV_nolen(value)); break; case TICKIT_TYPE_NONE: break; } OUTPUT: RETVAL void _emit_key(self,info) Tickit::Term self Tickit::Event::Key info CODE: tickit_term_emit_key(self, info); void _emit_mouse(self,info) Tickit::Term self Tickit::Event::Mouse info CODE: tickit_term_emit_mouse(self, info); MODULE = Tickit::Test::MockTerm PACKAGE = Tickit::Test::MockTerm SV * _new_mocking(package,lines,cols) char *package int lines int cols INIT: TickitMockTerm *mt; CODE: mt = tickit_mockterm_new(lines, cols); if(!mt) XSRETURN_UNDEF; RETVAL = newSVterm_noinc((TickitTerm *)mt, "Tickit::Test::MockTerm"); OUTPUT: RETVAL void get_methodlog(self) Tickit::Term self INIT: TickitMockTerm *mt; int loglen; int i; PPCODE: mt = (TickitMockTerm *)self; EXTEND(SP, (loglen = tickit_mockterm_loglen(mt))); for(i = 0; i < loglen; i++) { TickitMockTermLogEntry *entry = tickit_mockterm_peeklog(mt, i); AV *ret = newAV(); switch(entry->type) { case LOG_GOTO: av_push(ret, newSVpv("goto", 0)); av_push(ret, newSViv(entry->val1)); // line av_push(ret, newSViv(entry->val2)); // col break; case LOG_PRINT: av_push(ret, newSVpv("print", 0)); av_push(ret, newSVpvn_utf8(entry->str, entry->val1, 1)); break; case LOG_ERASECH: av_push(ret, newSVpv("erasech", 0)); av_push(ret, newSViv(entry->val1)); // count av_push(ret, newSViv(entry->val2 == 1 ? 1 : 0)); // moveend break; case LOG_CLEAR: av_push(ret, newSVpv("clear", 0)); break; case LOG_SCROLLRECT: av_push(ret, newSVpv("scrollrect", 0)); av_push(ret, newSViv(entry->rect.top)); av_push(ret, newSViv(entry->rect.left)); av_push(ret, newSViv(entry->rect.lines)); av_push(ret, newSViv(entry->rect.cols)); av_push(ret, newSViv(entry->val1)); // downward av_push(ret, newSViv(entry->val2)); // rightward break; case LOG_SETPEN: { HV *penattrs = newHV(); TickitPenAttr attr; for(attr = 1; attr < TICKIT_N_PEN_ATTRS; attr++) { const char *attrname = tickit_penattr_name(attr); int value; if(!tickit_pen_nondefault_attr(entry->pen, attr)) continue; switch(tickit_penattr_type(attr)) { case TICKIT_PENTYPE_BOOL: value = tickit_pen_get_bool_attr(entry->pen, attr); break; case TICKIT_PENTYPE_INT: value = tickit_pen_get_int_attr(entry->pen, attr); break; case TICKIT_PENTYPE_COLOUR: value = tickit_pen_get_colour_attr(entry->pen, attr); break; default: croak("Unreachable: unknown pen type"); } sv_setiv(*hv_fetch(penattrs, attrname, strlen(attrname), 1), value); } av_push(ret, newSVpv("setpen", 0)); av_push(ret, newRV_noinc((SV *)penattrs)); } break; } mPUSHs(newRV_noinc((SV *)ret)); } tickit_mockterm_clearlog(mt); XSRETURN(i); SV * get_display_text(self,line,col,width) Tickit::Term self int line int col int width INIT: STRLEN len; CODE: len = tickit_mockterm_get_display_text((TickitMockTerm *)self, NULL, 0, line, col, width); RETVAL = newSV(len+1); tickit_mockterm_get_display_text((TickitMockTerm *)self, SvPVX(RETVAL), len, line, col, width); SvPOK_on(RETVAL); SvUTF8_on(RETVAL); SvCUR_set(RETVAL, len); OUTPUT: RETVAL SV * get_display_pen(self,line,col) Tickit::Term self int line int col INIT: TickitPen *pen; HV *penattrs; TickitPenAttr attr; CODE: pen = tickit_mockterm_get_display_pen((TickitMockTerm *)self, line, col); penattrs = newHV(); for(attr = 1; attr < TICKIT_N_PEN_ATTRS; attr++) { const char *attrname; if(!tickit_pen_nondefault_attr(pen, attr)) continue; attrname = tickit_penattr_name(attr); hv_store(penattrs, attrname, strlen(attrname), pen_get_attr(pen, attr), 0); } RETVAL = newRV_noinc((SV *)penattrs); OUTPUT: RETVAL void resize(self,newlines,newcols) Tickit::Term self int newlines int newcols CODE: tickit_mockterm_resize((TickitMockTerm *)self, newlines, newcols); int line(self) Tickit::Term self ALIAS: line = 0 col = 1 cursorvis = 2 cursorshape = 3 INIT: TickitMockTerm *mt; CODE: mt = (TickitMockTerm *)self; switch(ix) { case 0: tickit_mockterm_get_position(mt, &RETVAL, NULL); break; case 1: tickit_mockterm_get_position(mt, NULL, &RETVAL); break; case 2: tickit_term_getctl_int(self, TICKIT_TERMCTL_CURSORVIS, &RETVAL); break; case 3: tickit_term_getctl_int(self, TICKIT_TERMCTL_CURSORSHAPE, &RETVAL); break; } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::Utils size_t string_count(str,pos,limit=NULL) SV *str Tickit::StringPos pos Tickit::StringPos limit INIT: char *s; STRLEN len; CODE: if(!SvUTF8(str)) { str = sv_mortalcopy(str); sv_utf8_upgrade(str); } s = SvPVutf8(str, len); RETVAL = tickit_utf8_ncount(s, len, pos, limit); if(RETVAL == -1) XSRETURN_UNDEF; OUTPUT: RETVAL size_t string_countmore(str,pos,limit=NULL) SV *str Tickit::StringPos pos Tickit::StringPos limit INIT: char *s; STRLEN len; CODE: if(!SvUTF8(str)) { str = sv_mortalcopy(str); sv_utf8_upgrade(str); } s = SvPVutf8(str, len); RETVAL = tickit_utf8_ncountmore(s, len, pos, limit); if(RETVAL == -1) XSRETURN_UNDEF; OUTPUT: RETVAL int textwidth(str) SV *str INIT: STRLEN len; const char *s; TickitStringPos pos, limit = INIT_TICKIT_STRINGPOS_LIMIT_NONE; CODE: RETVAL = 0; if(!SvUTF8(str)) { str = sv_mortalcopy(str); sv_utf8_upgrade(str); } s = SvPVutf8(str, len); if(tickit_utf8_ncount(s, len, &pos, &limit) == -1) XSRETURN_UNDEF; RETVAL = pos.columns; OUTPUT: RETVAL void chars2cols(str,...) SV *str; INIT: STRLEN len; const char *s; int i; TickitStringPos pos, limit; size_t bytes; PPCODE: if(!SvUTF8(str)) { str = sv_mortalcopy(str); sv_utf8_upgrade(str); } s = SvPVutf8(str, len); EXTEND(SP, items - 1); tickit_stringpos_zero(&pos); tickit_stringpos_limit_bytes(&limit, len); for(i = 1; i < items; i++ ) { limit.codepoints = SvUV(ST(i)); if(limit.codepoints < pos.codepoints) croak("chars2cols requires a monotonically-increasing list of character numbers; %d is not greater than %d\n", limit.codepoints, pos.codepoints); bytes = tickit_utf8_ncountmore(s, len, &pos, &limit); if(bytes == -1) XSRETURN_UNDEF; mPUSHu(pos.columns); if(GIMME_V != G_ARRAY) XSRETURN(1); } XSRETURN(items - 1); void cols2chars(str,...) SV *str; INIT: STRLEN len; const char *s; int i; TickitStringPos pos, limit; size_t bytes; PPCODE: if(!SvUTF8(str)) { str = sv_mortalcopy(str); sv_utf8_upgrade(str); } s = SvPVutf8(str, len); EXTEND(SP, items - 1); tickit_stringpos_zero(&pos); tickit_stringpos_limit_bytes(&limit, len); for(i = 1; i < items; i++ ) { limit.columns = SvUV(ST(i)); if(limit.columns < pos.columns) croak("cols2chars requires a monotonically-increasing list of column numbers; %d is not greater than %d\n", limit.columns, pos.columns); bytes = tickit_utf8_ncountmore(s, len, &pos, &limit); if(bytes == -1) XSRETURN_UNDEF; mPUSHu(pos.codepoints); if(GIMME_V != G_ARRAY) XSRETURN(1); } XSRETURN(items - 1); MODULE = Tickit PACKAGE = Tickit::Window SV * _new_root(package,tt,tickit) char *package Tickit::Term tt SV *tickit INIT: Tickit__Window self; TickitWindow *win; CODE: win = tickit_window_new_root(tt); if(!win) XSRETURN_UNDEF; RETVAL = newSVwin_noinc(win); self = INT2PTR(struct Tickit__Window *, SvIV(SvRV(RETVAL))); self->tickit = newSVsv(tickit); sv_rvweaken(self->tickit); OUTPUT: RETVAL SV * _make_sub(win,top,left,lines,cols,flags) Tickit::Window win; int top; int left; int lines; int cols; int flags; INIT: TickitRect rect; TickitWindow *subwin; CODE: rect.top = top; rect.left = left; rect.lines = lines; rect.cols = cols; subwin = tickit_window_new(win->win, rect, flags); if(!subwin) XSRETURN_UNDEF; /* parent window holds a reference, we have another */ RETVAL = newSVwin(subwin); OUTPUT: RETVAL void DESTROY(self) Tickit::Window self CODE: tickit_window_unref(self->win); self->win = NULL; void close(self) Tickit::Window self CODE: tickit_window_close(self->win); int top(self) Tickit::Window self CODE: RETVAL = tickit_window_top(self->win); OUTPUT: RETVAL int left(self) Tickit::Window self CODE: RETVAL = tickit_window_left(self->win); OUTPUT: RETVAL int lines(self) Tickit::Window self CODE: RETVAL = tickit_window_lines(self->win); OUTPUT: RETVAL int cols(self) Tickit::Window self CODE: RETVAL = tickit_window_cols(self->win); OUTPUT: RETVAL int abs_top(self) Tickit::Window self CODE: RETVAL = tickit_window_get_abs_geometry(self->win).top; OUTPUT: RETVAL int abs_left(self) Tickit::Window self CODE: RETVAL = tickit_window_get_abs_geometry(self->win).left; OUTPUT: RETVAL SV * root(self) Tickit::Window self ALIAS: root = 0 parent = 1 term = 2 _tickit = 3 CODE: switch(ix) { case 0: RETVAL = newSVwin(tickit_window_root(self->win)); break; case 1: { TickitWindow *parent = tickit_window_parent(self->win); RETVAL = parent ? newSVwin(parent) : &PL_sv_undef; break; } case 2: RETVAL = newSVterm(tickit_window_get_term(self->win), "Tickit::Term"); break; case 3: { RETVAL = self->tickit ? newSVsv(self->tickit) : &PL_sv_undef; break; } default: croak("Unreachable"); } OUTPUT: RETVAL void subwindows(self) Tickit::Window self INIT: size_t n; TickitWindow **children; size_t i; PPCODE: n = tickit_window_children(self->win); if(GIMME_V != G_ARRAY) { mPUSHi(n); XSRETURN(1); } Newx(children, n, TickitWindow *); tickit_window_get_children(self->win, children, n); EXTEND(SP, n); for(i = 0; i < n; i++) { mPUSHs(newSVwin(children[i])); } Safefree(children); XSRETURN(n); int _bind_event(self,ev,flags,code,data = &PL_sv_undef) Tickit::Window self char *ev int flags CV *code SV *data INIT: TickitWindowEvent _ev = -1; struct GenericEventData *user; CODE: switch(ev[0]) { case 'e': if(strEQ(ev, "expose")) _ev = TICKIT_WINDOW_ON_EXPOSE; break; case 'f': if(strEQ(ev, "focus")) _ev = TICKIT_WINDOW_ON_FOCUS; break; case 'g': if(strEQ(ev, "geomchange")) _ev = TICKIT_WINDOW_ON_GEOMCHANGE; break; case 'k': if(strEQ(ev, "key")) _ev = TICKIT_WINDOW_ON_KEY; break; case 'm': if(strEQ(ev, "mouse")) _ev = TICKIT_WINDOW_ON_MOUSE; break; } if(_ev == -1) croak("Unrecognised event name '%s'", ev); user = new_eventdata(_ev, newSVsv(data), code); user->self = newSVsv(ST(0)); sv_rvweaken(user->self); RETVAL = tickit_window_bind_event(self->win, _ev, flags|TICKIT_BIND_UNBIND, window_userevent_fn, user); OUTPUT: RETVAL void unbind_event_id(self,id) Tickit::Window self int id CODE: tickit_window_unbind_event_id(self->win, id); void flush(self) Tickit::Window self CODE: tickit_window_flush(self->win); void expose(self,rect = NULL) Tickit::Window self Tickit::Rect_MAYBE rect CODE: tickit_window_expose(self->win, rect); void hide(self) Tickit::Window self CODE: tickit_window_hide(self->win); void show(self) Tickit::Window self CODE: tickit_window_show(self->win); void resize(self,lines,cols) Tickit::Window self int lines int cols CODE: tickit_window_resize(self->win, lines, cols); void reposition(self,top,left) Tickit::Window self int top int left CODE: tickit_window_reposition(self->win, top, left); void change_geometry(self,top,left,lines,cols) Tickit::Window self int top int left int lines int cols INIT: TickitRect rect; CODE: rect.top = top; rect.left = left; rect.lines = lines; rect.cols = cols; tickit_window_set_geometry(self->win, rect); bool is_visible(self) Tickit::Window self CODE: RETVAL = tickit_window_is_visible(self->win); OUTPUT: RETVAL SV * pen(self) Tickit::Window self CODE: RETVAL = newSVpen(tickit_window_get_pen(self->win), "Tickit::Pen::Mutable"); OUTPUT: RETVAL void set_pen(self,pen) Tickit::Window self Tickit::Pen pen CODE: tickit_window_set_pen(self->win, pen); void raise(self) Tickit::Window self ALIAS: raise = 0 lower = 1 raise_to_front = 2 lower_to_back = 3 CODE: switch(ix) { case 0: tickit_window_raise(self->win); break; case 1: tickit_window_lower(self->win); break; case 2: tickit_window_raise_to_front(self->win); break; case 3: tickit_window_lower_to_back(self->win); break; } bool _scrollrect(self,rect,downward,rightward,pen) Tickit::Window self Tickit::Rect rect int downward int rightward Tickit::Pen pen CODE: RETVAL = tickit_window_scrollrect(self->win, rect, downward, rightward, pen); OUTPUT: RETVAL bool _scroll_with_children(self,downward,rightward) Tickit::Window self int downward int rightward CODE: RETVAL = tickit_window_scroll_with_children(self->win, downward, rightward); OUTPUT: RETVAL bool is_focused(self) Tickit::Window self CODE: RETVAL = tickit_window_is_focused(self->win); OUTPUT: RETVAL void take_focus(self) Tickit::Window self CODE: tickit_window_take_focus(self->win); void set_cursor_position(self,line,col) Tickit::Window self int line int col CODE: tickit_window_set_cursor_position(self->win, line, col); SV * getctl(self,ctl) Tickit::Window self SV *ctl INIT: TickitWindowCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_windowctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); switch(tickit_windowctl_type(ctl_e)) { case TICKIT_TYPE_BOOL: { int value; if(!tickit_window_getctl_int(self->win, ctl_e, &value)) XSRETURN_UNDEF; RETVAL = value ? &PL_sv_yes : &PL_sv_no; break; } case TICKIT_TYPE_INT: { int value; if(!tickit_window_getctl_int(self->win, ctl_e, &value)) XSRETURN_UNDEF; RETVAL = newSViv(value); break; } case TICKIT_TYPE_STR: case TICKIT_TYPE_NONE: RETVAL = &PL_sv_undef; break; } OUTPUT: RETVAL int setctl(self,ctl,value) Tickit::Window self SV *ctl SV *value INIT: TickitWindowCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_windowctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); RETVAL = 0; switch(tickit_windowctl_type(ctl_e)) { case TICKIT_TYPE_BOOL: case TICKIT_TYPE_INT: RETVAL = tickit_window_setctl_int(self->win, ctl_e, SvIV(value)); break; case TICKIT_TYPE_STR: // TODO: currently there aren't any break; case TICKIT_TYPE_NONE: break; } OUTPUT: RETVAL MODULE = Tickit PACKAGE = Tickit::_Tickit SV * new(package,term) char *package Tickit::Term_MAYBE term INIT: struct TickitBuilder builder = { 0 }; Tickit *t; CODE: if(term) builder.tt = tickit_term_ref(term); else builder.term_builder.open = TICKIT_OPEN_STDIO; t = tickit_build(&builder); if(!t) XSRETURN_UNDEF; RETVAL = newSV(0); sv_setref_pv(RETVAL, package, t); OUTPUT: RETVAL SV * _new_with_evloop(package, term, ...) char *package SV *term INIT: TickitTerm *tt = NULL; struct TickitBuilder builder = { 0 }; Tickit *t; EventLoopData *evdata; CODE: /* A not-actually-documented API to wrap the event hook binding function * tickit_new_with_evloop(3) * This is for use by Tickit::Async, POEx::Tickit, and maybe others */ if(!term || !SvOK(term)) tt = NULL; else if(SvROK(term) && sv_derived_from(term, "Tickit::Term")) tt = INT2PTR(TickitTerm *, SvIV((SV*)SvRV(term))); else Perl_croak(aTHX_ "term is not of type Tickit::Term"); if(tt) builder.tt = tickit_term_ref(tt); else builder.term_builder.open = TICKIT_OPEN_STDIO; Newx(evdata, 1, EventLoopData); Zero(evdata, 1, EventLoopData); #ifdef tTHX evdata->myperl = aTHX; #endif if(!SvROK(ST(2))) { U32 idx = 2; while(idx < items) { SV *namesv = ST(idx++); const char *name = SvPVbyte_nolen(namesv); CV *code = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), name)); if(strEQ(name, "init")) evdata->cb_init = code; else if(strEQ(name, "destroy")) evdata->cb_destroy = code; else if(strEQ(name, "run")) evdata->cb_run = code; else if(strEQ(name, "stop")) evdata->cb_stop = code; else if(strEQ(name, "io")) evdata->cb_io = code; else if(strEQ(name, "cancel_io")) evdata->cb_cancel_io = code; else if(strEQ(name, "timer")) evdata->cb_timer = code; else if(strEQ(name, "cancel_timer")) evdata->cb_cancel_timer = code; else if(strEQ(name, "later")) evdata->cb_later = code; else if(strEQ(name, "cancel_later")) evdata->cb_cancel_later = code; else if(strEQ(name, "signal")) evdata->cb_signal = code; else if(strEQ(name, "cancel_signal")) evdata->cb_cancel_signal = code; else if(strEQ(name, "process")) evdata->cb_process = code; else if(strEQ(name, "cancel_process")) evdata->cb_cancel_process = code; else croak("Unrecognised evloop callback name %s", name); } /* The first 6 are required */ if(!evdata->cb_init) croak("Required evloop callback 'init' is missing"); if(!evdata->cb_destroy) croak("Required evloop callback 'destroy' is missing"); if(!evdata->cb_run) croak("Required evloop callback 'run' is missing"); if(!evdata->cb_stop) croak("Required evloop callback 'stop' is missing"); if(!evdata->cb_io) croak("Required evloop callback 'io' is missing"); if(!evdata->cb_cancel_io) croak("Required evloop callback 'cancel_io' is missing"); /* The rest are optional */ } else { U32 idx = 2; /* likely a CODE ref; we'll do this old-style positional */ evdata->cb_init = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "init")); evdata->cb_destroy = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "destroy")); evdata->cb_run = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "run")); evdata->cb_stop = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "stop")); evdata->cb_io = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "io")); evdata->cb_cancel_io = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "cancel_io")); evdata->cb_timer = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "timer")); evdata->cb_cancel_timer = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "cancel_timer")); evdata->cb_later = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "later")); evdata->cb_cancel_later = (CV *)SvREFCNT_inc((SV *)cv_from_sv(ST(idx++), "cancel_later")); } /* Uses the not-technically-documented evhooks / evinitdata TickitBuilder fields */ builder.evhooks = &evhooks; builder.evinitdata = evdata; t = tickit_build(&builder); if(!t) XSRETURN_UNDEF; RETVAL = newSV(0); sv_setref_pv(RETVAL, package, t); OUTPUT: RETVAL void DESTROY(self) Tickit::_Tickit self CODE: tickit_unref(self); SV * rootwin(self,tickit) Tickit::_Tickit self SV *tickit INIT: Tickit__Window win; CODE: RETVAL = newSVwin(tickit_get_rootwin(self)); win = INT2PTR(struct Tickit__Window *, SvIV(SvRV(RETVAL))); if(!win->tickit) { win->tickit = newSVsv(tickit); sv_rvweaken(win->tickit); } OUTPUT: RETVAL SV * term(self) Tickit::_Tickit self CODE: RETVAL = newSVterm(tickit_get_term(self), "Tickit::Term"); OUTPUT: RETVAL bool setctl(self, ctl, value) Tickit::_Tickit self SV *ctl SV *value INIT: TickitCtl ctl_e; CODE: if(SvPOK(ctl)) { ctl_e = tickit_ctl_lookup(SvPV_nolen(ctl)); if(ctl_e == -1) croak("Unrecognised 'ctl' name '%s'", SvPV_nolen(ctl)); } else if(SvIOK(ctl)) ctl_e = SvIV(ctl); else croak("Expected 'ctl' to be an integer or string"); RETVAL = 0; switch(tickit_ctl_type(ctl_e)) { case TICKIT_TYPE_BOOL: case TICKIT_TYPE_INT: RETVAL = tickit_setctl_int(self, ctl_e, SvIV(value)); break; case TICKIT_TYPE_STR: case TICKIT_TYPE_NONE: break; } OUTPUT: RETVAL UV watch_io(self, fd, cond, code) Tickit::_Tickit self UV fd UV cond CV *code CODE: RETVAL = PTR2UV(tickit_watch_io(self, fd, cond, TICKIT_BIND_UNBIND, invoke_iocallback, new_eventdata_codeonly(code))); OUTPUT: RETVAL UV watch_timer_after(self, delay, code) Tickit::_Tickit self NV delay CV *code INIT: struct timeval after; CODE: /* For convenience of the calling Perl code we take fractional seconds and * convert to struct timeval here. */ after.tv_sec = (long)delay; after.tv_usec = (delay - after.tv_sec) * 1000000; RETVAL = PTR2UV(tickit_watch_timer_after_tv(self, &after, TICKIT_BIND_UNBIND, invoke_callback, new_eventdata_codeonly(code))); OUTPUT: RETVAL UV watch_timer_at(self, epoch, code) Tickit::_Tickit self NV epoch CV *code INIT: struct timeval at; CODE: /* For convenience of the calling Perl code we take fractional seconds and * convert to struct timeval here. */ at.tv_sec = (long)epoch; at.tv_usec = (epoch - at.tv_sec) * 1000000; RETVAL = PTR2UV(tickit_watch_timer_at_tv(self, &at, TICKIT_BIND_UNBIND, invoke_callback, new_eventdata_codeonly(code))); OUTPUT: RETVAL UV watch_signal(self, signum, code) Tickit::_Tickit self int signum CV *code CODE: RETVAL = PTR2UV(tickit_watch_signal(self, signum, TICKIT_BIND_UNBIND, invoke_callback, new_eventdata_codeonly(code))); OUTPUT: RETVAL UV watch_process(self, pid, code) Tickit::_Tickit self IV pid CV *code CODE: RETVAL = PTR2UV(tickit_watch_process(self, pid, TICKIT_BIND_UNBIND, invoke_processcallback, new_eventdata_codeonly(code))); OUTPUT: RETVAL void watch_cancel(self, id) Tickit::_Tickit self UV id CODE: tickit_watch_cancel(self, INT2PTR(void *,id)); UV watch_later(self, code) Tickit::_Tickit self CV *code CODE: RETVAL = PTR2UV(tickit_watch_later(self, TICKIT_BIND_UNBIND, invoke_callback, new_eventdata_codeonly(code))); OUTPUT: RETVAL void run(self) Tickit::_Tickit self CODE: tickit_run(self); void stop(self) Tickit::_Tickit self CODE: tickit_stop(self); void tick(self, flags=0) Tickit::_Tickit self int flags CODE: tickit_tick(self, flags); MODULE = Tickit PACKAGE = Tickit int version_major() ALIAS: version_major = 0 version_minor = 1 version_patch = 2 CODE: switch(ix) { case 0: RETVAL = tickit_version_major(); break; case 1: RETVAL = tickit_version_minor(); break; case 2: RETVAL = tickit_version_patch(); break; } OUTPUT: RETVAL BOOT: /* Check libtickit version */ if(tickit_version_major() != TICKIT_VERSION_MAJOR || tickit_version_minor() != TICKIT_VERSION_MINOR || tickit_version_patch() < TICKIT_VERSION_PATCH) { croak("libtickit version mismatch: compiled for version %d.%d.%d, running with %d.%d.%d\n", TICKIT_VERSION_MAJOR, TICKIT_VERSION_MINOR, TICKIT_VERSION_PATCH, tickit_version_major(), tickit_version_minor(), tickit_version_patch()); } S_setup_constants(aTHX); Tickit-0.73/lib/Tickit000755001750001750 014302155253 13410 5ustar00leoleo000000000000Tickit-0.73/lib/Tickit/Debug.pm000444001750001750 743514302155253 15142 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2014-2016 -- leonerd@leonerd.org.uk package Tickit::Debug 0.73; use v5.14; use warnings; use constant DEBUG => _enabled(); use Exporter 'import'; our @EXPORT = qw( DEBUG ); =head1 NAME C - debug logging support for C =head1 DESCRIPTION This module implements the debug logging logic for L. It is controlled by a number of environment variables. It exports a constant called C which will be true if the debug logging is enabled; allowing code to efficiently skip over it if it isn't. Debug messages themselves each have a flag name, which is a short string identifying the Tickit subsystem or kind of event that caused it. A given subset of these flags can be enabled for printing. Flags not enabled will not be printed. =cut =head1 FLAGS Each flag name starts with a upper-case letters indicating the subsystem it relates to, then lower-case letters to indicate the particular kind of event or message. =head2 B (RenderBuffer) =head3 Bd Drawing operations =head3 Bf Flushing =head3 Bs State stack save/restore =head3 Bt Transformations (translate, clip, mask) =head2 I (Input) =head3 Ik Keyboard events =head3 Im Mouse events =head3 Ir Resize events =head2 W (Window) =head3 Wd Rectangles of damage queued on the root window for re-expose =head3 Wh Hierarchy changes on Windows (creates, deletes, re-orderings) =head3 Ws Calls to C<< $win->scrollrect >> =head3 Wsr Calls to C<< $term->scrollrect >> on the root window as part of scrollrect =head3 Wx Expose events on Windows; which may result in calls to its C handler. As this event is recursive, it prints an indent. =cut =head1 ENVIRONMENT =head2 TICKIT_DEBUG_FLAGS A comma-separated list of the flags or flag categories to enable for printing. Each potential flag exists in a category, given by the leading upper-case letters of its name. Entire categories can be enabled by name, as can individual flags. See the L list above for the available flags. =head2 TICKIT_DEBUG_FD If set, debug logging is sent directly to the opened filehandle given by this file descriptor number, rather than opening a log file. Typically this is most useful to start a C-based application in a new terminal but have its debug logging printed to STDERR of the original terminal the new one was launched from. For example $ TICKIT_DEBUG_FD=3 TICKIT_DEBUG_FLAGS=... $TERM perl my-tickit-app.pl 3>&2 This requests that C log to file descriptor 3, which has been created by copying the original shell's standard error output, and so logging is printed to the shell this was run from. =head2 TICKIT_DEBUG_FILE Gives the name of a file to open and write logging to, if C is not set. If this is not set either, a filename will be generated using the PID of the process, named as tickit-PID.log =cut =head1 METHODS =cut =head2 log Tickit::Debug->log( $flag => $format, @args ) Prints a line to the debug log if the specified C<$flag> is present in the set of enabled flags. Any arguments that are C references are called and replaced by the list of values they return, then the line itself is generated by calling C using the format string and the given arguments. It is then printed to the log, prefixed by the flag name and with a linefeed appended. It is not necessary to include the C<\n> linefeed in the C<$format> itself. =cut sub log :method { shift; my ( $flag, $format, @args ) = @_; return unless _enabled(); my $message = sprintf $format, map { ref eq "CODE" ? $_->() : $_ } @args; _log( $flag, $message ); } =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Event.pm000444001750001750 564214302155253 15173 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2009-2016 -- leonerd@leonerd.org.uk package Tickit::Event 0.73; use v5.14; use warnings; use Carp; =head1 NAME C - event information structures =head1 DESCRIPTION When event handlers bound to L or L instances are invoked they receive an object instance to contain information about the event. Details of the event can be accessed as via accessor methods on these instances. =head1 ACCESSORS The following methods are shared between C and C instances. =head2 mod_is_alt =head2 mod_is_ctrl =head2 mod_is_shift Convenient shortcuts to tests on the C bitmask to test if each of the modifiers is set. =cut sub mod_is_alt { shift->mod & Tickit::MOD_ALT } sub mod_is_ctrl { shift->mod & Tickit::MOD_CTRL } sub mod_is_shift { shift->mod & Tickit::MOD_SHIFT } package Tickit::Event::Expose; our @ISA = qw( Tickit::Event ); =head1 Tickit::Event::Expose =head2 rb The L instance containing the buffer for this redraw cycle. =head2 rect A L instance containing the region of the window that needs repainting. =cut package Tickit::Event::Focus; our @ISA = qw( Tickit::Event ); =head1 Tickit::Event::Focus =head2 type This accessor has two forms of operation. The new behaviour is that it returns a dualvar giving the focus event type as an integer or a string event name (C or C). This behaviour is selected if the method is invoked with any true value as an argument. The legacy behaviour is that it returns a simple boolean giving the focus direction; C<1> for in, C<0> for out. This legacy behaviour will be removed in a later version. =head2 win The child L instance for child-focus notify events. =cut package Tickit::Event::Key; our @ISA = qw( Tickit::Event ); =head1 Tickit::Event::Key =head2 type A dualvar giving the key event type as an integer or string event name (C or C). =head2 str A string containing the key event string. =head2 mod An integer bitmask indicating the modifier state. =cut package Tickit::Event::Mouse; our @ISA = qw( Tickit::Event ); =head1 Tickit::Event::Mouse =head2 type A dualvar giving the mouse event type as an integer or string event name (C, C, C or C). =head2 button An integer for non-wheel events or a dualvar for wheel events giving the wheel direction (C or C). =head2 line =head2 col Integers giving the mouse position. =head2 mod An integer bitmask indicating the modifier state. =cut package Tickit::Event::Resize; our @ISA = qw( Tickit::Event ); =head1 Tickit::Event::Resize =head2 lines =head2 cols Integers giving the new size. =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Pen.pm000444001750001750 2015014302155253 14643 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2011-2017 -- leonerd@leonerd.org.uk package Tickit::Pen 0.73; use v5.14; use warnings; use Carp; our @ALL_ATTRS = qw( fg bg b u i rv strike af blink ); our @BOOL_ATTRS = qw( b u i rv strike blink ); our @INT_ATTRS = qw( fg bg af ); # Load the XS code require Tickit; =head1 NAME C - store a collection of rendering attributes =head1 DESCRIPTION A pen instance stores a collection of rendering attributes for text to display. It comes in two forms, mutable and immutable. Both types of pen are subclasses of the base C class. An immutable pen is an instance of C. Its attributes are set by the constructor and are fixed thereafter. Methods are provided to query the presence or value of attributes, and to fetch the entire set as a hash. A mutable pen is an instance of C. Its attributes may be set by the constructor, and can be changed at any time. As well as supporting the same query methods as immutable pens, more methods are provided to change or remove them. While mutable pens may initially seem more useful, they can complicate logic due to their shared referential nature. If the same mutable pen is shared across multiple places, care needs to be taken to redraw anything that depends on it if it is ever changed. If pens need sharing, especially if results are cached for performance, consider using immutable pens to simplify the logic. =head2 Attributes The following named pen attributes are supported: =over 8 =item fg => COL =item bg => COL Foreground or background colour. C may be an integer or one of the eight colour names. A colour name may optionally be prefixed by C for the high-intensity version (may not be supported by all terminals). Some terminals may support a palette of 256 colours instead, some 16, and some only 8. The pen object will not check this as it cannot be reliably detected in all cases. =item fg:rgb8 => STRING =item bg:rgb8 => STRING Foreground or background colour secondary RGB8 specification. The value is a string encoding the three 8-bit values in hexadecimal notation, prefixed by a hash (C<#>) symbol; for example #13579B On input, either lower- or upper-case is accepted; on output the letters will be upper-case. These attribute can only be set if the corresponding regular index attribute is also set. Changing or clearing the regular index will also clear the RGB8 version. Applications wishing to use this attribute should be aware that the majority of terminal drivers will not be able to support it, and so should make sure to set an appropriate regular colour index as well. Some terminals using the F driver may make use of it, however, and therefore ignore the index version. =item b => BOOL =item u => BOOL =item i => BOOL =item rv => BOOL =item strike => BOOL =item blink => BOOL Bold, underline, italics, reverse video, strikethrough, blink. =item af => INT Alternate font. =back Note that not all terminals can render the italics, strikethrough, or alternate font attributes. =cut =head1 CONSTRUCTORS =cut =head2 new $pen = Tickit::Pen->new( %attrs ) Returns a new pen, initialised from the given attributes. Currently this method returns a C, though this may change in a future version. It is provided for backward-compatibility for code that expects to be able to construct a C directly. $pen = Tickit::Pen::Immutable->new( %attrs ) $pen = Tickit::Pen::Mutable->new( %attrs ) Return a new immutable, or mutable pen, initialised from the given attributes. =cut sub new { my $class = shift; my %attrs = @_; # Default to mutable for now $class = "Tickit::Pen::Mutable" if $class eq __PACKAGE__; my $self = $class->_new( \%attrs ); croak "Unrecognised pen attributes " . join( ", ", sort keys %attrs ) if %attrs; return $self; } =head2 new_from_attrs $pen = Tickit::Pen->new_from_attrs( $attrs ) Returns a new pen, initialised from keys in the given HASH reference. Used keys are deleted from the hash. Currently this method returns a C, though this may change in a future version. It is provided for backward-compatibility for code that expects to be able to construct a C directly. $pen = Tickit::Pen::Immutable->new_from_attrs( $attrs ) $pen = Tickit::Pen::Mutable->new_from_attrs( $attrs ) Return a new immutable, or mutable pen, initialised from the given attributes. =cut sub new_from_attrs { my $class = shift; my ( $attrs ) = @_; # Default to mutable for now $class = "Tickit::Pen::Mutable" if $class eq __PACKAGE__; return $class->_new( $attrs ); } =head2 as_mutable =head2 clone $pen = $orig->as_mutable $pen = $orig->clone Returns a new mutable pen, initialised by copying the attributes of the original. C is provided as a legacy alias, but may be removed in a future version. =cut sub as_mutable { my $orig = shift; return Tickit::Pen::Mutable->new_from_attrs( { $orig->getattrs } ); } *clone = \&as_mutable; =head2 as_immutable $pen = $orig->as_immutable Returns an immutable pen, initialised by copying the attributes of the original. When called on an immutable pen, this method just returns the same pen instance. =cut sub as_immutable { my $orig = shift; return Tickit::Pen::Immutable->new_from_attrs( { $orig->getattrs } ); } =head2 mutable $is_mutable = $pen->mutable Returns true on mutable pens and false on immutable ones. =cut =head1 METHODS ON ALL PENS The following query methods apply to both immutable and mutable pens. =cut =head2 hasattr $exists = $pen->hasattr( $attr ) Returns true if the given attribute exists on this object =cut =head2 getattr $value = $pen->getattr( $attr ) Returns the current value of the given attribute =cut =head2 getattrs %values = $pen->getattrs Returns a key/value list of all the attributes =cut =head2 equiv_attr $equiv = $pen->equiv_attr( $other, $attr ) Returns true if the two pens have the equivalent values for the given attribute; that is, either both define it to the same value, or neither defines it. =cut =head2 equiv $equiv = $pen->equiv( $other ) Returns true if the two pens have equivalent values for all attributes. =cut =head1 METHODS ON MUTABLE PENS The following mutation methods exist on mutable pens. =cut =head2 chattr $pen->chattr( $attr, $value ) Change the value of an attribute. Setting C deletes the attribute entirely. See also C. =cut =head2 chattrs $pen->chattrs( \%attrs ) Change the values of all the attributes given in the hash. Recgonised attributes will be deleted from the hash. =cut =head2 delattr $pen->delattr( $attr ) Delete an attribute from this pen. This attribute will no longer be modified by this pen. =cut =head2 copy_from =head2 default_from $pen->copy_from( $other ) $pen->default_from( $other ) Copy attributes from the given pen. C will override attributes already defined by C<$pen>; C will only copy attributes that are not yet defined by C<$pen>. As a convenience both methods return C<$pen>. =cut sub copy_from { my $self = shift; my ( $other ) = @_; $self->copy( $other, 1 ); return $self; } sub default_from { my $self = shift; my ( $other ) = @_; $self->copy( $other, 0 ); return $self; } sub sprintf { my $self = shift; return "{" . join( ",", map { $self->hasattr($_) ? "$_=" . $self->getattr($_) : () } @ALL_ATTRS ) . "}"; } use overload '""' => sub { my $self = shift; return ref($self) . $self->sprintf }, bool => sub { 1 }; use Scalar::Util qw( refaddr ); use overload '==' => sub { refaddr($_[0]) == refaddr($_[1]) }; package Tickit::Pen::Immutable 0.73; use base qw( Tickit::Pen ); use constant mutable => 0; sub as_immutable { return $_[0] } package Tickit::Pen::Mutable 0.73; use base qw( Tickit::Pen ); use constant mutable => 1; # Adds further methods in XS =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Rect.pm000444001750001750 1121314302155253 15016 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2011-2016 -- leonerd@leonerd.org.uk package Tickit::Rect 0.73; use v5.14; use warnings; use Carp; # Load the XS code require Tickit; =head1 NAME C - a lightweight data structure representing a rectangle =head1 SYNOPSIS use Tickit::Rect; my $rect = Tickit::Rect->new( top => 0, left => 5, lines => 3, cols => 10 ); =head1 DESCRIPTION Objects in this class represent a rectangle, by storing the top left corner coordinate and the size in lines and columns. This data structure is purely abstract and not tied to a particular window or coordinate system. It exists simply as a convenient data store containing some useful utility methods. =cut =head1 CONSTRUCTORS =cut =head2 new $rect = Tickit::Rect->new( %args ) Construct a new rectangle of the given geometry, given by C, C and either C and C, or C and C. $rect = Tickit::Rect->new( $str ) If given a single string, this will be parsed in the form (left,top)..(right,bottom) =cut sub new { my $class = shift; my %args; if( @_ == 1 ) { @args{qw(left top right bottom)} = $_[0] =~ m/^\((\d+),(\d+)\)..\((\d+),(\d+)\)$/ or croak "Unrecognised Tickit::Rect string '$_[0]'"; } else { %args = @_; } defined $args{lines} or $args{lines} = $args{bottom} - $args{top}; defined $args{cols} or $args{cols} = $args{right} - $args{left}; return $class->_new( @args{qw( top left lines cols )} ); } =head2 intersect $rect = $existing_rect->intersect( $other_rect ) If there is an intersection between the given rectangles, return it. If not, return C. =cut =head2 translate $rect = $existing_rect->translate( $downward, $rightward ) Returns a new rectangle of the same size as the given one, moved down and to the right by the given argmuents (which may be negative) =cut =head1 ACCESSORS =cut =head2 top =head2 left =head2 bottom =head2 right $top = $rect->top $left = $rect->left $bottom = $rect->bottom $right = $rect->right Return the edge boundaries of the rectangle. =head2 lines =head2 cols $lines = $rect->lines $cols = $rect->cols Return the size of the rectangle. =cut =head2 linerange @lines = $rect->linerange( $min, $max ) A convenient shortcut to generate the list of lines covered that are within the given bounds (either bound may be given as C). Without bounds, equivalent to: $rect->top .. $rect->bottom - 1 =cut sub linerange { my $self = shift; my ( $min, $max ) = @_; my $start = $self->top; $start = $min if defined $min and $min > $start; my $stop = $self->bottom - 1; $stop = $max if defined $max and $max < $stop; return $start .. $stop; } =head1 METHODS =cut =head2 equals $bool = $rect->equals( $other ) $bool = ( $rect == $other ) Returns true if C<$other> represents the same area as C<$rect>. This method overloads the numerical equality operator (C<==>). =cut use overload '==' => "equals", eq => "equals"; =head2 contains $bool = $rect->contains( $other ) Returns true if C<$other> is entirely contained within the bounds of C<$rect>. =cut =head2 intersects $bool = $rect->intersects( $other ) Returns true if C<$other> and C<$rect> intersect at all, even if they overlap. =cut sub sprintf { my $self = shift; return sprintf "[(%d,%d)..(%d,%d)]", $self->left, $self->top, $self->right, $self->bottom; } use overload '""' => sub { my $self = shift; return ref($self) . $self->sprintf; }, bool => sub { 1 }; =head2 add @r = $rect->add( $other ) Returns a list of the non-overlapping regions covered by either C<$rect> or C<$other>. In the trivial case that the two given rectangles do not touch, the result will simply be a list of the two initial rectangles. Otherwise a list of newly-constructed rectangles will be returned that covers the same area as the original two. This list will contain anywhere between 1 and 3 rectangles. =cut =head2 subtract @r = $rect->subtract( $other ) Returns a list of the non-overlapping regions covered by C<$rect> but not by C<$other>. In the trivial case that C<$other> completely covers C<$rect> then the empty list is returned. In the trivial case that C<$other> and C<$rect> do not intersect then a list containing C<$rect> is returned. Otherwise, a list of newly-constructed rectangles will be returned that covers the required area. This list will contain anywhere between 1 and 4 rectangles. =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/RectSet.pm000444001750001750 355014302155253 15457 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2012-2016 -- leonerd@leonerd.org.uk package Tickit::RectSet 0.73; use v5.14; use warnings; use List::Util qw( min max ); # Load the XS code require Tickit; =head1 NAME C - store a set of rectangular regions =head1 DESCRIPTION Objects in this class store a set of rectangular regions. The object tracks which areas are covered, to ensure that overlaps are avoided, and that neighbouring regions are merged where possible. The order in which they are added is not important. New regions can be added using the C method. The C method returns a list of non-overlapping L regions, in top-to-bottom, left-to-right order. =cut =head1 CONSTRUCTOR =cut =head2 new $rectset = Tickit::RectSet->new Returns a new C instance, initially empty. =cut =head1 METHODS =cut =head2 rects @rects = $rectset->rects Returns a list of the covered regions, in order first top to bottom, then left to right. =cut =head2 add $rectset->add( $rect ) Adds the region covered by C<$rect> to the stored region list. =cut =head2 subtract $rectset->subtract( $rect ) Removes any covered region that intersects with C<$rect> from the stored region list. =cut =head2 clear $rectset->clear Remove all the regions from the set. =cut =head2 intersects $bool = $rectset->intersects( $rect ) Returns true if C<$rect> intersects with any region in the set. =cut =head2 contains $bool = $rectset->contains( $rect ) Returns true if C<$rect> is entirely covered by the regions in the set. Note that it may be that the rect requires two or more regions in the set to completely cover it. =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/RenderBuffer.pm000444001750001750 3775114302155253 16511 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2013-2017 -- leonerd@leonerd.org.uk package Tickit::RenderBuffer 0.73; use v5.14; use warnings; use Carp; use Scalar::Util qw( refaddr ); # Load the XS code require Tickit; use Tickit::Utils qw( textwidth ); use Tickit::Rect; use Tickit::Pen 0.31; use Struct::Dumb qw( readonly_struct ); # Exported API constants use Exporter 'import'; our @EXPORT_OK = qw( LINE_SINGLE LINE_DOUBLE LINE_THICK CAP_START CAP_END CAP_BOTH ); use constant { LINE_SINGLE => 0x01, LINE_DOUBLE => 0x02, LINE_THICK => 0x03, }; use constant { CAP_START => 0x01, CAP_END => 0x02, CAP_BOTH => 0x03, }; =head1 NAME C - efficiently render text and line-drawing =head1 SYNOPSIS package Tickit::Widget::Something; ... sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; $rb->eraserect( $rect ); $rb->text_at( 2, 2, "Hello, world!", $self->pen ); } Z<> $win->set_on_expose( sub { my ( $win, $rb, $rect ) = @_; $rb->eraserect( $rect ); $rb->text_at( 2, 2, "Hello, world!" ); }); =head1 DESCRIPTION Provides a buffer of pending rendering operations to apply to the terminal. The buffer is modified by rendering operations performed by widgets or other code, and flushed to the terminal when complete. This provides the following advantages: =over 2 =item * Changes can be made in any order, and will be flushed in top-to-bottom, left-to-right order, minimising cursor movements. =item * Buffered content can be overwritten or partly erased once stored, simplifying some styles of drawing operation. Large areas can be erased, and then redrawn with text or lines, without causing a double-drawing flicker on the output terminal. =item * The buffer supports line-drawing, complete with merging of line segments that meet in a character cell. Boxes, grids, and other shapes can be easily formed by drawing separate line segments, and the C will handle the corners and other junctions formed. =item * A single buffer can be passed around all of the windows or widgets to properly combine line segments and layering effects, making it possible to create many kinds of sub-divided or layered output. =back Drawing methods come in two forms; absolute, and cursor-relative: =over 2 =item * Absolute methods, identified by their name having a suffixed C<_at>, operate on a position within the buffer specified by their argument. =item * Cursor-relative methods, identified by their lack of C<_at> suffix, operate at and update the position of the "virtual cursor". This is a position within the buffer that can be set using the C method. The position of the virtual cursor is not affected by the absolute-position methods. =back =head2 State Stack The C stores a stack of saved state. The state of the buffer can be stored using the C method, so that changes can be made, before finally restoring back to that state using C. The following items of state are saved: =over 2 =item * The virtual cursor position =item * The clipping rectangle =item * The render pen =item * The translation offset =item * The set of masked regions =back When the state is saved to the stack, the render pen is remembered and merged with any pen set using the C method. The queued content to render is not part of the state stack. It is intended that the state stack be used to implement recursive delegation of drawing operations down a tree of code, allowing child contexts to be created by saving state and modifying it, to later restore it again afterwards. =cut =head1 CONSTRUCTOR =cut =head2 new $rb = Tickit::RenderBuffer->new( %args ) Returns a new instance of a C. Takes the following named arguments: =over 8 =item lines => INT =item cols => INT The size of the buffer area. =back =cut sub new { my $class = shift; my %args = @_; my $lines = $args{lines}; my $cols = $args{cols}; return $class->_xs_new( $lines, $cols ); } =head1 METHODS =cut =head2 lines =head2 cols $lines = $rb->lines $cols = $rb->cols Returns the size of the buffer area =cut =head2 line =head2 col $line = $rb->line $col = $rb->col Returns the current position of the virtual cursor, or C if it is not set. =cut =head2 save $rb->save Pushes a new state-saving context to the stack, which can later be returned to by the C method. =cut =head2 savepen $rb->savepen Pushes a new state-saving context to the stack that only stores the pen. This can later be returned to by the C method, but will only restore the pen. Other attributes such as the virtual cursor position will be unaffected. This may be more efficient for rendering runs of text in a different pen, than multiple calls to C or C using the same pen. For a single call it is better just to pass a different pen directly. =cut =head2 restore $rb->restore Pops and restores a saved state previously created with C. =cut =head2 clip $rb->clip( $rect ) Restricts the clipping rectangle of drawing operations to be no further than the limits of the given rectangle. This will apply to subsequent rendering operations but does not affect existing content, nor the actual rendering to the terminal. Clipping rectangles cumulative; each call further restricts the drawing region. To revert back to a larger drawing area, use the C and C stack. =cut =head2 mask $rb->mask( $rect ) Masks off the given area against any further changes. This will apply to subsequent rendering operations but does not affect the existing content, nor the actual rendering to the terminal. Areas within the clipping region may be arbitrarily masked. Masks are scoped to the depth of the stack they are applied at; once the C method is invoked, any masks applied since its corresponding C will be removed. =head2 translate $rb->translate( $downward, $rightward ) Applies a translation to the coordinate system used by C and the absolute-position methods C<*_at>. After this call, all positions used will be offset by the given amount. =cut =head2 reset $rb->reset Removes any pending changes and reverts the C to its default empty state. Undefines the virtual cursor position, resets the clipping rectangle, and clears the stack of saved state. =cut =head2 clear $rb->clear( $pen ) Resets every cell in the buffer to an erased state. A shortcut to calling C for every line. =cut =head2 goto $rb->goto( $line, $col ) Sets the position of the virtual cursor. =cut =head2 setpen $rb->setpen( $pen ) Sets the rendering pen to use for drawing operations. If a pen is set then a C<$pen> argument is optional to any of the drawing methods. If a pen argument is supplied as well as having a stored pen, then the attributes are merged, with the directly-applied pen taking precedence. Successive calls to this method will replace the active pen used, but if there is a saved state on the stack it will be merged with the rendering pen of the most recent saved state. This method may be preferable to passing pens into multiple C or C calls as it may be more efficient than merging the same pen on every call. If the original pen is still required afterwards, the C / C pair may be useful. =cut =head2 skip_at $rb->skip_at( $line, $col, $len ) Sets the range of cells given to a skipped state. No content will be drawn here, nor will any content existing on the terminal be erased. Initially, or after calling C, all cells are set to this state. =cut =head2 skip $rb->skip( $len ) Sets the range of cells at the virtual cursor position to a skipped state, and updates the position. =cut =head2 skip_to $rb->skip_to( $col ) Sets the range of cells from the virtual cursor position until before the given column to a skipped state, and updates the position to the column. If the position is already past this column then the cursor is moved backwards and no buffer changes are made. =cut =head2 skiprect $rb->skiprect( $rect ) Sets the range of cells given by the rectangle to skipped state. =cut =head2 text_at $cols = $rb->text_at( $line, $col, $text, $pen ) Sets the range of cells starting at the given position, to render the given text in the given pen. Returns the number of columns wide the actual C<$text> is (which may be more than was actually printed). =cut =head2 text $cols = $rb->text( $text, $pen ) Sets the range of cells at the virtual cursor position to render the given text in the given pen, and updates the position. Returns the number of columns wide the actual C<$text> is (which may be more than was actually printed). =cut =head2 erase_at $rb->erase_at( $line, $col, $len, $pen ) Sets the range of cells given to erase with the given pen. =cut =head2 erase $rb->erase( $len, $pen ) Sets the range of cells at the virtual cursor position to erase with the given pen, and updates the position. =cut =head2 erase_to $rb->erase_to( $col, $pen ) Sets the range of cells from the virtual cursor position until before the given column to erase with the given pen, and updates the position to the column. If the position is already past this column then the cursor is moved backwards and no buffer changes are made. =cut =head2 eraserect $rb->eraserect( $rect, $pen ) Sets the range of cells given by the rectangle to erase with the given pen. =cut =head1 LINE DRAWING The C supports storing line-drawing characters in cells, and can merge line segments where they meet, attempting to draw the correct character for the segments that meet in each cell. There are three exported constants giving supported styles of line drawing: =over 4 =item * LINE_SINGLE A single, thin line =item * LINE_DOUBLE A pair of double, thin lines =item * LINE_THICK A single, thick line =back Note that linedrawing is performed by Unicode characters, and not every possible combination of line segments of differing styles meeting in a cell is supported by Unicode. The following sets of styles may be relied upon: =over 4 =item * Any possible combination of only C segments, C segments, or both. =item * Any combination of only C segments, except cells that only have one of the four borders occupied. =item * Any combination of C and C segments except where the style changes between C to C on a vertical or horizontal run. =back Other combinations are not directly supported (i.e. any combination of C and C in the same cell, or any attempt to change from C to C in either the vertical or horizontal direction). To handle these cases, a cell may be rendered with a substitution character which replaces a C or C segment with a C one within that cell. The effect will be the overall shape of the line is retained, but close to the edge or corner it will have the wrong segment type. Conceptually, every cell involved in line drawing has a potential line segment type at each of its four borders to its neighbours. Horizontal lines are drawn though the vertical centre of each cell, and vertical lines are drawn through the horizontal centre. There is a choice of how to handle the ends of line segments, as to whether the segment should go to the centre of each cell, or should continue through the entire body of the cell and stop at the boundary. By default line segments will start and end at the centre of the cells, so that horizontal and vertical lines meeting in a cell will form a neat corner. When drawing isolated lines such as horizontal or vertical rules, it is preferable that the line go right through the cells at the start and end. To control this behaviour, the C<$caps> bitmask is used. C and C state that the line should consume the whole of the start or end cell, respectively; C is a convenient shortcut specifying both behaviours. A rectangle may be formed by combining two C and two C calls, without end caps: $rb->hline_at( $top, $left, $right, $style, $pen ); $rb->hline_at( $bottom, $left, $right, $style, $pen ); $rb->vline_at( $top, $bottom, $left, $style, $pen ); $rb->vline_at( $top, $bottom, $right, $style, $pen ); =cut =head2 hline_at $rb->hline_at( $line, $startcol, $endcol, $style, $pen, $caps ) Draws a horizontal line between the given columns (both are inclusive), in the given line style, with the given pen. =cut =head2 vline_at $rb->vline_at( $startline, $endline, $col, $style, $pen, $caps ) Draws a vertical line between the centres of the given lines (both are inclusive), in the given line style, with the given pen. =cut =head2 linebox_at $rb->linebox_at( $startline, $endline, $startcol, $endcol, $style, $pen ) A convenient shortcut to calling two C and two C in order to draw a rectangular box. =cut sub linebox_at { my $self = shift; my ( $startline, $endline, $startcol, $endcol, $style, $pen ) = @_; $self->hline_at( $startline, $startcol, $endcol, $style, $pen ); $self->hline_at( $endline, $startcol, $endcol, $style, $pen ); $self->vline_at( $startline, $endline, $startcol, $style, $pen ); $self->vline_at( $startline, $endline, $endcol, $style, $pen ); } =head2 char_at $rb->char_at( $line, $col, $codepoint, $pen ) Sets the given cell to render the given Unicode character (as given by codepoint number, not character string) in the given pen. =cut =head2 char $rb->char( $codepoint, $pen ) Sets the cell at the virtual cursor position to render the given Unicode character (as given by codepoint number, not character string) in the given pen, and updates the position. While this is also achieveable by the C and C methods, these methods are implemented without storing a text segment, so can be more efficient than many single-column wide C calls. =cut =head2 copyrect =head2 moverect $rb->copyrect( $dest, $src ) $rb->moverect( $dest, $src ) Copies (or moves) buffered content from one rectangular region to another. The two regions may overlap. The move operation is identical to the copy operation followed by setting the vacated areas of the source rectangle not covered by the destination to skipping state. =cut =head2 get_cell $cell = $rb->get_cell( $line, $col ) Returns a structure containing the content stored in the given cell. The C<$cell> structure responds to the following methods: =over 4 =item $cell->char On a skipped cell, returns C. On a text or char cell, returns the unicode codepoint number. On a line or erased cell, returns 0. =item $cell->linemask On a line cell, returns a representation of the line segments in the cell. This is a sub-structure with four fields; C, C, C, C to represent the four cell borders; the value of each is either zero, or one of the C constants. On any other kind of cell, returns C. =item $cell->pen Returns the C for non-skipped cells, or C for skipped cells. =back =cut readonly_struct Cell => [qw( char linemask pen )]; readonly_struct LineMask => [qw( north south east west )]; sub get_cell { my $self = shift; my ( $line, $col ) = @_; my ( $text, $pen, $north, $south, $east, $west ) = $self->_xs_get_cell( $line, $col ); if( !defined $text ) { # SKIP return Cell( undef, undef, undef ); } if( !length $text ) { # ERASE return Cell( 0, undef, $pen ); } if( !defined $north ) { # TEXT or CHAR return Cell( ord $text, undef, $pen ); } else { # LINE return Cell( 0, LineMask( $north, $south, $east, $west ), $pen ); } } =head2 flush_to_term $rb->flush_to_term( $term ) Renders the stored content to the given L. After this, the buffer will be cleared and reset back to initial state. =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/StringPos.pm000444001750001750 466514302155253 16046 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2012-2016 -- leonerd@leonerd.org.uk package Tickit::StringPos 0.73; use v5.14; use warnings; # XS code comes from Tickit itself require Tickit; =head1 NAME C - store string position counters =head1 SYNOPSIS use Tickit::StringPos; use Tickit::Utils qw( string_count ); my $pos = Tickit::StringPos->zero; string_count( "Here is a message", $pos ); print "The message consumes ", $pos->columns, " columns\n"; =head1 DESCRIPTION Instances in this object class store four position counters that relate to counting strings. The C member counts UTF-8 bytes which encode individual codepoints. For example the Unicode character U+00E9 is encoded by two bytes 0xc3, 0xa9; it would increment the bytes counter by 2 and the C counter by 1. The C member counts individual Unicode codepoints. The C member counts whole composed graphical clusters of codepoints, where combining accents which count as individual codepoints do not count as separate graphemes. For example, the codepoint sequence U+0065 U+0301 would increment the C counter by 2 and the C counter by 1. The C member counts the number of screen columns consumed by the graphemes. Most graphemes consume only 1 column, but some are defined in Unicode to consume 2. Instances are also used to store count limits, where any memeber may be set to -1 to indicate no limit in that counter. =cut =head1 CONSTRUCTORS =head2 zero $pos = Tickit::StringPos->zero Returns a new instance with all counters set to zero. =head2 limit_bytes =head2 limit_codepoints =head2 limit_graphemes =head2 limit_columns $pos = Tickit::StringPos->limit_bytes( $bytes ) $pos = Tickit::StringPos->limit_codepoints( $codepoints ) $pos = Tickit::StringPos->limit_graphemes( $graphemes ) $pos = Tickit::StringPos->limit_columns( $columns ) Return a new instance with one counter set to the given limit and the other three counters set to -1. =cut =head1 METHODS =head2 bytes =head2 codepoints =head2 graphemes =head2 columns $bytes = $pos->bytes $codepoints = $pos->codepoints $graphemes = $pos->graphemes $columns = $pos->columns Return the current value the counters. =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Term.pm000444001750001750 3412314302155253 15035 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2009-2020 -- leonerd@leonerd.org.uk package Tickit::Term 0.73; use v5.14; use warnings; use Carp; # Load the XS code use Tickit qw( MOD_SHIFT MOD_ALT MOD_CTRL BIND_FIRST ); # We export some constants use Exporter 'import'; # Old names for these use constant { TERM_CURSORSHAPE_BLOCK => CURSORSHAPE_BLOCK, TERM_CURSORSHAPE_UNDER => CURSORSHAPE_UNDER, TERM_CURSORSHAPE_LEFT_BAR => CURSORSHAPE_LEFT_BAR, }; push our @EXPORT_OK, qw( TERM_CURSORSHAPE_BLOCK TERM_CURSORSHAPE_UNDER TERM_CURSORSHAPE_LEFT_BAR MOD_SHIFT MOD_ALT MOD_CTRL BIND_FIRST ); =head1 NAME C - terminal formatting abstraction =head1 SYNOPSIS =head1 DESCRIPTION Provides terminal control primitives for L; a number of methods that control the terminal by writing control strings. This object itself performs no actual IO work; it writes bytes to a delegated object given to the constructor called the writer. This object is not normally constructed directly by the containing application; instead it is used indirectly by other parts of the C distribution. Note that a given program may contain multiple objects in this class that all refer to the same underlying C instance from the C library. This is especially true of the first argument provided to event binding callbacks. This class overloads numify and stringify operations, so that instances may be compared using the C<==> or C operators, or used as keys in hashes, and they will act as expected. Do not rely on plain C comparison however as you may get incorrect results. =cut use overload '0+' => "_xs_addr", '""' => sub { sprintf "Tickit::Term=XS(tt=0x%x)", $_[0]->_xs_addr }, fallback => 1; =head1 CONSTRUCTOR =cut =head2 new $term = Tickit::Term->new( %params ) Constructs a new C object. Takes the following named arguments at construction time: =over 8 =item UTF8 => BOOL If defined, overrides locale detection to enable or disable UTF-8 mode. If not defined then this will be detected from the locale by using Perl's C<${^UTF8LOCALE}> variable. =item writer => OBJECT An object delegated to for sending strings of terminal control bytes to the terminal itself. This object must support a single method, C, taking a string of bytes. $writer->write( $data ) Such an interface is supported by an C object. =item output_handle => HANDLE Optional. If supplied, will be used as the terminal filehandle for querying the size. Even if supplied, all writing operations will use the C function rather than performing IO operations on this filehandle. =item input_handle => HANDLE Optional. If supplied, will be used as the terminal filehandle for reading keypress and other events. =back =cut sub new { my $class = shift; my %params = @_; return $class->_new( $ENV{TERM}, @params{qw( input_handle output_handle writer UTF8 )} ) || croak "Cannot construct Tickit::Term - $!"; } =head2 open_stdio $term = Tickit::Term->open_stdio Convenient shortcut for obtaining a L instance bound to the STDIN and STDOUT streams of the process. =cut =head1 METHODS =cut =head2 get_input_handle $fh = $term->get_input_handle Returns the input handle set by the C constructor arg. Note that because L merely wraps an object provided by the lower-level F C library, it is no longer guaranteed that this method will return the same perl-level object that was given to the constructor. The object may be newly-constructed to represent a new perl-level readable filehandle on the same file number. =cut sub get_input_handle { my $self = shift; return IO::Handle->new_from_fd( $self->get_input_fd, "r" ); } =head2 get_output_handle $fh = $term->get_output_handle Returns the output handle set by the C constructor arg. Note that because L merely wraps an object provided by the lower-level F C library, it is no longer guaranteed that this method will return the same perl-level object that was given to the constructor. The object may be newly-constructed to represent a new perl-level writable filehandle on the same file number. =cut sub get_output_handle { my $self = shift; return IO::Handle->new_from_fd( $self->get_output_fd, "w" ); } =head2 set_output_buffer $term->set_output_buffer( $len ) Sets the size of the output buffer =cut =head2 await_started $term->await_started( $timeout ) Waits for the terminal startup process to complete, up to the timeout given in seconds. =cut =head2 pause $term->pause Suspends operation of the terminal by resetting it to its default state. =cut =head2 resume $term->resume Resumes operation of the terminal after a L. Typically these two methods are used together, either side of a blocking wait around a C. sub suspend { $term->pause; kill STOP => $$; $term->resume; $rootwin->expose; } =cut =head2 teardown $term->teardown Shuts down operation of the terminal entirely, in preparation for terminating the process. =cut =head2 flush $term->flush Flushes the output buffer to the terminal =cut =head2 bind_event $id = $term->bind_event( $ev, $code, $data ) Installs a new event handler to watch for the event specified by C<$ev>, invoking the C<$code> reference when it occurs. C<$code> will be invoked with the given terminal, the event name, an event information object, and the C<$data> value it was installed with. C returns an ID value that may be used to remove the handler by calling C. $ret = $code->( $term, $ev, $info, $data ) The type of C<$info> will depend on the kind of event that was received, as indicated by C<$ev>. The information structure types are documented in L. =head2 bind_event (with flags) $id = $term->bind_event( $ev, $flags, $code, $data ) The C<$code> argument may optionally be preceded by an integer of flag values. This should be zero to apply default semantics, or a bitmask of one or more of the following constants: =over 4 =item TICKIT_BIND_FIRST Inserts this event handler first in the chain, before any existing ones. =item TICKIT_BIND_ONESHOT Remove the event handler after it has been invoked the first time. =back =head2 unbind_event_id $term->unbind_event_id( $id ) Removes an event handler that returned the given C<$id> value. =cut sub bind_event { my $self = shift; my $ev = shift; my ( $flags, $code, $data ) = ( ref $_[0] ) ? ( 0, @_ ) : @_; $self->_bind_event( $ev, $flags, $code, $data ); } =head2 refresh_size $term->refresh_size If a filehandle was supplied to the constructor, fetch the size of the terminal and update the cached sizes in the object. May invoke C if the new size is different. =cut =head2 set_size $term->set_size( $lines, $cols ) Defines the size of the terminal. Invoke C if the new size is different. =cut =head2 lines =head2 cols $lines = $term->lines $cols = $term->cols Query the size of the terminal, as set by the most recent C or C operation. =cut sub lines { ( shift->get_size )[0] } sub cols { ( shift->get_size )[1] } =head2 goto $success = $term->goto( $line, $col ) Move the cursor to the given position on the screen. If only one parameter is defined, does not alter the other. Both C<$line> and C<$col> are 0-based. Note that not all terminals can support these partial moves. This method returns a boolean indicating success; if the terminal could not perform the move it will need to be retried using a fully-specified call. =cut =head2 move $term->move( $downward, $rightward ) Move the cursor relative to where it currently is. =cut =head2 scrollrect $success = $term->scrollrect( $top, $left, $lines, $cols, $downward, $rightward ) Attempt to scroll the rectangle of the screen defined by the first four parameters by an amount given by the latter two. Since most terminals cannot perform arbitrary rectangle scrolling, this method returns a boolean to indicate if it was successful. The caller should test this return value and fall back to another drawing strategy if the attempt was unsuccessful. The cursor may move as a result of calling this method; its location is undefined if this method returns successful. =cut =head2 chpen $term->chpen( $pen ) $term->chpen( %attrs ) Changes the current pen attributes to those given. Any attribute whose value is given as C is reset. Any attributes not named are unchanged. For details of the supported pen attributes, see L. =cut =head2 setpen $term->setpen( $pen ) $term->setpen( %attrs ) Similar to C, but completely defines the state of the terminal pen. Any attribute not given will be reset to its default value. =cut =head2 print $term->print( $text, [ $pen ] ) Print the given text to the terminal at the current cursor position. An optional C may be provided; if present it will be set as if given to C first. =cut =head2 clear $term->clear( [ $pen ] ) Erase the entire screen. An optional C may be provided; if present it will be set as if given to C first. =cut =head2 erasech $term->erasech( $count, $moveend, [ $pen ] ) Erase C<$count> characters forwards. If C<$moveend> is true, the cursor is moved to the end of the erased region. If defined but false, the cursor will remain where it is. If undefined, the terminal will perform whichever of these behaviours is more efficient, and the cursor will end at some undefined location. Using C<$moveend> may be more efficient than separate C and C calls on terminals that do not have an erase function, as it will be implemented by printing spaces. This removes the need for two cursor jumps. An optional C may be provided; if present it will be set as if given to C first. =cut =head2 getctl_int =head2 setctl_int $value = $term->getctl_int( $ctl ) $success = $term->setctl_int( $ctl, $value ) Gets or sets the value of an integer terminal control option. C<$ctl> should be one of the following options. They can be specified either as integers, using the following named constants, or as strings giving the part following C in lower-case. On failure, each method returns C. =over 8 =item TERMCTL_ALTSCREEN Enables DEC Alternate Screen mode =item TERMCTL_CURSORVIS Enables cursor visible mode =item TERMCTL_CURSORBLINK Enables cursor blinking mode =item TERMCTL_CURSORSHAPE Sets the shape of the cursor. C<$value> should be one of C, C or C. =item TERMCTL_KEYPAD_APP Enables keypad application mode =item TERMCTL_MOUSE Enables mouse tracking mode. C<$vaule> should be one of C, C, C or C. =back =head2 setctl_str $success = $term->setctl_str( $ctl, $value ) Sets the value of a string terminal control option. C<$ctrl> should be one of the following options. They can be specified either as integers or strings, as for C. =over 8 =item TERMCTL_ICON_TEXT =item TERMCTL_TITLE_TEXT =item TERMCTL_ICONTITLE_TEXT Sets the terminal window icon text, title, or both. =back =head2 getctl =head2 setctl $value = $term->getctl( $ctl ) $success = $term->setctl( $ctl, $value ) A newer form of the various typed get and set methods above. This version will interpret the given value as appropriate, depending on the control type. =cut =head2 input_push_bytes $term->input_push_bytes( $bytes ) Feeds more bytes of input. May result in C or C events. =cut =head2 input_readable $term->input_readable Informs the term that the input handle may be readable. Attempts to read more bytes of input. May result in C or C events. =cut =head2 input_wait $term->input_wait( $timeout ) Block until some input is available, and process it. Returns after one round of input has been processed. May result in C or C events. If C<$timeout> is defined, it will wait a period of time no longer than this time before returning, even if no input events were received. =cut =head2 check_timeout $timeout = $term->check_timeout Returns a number in seconds to represent when the next timeout should occur on the terminal, or C if nothing is waiting. May invoke expired timeouts, and cause a C event to occur. =cut =head2 emit_key $term->emit_key( type => $type, str => $str, [ mod => $mod ] ) Invokes the key event handlers as if an event with the given info had just been received. The C argument is optional, a default of 0 will apply if it is missing. =cut sub emit_key { my $self = shift; my %args = @_; $self->_emit_key( Tickit::Event::Key->_new( $args{type}, $args{str}, $args{mod} // 0 ) ); } =head2 emit_mouse $term->emit_mouse( type => $type, button => $button, line => $line, col => $col, [ mod => $mod ] ) Invokes the mouse event handlers as if an event with the given info had just been received. The C argument is optional, a default of 0 will apply if it is missing. =cut sub emit_mouse { my $self = shift; my %args = @_; $self->_emit_mouse( Tickit::Event::Mouse->_new( $args{type}, $args{button}, $args{line}, $args{col}, $args{mod} // 0 ) ); } =head1 EVENTS The following event types are emitted and may be observed by L. =head2 resize Emitted when the terminal itself has been resized. =head2 key Emitted when a key on the keyboard is pressed. =head2 mouse Emitted when a mouse button is pressed or released, the cursor moved while a button is held (a dragging event), or the wheel is scrolled. Behaviour of events involving more than one mouse button is not well-specified by terminals. =cut =head1 TODO =over 4 =item * Track cursor position, and optimise (or eliminate entirely) C calls. =back =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Test.pm000444001750001750 4135114302155253 15046 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2011-2021 -- leonerd@leonerd.org.uk package Tickit::Test 0.73; use v5.14; use warnings; use Carp; use Exporter 'import'; our @EXPORT = qw( mk_term mk_tickit mk_window mk_term_and_window flush_tickit drain_termlog clear_term resize_term presskey pressmouse is_termlog is_display is_cursorpos is_termctl TEXT BLANK BLANKLINE BLANKLINES CLEAR GOTO ERASECH SCROLLRECT PRINT SETPEN SETBG ); use Tickit::Test::MockTerm; use Tickit::Pen; use Tickit; use Tickit::Utils qw( textwidth substrwidth ); use Test::Builder; use Time::HiRes qw( time ); =head1 NAME C - unit testing for C-based code =head1 SYNOPSIS use Test::More tests => 2; use Tickit::Test; use Tickit::Widget::Static; my $win = mk_window; my $widget = Tickit::Widget::Static->new( text => "Message" ); $widget->set_window( $win ); flush_tickit; is_termlog( [ SETPEN, CLEAR, GOTO(0,0), SETPEN, PRINT("Message"), SETBG(undef), ERASECH(73) ] ); is_display( [ "Message" ] ); =head1 DESCRIPTION This module helps write unit tests for L-based code, such as L subclasses. Primarily, it provides a mock terminal implementation, allowing the code under test to affect a virtual terminal, whose state is inspectable by the unit test script. This module is used by the C unit tests themselves, and provided as an installable module, so that authors of widget subclasses can use it too. =cut =head1 FUNCTIONS =cut my $term; my $tickit; =head2 mk_term $term = mk_term Constructs and returns the mock terminal to unit test with. This object will be cached and returned if this function is called again. Most unit tests will want a root window as well; for convenience see instead C. The mock terminal usually starts with a size of 80 columns and 25 lines, though can be overridden by passing named arguments. $term = mk_term lines => 30, cols => 100; =cut sub mk_term { return $term ||= Tickit::Test::MockTerm->new( @_ ); } =head2 mk_tickit $tickit = mk_tickit Constructs and returns the mock toplevel L instance to unit test with. This object will be cached and returned if the function is called again. Note that this object is not a full implementation and in particular does not have a real event loop. Any later or timer watches are stored internally and flushed by the L function. This helps isolate unit tests from real-world effects. =cut sub mk_tickit { mk_term; return $tickit ||= __PACKAGE__->new( term => $term ); } =head2 mk_window $win = mk_window Construct a root window using the mock terminal, to unit test with. =cut sub mk_window { mk_tickit; my $win = $tickit->rootwin; # Clear the method log from ->setup_term $term->get_methodlog; return $win; } =head2 mk_term_and_window ( $term, $win ) = mk_term_and_window Constructs and returns the mock terminal and root window; equivalent to calling each of C and C separately. =cut sub mk_term_and_window { my $term = mk_term( @_ ); my $win = mk_window; return ( $term, $win ); } ## Actual object implementation use base qw( Tickit ); use Struct::Dumb 0.04; my @later; sub watch_later { push @later, $_[1]; return \$later[-1] } my @timers; BEGIN { struct Timer => [qw( after code )], predicate => "is_Timer"; } sub watch_timer_after { # keep list sorted @timers = sort { $a->after <=> $b->after } @timers, my $w = Timer( $_[1], $_[2] ); return $w; } sub watch_timer_at { watch_timer_after( $_[0], $_[1] - time, $_[2] ); } sub watch_cancel { my ( undef, $w ) = @_; if( ref $w eq "REF" ) { # later @later = grep { \$_ != $w } @later; } if( is_Timer $w ) { @timers = grep { $_ != $w } @timers; } } sub lines { return $term->lines } sub cols { return $term->cols } =head2 flush_tickit flush_tickit( $timeskip ) Flushes any pending timer or later events in the testing C object. Because the unit test script has no real event loop, this is required instead, to flush any pending events. If the optional C<$timeskip> argument has a nonzero value then any queued timers will experience the given amount of time passing; any that should now expire will be invoked. =cut sub flush_tickit { my ( $timeskip ) = @_; while( @later ) { my @queue = @later; @later = (); $_->() for @queue; } if( $timeskip ) { $_->after -= $timeskip for @timers; } while( @timers and $timers[0]->after <= 0 ) { ( shift @timers )->code->(); } $tickit->rootwin->flush if $tickit && $tickit->rootwin; } =head2 drain_termlog drain_termlog Drains any pending events from the method log used by the C test. Useful to clear up non-tested events before running a test. =cut sub drain_termlog { $term->get_methodlog; } =head2 clear_term clear_term Clears the entire content form the mock terminal. Useful at the end of a section of tests before starting another one. Don't forget to C afterwards. =cut sub clear_term { $term->clear } =head2 resize_term resize_term( $lines, $cols ) Resize the virtual testing terminal to the size given =cut sub resize_term { my ( $lines, $cols ) = @_; $term->resize( $lines, $cols ); } =head2 presskey presskey( $type, $str, $mod ) Fire a key event =cut sub presskey { my ( $type, $str, $mod ) = @_; $term->_emit_key( Tickit::Event::Key->_new( $type, $str, $mod || 0 ) ); } =head2 pressmouse pressmouse( $type, $button, $line, $col, $mod ) Fire a mouse button event =cut sub pressmouse { my ( $type, $button, $line, $col, $mod ) = @_; $term->_emit_mouse( Tickit::Event::Mouse->_new( $type, $button, $line, $col, $mod || 0 ) ); } =head1 TEST FUNCTIONS The following functions can be used like C primitives, in unit test scripts. =cut sub _pen2string { my $pen = shift; my %attrs = $pen ? %$pen : (); # Normalise requests to reset to default as undef defined $attrs{$_} and $attrs{$_} == -1 and undef $attrs{$_} for @Tickit::Pen::INT_ATTRS; !$attrs{$_} and undef $attrs{$_} for @Tickit::Pen::BOOL_ATTRS; # Remove undefs defined $attrs{$_} or delete $attrs{$_} for keys %attrs; return "{" . join( ",", map { defined $attrs{$_} ? "$_=" . ($attrs{$_} || 0) : "!$_" } sort keys %attrs ) . "}"; } =head2 is_termlog is_termlog( [ @log ], $name ) Asserts that the mock terminal log contains exactly the given sequence of methods. See also the helper functions below. Because this test is quite fragile, relying on the exact nature and order of drawing methods invoked on the terminal, it should only be used rarely. Most normal cases of widget unit tests should instead only use C. is_termlog( { $pos => \@log, ... }, $name ) The expectation HASH is keyed by strings giving a GOTO position, and the test asserts that a sequence of GOTO and other operations were performed equivalent to the expectations given in the HASH. This differs from the simpler ARRAY reference form by being somewhat more robust against rendering order. It checks that every expectation sequence happens exactly once, but does not care which order the sections happen in. is_termlog( { "0,0" => [ PRINT("Hello") ], "0,6" => [ PRINT("World!") ] } ); =cut sub _step_to_text { my ( $step ) = @_; return "none" unless defined $step; my ( $op, @args ) = @$step; if( $op eq "setpen" ) { return "$op(" . _pen2string( $args[0] ) . ")"; } else { return "$op(" . join( ",", map { defined $_ ? $_ =~ m/^-?\d+$/ ? $_ : qq("$_") : "undef" } @args ) . ")"; } } sub _steps_ok { my ( $tb, $want_log, $got_log, $stop_before_GOTO, $name ) = @_; my $prev_line; for( my $idx = 0; @$want_log or @$got_log; $idx++ ) { my $got_line; if( $stop_before_GOTO and @$got_log and $got_log->[0][0] eq "goto" ) { $got_line = undef; } else { $got_line = shift @$got_log; } my $want_line = shift @$want_log; if( $want_line and $want_line->[0] eq "setpen_bg" and $got_line and $got_line->[0] eq "setpen" ) { $got_line = [ setpen_bg => $got_line->[1]->{bg} ]; } $_ = _step_to_text($_) for $want_line, $got_line; if( $want_line eq $got_line ) { $prev_line = $want_line; return 1 if $stop_before_GOTO and @$got_log and $got_log->[0][0] eq "goto"; next; } local $" = ","; my $ok = $tb->ok( 0, $name ); $tb->diag( "Expected terminal operation $want_line, got $got_line at step $idx" ); $tb->diag( " after $prev_line" ) if defined $prev_line; return $ok; } return 1; } sub is_termlog { my ( $log, $name ) = @_; my $tb = Test::Builder->new; my @got_log = $term->get_methodlog; if( ref $log eq "ARRAY" ) { local $Test::Builder::Level = $Test::Builder::Level + 1; return unless _steps_ok( $tb, $log, \@got_log, 0, $name ); } elsif( ref $log eq "HASH" ) { my %regions = %$log; while( keys %regions and @got_log ) { if( !$got_log[0]->[0] eq "goto" ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Expected a goto terminal operation, got " . _step_to_text( $got_log[0] ) ); return $ok; } my $pos = sprintf "%d,%d", @{ shift @got_log }[1,2]; my $want_log = delete $regions{$pos}; unless( $want_log ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Did not expect goto($pos)" ); return $ok; } local $Test::Builder::Level = $Test::Builder::Level + 1; return unless _steps_ok( $tb, $want_log, \@got_log, 1, $name ); } if( keys %regions ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Expected a goto(" . ( keys %regions )[0] . ", got none" ); return $ok; } if( @got_log ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Expected none, got " . _step_to_text( $got_log[0] ) ); return $ok; } } return $tb->ok( 1, $name ); } =head2 is_display is_display( $lines, $name ) Asserts that the mock terminal display is exactly that as given by the content of C<$lines>, which must be an ARRAY reference containing one value for each line of the display. Each item may either be a plain string, or an ARRAY reference. If a plain string is given, it asserts that the characters on display are those as given by the string (trailing blanks may be omitted). The pen attributes of the characters do not matter in this case. is_display( [ "some lines of", "content here" ] ); If an ARRAY reference is given, it should contain chunks of content from the C function. Each chunk represents content on display for the corresponding columns. is_display( [ [TEXT("some"), TEXT(" lines of")], "content here" ] ); The C function accepts pen attributes, to assert that the displayed characters have exactly the attributes given. In character cells containing spaces, only the C attribute is tested. is_display( [ [TEXT("This is ",fg=>2), TEXT("bold",fg=>2,b=>1) ] ] ); The C function is a shortcut to providing a number of blank cells BLANK(20,bg=>1) is TEXT(" ",bg=>1) The C and C functions are a shortcut to providing an entire line, or several lines, of blank content. They yield an array reference or list of array references directly. BLANKLINE is [TEXT("")] BLANKLINES(3) is [TEXT("")], [TEXT("")], [TEXT("")] =cut sub is_display { my ( $lines, $name ) = @_; my $tb = Test::Builder->new; foreach my $line ( 0 .. $term->lines - 1 ) { my $want = $lines->[$line]; if( ref $want ) { my @chunks = @$want; my $col = 0; while( $col < $term->cols ) { my $chunk = shift @chunks; my ( $want_text ) = ref $chunk ? @$chunk : ( $chunk ); $want_text .= " " x ( $term->cols - $col ) unless defined $want_text and length $want_text; my $got_text = $term->get_display_text( $line, $col, textwidth $want_text ); if( $got_text ne $want_text ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Display differs on line $line at column $col" ); $tb->diag( "Got: '$got_text'" ); $tb->diag( "Expected: '$want_text'" ); return $ok; } my $want_pen = _pen2string( $chunk->[1] ); my $idx = 0; while( $idx < textwidth $want_text ) { if( substrwidth( $want_text, $idx, 1 ) eq " " ) { my $want_bg = $chunk->[1]->{bg} // "undef"; my $got_bg = $term->get_display_pen( $line, $col )->{bg} // "undef"; if( $got_bg ne $want_bg ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Display differs on line $line at column $col" ); $tb->diag( "Got pen bg: $got_bg" ); $tb->diag( "Expected pen bg: $want_bg" ); return $ok; } } else { my $got_pen = _pen2string( $term->get_display_pen( $line, $col ) ); if( $got_pen ne $want_pen ) { my $ok = $tb->ok( 0, $name ); $tb->diag( "Display differs on line $line at column $col" ); $tb->diag( "Got pen: $got_pen" ); $tb->diag( "Expected pen: $want_pen" ); return $ok; } } $idx++; $col++; } } } elsif( defined $want ) { my $display_line = $term->get_display_text( $line, 0, $term->cols ); # pad blanks $want = sprintf "% -*s", $term->cols, $want; $want eq $display_line and next; my $ok = $tb->ok( 0, $name ); $tb->diag( "Display differs on line $line" ); $tb->diag( "Got: '$display_line'" ); $tb->diag( "Expected: '$want'" ); return $ok; } else { my $display_line = $term->get_display_text( $line, 0, $term->cols ); $display_line eq " " x $term->cols and next; my $ok = $tb->ok( 0, $name ); $tb->diag( "Display differs on line $line" ); $tb->diag( "Got: '$display_line'" ); $tb->diag( "Expected: blank" ); return $ok; } } return $tb->ok( 1, $name ); } =head2 is_cursorpos is_cursorpos( $line, $col, $name ) Asserts that the mock terminal cursor is at the given position. =cut sub is_cursorpos { my ( $line, $col, $name ) = @_; my $tb = Test::Builder->new; my $at_line = $term->line; my $at_col = $term->col; my $ok = $tb->ok( $line == $at_line && $col == $at_col, $name ); $tb->diag( "Expected to be on line $line, actually on line $at_line" ) if $line != $at_line; $tb->diag( "Expected to be on column $col, actually on column $at_col" ) if $col != $at_col; return $ok; } =head2 is_termctl is_termctl( $ctl, $value, $name ) Asserts that the mock terminal has the given value for the given terminal control. C<$ctl> should be a value from the C constants. =cut sub is_termctl { my ( $ctl, $value, $name ) = @_; my $tb = Test::Builder->new; # currently all the supported ctls are numeric anyway return $tb->is_num( my $got = $term->getctl( $ctl ), $value, $name ); } sub TEXT { my $text = shift; my %attrs = @_; return [ $text, \%attrs ]; } sub BLANK { my $count = shift; TEXT(" "x$count, @_); } sub BLANKLINE { [ TEXT("", @_) ]; } sub BLANKLINES { my $count = shift; ( BLANKLINE(@_) ) x $count; } use constant DEFAULTPEN => map { $_ => undef } @Tickit::Pen::ALL_ATTRS; =head1 METHOD LOG HELPER FUNCTIONS The following functions can be used to help write the expected log for a call to C. CLEAR GOTO($line,$col) ERASECH($count,$move_to_end) SCROLLRECT($top,$left,$lines,$cols,$downward,$rightward) PRINT($string) SETPEN(%attrs) SETBG($bg_attr) =cut sub CLEAR { [ clear => ] } sub GOTO { [ goto => $_[0], $_[1] ] } sub ERASECH { [ erasech => $_[0], $_[1] || 0 ] } sub SCROLLRECT { [ scrollrect => @_[0..5] ] } sub PRINT { [ print => $_[0] ] } sub SETPEN { [ setpen => { DEFAULTPEN, @_ } ] } sub SETBG { [ setpen_bg => $_[0] ] } =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Utils.pm000444001750001750 1737114302155253 15234 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2011-2016 -- leonerd@leonerd.org.uk package Tickit::Utils 0.73; use v5.14; use warnings; use Carp; use Exporter 'import'; our @EXPORT_OK = qw( string_count string_countmore textwidth chars2cols cols2chars substrwidth align bound distribute ); # XS code comes from Tickit itself require Tickit; =head1 NAME C - utility functions for C =head1 DESCRIPTION This module provides a number of utility functions used across C. =cut =head1 FUNCTIONS =head2 string_count $bytes = string_count( $str, $pos, $limit ) Given a string in C<$str> and a L instance in C<$pos>, updates the counters in C<$pos> by counting the string, and returns the number of bytes consumed. If C<$limit> is given, then it will count no further than any of the limits given. =head2 string_countmore $bytes = string_countmore( $str, $pos, $limit ) Similar to C but will not zero the counters before it begins. Counters in C<$pos> will still be incremented. =head2 textwidth $cols = textwidth( $str ) Returns the number of screen columns consumed by the given (Unicode) string. =cut # Provided by XS =head2 chars2cols @cols = chars2cols( $text, @chars ) Given a list of increasing character positions, returns a list of column widths of those characters. In scalar context returns the first columns width. =cut # Provided by XS =head2 cols2chars @chars = cols2chars( $text, @cols ) Given a list of increasing column widths, returns a list of character positions at those widths. In scalar context returns the first character position. =cut # Provided by XS =head2 substrwidth $substr = substrwidth $text, $startcol $substr = substrwidth $text, $startcol, $widthcols $substr = substrwidth $text, $startcol, $widthcols, $replacement Similar to C, but counts start offset and length in screen columns instead of characters =cut sub substrwidth { if( @_ > 2 ) { my ( $start, $end ) = cols2chars( $_[0], $_[1], $_[1]+$_[2] ); if( @_ > 3 ) { return substr( $_[0], $start, $end-$start, $_[3] ); } else { return substr( $_[0], $start, $end-$start ); } } else { my $start = cols2chars( $_[0], $_[1] ); return substr( $_[0], $start ); } } =head2 align ( $before, $alloc, $after ) = align( $value, $total, $alignment ) Returns a list of three integers created by aligning the C<$value> to a position within the C<$total> according to C<$alignment>. The sum of the three returned values will always add to total. If the value is not larger than the total then the returned allocation will be the entire value, and the remaining space will be divided between before and after according to the given fractional alignment, with more of the remainder being allocated to the C<$after> position in proportion to the alignment. If the value is larger than the total, then the total is returned as the allocation and the before and after positions will both be given zero. =cut sub align { my ( $value, $total, $alignment ) = @_; return ( 0, $total, 0 ) if $value >= $total; my $spare = $total - $value; my $before = int( $spare * $alignment ); return ( $before, $value, $spare - $before ); } =head2 bound $val = bound( $min, $val, $max ) Returns the value of C<$val> bounded by the given minimum and maximum. Either limit may be left undefined, causing no limit of that kind to be applied. =cut sub bound { my ( $min, $val, $max ) = @_; $val = $min if defined $min and $val < $min; $val = $max if defined $max and $val > $max; return $val; } =head2 distribute distribute( $total, @buckets ) Given a total amount of quota, and a list of buckets, distributes the quota among the buckets according to the values given in them. Each value in the C<@buckets> list is a C reference which will be modified by the function. On entry, the following keys are inspected. =over 8 =item base => INT If present, this bucket shall be a flexible bucket containing initially this quantity of quota, but may be allocated more, or less, depending on the value of the C key, and how much spare is remaining. =item expand => INT For a C flexible bucket, the relative distribution of C value among the flexible buckets determines how the spare quota is distributed among them. If absent, defaults to 0. =item fixed => INT If present, this bucket shall be of the exact fixed size given. =back On return, the bucket hashes will be modified to contain two more keys: =over 8 =item value => INT The amount of quota allocated to this bucket. For C buckets, this will be the fixed value. For C buckets, this may include extra spare quota distributed in proportion to the C value, or may be reduced in order to fit the total. =item start => INT Gives the cumulative amount of quota allocated to each previous bucket. The first bucket's C value will be 0, the second will be the C allocated to the first, and so on. =back The bucket hashes will not otherwise be modified; the caller may place any extra keys in the hashes as required. =cut sub _assert_int { my ( $name, $value ) = @_; $value == int $value or croak "'$name' value must be an integer"; return $value; } sub distribute { my ( $total, @buckets ) = @_; _assert_int total => $total; my $base_total = 0; my $expand_total = 0; my $fixed_total = 0; foreach my $b ( @buckets ) { if( defined $b->{base} ) { $base_total += _assert_int base => $b->{base}; $expand_total += _assert_int expand => $b->{expand} || 0; } elsif( defined $b->{fixed} ) { $fixed_total += _assert_int fixed => $b->{fixed}; } } my $allocatable = $total - $fixed_total; my $spare = $allocatable - $base_total; if( $spare >= 0 ) { my $err = 0; # This algorithm tries to allocate spare quota roughly evenly to the # buckets. It keeps track of rounding errors in $err, to ensure that # rounding-down-to-int() errors don't leave us some spare amount my $current = 0; foreach my $b ( @buckets ) { die "ARG: ran out of quota" if( $current > $total ); my $amount; if( defined $b->{base} ) { my $extra = 0; if( $expand_total ) { $extra = $spare * ( $b->{expand} || 0 ); # Avoid floating point divisions $err += $extra % $expand_total; $extra = do { use integer; $extra / $expand_total }; $extra++, $err -= $expand_total if $err >= $expand_total; } $amount = $b->{base} + $extra; } elsif( defined $b->{fixed} ) { $amount = $b->{fixed}; } if( $current + $amount > $total ) { $amount = $total - $current; # All remaining space } $b->{start} = $current; $b->{value} = $amount; $current += $amount; } } elsif( $allocatable > 0 ) { # Divide it best we can my $err = 0; my $current = 0; foreach my $b ( @buckets ) { my $amount; if( defined $b->{base} ) { $amount = $b->{base} * $allocatable / $base_total; $err += $amount - int($amount); $amount++, $err-- if $err >= 1; $amount = int($amount); } elsif( defined $b->{fixed} ) { $amount = $b->{fixed}; } $b->{start} = $current; $b->{value} = $amount; $current += $amount; } } } =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-0.73/lib/Tickit/Window.pm000444001750001750 5700014302155253 15374 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2009-2019 -- leonerd@leonerd.org.uk package Tickit::Window 0.73; use v5.14; use warnings; use Carp; use Scalar::Util qw( weaken refaddr blessed ); use List::Util qw( first ); use Tickit::Pen; use Tickit::Rect; use Tickit::RectSet; use Tickit::RenderBuffer; use Tickit::Utils qw( string_countmore ); use Tickit::Debug; use constant WEAKEN_CHILDREN => $ENV{TICKIT_CHILD_WINDOWS_WEAKEN} // 1; =head1 NAME C - a window for drawing operations =head1 SYNOPSIS use Tickit; use Tickit::Pen; my $tickit = Tickit->new; my $rootwin = $tickit->rootwin; $rootwin->bind_event( expose => sub { my ( $win, undef, $info ) = @_; my $rb = $info->rb; $rb->clear; $rb->text_at( int( $win->lines / 2 ), int( ($win->cols - 12) / 2 ), "Hello, world" ); }); $rootwin->bind_event( geomchange => sub { shift->expose } ); $rootwin->set_pen( Tickit::Pen->new( fg => "white" ) ); $rootwin->expose; $tickit->run; =head1 DESCRIPTION Provides coordination of widget drawing activities. A C represents a region of the screen that a widget occupies. Windows cannot directly be constructed. Instead they are obtained by sub-division of other windows, ultimately coming from the root window associated with the terminal. Normally all windows are visible, but a window may be hidden by calling the C method. After this, the window will not respond to any of the drawing methods, until it is made visible again with the C method. A hidden window will not receive focus or input events. It may still receive geometry change events if it is resized. =head2 Sub Windows A division of a window made by calling C or C obtains a window that represents some portion of the drawing area of the parent window. Child windows are stored in order; C adds a new child to the end of the list, and C adds one at the start. Higher windows (windows more towards the start of the list), will always handle input events before lower siblings. The extent of windows also obscures lower windows; drawing on lower windows may not be visible because higher windows are above it. =head2 Deferred Child Window Operations In order to minimise the chances of ordering-specific bugs in window event handlers that cause child window creation, reordering or deletion, the actual child window list is only mutated after the event processing has finished, by using a L C block. =cut # Internal constructor sub new { my $class = shift; my ( $tickit ) = @_; return $class->_new_root( $tickit->term, $tickit ); } # We need to ensure all geomety changes happen before any redrawing =head1 METHODS =cut =head2 close $win->close Removes the window from its parent and clears any event handlers set using L. Also recursively closes any child windows. Currently this is an optional method, as child windows are stored as weakrefs, so should be destroyed when the last reference to them is dropped. Widgets should make sure to call this method anyway, because this will be changed in a future version. =cut =head2 make_sub $sub = $win->make_sub( $top, $left, $lines, $cols ) Constructs a new sub-window of the given geometry, and places it at the end of the child window list; below any other siblings. =cut sub make_sub { my $self = shift; return $self->_make_sub( @_, WINDOW_LOWEST ); } =head2 make_hidden_sub $sub = $win->make_hidden_sub( $top, $left, $lines, $cols ) Constructs a new sub-window like C, but the window starts initially hidden. This avoids having to call C separately afterwards. =cut sub make_hidden_sub { my $self = shift; return $self->_make_sub( @_, WINDOW_HIDDEN ); } =head2 make_float $float = $win->make_float( $top, $left, $lines, $cols ) Constructs a new sub-window of the given geometry, and places it at the start of the child window list; above any other siblings. =cut sub make_float { my $self = shift; return $self->_make_sub( @_, 0 ); } =head2 make_popup $popup = $win->make_popup( $top, $left, $lines, $cols ) Constructs a new floating popup window starting at the given coordinates relative to this window. It will be sized to the given limits. This window will have the root window as its parent, rather than the window the method was called on. Additionally, a popup window will steal all keyboard and mouse events that happen, regardless of focus or mouse position. It is possible that, if the window has an C handler, that it may receive mouse events from outwide the bounds of the window. =cut sub make_popup { my $self = shift; return $self->_make_sub( @_, WINDOW_POPUP ); } =head2 bind_event $id = $win->bind_event( $ev, $code, $data ) Installs a new event handler to watch for the event specified by C<$ev>, invoking the C<$code> reference when it occurs. C<$code> will be invoked with the given window, the event name, an event information object, and the C<$data> value it was installed with. C returns an ID value that may be used to remove the handler by calling C. $ret = $code->( $win, $ev, $info, $data ) The type of C<$info> will depend on the kind of event that was received, as indicated by C<$ev>. The information structure types are documented in L. =head2 bind_event (with flags) $id = $win->bind_event( $ev, $flags, $code, $data ) The C<$code> argument may optionally be preceded by an integer of flag values. This should be zero to apply default semantics, or a bitmask of constants. The constants are documented in L. =cut sub bind_event { my $self = shift; my $ev = shift; my ( $flags, $code, $data ) = ( ref $_[0] ) ? ( 0, @_ ) : @_; $self->_bind_event( $ev, $flags, $code, $data ); } =head2 unbind_event_id $win->unbind_event_id( $id ) Removes an event handler that returned the given C<$id> value. =cut =head2 raise $win->raise =head2 lower $win->lower Moves the order of the window in its parent one higher or lower relative to its siblings. =cut =head2 raise_to_front $win->raise_to_front Moves the order of the window in its parent to be the front-most among its siblings. =cut =head2 lower_to_back $win->lower_to_back Moves the order of the window in its parent to be the back-most among its siblings. =cut =head2 parent $parentwin = $win->parent Returns the parent window; i.e. the window on which C or C was called to create this one =cut =head2 subwindows @windows = $win->subwindows Returns a list of the subwindows of this one. They are returned in order, highest first. =cut =head2 root $rootwin = $win->root Returns the root window =cut =head2 term $term = $win->term Returns the L instance of the terminal on which this window lives. Note that it is not guaranteed that this method will return the same Perl-level terminal instance that the root window was constructed with. In particular, if the root window in fact lives on a mock terminal created by L this method may "forget" this fact, returning an object instance simply in the C class instead. While the instance will still be useable as a terminal, the fact it was a mock terminal may get forgotten. =cut =head2 tickit $tickit = $win->tickit Returns the L instance with which this window is associated. =cut sub tickit { return shift->root->_tickit; } =head2 show $win->show Makes the window visible. Allows drawing methods to output to the terminal. Calling this method also exposes the window, invoking the C handler. Shows the cursor if this window currently has focus. =cut =head2 hide $win->hide Makes the window invisible. Prevents drawing methods outputting to the terminal. Hides the cursor if this window currently has focus. =cut =head2 is_visible $visible = $win->is_visible Returns true if the window is currently visible. =cut =head2 resize $win->resize( $lines, $cols ) Change the size of the window. =cut =head2 reposition $win->reposition( $top, $left ) Move the window relative to its parent. =cut =head2 change_geometry $win->change_geometry( $top, $left, $lines, $cols ) A combination of C and C, to atomically change all the coordinates of the window. Will only invoke C once, rather than twice as would be the case calling the above methods individually. =cut our $INDENT = ""; sub _do_expose { my $self = shift; my ( $rect, $rb ) = @_; $rb->setpen( $self->pen ); Tickit::Debug->log( Wx => "${INDENT}Expose %s %s", $self->sprintf, $rect->sprintf ) if DEBUG; local $INDENT = "| $INDENT"; foreach my $win ( $self->subwindows ) { next unless $win->is_visible; if( my $winrect = $rect->intersect( $win->rect ) ) { $rb->save; $rb->clip( $winrect ); $rb->translate( $win->top, $win->left ); $win->_do_expose( $winrect->translate( -$win->top, -$win->left ), $rb ); $rb->restore; } $rb->mask( $win->rect ); } $rb->save; $self->_fire_event( expose => Tickit::Event::Expose->_new( $rb, $rect ) ); $rb->restore; } =head2 expose $win->expose( $rect ) Marks the given region of the window as having been exposed, to invoke the C event handler on itself, and all its child windows. The window's own handler will be invoked first, followed by all the child windows, in screen order (top to bottom, then left to right). If C<$rect> is not supplied it defaults to exposing the entire window area. The C event handler isn't invoked immediately; instead, the C C method is used to invoke it at the next round of IO event handling. Until then, any other window could be exposed. Duplicates are suppressed; so if a window and any of its ancestors are both queued for expose, the actual handler will only be invoked once per unique region of the window. =cut =head2 getctl =head2 setctl $value = $win->getctl( $ctl ) $success = $win->setctl( $ctl, $value ) Accessor and mutator for window control options. C<$ctl> should be one of the following options: =over 4 =item cursor-blink (bool) =item cursor-shape (int) =item cursor-visible (bool) Cursor properties to set for the terminal cursor when this window has input focus. =item focus-child-notify (bool) Whether the window will also receive focus events about child windows. =item steal-input (bool) Whether the window is currently stealing input from its siblings. =back =cut =head2 set_focus_child_notify $win->set_focus_child_notify( $notify ) If set to a true value, the C event handler will also be invoked when descendent windows gain or lose focus, in addition to when it gains or loses focus itself. Defaults to false; meaning the C handler only receives notifications about the window itself. =cut sub set_focus_child_notify { my $self = shift; my ( $notify ) = @_; $self->setctl( 'focus-child-notify' => $notify ); } =head2 top =head2 bottom =head2 left =head2 right $top = $win->top $bottom = $win->bottom $left = $win->left $right = $win->right Returns the coordinates of the start of the window, relative to the parent window. =cut sub bottom { my $self = shift; return $self->top + $self->lines; } sub right { my $self = shift; return $self->left + $self->cols; } =head2 abs_top =head2 abs_left $top = $win->abs_top $left = $win->abs_left Returns the coordinates of the start of the window, relative to the root window. =cut =head2 cols =head2 lines $cols = $win->cols $lines = $win->lines Obtain the size of the window =cut =head2 selfrect $rect = $win->selfrect Returns a L containing representing the window's extent within itself. This will have C and C equal to 0. =cut sub selfrect { my $self = shift; # TODO: Cache this, invalidate it in ->change_geometry return Tickit::Rect->new( top => 0, left => 0, lines => $self->lines, cols => $self->cols, ); } =head2 rect $rect = $win->rect Returns a L containing representing the window's extent relative to its parent =cut sub rect { my $self = shift; # TODO: Cache this, invalidate it in ->change_geometry return Tickit::Rect->new( top => $self->top, left => $self->left, lines => $self->lines, cols => $self->cols, ); } =head2 pen $pen = $win->pen Returns the current L object associated with this window =cut =head2 set_pen $win->set_pen( $pen ) Replace the current L object for this window with a new one. The object reference will be stored, allowing it to be shared with other objects. If C is set, then a new, blank pen will be constructed. =cut =head2 getpenattr $val = $win->getpenattr( $attr ) Returns a single attribue from the current pen =cut sub getpenattr { my $self = shift; my ( $attr ) = @_; return $self->pen->getattr( $attr ); } =head2 get_effective_pen $pen = $win->get_effective_pen Returns a new L containing the effective pen attributes for the window, combined by those of all its parents. =cut sub get_effective_pen { my $win = shift; my $pen = $win->pen->as_mutable; for( my $parent = $win->parent; $parent; $parent = $parent->parent ) { $pen->default_from( $parent->pen ); } return $pen; } =head2 get_effective_penattr $val = $win->get_effective_penattr( $attr ) Returns the effective value of a pen attribute. This will be the value of this window's attribute if set, or the effective value of the attribute from its parent. =cut sub get_effective_penattr { my $win = shift; my ( $attr ) = @_; for( ; $win; $win = $win->parent ) { my $value = $win->pen->getattr( $attr ); return $value if defined $value; } return undef; } =head2 scrollrect $success = $win->scrollrect( $rect, $downward, $rightward ) $success = $win->scrollrect( $top, $left, $lines, $cols, $downward, $rightward ) $success = $win->scrollrect( ..., $pen ) $success = $win->scrollrect( ..., %attrs ) Attempt to scroll the rectangle of the window (either given by a C or defined by the first four parameters) by an amount given by the latter two. Since most terminals cannot perform arbitrary rectangle scrolling, this method returns a boolean to indicate if it was successful. The caller should test this return value and fall back to another drawing strategy if the attempt was unsuccessful. Optionally, a C instance or hash of pen attributes may be provided, to override the background colour used for erased sections behind the scroll. The cursor may move as a result of calling this method; its location is undefined if this method returns successful. The terminal pen, in particular the background colour, may be modified by this method even if it fails to scroll the terminal (and returns false). This method will enqueue all of the required expose requests before returning, so in this case the return value is not interesting. =cut sub scrollrect { my $self = shift; my $rect; if( blessed $_[0] and $_[0]->isa( "Tickit::Rect" ) ) { $rect = shift; } else { my ( $top, $left, $lines, $cols ) = splice @_, 0, 4; $rect = Tickit::Rect->new( top => $top, left => $left, lines => $lines, cols => $cols, ); } my ( $downward, $rightward, @penargs ) = @_; die "PENARGS" if @penargs; my $pen = ( @penargs == 0 ) ? undef : ( @penargs == 1 ) ? $penargs[0]->as_mutable : Tickit::Pen::Mutable->new( @penargs ); $self->_scrollrect( $rect, $downward, $rightward, $pen ); } =head2 scroll $success = $win->scroll( $downward, $rightward ) A shortcut for calling C on the entire region of the window. =cut sub scroll { my $self = shift; my ( $downward, $rightward ) = @_; return $self->scrollrect( 0, 0, $self->lines, $self->cols, $downward, $rightward ); } =head2 scroll_with_children $win->scroll_with_children( $downward, $rightward ) Similar to C but ignores child windows of this one, moving all of the terminal content paying attention only to obscuring by newer siblings of ancestor windows. This method is experimental, intended only for use by L. After calling this method, the terminal content will have moved and the windows drawing them will be confused unless the window position was also updated. C takes care to do this. =cut sub scroll_with_children { my $self = shift; my ( $downward, $rightward, @args ) = @_; die "PENARGS" if @args; my $pen = ( @args == 0 ) ? undef : ( @args == 1 ) ? $args[0]->as_mutable : Tickit::Pen::Mutable->new( @args ); $self->_scroll_with_children( $downward, $rightward ); } =head2 cursor_at $win->cursor_at( $line, $col ) Sets the position in the window at which the terminal cursor will be placed if this window has focus. This method does I force the window to take the focus though; for that see C. =cut sub cursor_at { my $self = shift; $self->set_cursor_position( @_ ); } =head2 cursor_visible $win->cursor_visible( $visible ) Sets whether the terminal cursor is visible on the window when it has focus. Normally it is, but passing a false value will make the cursor hidden even when the window is focused. =cut sub set_cursor_visible { my $self = shift; my ( $visible ) = @_; $self->setctl( 'cursor-visible' => $visible ); } *cursor_visible = \&set_cursor_visible; =head2 cursor_shape $win->cursor_shape( $shape ) Sets the shape that the terminal cursor will have if this window has focus. This method does I force the window to take the focus though; for that see C. Valid values for C<$shape> are the various C constants from L. =cut sub set_cursor_shape { my $self = shift; my ( $shape ) = @_; $self->setctl( 'cursor-shape' => $shape ); } *cursor_shape = \&set_cursor_shape; =head2 take_focus $win->take_focus Causes this window to take the input focus, and updates the cursor position to the stored active position given by C. =cut =head2 focus $win->focus( $line, $col ) A convenient shortcut combining C with C; setting the focus cursor position and taking the input focus. =cut sub focus { my $self = shift; $self->cursor_at( @_ ); $self->take_focus; } =head2 is_focused $focused = $win->is_focused Returns true if this window currently has the input focus =cut =head2 is_steal_input $steal = $win->is_steal_input Returns true if this window is currently stealing input from its siblings =cut sub is_steal_input { my $self = shift; return $self->getctl( 'steal-input' ); } =head2 set_steal_input $win->set_steal_input( $steal ) Controls whether this window is currently stealing input from its siblings =cut sub set_steal_input { my $self = shift; my ( $steal ) = @_; $self->setctl( 'steal-input' => $steal ); } sub sprintf { my $self = shift; return sprintf "[%dx%d abs@%d,%d]", $self->cols, $self->lines, $self->abs_left, $self->abs_top; } use overload '""' => sub { my $self = shift; return ref($self) . $self->sprintf, }, '0+' => sub { my $self = shift; return $self; }, bool => sub { 1 }, fallback => 1; =head1 EVENTS The following event types are emitted and may be observed by L. =head2 key Emitted when a key on the keyboard is pressed while this window or one of its child windows has the input focus, or is set to steal input anyway. The event handler should return a true value if it considers the keypress dealt with, or false to pass it up to its parent window. Before passing it to its parent, a window will also try any other non-focused sibling windows of the currently-focused window in order of creation (though note this order is not necessarily the order the child widgets that own those windows were created or added to their container). If no window actually handles the keypress, then every window will eventually be consulted about it, preferring windows closer to the focused one. This broadcast-like behaviour allows widgets to handle keypresses that should make sense even though their window does not actually have the keyboard focus. This feature should be used sparingly, to only capture one or two keypresses that really make sense; for example to capture the C and C keys in a scrolling list, or a numbered function key that performs some special action. =head2 mouse Emitted when a mouse button is pressed or released, the cursor moved while a button is held (a dragging event), or the wheel is scrolled. The following event names may be observed: =over 8 =item press A mouse button has been pressed down on this cell =item drag_start The mouse was moved while a button was held, and was initially in the given cell =item drag The mouse was moved while a button was held, and is now in the given cell =item drag_outside The mouse was moved outside of the window that handled the C event, and is still being dragged. =item drag_drop A mouse button was released after having been moved, while in the given cell =item drag_stop The drag operation has finished. This event is always given directly to the window that handled the C event, rather than the window on which the mouse release event happened. =item release A mouse button was released after being pressed =item wheel The mouse wheel was moved. C