Tickit-Widgets-0.42000755001750001750 014670354543 13026 5ustar00leoleo000000000000Tickit-Widgets-0.42/.editorconfig000444001750001750 5314670354543 15576 0ustar00leoleo000000000000root = true [*.{pm,pl,t}] indent_size = 3 Tickit-Widgets-0.42/Build.PL000444001750001750 151214670354543 14456 0ustar00leoleo000000000000use v5; use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Tickit::Widgets', dist_abstract => "a collection of Tickit::Widget implementations", configure_requires => { 'Module::Build' => '0.4004', # test_requires }, requires => { 'perl' => '5.020', # experimental.pm; postderef 'meta' => '0.008', 'List::Util' => '1.33', 'Object::Pad' => '0.808', 'Parser::MGC' => 0, 'Syntax::Keyword::Dynamically' => 0, 'Tickit::Event' => '0.66', # $info->type newapi 'Tickit::RenderBuffer' => 0, 'Tickit::Utils' => '0.29', 'Tickit::Window' => '0.57', # $win->bind_event }, test_requires => { 'Test2::V0' => 0, }, license => 'perl', create_license => 1, create_readme => 1, ); $build->create_build_script; Tickit-Widgets-0.42/Changes000444001750001750 2467614670354543 14515 0ustar00leoleo000000000000Revision history for Tickit-Widgets 0.42 2024-09-11 [CHANGES] * Use `meta` v0.008 rather than `no strict 'refs'` + `Sub::Util` hackery 0.41 2024-01-06 [CHANGES] * Quiet the meta::experimental warnings of meta 0.003_002 0.40 2024-01-03 [CHANGES] * Use `meta` instead of `no strict refs' hackery to obtain caller's \*DATA glob in Tickit::Style 0.39 2023-12-29 [CHANGES] * Use Object::Pad::MOP rather than no strict 'refs' hackery where possible, issue a warning when not 0.38 2023-12-13 [CHANGES] * Updated for Object::Pad v0.807 + Explicit `use warnings` to account for removal of implied pragma + `ADJUST :params` is now stable, no need for experimental + Use new `apply` and `inherit` keywords + Use experimental inheritable fields to avoid internal methods between LinearSplit and HSplit/VSplit * Various small Pod style updates 0.37 2023-06-12 [CHANGES] * Added Tickit::Widget::HLine / Tickit::Widget::VLine * Support optionally drawing dividing lines between child widgets in HBox/VBox * Swap all unit tests from `Test::More` to `Test2::V0` 0.36 2022-12-14 [CHANGES] * Updated for Object::Pad v0.75 + Use `field NAME :param //= EXPR` syntax + Use `ADJUST :params` + Set `:strict(params)` 0.35 2022-07-07 [CHANGES] * Updates for Object::Pad 0.63 + Quiet the `:experimental(init_expr)` warning * Avoid uses of $_[N] by unpacking args from @_ * Try to find `set_subname` from Sub::Util before falling back on other alternatives [BUGFIXES] * Tickit::Widget::Border should invoke ->resized when children change, not ->reshape * Various bugfixes to bundled example scripts 0.34 2021-11-20 [CHANGES] * Updates for Object::Pad 0.57 + Use :isa and :does instead of legacy `extends` and `implements` + Use slot initialisation blocks instead of ADJUST + Default values for non-scalar slots 0.33 2021-08-28 [CHANGES] * Updates for Object::Pad 0.52 + Use ADJUSTPARAMS blocks in favour of BUILD blocks * Use a regular Tickit::Style definition to set up the and base key behaviour, so widgets can override it * Added Tickit::Widget::Entry->make_popup_at_cursor * Print deprecation warnings about `child` constructor args and legacy direct applied pen attributes on Widgets 0.32 2021-07-03 [CHANGES] * Use Object::Pad to implement even the base Tickit::Widget class * Updates for Object::Pad 0.43: + Use :param on slots where possible + Use ADJUST blocks instead of BUILD blocks where possible * No longer support construction-time `child`-like arguments * Removed no longer needed Tickit::OneLineWidget [BUGFIXES] * Make sure that window `expose` event handler always returns an integer, thus avoiding "... isn't numeric" warnings in unit tests 0.31 2020-11-02 [CHANGES] * Use Object::Pad to implement the individual Tickit::Widget::* subclasses * Accept a wildcard type in stylesheets to apply a common style to all widgets * Allow ->add-like methods on container widgets to take per-child opts * Render [brackets] on a button if it has linetype=none 0.30 2020-04-02 [CHANGES] * Ignore mouse wheel events on T:W:Button * Avoid smartmatch * Update for Tickit::Event 0.66 * Discourage use of `child`-like arguments to constructors in favour of chaining mutator `->set_child`-like methods * Support Widget version tests in Tickit::Widgets->import 0.29 2018-03-13 13:49:27 [CHANGES] * Have Tickit::Widget::Entry also delete back a word on Ctrl-Backspace [BUGFIXES] * Fix off-by-one error calculating the size of a Tickit::Widget::GridBox 0.28 2017-11-30 13:32:58 [CHANGES] * Add SingleChildWidget->remove (RT122231) * Update for Tickit 0.63's new focus event API 0.27 2017/03/17 18:50:40 [BUGFIXES] * Ensure ContainerWidget can handle windowless children * Remember to actually close child windows from empty-sized children in LinearBoxes * Avoid complaints about mouse wheel direction names not being numeric in linear Split (RT119857) 0.26 2017/02/15 15:03:58 [BUGFIXES] * ContainerWidget should ->close dropped child windows when it loses its own (WINDOW_XS branch) 0.25 2017/02/04 14:54:12 [CHANGES] * Minor edits to unit tests to pass on Tickit post-0.61 (WINDOW_XS branch) 0.24 2016/08/08 13:43:01 [CHANGES] * Tickit 0.57 deprecations: + Use $win->bind_event instead of $win->set_on_* [BUGFIXES] * Ensure that Tickit::Widget::Box can cope with removing its child or window * Ensure that construction-time child proportion works on Tickit::Widget::Box 0.23 2016/05/10 17:51:02 [CHANGES] * Prepare for Tickit 0.56 deprecations: + No more pen observers + Have Tickit::Widget->pen return an immutable pen 0.22 2016/02/09 23:40:28 [CHANGES] * Ensure that a GridBox can be incrementally built both row- and column-wise * Since Tickit 0.39 it's not been necessary to set $win->expose_after_scroll 0.21 2015/07/14 13:43:29 [CHANGES] * Avoid dependency on List::MoreUtils * Imported remaining Widget-related demos and examples from Tickit dist * Tickit 0.54 deprecations: + Kill WIDGET_PEN_FROM_STYLE + Warn on mutation of Widget pen 0.20 2015/03/27 19:21:10 [CHANGES] * Imported the entire Tickit::Widget base class and related modules from the Tickit distribution * Document the $button->click mtehod * Added examples for HBox / VBox 0.19 2014/08/26 18:12:01 [CHANGES] * Added Tickit::Widget::Fill 0.18 2014/08/16 21:17:51 [BUGFIXES] * Cope with differing Tickit::Widget::Frame linestyles per border when passed at construction time 0.17 2014/08/14 18:12:50 [CHANGES] * Capture Tickit::Widget::HBox and ::VBox from main Tickit dist * Added editing methods to Tickit::Widget::GridBox: + insert/append/delete row/column + get cell/row/column 0.16 2014/04/12 04:10:47 [CHANGES] * Update Tickit::Widget::Entry to avoid direct Window drawing operations; use ->expose calls to request re-rendering * Prepare for Tickit 0.45's removal of INSERTCH/DELETECH from is_termlog() logging [BUGFIXES] * Correct display of Entry widget's posttext marker when deleting text before it 0.15 2014/04/01 20:37:30 [BUGFIXES] * Remove child widget from GridBox before exposing cleared area 0.14 2013/11/09 13:53:58 [CHANGES] * Use the new child widget "requested size" API from Tickit 0.40 in containers [BUGFIXES] * Remember to re-expose window area of a removed GridBox child 0.13 2013/09/28 15:01:32 [CHANGES] * Added 'on_toggle' to CheckButton (RT88954) * Added 'on_activate' to RadioButton and 'on_changed' to RadioButton::Group (RT88954) * Added 'linetype' style to Button, and allow borderless Buttons (RT88953) [BUGFIXES] * Don't try to create zero-sized rows or columns in GridBox * Ensure that VSplit/HSplit correctly obeys the ContainerWidget interface - call ->add and ->remove 0.12 CHANGES: * Initial attempt at Tickit::Widget::Spinner * Fix SYNOPSIS in CheckButton (RT88294) 0.11 CHANGES: * Use Tickit dragging events to better handle mouse click/release on Button * Use Tickit::RenderBuffer to render Frame * Allow differing or absent line styles per Frame edge * Allow GridBox to be initialised by child widgets given in a 2D array BUGFIXES: * Bugfix for scrollrect ICH/DCH fix 0.10 CHANGES: * Implement key actions in Button, CheckButton, RadioButton * Neater visual style for Button; indicate focus vs. active * Visually flash Button on activation by keypress * Update to use Tickit 0.35's ->render_to_rb BUGFIXES * Ensure that Entry doesn't consume keypresses unless it is focused 0.09 CHANGES: * Added optional title to Placegrid * Avoid infinite CPU spin in Entry * Handle Tickit 0.34 focus behaviours * Improved Button behaviour and style information * Updated all to use RenderBuffer instead of RenderContext 0.08 CHANGES: * Added Tickit::Widget::Placegrid * Fix floating-point rounding bug in HSplit/VSplit * Better HSplit/VSplit behavior on resize 0.07 CHANGES: * Added Tickit::Widget::HSplit and Tickit::Widget::VSplit * Use new style_reshape_keys from Tickit::Style 0.32 * Take GridBox's spacing from style * Use Tickit::RenderContext in most widgets 0.06 CHANGES: * Use new WIDGET_PEN_FROM_STYLE from Tickit 0.30 * Update widgets to use more Tickit::Style behaviour * Renamed Tickit::Widget::Frame's "style" attribute to "linetype" 0.05 CHANGES: * Added Tickit::Widget::RadioButton * Added Tickit::Widget::CheckButton * Neater SYNOPSIS examples * Set dist_abstract to more accurately reflect the distribution as a whole 0.04 CHANGES: * Added Tickit::Widget::GridBox 0.03 CHANGES: * Added Tickit::Widget::Frame (copy from Tickit dist) * Added Tickit::Widget::Border (copy of Tickit::Widget::Box in Tickit dist) 0.02 CHANGES: * Added Tickit::Widget::Button * Document Tickit::Widget::Entry constructor arguments 0.01 First version, released on an unsuspecting world. Tickit-Widgets-0.42/LICENSE000444001750001750 4653414670354543 14224 0ustar00leoleo000000000000This software is copyright (c) 2024 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) 2024 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 Perl Artistic License 1.0 --- This software is Copyright (c) 2024 by Paul Evans . This is free software, licensed under: The Perl 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 as specified below. "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 uunet.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) give non-standard executables non-standard names, and clearly document 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. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 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 whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. 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-Widgets-0.42/MANIFEST000444001750001750 337614670354543 14325 0ustar00leoleo000000000000.editorconfig Build.PL Changes examples/demo-border.pl examples/demo-button.pl examples/demo-checkbutton.pl examples/demo-entry.pl examples/demo-frame.pl examples/demo-gridbox.pl examples/demo-hbox.pl examples/demo-hsplit.pl examples/demo-radiobutton.pl examples/demo-spinner.pl examples/demo-vbox.pl examples/demo-vsplit.pl examples/focus.pl examples/hello-world.pl examples/HelloWorldWidget-1.pm examples/HelloWorldWidget-2.pm examples/testonewidget.pl lib/Tickit/ContainerWidget.pm lib/Tickit/SingleChildWidget.pm lib/Tickit/Style.pm lib/Tickit/Style/Parser.pm lib/Tickit/Widget.pm lib/Tickit/Widget/Border.pm lib/Tickit/Widget/Box.pm lib/Tickit/Widget/Button.pm lib/Tickit/Widget/CheckButton.pm lib/Tickit/Widget/Entry.pm lib/Tickit/Widget/Fill.pm lib/Tickit/Widget/Frame.pm lib/Tickit/Widget/GridBox.pm lib/Tickit/Widget/HBox.pm lib/Tickit/Widget/HLine.pm lib/Tickit/Widget/HSplit.pm lib/Tickit/Widget/LinearBox.pm lib/Tickit/Widget/LinearSplit.pm lib/Tickit/Widget/Placegrid.pm lib/Tickit/Widget/RadioButton.pm lib/Tickit/Widget/Spinner.pm lib/Tickit/Widget/Static.pm lib/Tickit/Widget/VBox.pm lib/Tickit/Widget/VLine.pm lib/Tickit/Widget/VSplit.pm lib/Tickit/WidgetRole.pm lib/Tickit/WidgetRole/Alignable.pm lib/Tickit/WidgetRole/SingleChildContainer.pm lib/Tickit/Widgets.pm LICENSE MANIFEST This list of files META.json META.yml README t/00use.t t/01widget.t t/02widget-window.t t/03widget-container.t t/04widget-style.t t/05widget-focus.t t/06widget-input.t t/07widget-container-focus.t t/10static.t t/11entry-model.t t/12entry-input.t t/13entry-scroll.t t/14entry-popup.t t/20button.t t/21radiobutton.t t/22checkbutton.t t/23fill.t t/24spinner.t t/30box.t t/31frame.t t/32border.t t/33hbox.t t/33vbox.t t/34gridbox.t t/35hsplit.t t/35vsplit.t t/36hline.t t/36vline.t t/99pod.t Tickit-Widgets-0.42/META.json000444001750001750 1146314670354543 14631 0ustar00leoleo000000000000{ "abstract" : "a collection of Tickit::Widget implementations", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4234", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Tickit-Widgets", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.4004" } }, "runtime" : { "requires" : { "List::Util" : "1.33", "Object::Pad" : "0.808", "Parser::MGC" : "0", "Syntax::Keyword::Dynamically" : "0", "Tickit::Event" : "0.66", "Tickit::RenderBuffer" : "0", "Tickit::Utils" : "0.29", "Tickit::Window" : "0.57", "meta" : "0.008", "perl" : "5.020" } }, "test" : { "requires" : { "Test2::V0" : "0" } } }, "provides" : { "Tickit::ContainerWidget" : { "file" : "lib/Tickit/ContainerWidget.pm", "version" : "0.59" }, "Tickit::SingleChildWidget" : { "file" : "lib/Tickit/SingleChildWidget.pm", "version" : "0.59" }, "Tickit::Style" : { "file" : "lib/Tickit/Style.pm", "version" : "0.60" }, "Tickit::Style::Parser" : { "file" : "lib/Tickit/Style/Parser.pm", "version" : "0.56" }, "Tickit::Widget" : { "file" : "lib/Tickit/Widget.pm", "version" : "0.58" }, "Tickit::Widget::Border" : { "file" : "lib/Tickit/Widget/Border.pm", "version" : "0.42" }, "Tickit::Widget::Box" : { "file" : "lib/Tickit/Widget/Box.pm", "version" : "0.60" }, "Tickit::Widget::Button" : { "file" : "lib/Tickit/Widget/Button.pm", "version" : "0.42" }, "Tickit::Widget::CheckButton" : { "file" : "lib/Tickit/Widget/CheckButton.pm", "version" : "0.42" }, "Tickit::Widget::Entry" : { "file" : "lib/Tickit/Widget/Entry.pm", "version" : "0.42" }, "Tickit::Widget::Fill" : { "file" : "lib/Tickit/Widget/Fill.pm", "version" : "0.42" }, "Tickit::Widget::Frame" : { "file" : "lib/Tickit/Widget/Frame.pm", "version" : "0.42" }, "Tickit::Widget::GridBox" : { "file" : "lib/Tickit/Widget/GridBox.pm", "version" : "0.42" }, "Tickit::Widget::HBox" : { "file" : "lib/Tickit/Widget/HBox.pm", "version" : "0.53" }, "Tickit::Widget::HLine" : { "file" : "lib/Tickit/Widget/HLine.pm", "version" : "0.42" }, "Tickit::Widget::HSplit" : { "file" : "lib/Tickit/Widget/HSplit.pm", "version" : "0.42" }, "Tickit::Widget::LinearBox" : { "file" : "lib/Tickit/Widget/LinearBox.pm", "version" : "0.55" }, "Tickit::Widget::LinearSplit" : { "file" : "lib/Tickit/Widget/LinearSplit.pm", "version" : "0.42" }, "Tickit::Widget::Placegrid" : { "file" : "lib/Tickit/Widget/Placegrid.pm", "version" : "0.42" }, "Tickit::Widget::RadioButton" : { "file" : "lib/Tickit/Widget/RadioButton.pm", "version" : "0.42" }, "Tickit::Widget::RadioButton::Group" : { "file" : "lib/Tickit/Widget/RadioButton.pm" }, "Tickit::Widget::Spinner" : { "file" : "lib/Tickit/Widget/Spinner.pm", "version" : "0.42" }, "Tickit::Widget::Static" : { "file" : "lib/Tickit/Widget/Static.pm", "version" : "0.58" }, "Tickit::Widget::VBox" : { "file" : "lib/Tickit/Widget/VBox.pm", "version" : "0.53" }, "Tickit::Widget::VLine" : { "file" : "lib/Tickit/Widget/VLine.pm", "version" : "0.42" }, "Tickit::Widget::VSplit" : { "file" : "lib/Tickit/Widget/VSplit.pm", "version" : "0.42" }, "Tickit::WidgetRole" : { "file" : "lib/Tickit/WidgetRole.pm", "version" : "0.54" }, "Tickit::WidgetRole::Alignable" : { "file" : "lib/Tickit/WidgetRole/Alignable.pm", "version" : "0.52" }, "Tickit::WidgetRole::SingleChildContainer" : { "file" : "lib/Tickit/WidgetRole/SingleChildContainer.pm", "version" : "0.42" }, "Tickit::Widgets" : { "file" : "lib/Tickit/Widgets.pm", "version" : "0.42" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.42", "x_serialization_backend" : "JSON::PP version 4.16" } Tickit-Widgets-0.42/META.yml000444001750001750 641614670354543 14443 0ustar00leoleo000000000000--- abstract: 'a collection of Tickit::Widget implementations' author: - 'Paul Evans ' build_requires: Test2::V0: '0' configure_requires: Module::Build: '0.4004' dynamic_config: 1 generated_by: 'Module::Build version 0.4234, 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-Widgets provides: Tickit::ContainerWidget: file: lib/Tickit/ContainerWidget.pm version: '0.59' Tickit::SingleChildWidget: file: lib/Tickit/SingleChildWidget.pm version: '0.59' Tickit::Style: file: lib/Tickit/Style.pm version: '0.60' Tickit::Style::Parser: file: lib/Tickit/Style/Parser.pm version: '0.56' Tickit::Widget: file: lib/Tickit/Widget.pm version: '0.58' Tickit::Widget::Border: file: lib/Tickit/Widget/Border.pm version: '0.42' Tickit::Widget::Box: file: lib/Tickit/Widget/Box.pm version: '0.60' Tickit::Widget::Button: file: lib/Tickit/Widget/Button.pm version: '0.42' Tickit::Widget::CheckButton: file: lib/Tickit/Widget/CheckButton.pm version: '0.42' Tickit::Widget::Entry: file: lib/Tickit/Widget/Entry.pm version: '0.42' Tickit::Widget::Fill: file: lib/Tickit/Widget/Fill.pm version: '0.42' Tickit::Widget::Frame: file: lib/Tickit/Widget/Frame.pm version: '0.42' Tickit::Widget::GridBox: file: lib/Tickit/Widget/GridBox.pm version: '0.42' Tickit::Widget::HBox: file: lib/Tickit/Widget/HBox.pm version: '0.53' Tickit::Widget::HLine: file: lib/Tickit/Widget/HLine.pm version: '0.42' Tickit::Widget::HSplit: file: lib/Tickit/Widget/HSplit.pm version: '0.42' Tickit::Widget::LinearBox: file: lib/Tickit/Widget/LinearBox.pm version: '0.55' Tickit::Widget::LinearSplit: file: lib/Tickit/Widget/LinearSplit.pm version: '0.42' Tickit::Widget::Placegrid: file: lib/Tickit/Widget/Placegrid.pm version: '0.42' Tickit::Widget::RadioButton: file: lib/Tickit/Widget/RadioButton.pm version: '0.42' Tickit::Widget::RadioButton::Group: file: lib/Tickit/Widget/RadioButton.pm Tickit::Widget::Spinner: file: lib/Tickit/Widget/Spinner.pm version: '0.42' Tickit::Widget::Static: file: lib/Tickit/Widget/Static.pm version: '0.58' Tickit::Widget::VBox: file: lib/Tickit/Widget/VBox.pm version: '0.53' Tickit::Widget::VLine: file: lib/Tickit/Widget/VLine.pm version: '0.42' Tickit::Widget::VSplit: file: lib/Tickit/Widget/VSplit.pm version: '0.42' Tickit::WidgetRole: file: lib/Tickit/WidgetRole.pm version: '0.54' Tickit::WidgetRole::Alignable: file: lib/Tickit/WidgetRole/Alignable.pm version: '0.52' Tickit::WidgetRole::SingleChildContainer: file: lib/Tickit/WidgetRole/SingleChildContainer.pm version: '0.42' Tickit::Widgets: file: lib/Tickit/Widgets.pm version: '0.42' requires: List::Util: '1.33' Object::Pad: '0.808' Parser::MGC: '0' Syntax::Keyword::Dynamically: '0' Tickit::Event: '0.66' Tickit::RenderBuffer: '0' Tickit::Utils: '0.29' Tickit::Window: '0.57' meta: '0.008' perl: '5.020' resources: license: http://dev.perl.org/licenses/ version: '0.42' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Tickit-Widgets-0.42/README000444001750001750 154214670354543 14045 0ustar00leoleo000000000000NAME Tickit::Widgets - load several Tickit::Widget classes at once SYNOPSIS use Tickit::Widgets qw( Static VBox HBox ); Equivalent to use Tickit::Widget::Static; use Tickit::Widget::VBox; use Tickit::Widget::HBox; DESCRIPTION This module provides an import utility to simplify code that uses many different Tickit::Widget subclasses. Instead of a use line per module, you can simply use this module and pass it the base name of each class. It will require each of the modules. Note that because each Widget module should be a pure object class with no exports, this utility does not run the import method of the used classes. An optional version check may be supplied using a = sign: use Tickit::Widgets qw( HBox=0.48 VBox=0.48 ); AUTHOR Paul Evans Tickit-Widgets-0.42/examples000755001750001750 014670354543 14644 5ustar00leoleo000000000000Tickit-Widgets-0.42/examples/HelloWorldWidget-1.pm000444001750001750 41114670354543 20670 0ustar00leoleo000000000000use v5.20; use warnings; use Object::Pad 0.807; class HelloWorldWidget; inherit Tickit::Widget; method lines { 1 } method cols { 12 } method render_to_rb { my ( $rb, $rect ) = @_; $rb->eraserect( $rect ); $rb->text_at( 0, 0, "Hello, world" ); } 1; Tickit-Widgets-0.42/examples/HelloWorldWidget-2.pm000444001750001750 53414670354543 20677 0ustar00leoleo000000000000use v5.20; use warnings; use Object::Pad 0.807; class HelloWorldWidget; inherit Tickit::Widget; method lines { 1 } method cols { 12 } method render_to_rb { my ( $rb, $rect ) = @_; my $win = $self->window; $rb->eraserect( $rect ); $rb->text_at( ( $win->lines - 1 ) / 2, ( $win->cols - 12 ) / 2, "Hello, world" ); } 1; Tickit-Widgets-0.42/examples/demo-border.pl000444001750001750 62614670354543 17521 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( Border Static ); my $border = Tickit::Widget::Border->new( h_border => 4, v_border => 2, style => { bg => "green" }, ) ->set_child( Tickit::Widget::Static->new( text => "Hello, world!", align => "centre", valign => "middle", style => { bg => "black" }, ) ); Tickit->new( root => $border )->run; Tickit-Widgets-0.42/examples/demo-button.pl000444001750001750 226014670354543 17573 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( Border Button VBox RadioButton ); Tickit::Style->load_style( <<'EOF' ); Button { fg: "black"; bg: "white"; } EOF my $border = Tickit::Widget::Border->new( h_border => 10, v_border => 2, ) ->set_child( my $vbox = Tickit::Widget::VBox->new( spacing => 2, style => { bg => "black" } ) ); my @buttons; foreach my $colour (qw( red blue green yellow )) { $vbox->add( my $button = Tickit::Widget::Button->new( label => $colour, on_click => sub { $border->set_style( bg => $colour ) }, ) ); push @buttons, $button; } my $tickit = Tickit->new( root => $border ); $vbox->add( my $button = Tickit::Widget::Button->new( label => "Quit", on_click => sub { $tickit->stop }, ) ); push @buttons, $button; { my $group = Tickit::Widget::RadioButton::Group->new; $group->set_on_changed( sub { my ( undef, $type ) = @_; $_->set_style( linetype => $type ) for @buttons; }); $vbox->add( Tickit::Widget::RadioButton->new( label => $_, value => $_, group => $group, ) ) for qw( none single double thick ); } $tickit->run; Tickit-Widgets-0.42/examples/demo-checkbutton.pl000444001750001750 66714670354543 20562 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( VBox CheckButton ); my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); foreach ( 1 .. 5 ) { $vbox->add( Tickit::Widget::CheckButton->new( class => "check$_", style => { fg => $_ }, label => "Check $_", ) ); } Tickit::Style->load_style_file( "./tickit.style" ) if -e "./tickit.style"; Tickit->new( root => $vbox )->run; Tickit-Widgets-0.42/examples/demo-entry.pl000444001750001750 123514670354543 17422 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( Static Entry Border VBox ); my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); $vbox->add( Tickit::Widget::Static->new( text => "Enter some text here:" ) ); $vbox->add( Tickit::Widget::Border->new( h_border => 2, v_border => 1, style => { bg => 'blue' }, ) ->set_child( my $entry = Tickit::Widget::Entry->new ), ); $vbox->add( my $label = Tickit::Widget::Static->new( text => "" ) ); $entry->set_on_enter( sub { my ( $entry, $text ) = @_; $label->set_text( "You entered: $text" ); $entry->set_text( "" ); } ); Tickit->new( root => $vbox )->run; Tickit-Widgets-0.42/examples/demo-frame.pl000444001750001750 221014670354543 17345 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( Static VBox Frame ); my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); my $fg = 1; foreach my $linetype ( qw( ascii single double thick solid_inside solid_outside ) ) { $vbox->add( Tickit::Widget::Frame->new( style => { linetype => $linetype, frame_fg => $fg++, }, )->set_child( Tickit::Widget::Static->new( text => $linetype, align => 0.5 ) ) ); } $vbox->add( Tickit::Widget::Frame->new( style => { linetype_top => "double", linetype_bottom => "double", linetype_left => "single", linetype_right => "single", }, )->set_child( Tickit::Widget::Static->new( text => "mixed lines", align => 0.5 ) ) ); $vbox->add( Tickit::Widget::Frame->new( style => { linetype_top => "double", linetype_bottom => "single", linetype_left => "solid_outside", linetype_right => "solid_outside", }, )->set_child( Tickit::Widget::Static->new( text => "mixed", align => 0.5 ) ) ); Tickit->new( root => $vbox )->run; Tickit-Widgets-0.42/examples/demo-gridbox.pl000444001750001750 117014670354543 17715 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( Static GridBox ); my $gridbox = Tickit::Widget::GridBox->new( style => { row_spacing => 1, col_spacing => 2, }, ); foreach my $row ( 0 .. 9 ) { foreach my $col ( 0 .. 5 ) { $gridbox->add( $row, $col, Tickit::Widget::Static->new( text => chr( 65 + rand 26 ) x ( 2 + rand 12 ), align => 0.5, valign => 0.5, style => { bg => (qw( red blue green yellow ))[($row+$col) % 4] }, ), row_expand => 1, col_expand => 1, ); } } Tickit->new( root => $gridbox )->run; Tickit-Widgets-0.42/examples/demo-hbox.pl000444001750001750 70714670354543 17204 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widget::Static; use Tickit::Widget::HBox; my $hbox = Tickit::Widget::HBox->new( style => { spacing => 1, }, ); foreach ( 1 .. 6 ) { $hbox->add( Tickit::Widget::Static->new( text => "$_", style => { bg => $_, fg => "hi-white" }, align => "centre", valign => "middle", ), expand => 1, ) } Tickit->new( root => $hbox )->run; Tickit-Widgets-0.42/examples/demo-hsplit.pl000444001750001750 66714670354543 17554 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( HSplit Static ); my $hsplit = Tickit::Widget::HSplit->new ->set_top_child( Tickit::Widget::Static->new( text => "Top child", align => "centre", valign => "middle", ) ) ->set_bottom_child( Tickit::Widget::Static->new( text => "Bottom child", align => "centre", valign => "middle", ) ); Tickit->new( root => $hsplit )->run; Tickit-Widgets-0.42/examples/demo-radiobutton.pl000444001750001750 100614670354543 20607 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( VBox RadioButton ); my $vbox = Tickit::Widget::VBox->new( spacing => 1 ); my $group = Tickit::Widget::RadioButton::Group->new; foreach ( 1 .. 5 ) { $vbox->add( Tickit::Widget::RadioButton->new( class => "radio$_", style => { fg => $_ }, label => "Radio $_", group => $group, ) ); } Tickit::Style->load_style_file( "./tickit.style" ) if -e "./tickit.style"; Tickit->new( root => $vbox )->run; Tickit-Widgets-0.42/examples/demo-spinner.pl000444001750001750 123614670354543 17740 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( Spinner Button HBox VBox ); my $vbox = Tickit::Widget::VBox->new; $vbox->add( my $spinner = Tickit::Widget::Spinner->new( chars => [ map { substr( "-=X=- -=X=-", 9-$_, 10 ) } 0 .. 9 ], interval => 0.1, ), expand => 3, ); $vbox->add( my $hbox = Tickit::Widget::HBox->new, expand => 1, ); $hbox->add( Tickit::Widget::Button->new( label => "Start", on_click => sub { $spinner->start } ), expand => 1 ); $hbox->add( Tickit::Widget::Button->new( label => "Stop", on_click => sub { $spinner->stop } ), expand => 1, ); Tickit->new( root => $vbox )->run; Tickit-Widgets-0.42/examples/demo-vbox.pl000444001750001750 71314670354543 17217 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widget::Static; use Tickit::Widget::VBox; my $vbox = Tickit::Widget::VBox->new( style => { spacing => 1, }, ); foreach ( 1 .. 6 ) { $vbox->add( Tickit::Widget::Static->new( text => "Row $_", style => { bg => $_, fg => "hi-white" }, align => "centre", valign => "middle", ), expand => 1, ) } Tickit->new( root => $vbox )->run; Tickit-Widgets-0.42/examples/demo-vsplit.pl000444001750001750 66714670354543 17572 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( VSplit Static ); my $vsplit = Tickit::Widget::VSplit->new ->set_left_child (Tickit::Widget::Static->new( text => "Left child", align => "centre", valign => "middle", ) ) ->set_right_child( Tickit::Widget::Static->new( text => "Right child", align => "centre", valign => "middle", ) ); Tickit->new( root => $vsplit )->run; Tickit-Widgets-0.42/examples/focus.pl000444001750001750 342714670354543 16463 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widgets qw( GridBox Frame HBox Entry Static Button CheckButton RadioButton ); Tickit::Style->load_style( <<'EOF' ); Entry:focus { bg: "blue"; b: 1; } Frame { linetype: "single"; } Frame:focus-child { frame-fg: "red"; } CheckButton:focus { check-bg: "blue"; } RadioButton:focus { tick-bg: "blue"; } EOF my $gridbox = Tickit::Widget::GridBox->new( style => { row_spacing => 1, col_spacing => 2, }, ); foreach my $row ( 0 .. 2 ) { $gridbox->add( $row, 0, Tickit::Widget::Static->new( text => "Entry $row" ) ); $gridbox->add( $row, 1, Tickit::Widget::Entry->new, col_expand => 1 ); } { $gridbox->add( 3, 0, Tickit::Widget::Static->new( text => "Buttons" ) ); $gridbox->add( 3, 1, Tickit::Widget::Frame->new() ->set_child( my $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ), ); foreach my $label (qw( One Two Three )) { $hbox->add( Tickit::Widget::Button->new( label => $label, on_click => sub {} ), expand => 1 ); } } { $gridbox->add( 4, 0, Tickit::Widget::Static->new( text => "Checks" ) ); $gridbox->add( 4, 1, Tickit::Widget::Frame->new() ->set_child( my $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ) ); foreach ( 0 .. 2 ) { $hbox->add( Tickit::Widget::CheckButton->new( label => "Check $_" ) ); } } { $gridbox->add( 5, 0, Tickit::Widget::Static->new( text => "Radios" ) ); $gridbox->add( 5, 1, Tickit::Widget::Frame->new() ->set_child( my $hbox = Tickit::Widget::HBox->new( spacing => 2 ) ), ); my $group = Tickit::Widget::RadioButton::Group->new; foreach ( 0 .. 2 ) { $hbox->add( Tickit::Widget::RadioButton->new( label => "Radio $_", group => $group ) ); } } Tickit->new( root => $gridbox )->run; Tickit-Widgets-0.42/examples/hello-world.pl000444001750001750 65114670354543 17550 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Tickit::Widget::Box; use Tickit::Widget::Static; my $box = Tickit::Widget::Box->new( style => { bg => "green" }, child_lines => '80%', child_cols => '80%', )->set_child( Tickit::Widget::Static->new( text => "Hello, world!", align => "centre", valign => "middle", style => { bg => "black" }, ) ); Tickit->new( root => $box )->run; Tickit-Widgets-0.42/examples/testonewidget.pl000555001750001750 51414670354543 20206 0ustar00leoleo000000000000#!/usr/bin/perl use v5.20; use warnings; use Tickit; use Getopt::Long; my $widgetclass; my $file; GetOptions( 'widget=s' => \$widgetclass, 'file=s' => \$file, ) or exit 1; defined $file or ( $file = "$widgetclass.pm" ) =~ s{::}{/}g; require $file; my $widget = $widgetclass->new; Tickit->new( root => $widget )->run; Tickit-Widgets-0.42/lib000755001750001750 014670354543 13574 5ustar00leoleo000000000000Tickit-Widgets-0.42/lib/Tickit000755001750001750 014670354543 15023 5ustar00leoleo000000000000Tickit-Widgets-0.42/lib/Tickit/ContainerWidget.pm000444001750001750 2450114670354543 20626 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-2023 -- leonerd@leonerd.org.uk use v5.20; use warnings; use Object::Pad 0.807; package Tickit::ContainerWidget 0.59; class Tickit::ContainerWidget; inherit Tickit::Widget; use Carp; use Scalar::Util qw( refaddr ); =head1 NAME C - abstract base class for widgets that contain other widgets =head1 SYNOPSIS TODO =head1 DESCRIPTION This class acts as an abstract base class for widgets that contain at leaast one other widget object. It provides storage for a hash of "options" associated with each child widget. =head1 STYLE The following style tags are used: =over 4 =item :focus-child Set whenever a child widget within the container has the input focus. =back =cut =head1 CONSTRUCTOR =cut =head2 new $widget = Tickit::ContainerWidget->new( %args ); Constructs a new C object. Must be called on a subclass that implements the required methods; see the B section below. =cut field %_child_opts; # This class should probably be a role ADJUST { my $class = ref $self; foreach my $method (qw( children )) { $class->can( $method ) or croak "$class cannot ->$method - do you subclass and implement it?"; } } =head1 METHODS =cut =head2 add $widget->add( $child, %opts ); Sets the child widget's parent, stores the options for the child, and calls the C method. The concrete implementation will have to implement storage of this child widget. Returns the container C<$widget> itself, for easy chaining. =cut method add { my ( $child, %opts ) = @_; $child and $child->isa( "Tickit::Widget" ) or croak "Expected child to be a Tickit::Widget"; $child->set_parent( $self ); $_child_opts{refaddr $child} = \%opts; $self->children_changed; return $self; } =head2 remove $widget->remove( $child_or_index ); Removes the child widget's parent, and calls the C method. The concrete implementation will have to remove this child from its storage. Returns the container C<$widget> itself, for easy chaining. =cut method remove { my ( $child ) = @_; $child->set_parent( undef ); $child->window->close if $child->window; $child->set_window( undef ); delete $_child_opts{refaddr $child}; $self->children_changed; return $self; } =head2 child_opts %opts = $widget->child_opts( $child ); $opts = $widget->child_opts( $child ); Returns the options currently set for the given child as a key/value list in list context, or as a HASH reference in scalar context. The HASH reference in scalar context is the actual hash used to store the options - modifications to it will be preserved. =cut method child_opts { my ( $child ) = @_; my $opts = $_child_opts{refaddr $child}; return $opts if !wantarray; return %$opts; } =head2 set_child_opts $widget->set_child_opts( $child, %newopts ); Sets new options on the given child. Any options whose value is given as C are deleted. =cut method set_child_opts { my ( $child, %newopts ) = @_; my $opts = $_child_opts{refaddr $child}; foreach ( keys %newopts ) { defined $newopts{$_} ? ( $opts->{$_} = $newopts{$_} ) : ( delete $opts->{$_} ); } $self->children_changed; } method child_resized { $self->reshape if $self->window; $self->resized; } method children_changed { $self->reshape if $self->window; $self->resized; } method window_gained { $self->SUPER::window_gained( @_ ); $self->window->set_focus_child_notify( 1 ); } method window_lost { foreach my $child ( $self->children ) { my $childwin = $child->window; $childwin and $childwin->close; $child->set_window( undef ); } $self->SUPER::window_lost( @_ ); } method _on_win_focus { my ( $win, $evtype, $childwin ) = @_; $self->SUPER::_on_win_focus( @_ ); $self->set_style_tag( "focus-child" => $evtype ) if $childwin; } =head2 find_child $child = $widget->find_child( $how, $other, %args ); Returns a child widget. The C<$how> argument determines how this is done, relative to the child widget given by C<$other>: =over 4 =item first The first child returned by C (C<$other> is ignored) =item last The last child returned by C (C<$other> is ignored) =item before The child widget just before C<$other> in the order given by C =item after The child widget just after C<$other> in the order given by C =back Takes the following named arguments: =over 8 =item where => CODE Optional. If defined, gives a filter function to filter the list of children before searching for the required one. Will be invoked once per child, with the child widget set as C<$_>; it should return a boolean value to indicate if that child should be included in the search. =back =cut method find_child { my ( $how, $other, %args ) = @_; my $children = $args{children} // "children"; my @children = $self->$children; if( my $where = $args{where} ) { @children = grep { defined $other and $_ == $other or $where->() } @children; } if( $how eq "first" ) { return $children[0]; } elsif( $how eq "last" ) { return $children[-1]; } elsif( $how eq "before" ) { $children[$_] == $other and return $children[$_-1] for 1 .. $#children; return undef; } elsif( $how eq "after" ) { $children[$_] == $other and return $children[$_+1] for 0 .. $#children-1; return undef; } else { croak "Unrecognised ->find_child mode '$how'"; } } use constant CONTAINER_OR_FOCUSABLE => sub { $_->isa( "Tickit::ContainerWidget" ) or $_->window && $_->window->is_visible && $_->CAN_FOCUS }; =head2 focus_next $widget->focus_next( $how, $other ); Moves the input focus to the next widget in the widget tree, by searching in the direction given by C<$how> relative to the widget given by C<$other> (which must be an immediate child of C<$widget>). The direction C<$how> must be one of the following four values: =over 4 =item first =item last Moves focus to the first or last child widget that can take focus. Recurses into child widgets that are themselves containers. C<$other> is ignored. =item after =item before Moves focus to the next or previous child widget in tree order from the one given by C<$other>. Recurses into child widgets that are themselves containers, and out into parent containers. These searches will wrap around the widget tree; moving C the last node in the widget tree will move to the first, and vice versa. =back This differs from C in that it performs a full tree search through the widget tree, considering parents and children. If a C or C search falls off the end of one node, it will recurse up to its parent and search within the next child, and so on. Usually this would be used via the widget itself: $self->parent->focus_next( $how => $self ); =cut method focus_next { my ( $how, $other ) = @_; # This tree search has the potential to loop infinitely, if there are no # focusable widgets at all. It would only do this if it cycles via the root # widget twice in a row. Technically we could detect it earlier, but that # is more difficult to arrange for my $done_root; my $next; my $children = $self->can( "children_for_focus" ) || "children"; while(1) { $next = $self->find_child( $how, $other, where => CONTAINER_OR_FOCUSABLE, children => $children, ); last if $next and $next->CAN_FOCUS; # Either we found a container (recurse into it), if( $next ) { my $childhow = $how; if( $how eq "after" ) { $childhow = "first" } elsif( $how eq "before" ) { $childhow = "last" } # See if child has it return 1 if $next->focus_next( $childhow => undef ); $other = $next; redo; } # or we'll have to recurse up to my parent elsif( my $parent = $self->parent ) { if( $how eq "after" or $how eq "before" ) { $other = $self; $self = $parent; redo; } else { return undef; } } # or we'll have to cycle around the root else { die "Cycled through the entire widget tree and did not find a focusable widget" if $done_root; $done_root++; if( $how eq "after" ) { $how = "first" } elsif( $how eq "before" ) { $how = "last" } else { die "Cannot cycle how=$how around root widget"; } $other = undef; redo; } } $next->take_focus; return 1; } =head1 SUBCLASS METHODS =head2 children @children = $widget->children; Required. Should return a list of all the contained child widgets. The order is not specified, but should be in some stable order that makes sense given the layout of the widget's children. This method is used by C to remove the windows from all the child widgets automatically, and by C to obtain a child relative to another given one. =head2 children_for_focus @children = $widget->children_for_focus; Optional. If implemented, this method is called to obtain a list of child widgets to perform a child search on when changing focus using the C method. If it is not implemented, the regular C method is called instead. Normally this method shouldn't be used, but it may be useful on container widgets that also display "helper" widgets that should not be considered as part of the main focus set. This method can then exclude them. =head2 children_changed $widget->children_changed; Optional. If implemented, this method will be called after any change of the contained child widgets or their options. Typically this will be used to set windows on them by sub-dividing the window of the parent. If not overridden, the base implementation will call C. =head2 child_resized $widget->child_resized( $child ); Optional. If implemented, this method will be called after a child widget changes or may have changed its size requirements. Typically this will be used to adjusts the windows allocated to children. If not overridden, the base implementation will call C. =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-Widgets-0.42/lib/Tickit/SingleChildWidget.pm000444001750001750 230514670354543 21047 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-2023 -- leonerd@leonerd.org.uk use v5.20; use warnings; use Object::Pad 0.807; package Tickit::SingleChildWidget 0.59; class Tickit::SingleChildWidget; inherit Tickit::ContainerWidget; apply Tickit::WidgetRole::SingleChildContainer; use Carp; =head1 NAME C - abstract base class for widgets that contain a single other widget =head1 SYNOPSIS TODO =head1 DESCRIPTION This subclass of L acts as an abstract base class for widgets that contain exactly one other widget. It enforces that only one child widget may be contained at any one time, and provides a convenient accessor to obtain it. =cut =head1 CONSTRUCTOR =cut =head2 new $widget = Tickit::SingleChildWidget->new( %args ); Constructs a new C object. =cut ADJUST :params ( :$child = undef ) { if( $child ) { croak "The 'child' constructor argument to ${\ref $self} is no longer recognised; use ->set_child instead"; } } =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-Widgets-0.42/lib/Tickit/Style.pm000444001750001750 3602114670354543 16640 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-2024 -- leonerd@leonerd.org.uk use v5.20; use warnings; use Object::Pad 0.805; package Tickit::Style 0.60; use warnings; use experimental 'postderef'; use meta 0.008; no warnings 'meta::experimental'; use Carp; use Tickit::Pen; use Tickit::Style::Parser; our @EXPORTS = qw( style_definition style_reshape_keys style_reshape_textwidth_keys style_redraw_keys ); # {$type}->{$class} = $tagset my %TAGSETS_BY_TYPE_CLASS; # {$type}->{$key} = 1 my %RESHAPE_KEYS; my %RESHAPE_TEXTWIDTH_KEYS; my %REDRAW_KEYS; =head1 NAME C - declare customisable style information on widgets =head1 SYNOPSIS package My::Widget::Class use base qw( Tickit::Widget ); use Tickit::Style; style_definition base => fg => "red"; style_definition ':active' => b => 1; ... sub render_to_rb { my $self = shift; my ( $rb, $rect ) = @_; $rb->text_at( 0, 0, "Here is my text", $self->get_style_pen ); } Z<> use My::Widget::Class; my $w = My::Widget::Class->new( class => "another-class", ); ... =head1 DESCRIPTION This module adds the ability to a L class to declare a set of named keys that take values, and provides convenient accessors for the widget to determine what the values are at any given moment in time. The values currently in effect are determined by the widget class code, and any stylesheet files loaded by the application. The widget itself can store a set of tags; named entities that may be present or absent. The set of tags currently active on a widget helps to determine which definitions style are to be used. Finally, the widget itself stores a list of style class names. These classes also help determine which style definitions from a loaded stylesheet file are applied. =head2 Stylesheet Files A stylesheet file contains a list of definitions of styles. Each definition gives a C class name, optionally a style class name prefixed by a period (C<.>), optionally a set of tags prefixed with colons (C<:>), and a body definition in a brace-delimited (C<{}>) block. Comments can appear anywhere that whitespace is allowed, starting with a hash symbol (C<#>) and continuing to the end of the line. WidgetClass { # basic style goes here } WidgetClass.styleclass { # style to apply for this class goes here } WidgetClass:tag { # style to apply when this tag is active goes here } Each style definition contains a set semicolon-delimited (C<;>) assignments of values to keys. Each key is suffixed by a colon (C<:>), and the values may be integers, quoted strings (C<"...">), or the special identifiers C or C. WidgetClass.styleclass { key1: "value 1"; key2: 123; key3: true; } While it is more traditional for keys in stylesheet files to contain hyphens (C<->), it is more convenient in Perl code to use underscores (C<_>) instead. The parser will convert hyphens in key names into underscores. As well as giving visual styling information, stylesheets can also associate behavioural actions with keypresses. These are given by a keypress key name in angle brackets (C<< >>) and an action name, which is a bareword identifier. WidgetClass { : activate; } A special widget type name of C<*> can also be used to provide style blocks that will apply (at lower priority) to any type of widget. Typically these would be used along with classes or tags, to set application-wide styles. *:error { bg: "red"; fg: "hi-white"; } =head2 How Style is Determined The full set of style definitions applied to one named class of one widget type for all its style tags is called a "tagset". Each tagset consists of a partially-ordered list of entities called "keysets", which give a mapping from style keys to values for one particular set of active style tags. The widget may also have a special tagset containing the "direct-applied" style definition given to the constructor. The style at any given moment is determined by taking into account the style classes and tags that are in effect. The value of each key is determined by a first-match-wins search along the "direct applied" tagset (if present), then the tagset for each of the style classes, in order, followed finally by the base tagset for the widget type without class. Within each tagset, only the keysets that do not depend on a style tag that is inactive are considered. That is, a keyset that depends on no tags will always be considered, and any keyset that only depends on active keys will be considered, even if there are other active tags that the keyset does not consider. Tags are always additive, in this regard. While the order of the tagsets is exactly defined by the order of the style classes applied to the widget, the order of keysets within each tagset is not fully specified. Tagsets are stored partially ordered, sorted by the number of style tags that each keyset depends on. This ensures that more specific keysets are found before, and therefore override, less specific ones. However, it is not defined the ordering of keysets with equal numbers of (distinct) tags. For instance, if both C and C are active, the following stylesheet does not precisely determine the foreground colour: WidgetClass { fg: "red"; } WidgetClass:tag1 { fg: "blue"; } WidgetClass:tag2 { fg: "green"; } While it is not specified which tagged definition takes precedence, and therefore whether it shall be blue or green, it is specified that both of the tagged definitions take precedence over the untagged definition, so the colour will not be red. =head1 SUBCLASSING If a Widget class is subclassed and the subclass does not declare C again, the subclass will be transparent from the point of view of style. Any style applied to the base class will apply equally to the subclass, and the name of the subclass does not take part in style decisions. If the subclass does C again then the new subclass has a distinct widget type for style purposes. It can optionally copy the style information from its base class, but thereafter the stored information is distinct, and changes in the base class (such as loading style files) will not affect it. To copy the style information from the base, apply the C<-copy> keyword: use Tickit::Style -copy; Alternatively, to start with a new blank state, use the C<-blank> keyword: use Tickit::Style -blank; Currently, C<-blank> is the default behaviour, but this may change in a future version, with a deprecation warning if no keyword is specified. =cut # This class imports functions and sets up initial state sub import { my $class = shift; my $pkg = caller; my @symbols = @_; ( my $type = $pkg ) =~ s/^Tickit::Widget:://; my $mode = "blank"; foreach ( @symbols ) { $mode = "blank", next if $_ eq "-blank"; $mode = "copy", next if $_ eq "-copy"; croak "Unrecognised symbol $_ to Tickit::Style->import"; } my $srctype = $pkg->can( "_widget_style_type" ) && $pkg->_widget_style_type; if( $mode eq "blank" ) { # OK } elsif( $mode eq "copy" ) { defined $srctype or croak "Cannot Tickit::Style -copy in $pkg as there is no source type"; foreach my $c ( keys %{ $TAGSETS_BY_TYPE_CLASS{$srctype} || {} } ) { $TAGSETS_BY_TYPE_CLASS{$type}{$c} = $TAGSETS_BY_TYPE_CLASS{$srctype}{$c}->clone; } foreach my $hash ( \%RESHAPE_KEYS, \%RESHAPE_TEXTWIDTH_KEYS, \%REDRAW_KEYS ) { # shallow copy is sufficient $hash->{$type} = { $hash->{$srctype}->%* } if $hash->{$srctype}; } } # Import the symbols use Object::Pad 0.808 ':experimental(mop)'; if( my $meta = Object::Pad::MOP::Class->try_for_class( $pkg ) ) { $meta->add_method( $_ => \&{"Tickit::Style::$_"} ) for @EXPORTS; $meta->add_method( _widget_style_type => sub () { $type } ); } else { carp "Using legacy Tickit::Style exporter for non-class"; my $metapkg = meta::package->get( $pkg ); $metapkg->add_named_sub( $_ => \&{"Tickit::Style::$_"} ) for @EXPORTS; $metapkg->add_named_sub( _widget_style_type => sub () { $type } ); } $TAGSETS_BY_TYPE_CLASS{$type} ||= {}; } sub _ref_tagset { my ( $type, $class ) = @_; $type eq "*" or $TAGSETS_BY_TYPE_CLASS{$type} or croak "$type is not a styled Widget type"; $class = "" if !defined $class; return $TAGSETS_BY_TYPE_CLASS{$type}{$class} ||= Tickit::Style::_Tagset->new; } =head1 FUNCTIONS =cut =head2 style_definition style_definition( $tags, %definition ); In addition to any loaded stylesheets, the widget class itself can provide style information, via the C function. It provides a definition equivalent to a stylesheet definition with no style class, optionally with a single set of tags. To supply no tags, use the special string C<"base">. style_definition base => key1 => "value", key2 => 123; To provide definitions with tags, use the colon-prefixed notation. style_definition ':active' => key3 => "value"; =cut sub style_definition { my $class = caller; my ( $tags, %definition ) = @_; my %tags; $tags{$1}++ while $tags =~ s/:([A-Z0-9_-]+)//i; die "Expected '\$tags' to be 'base' or a set of :tag names" unless $tags eq "base" or $tags eq ""; my $type = $class->_widget_style_type; _ref_tagset( $type, undef )->merge_with_tags( \%tags, \%definition ); } =head2 style_reshape_keys style_reshape_keys( @keys ); Declares that the given list of keys are somehow responsible for determining the shape of the widget. If their values are changed, the C method is called. =cut sub style_reshape_keys { my $class = caller; my $type = $class->_widget_style_type; $RESHAPE_KEYS{$type}{$_} = 1 for @_; } sub _reshape_keys { my ( $type ) = @_; return keys $RESHAPE_KEYS{$type}->%*; } =head2 style_reshape_textwidth_keys style_reshape_textwidth_keys( @keys ); Declares that the given list of keys contain text, the C of which is used to determine the shape of the widget. If their values are changed such that the C differs, the C method is called. =cut sub style_reshape_textwidth_keys { my $class = caller; my $type = $class->_widget_style_type; $RESHAPE_TEXTWIDTH_KEYS{$type}{$_} = 1 for @_; } sub _reshape_textwidth_keys { my ( $type ) = @_; return keys $RESHAPE_TEXTWIDTH_KEYS{$type}->%*; } =head2 style_redraw_keys style_redraw_keys( @keys ); Declares that the given list of keys are somehow responsible for determining the look of the widget, but in a way that does not determine the size. If their values are changed, the C method is called. Between them these three methods may help avoid C classes from needing to override the C method. =cut sub style_redraw_keys { my $class = caller; my $type = $class->_widget_style_type; $REDRAW_KEYS{$type}{$_} = 1 for @_; } sub _redraw_keys { my ( $type ) = @_; return keys $REDRAW_KEYS{$type}->%*; } my @ON_STYLE_LOAD; # Not exported sub _load_style { my ( $defs ) = @_; foreach my $def ( @$defs ) { my $type = $def->type; $TAGSETS_BY_TYPE_CLASS{$type} ||= {}; my $tagset = _ref_tagset( $type, $def->class ); $tagset->merge_with_tags( $def->tags, $def->style ); } foreach my $code ( @ON_STYLE_LOAD ) { $code->(); } } =head1 ADDITIONAL FUNCTIONS/METHODS These functions are not exported, but may be called directly. =cut =head2 load_style Tickit::Style->load_style( $string ); Loads definitions from a stylesheet given in a string. Definitions will be merged with existing definitions in memory, with new values overwriting existing values. =cut sub load_style { shift; my ( $str ) = @_; _load_style( Tickit::Style::Parser->new->from_string( $str ) ); } =head2 load_style_file Tickit::Style->load_style_file( $path ); Loads definitions from a stylesheet file given by the path. Definitions will be merged the same way as C. =cut sub load_style_file { shift; my ( $path ) = @_; # TODO: use ->from_file( $path, binmode => ":encoding(UTF-8)" ) when available my $str = do { open my $fh, "<:encoding(UTF-8)", $path or croak "Cannot read $path - $!"; local $/; <$fh>; }; _load_style( Tickit::Style::Parser->new->from_string( $str ) ); } =head2 load_style_from_DATA Tickit::Style->load_style_from_DATA; A convenient shortcut for loading style definitions from the caller's C filehandle. =cut sub load_style_from_DATA { shift; my $pkg = caller; my $fh = meta::package->get( $pkg )->get_glob( "DATA" )->reference; my $str = do { local $/; <$fh> }; _load_style( Tickit::Style::Parser->new->from_string( $str ) ); } =head2 on_style_load Tickit::Style::on_style_load( \&code ); Adds a CODE reference to be invoked after either C or C are called. This may be useful to flush any caches or invalidate any state that depends on style information. =cut sub on_style_load { my ( $code ) = @_; push @ON_STYLE_LOAD, $code; } class # hide from indexer Tickit::Style::_Keyset :strict(params) { # A "Keyset" is the set of style keys applied to one particular set of # style tags field $tags :reader :param; field $style :reader :param; method clone { return __PACKAGE__->new( tags => $tags, style => { %$style } ); } } class # hide from indexer Tickit::Style::_Tagset :strict(params); use experimental 'postderef'; field @_keysets; ADJUST :params ( :$keysets = undef ) { @_keysets = $keysets->@* if $keysets; } method clone { return __PACKAGE__->new( keysets => [ map { $_->clone } @_keysets ] ); } method add { my ( $key, $value ) = @_; my %tags; $tags{$1}++ while $key =~ s/:([A-Z0-9_-]+)//i; $self->merge_with_tags( \%tags, { $key => $value } ); } method merge { my ( $other ) = @_; foreach my $keyset ( $other->keysets ) { $self->merge_with_tags( $keyset->tags, $keyset->style ); } } method merge_with_tags { my ( $tags, $style ) = @_; my $keyset = Tickit::Style::_Keyset->new( tags => $tags, style => $style ); @_keysets = ( $keyset ) and return if !@_keysets; # First see if we have to merge an existing one KEYSET: foreach my $keyset ( @_keysets ) { $keyset->tags->{$_} or next KEYSET for keys %$tags; $tags->{$_} or next KEYSET for keys $keyset->tags->%*; # Merge foreach my $key ( keys %$style ) { defined $style->{$key} ? $keyset->style->{$key} = $style->{$key} : delete $keyset->style->{$key}; } return; } # Keep sorted, most tags first # TODO: this might be doable more efficiently but we don't care for now @_keysets = sort { scalar keys $b->tags->%* <=> scalar keys $a->tags->%* } ( @_keysets, $keyset ); } method keysets { return @_keysets; } =head1 AUTHOR Paul Evans =cut 0x55AA; Tickit-Widgets-0.42/lib/Tickit/Widget.pm000444001750001750 6716214670354543 16775 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-2023 -- leonerd@leonerd.org.uk use v5.20; use warnings; use Object::Pad 0.805; package Tickit::Widget 0.58; class Tickit::Widget :repr(HASH); use experimental 'postderef'; use Carp; use Scalar::Util qw( blessed weaken ); use List::Util 1.33 qw( all ); use Tickit::Pen; use Tickit::Style; use Tickit::Utils qw( textwidth ); use Tickit::Window 0.57; # $win->bind_event use Tickit::Event 0.66; # $info->type newapi use constant PEN_ATTR_MAP => { map { $_ => 1 } @Tickit::Pen::ALL_ATTRS }; use constant KEYPRESSES_FROM_STYLE => 0; use constant CAN_FOCUS => 0; =head1 NAME C - abstract base class for on-screen widgets =head1 DESCRIPTION This class acts as an abstract base class for on-screen widget objects. It provides the lower-level machinery required by most or all widget types. Objects cannot be directly constructed in this class. Instead, a subclass of this class which provides a suitable implementation of the C and other provided methods is derived. Instances in that class are then constructed. See the C section below. The core F distribution only contains a couple of simple widget classes. Many more widget types are available on CPAN. Almost certainly for any widget-based program you will want to at least install the L distribution, which provides many of the basic UI types of widget. =head1 STYLE The following style tags are used on all widget classes that use Style: =over 4 =item :focus Set when this widget has the input focus =back The following style actions are used: =over 4 =item focus_next_before () =item focus_next_after () Requests the focus move to the next or previous focusable widget in display order. =back =cut style_definition base => '' => "focus_next_after", '' => "focus_next_before"; =head1 CONSTRUCTOR =cut =head2 new $widget = Tickit::Widget->new( %args ); Constructs a new C object. Must be called on a subclass that implements the required methods; see the B section below. Any pen attributes present in C<%args> will be used to set the default values on the widget's pen object, other than the following: =over 8 =item class => STRING =item classes => ARRAY of STRING If present, gives the C class name or names applied to this widget. =item style => HASH If present, gives a set of "direct applied" style to the Widget. This is treated as an extra set of style definitions that apply more directly than any of the style classes or the default definitions. The hash should contain style keys, optionally suffixed by style tags, giving values. style => { 'fg' => 3, 'fg:active' => 5, } =back =cut field @_style_classes; field $_style_direct; field %_style_tag; ADJUST { my $class = ref $self; foreach my $method (qw( lines cols render_to_rb )) { $class->can( $method ) or croak "$class cannot ->$method - do you subclass and implement it?"; } } ADJUST :params ( :$class = undef, :$classes = [ $class ], ) { @_style_classes = $classes->@*; } ADJUST :params ( :$style = undef, %params ) { # Legacy direct-applied-style argument support foreach my $attr ( @Tickit::Pen::ALL_ATTRS ) { next unless defined( my $val = delete $params{$attr} ); carp "Applying legacy direct pen attribute '$attr' for ${\ref $self}"; $style->{$attr} = $val; } if( $style ) { my $tagset = $_style_direct = Tickit::Style::_Tagset->new; foreach my $key ( keys %$style ) { $tagset->add( $key, $style->{$key} ); } } $self->_update_pen( $self->get_style_pen ); } field $_parent :reader; field $_window :reader; field $_pen :reader; field $_focus_pending; field %_event_ids; =head1 METHODS =cut =head2 style_classes @classes = $widget->style_classes; Returns a list of the style class names this Widget has. =cut method style_classes { return @_style_classes; } =head2 set_style_tag $widget->set_style_tag( $tag, $value ); Sets the (boolean) state of the named style tag. After calling this method, the C methods may return different results. No resizing or redrawing is necessarily performed; but the widget can use C, C or C to declare which style keys should cause automatic reshaping or redrawing. In addition it can override the C method to inspect the changes and decide for itself. =cut # This is cached, so will need invalidating on style loads my %KEYS_BY_TYPE_CLASS_TAG; Tickit::Style::on_style_load( sub { undef %KEYS_BY_TYPE_CLASS_TAG } ); method set_style_tag { my ( $tag, $value ) = @_; # Early-return on no change return if !$_style_tag{$tag} == !$value; # Work out what style keys might depend on this tag my %values; if( $_style_direct ) { KEYSET: foreach my $keyset ( $_style_direct->keysets ) { $keyset->tags->{$tag} or next KEYSET; $values{$_} ||= [] for keys $keyset->style->%*; } } my $type = $self->_widget_style_type; foreach my $class ( $self->style_classes, undef ) { my $keys = $KEYS_BY_TYPE_CLASS_TAG{$type}{$class//""}{$tag} ||= do { my $tagset = Tickit::Style::_ref_tagset( $type, $class ); my %keys; KEYSET: foreach my $keyset ( $tagset->keysets ) { $keyset->tags->{$tag} or next KEYSET; $keys{$_}++ for keys $keyset->style->%*; } [ keys %keys ]; }; $values{$_} ||= [] for @$keys; } my @keys = keys %values; my @old_values = $self->get_style_values( @keys ); $values{$keys[$_]}[0] = $old_values[$_] for 0 .. $#keys; $_style_tag{$tag} = !!$value; $self->_style_changed_values( \%values ); } method _style_tags { return join "|", sort grep { $_style_tag{$_} } keys %_style_tag; } =head2 get_style_values @values = $widget->get_style_values( @keys ); $value = $widget->get_style_values( $key ); Returns a list of values for the given keys of the currently-applied style. For more detail see the L documentation. Returns just one value in scalar context. =cut field %_style_cache; method get_style_values { my @keys = @_; my $type = $self->_widget_style_type; my @set = ( 0 ) x @keys; my @values = ( undef ) x @keys; my $cache = $_style_cache{$self->_style_tags} ||= {}; foreach my $i ( 0 .. $#keys ) { next unless exists $cache->{$keys[$i]}; $set[$i] = 1; $values[$i] = $cache->{$keys[$i]}; } my @classes = ( $self->style_classes, undef ); my $tagset = $_style_direct; while( !all { $_ } @set and @classes ) { # First time around this uses the direct style, if set. Thereafter uses # the style classes in order, finally the unclassed base. defined $tagset or $tagset = Tickit::Style::_ref_tagset( $type, shift @classes ); KEYSET: foreach my $keyset ( $tagset->keysets ) { $_style_tag{$_} or next KEYSET for keys $keyset->tags->%*; my $style = $keyset->style; foreach ( 0 .. $#keys ) { exists $style->{$keys[$_]} or next; $set[$_] and next; $values[$_] = $style->{$keys[$_]}; $set[$_] = 1; } } undef $tagset; # After all the classes, try again with type as "*" if( $type ne "*" and !@classes ) { $type = "*"; @classes = ( $self->style_classes, undef ); } } foreach my $i ( 0 .. $#keys ) { next if exists $cache->{$keys[$i]}; $cache->{$keys[$i]} = $values[$i]; } return @values if wantarray; return $values[0]; } =head2 get_style_pen $pen = $widget->get_style_pen( $prefix ); A shortcut to calling C to collect up the pen attributes, and form a L object from them. If C<$prefix> is supplied, it will be prefixed on the pen attribute names with an underscore (which would be read from the stylesheet file as a hyphen). Note that the returned pen instance is immutable, and may be cached. =cut field %_style_pen_cache; method get_style_pen { my $class = ref $self; my ( $prefix ) = @_; return $_style_pen_cache{$self->_style_tags}{$prefix//""} ||= do { my @keys = map { defined $prefix ? "${prefix}_$_" : $_ } @Tickit::Pen::ALL_ATTRS; my %attrs; @attrs{@Tickit::Pen::ALL_ATTRS} = $self->get_style_values( @keys ); Tickit::Pen::Immutable->new( %attrs ); }; } =head2 get_style_text $text = $widget->get_style_text; A shortcut to calling C for a single key called C<"text">. =cut method get_style_text { my $class = ref $self; return $self->get_style_values( "text" ) // croak "$class style does not define text"; } =head2 set_style $widget->set_style( %defs ); Changes the widget's direct-applied style. C<%defs> should contain style keys optionally suffixed with tags in the same form as that given to the C