From d38ea3c6312e8075383c3e53004d53db8198446f Mon Sep 17 00:00:00 2001 From: Andrej Shadura Date: Sat, 28 Jul 2018 16:54:34 +0100 Subject: Import original source of Tickit-Widget-Scroller 0.23 --- Build.PL | 31 + Changes | 123 +++ LICENSE | 379 +++++++++ MANIFEST | 31 + META.json | 56 ++ META.yml | 35 + Makefile.PL | 18 + README | 294 +++++++ examples/richtext.pl | 57 ++ examples/text.pl | 62 ++ lib/Tickit/Widget/Scroller.pm | 1143 +++++++++++++++++++++++++++ lib/Tickit/Widget/Scroller/Item.pod | 62 ++ lib/Tickit/Widget/Scroller/Item/RichText.pm | 76 ++ lib/Tickit/Widget/Scroller/Item/Text.pm | 215 +++++ t/00use.t | 10 + t/01item-text.t | 205 +++++ t/02item-richtext.t | 123 +++ t/10initial.t | 117 +++ t/11scroll.t | 380 +++++++++ t/12resize-bottom.t | 102 +++ t/12resize-top.t | 100 +++ t/20push-bottom.t | 188 +++++ t/20push-top.t | 181 +++++ t/21shift-bottom.t | 177 +++++ t/21shift-top.t | 168 ++++ t/22unshift-bottom.t | 187 +++++ t/22unshift-top.t | 190 +++++ t/23pop-bottom.t | 170 ++++ t/23pop-top.t | 182 +++++ t/30indicator.t | 143 ++++ t/99pod.t | 11 + 31 files changed, 5216 insertions(+) create mode 100644 Build.PL create mode 100644 Changes create mode 100644 LICENSE create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 examples/richtext.pl create mode 100644 examples/text.pl create mode 100644 lib/Tickit/Widget/Scroller.pm create mode 100644 lib/Tickit/Widget/Scroller/Item.pod create mode 100644 lib/Tickit/Widget/Scroller/Item/RichText.pm create mode 100644 lib/Tickit/Widget/Scroller/Item/Text.pm create mode 100644 t/00use.t create mode 100644 t/01item-text.t create mode 100644 t/02item-richtext.t create mode 100644 t/10initial.t create mode 100644 t/11scroll.t create mode 100644 t/12resize-bottom.t create mode 100644 t/12resize-top.t create mode 100644 t/20push-bottom.t create mode 100644 t/20push-top.t create mode 100644 t/21shift-bottom.t create mode 100644 t/21shift-top.t create mode 100644 t/22unshift-bottom.t create mode 100644 t/22unshift-top.t create mode 100644 t/23pop-bottom.t create mode 100644 t/23pop-top.t create mode 100644 t/30indicator.t create mode 100644 t/99pod.t diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..b40c370 --- /dev/null +++ b/Build.PL @@ -0,0 +1,31 @@ +use strict; +use warnings; + +use Module::Build; + +my $build = Module::Build->new( + module_name => 'Tickit::Widget::Scroller', + requires => { + 'String::Tagged' => 0, + 'Tickit::RenderBuffer' => '0.43', # flush_to_term + 'Tickit::Widget' => '0.35', + 'Tickit::Window' => '0.57', + 'Tickit::Pen' => '0.19', + }, + test_requires => { + 'Test::More' => '0.88', # done_testing + 'Tickit::Test' => '0.12', + }, + auto_configure_requires => 0, # Don't add M::B to configure_requires + license => 'perl', + create_makefile_pl => 'traditional', + create_license => 1, + create_readme => 1, + meta_merge => { + resources => { + x_IRC => "irc://irc.freenode.net/#tickit", + }, + }, +); + +$build->create_build_script; diff --git a/Changes b/Changes new file mode 100644 index 0000000..2b9c2ee --- /dev/null +++ b/Changes @@ -0,0 +1,123 @@ +Revision history for Tickit-Widget-Scroller + +0.23 2017/05/22 13:13:40 + [CHANGES] + * Avoid $win->clear in unit tests + + [BUGFIXES] + * Fix for handling trailing linefeeds at the end of text chunks + +0.22 2016/08/08 14:11:25 + [CHANGES] + * Updated for Tickit 0.57: + + Use $win->bind_event instead of $win->set_on_* + +0.21 2016/05/16 11:48:54 + [BUGFIXES] + * Fix for ->shift when exposing bottom of contained content + +0.20 2016/01/06 19:48:20 + [CHANGES] + * Updates for latest Tickit: + + no longer necessary to set $win->expose_after_scroll + * Updated module documentation style to use =head2 barenames + +0.19 2014/12/15 18:49:57 + [CHANGES] + * Added ->pop method + * Have ->shift and ->pop return the item(s) they removed + +0.18 2014/04/12 14:40:45 + [CHANGES] + * Avoid $rb->flush_to_window during unit testing; all unit tests + should be done directly to mockterm + + [BUGFIXES] + * Text item render shouldn't care about the width of the + RenderBuffer, only of itself + +0.17 2014/04/04 00:00:45 + [CHANGES] + * Use Tickit 0.32-style event structures for key/mouse events + * Prepare for Tickit 0.44's whole-tree RB rendering order + +0.16 2014/04/01 22:50:13 + [CHANGES] + * Clarify documentation on behaviour of on_scrolled + * Use new Window expose with_rb event from Tickit 0.42 + * Fix unit tests to work with Tickit 0.43's new ordering + +0.15 2013/11/11 20:23:05 + [CHANGES] + * Added 'on_scrolled' event + + [BUGFIXES] + * Correctly reset gravity after shrinking from oversized window + +0.14 2013/09/02 00:44:56 + [CHANGES] + * Don't declare linecount as ->lines after all, as it breaks things + * Implement ->scroll_to on top of ->scroll, preparing for use via + Tickit::Widget::ScrollBox + + [BUGFIXES] + * Update unit tests to use RenderBuffer instead of RenderContext + +0.13 2013/09/01 01:39:07 + [CHANGES] + * Use Tickit::RenderBuffer and ->render_to_rb from + Tickit::Widget 0.35 + * Have Scroller declare its actual total line height as 'lines' + +0.12 CHANGES: + * Updated for Tickit::Style 0.32 and Tickit::RenderContext 0.07 + +0.11 CHANGES: + * Updated to use Tickit::Style and Tickit::RenderContext + +0.10 CHANGES: + * Added ->unshift operation analogous to ->push + +0.09 CHANGES: + * Added indicators (may require Tickit 0.24 to scroll efficiently) + * Added ->lines_above, ->lines_below + * Added count_offscreen behaviour to item2line + +0.08 CHANGES: + * Try to linewrap on word boundaries if possible, even during pen + changes + * Enable new expose_after_scroll behaviour + * Disable deprecated CLEAR_BEFORE_RENDER behaviour + * Fix unit tests to work correctly with new experimental + FLOAT_ALL_THE_WINDOWS behaviour + +0.07 CHANGES: + * Don't allow overscroll past the end of the content + * More unit testing of full Unicode text + * Handle zero-length substring chunks correctly + +0.06 CHANGES: + * Allow linefeeds in Text and RichText items + +0.05 CHANGES: + * Bugfix to item wrapping boundary condition when a word ends exactly + at the righthand boundary + +0.04 CHANGES: + * Added 'gravity' parameter to control resize behaviour + * Respond to mouse wheel events by scrolling 5 lines at a time + +0.03 CHANGES: + * Use Window->print rather than Window->penprint + * Handle ->item2line with no items + * Preserve 'at-bottom'ness while not onscreen, restore it later + * Use new is_display TEXT() assertions from Tickit 0.12 + +0.02 CHANGES: + * Added Tickit::Widget::Scroller::Item::RichText + * New API for ->item2line + * Handle some keybindings by default + * Updated for Tickit::Test 0.07 + +0.01 First version, released on an unsuspecting world. + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..8a8e8e5 --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2017 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) 2017 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) 2017 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 +MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..7202cf5 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,31 @@ +Build.PL +Changes +examples/richtext.pl +examples/text.pl +lib/Tickit/Widget/Scroller.pm +lib/Tickit/Widget/Scroller/Item.pod +lib/Tickit/Widget/Scroller/Item/RichText.pm +lib/Tickit/Widget/Scroller/Item/Text.pm +LICENSE +Makefile.PL +MANIFEST This list of files +META.json +META.yml +README +t/00use.t +t/01item-text.t +t/02item-richtext.t +t/10initial.t +t/11scroll.t +t/12resize-bottom.t +t/12resize-top.t +t/20push-bottom.t +t/20push-top.t +t/21shift-bottom.t +t/21shift-top.t +t/22unshift-bottom.t +t/22unshift-top.t +t/23pop-bottom.t +t/23pop-top.t +t/30indicator.t +t/99pod.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..1b93926 --- /dev/null +++ b/META.json @@ -0,0 +1,56 @@ +{ + "abstract" : "a widget displaying a scrollable collection of", + "author" : [ + "Paul Evans " + ], + "dynamic_config" : 1, + "generated_by" : "Module::Build version 0.422", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Tickit-Widget-Scroller", + "prereqs" : { + "runtime" : { + "requires" : { + "String::Tagged" : "0", + "Tickit::Pen" : "0.19", + "Tickit::RenderBuffer" : "0.43", + "Tickit::Widget" : "0.35", + "Tickit::Window" : "0.57" + } + }, + "test" : { + "requires" : { + "Test::More" : "0.88", + "Tickit::Test" : "0.12" + } + } + }, + "provides" : { + "Tickit::Widget::Scroller" : { + "file" : "lib/Tickit/Widget/Scroller.pm", + "version" : "0.23" + }, + "Tickit::Widget::Scroller::Item::RichText" : { + "file" : "lib/Tickit/Widget/Scroller/Item/RichText.pm", + "version" : "0.23" + }, + "Tickit::Widget::Scroller::Item::Text" : { + "file" : "lib/Tickit/Widget/Scroller/Item/Text.pm", + "version" : "0.23" + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/" + ], + "x_IRC" : "irc://irc.freenode.net/#tickit" + }, + "version" : "0.23", + "x_serialization_backend" : "JSON::PP version 2.27400" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..bfdba94 --- /dev/null +++ b/META.yml @@ -0,0 +1,35 @@ +--- +abstract: 'a widget displaying a scrollable collection of' +author: + - 'Paul Evans ' +build_requires: + Test::More: '0.88' + Tickit::Test: '0.12' +dynamic_config: 1 +generated_by: 'Module::Build version 0.422, CPAN::Meta::Converter version 2.150005' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Tickit-Widget-Scroller +provides: + Tickit::Widget::Scroller: + file: lib/Tickit/Widget/Scroller.pm + version: '0.23' + Tickit::Widget::Scroller::Item::RichText: + file: lib/Tickit/Widget/Scroller/Item/RichText.pm + version: '0.23' + Tickit::Widget::Scroller::Item::Text: + file: lib/Tickit/Widget/Scroller/Item/Text.pm + version: '0.23' +requires: + String::Tagged: '0' + Tickit::Pen: '0.19' + Tickit::RenderBuffer: '0.43' + Tickit::Widget: '0.35' + Tickit::Window: '0.57' +resources: + IRC: irc://irc.freenode.net/#tickit + license: http://dev.perl.org/licenses/ +version: '0.23' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..d8d3a0b --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.4220 +use ExtUtils::MakeMaker; +WriteMakefile +( + 'NAME' => 'Tickit::Widget::Scroller', + 'VERSION_FROM' => 'lib/Tickit/Widget/Scroller.pm', + 'PREREQ_PM' => { + 'String::Tagged' => 0, + 'Tickit::Pen' => '0.19', + 'Tickit::RenderBuffer' => '0.43', + 'Tickit::Widget' => '0.35', + 'Tickit::Window' => '0.57' + }, + 'INSTALLDIRS' => 'site', + 'EXE_FILES' => [], + 'PL_FILES' => {} +) +; diff --git a/README b/README new file mode 100644 index 0000000..fe5bb82 --- /dev/null +++ b/README @@ -0,0 +1,294 @@ +NAME + + Tickit::Widget::Scroller - a widget displaying a scrollable collection + of items + +SYNOPSIS + + use Tickit; + use Tickit::Widget::Scroller; + use Tickit::Widget::Scroller::Item::Text; + + my $tickit = Tickit->new; + + my $scroller = Tickit::Widget::Scroller->new; + + $scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Hello world" ), + Tickit::Widget::Scroller::Item::Text->new( "Here are some lines" ), + map { Tickit::Widget::Scroller::Item::Text->new( "" ) } 1 .. 50, + ); + + $tickit->set_root_widget( $scroller ); + + $tickit->run + +DESCRIPTION + + This class provides a widget which displays a scrollable list of items. + The view of the items is scrollable, able to display only a part of the + list. + + A Scroller widget stores a list of instances implementing the + Tickit::Widget::Scroller::Item interface. + +STYLE + + The default style pen is used as the widget pen. + + The following style pen prefixes are used: + + indicator => PEN + + The pen used for the scroll position indicators at the top or bottom + of the display + +KEYBINDINGS + + The following keys are bound + + * Down + + Scroll one line down + + * Up + + Scroll one line up + + * PageDown + + Scroll half a window down + + * PageUp + + Scroll half a window up + + * Ctrl-Home + + Scroll to the top + + * Ctrl-End + + Scroll to the bottom + +CONSTRUCTOR + + new + + $scroller = Tickit::Widget::Scroller->new( %args ) + + Constructs a new Tickit::Widget::Scroller object. The new object will + start with an empty list of items. + + Takes the following named arguments: + + gravity => STRING + + Optional. If given the value bottom, resize events and the push + method will attempt to preserve the item at the bottom of the screen. + Otherwise, will preserve the top. + + gen_top_indicator => CODE + + gen_bottom_indicator => CODE + + Optional. Generator functions for the top and bottom indicators. See + also set_gen_top_indicator and set_gen_bottom_indicator. + +METHODS + + on_scrolled + + set_on_scrolled + + $on_scrolled = $scroller->on_scrolled + + $scroller->set_on_scrolled( $on_scrolled ) + + Return or set the CODE reference to be called when the scroll position + is adjusted. + + $on_scrolled->( $scroller, $delta ) + + This is invoked by the scroll method, including the scroll_to, + scroll_to_top and scroll_to_bottom. In normal cases it will be given + the delta offset that scroll itself was invoked with, though this may + be clipped if this would scroll past the beginning or end of the + display. + + push + + $scroller->push( @items ) + + Append the given items to the end of the list. + + If the Scroller is already at the tail (that is, the last line of the + last item is on display) and the gravity mode is bottom, the newly + added items will be displayed, possibly by scrolling downward if + required. While the scroller isn't adjusted by using any of the scroll + methods, it will remain following the tail of the items, scrolling + itself downwards as more are added. + + unshift + + $scroller->unshift( @items ) + + Prepend the given items to the beginning of the list. + + If the Scroller is already at the head (that is, the first line of the + first item is on display) and the gravity mode is top, the newly added + items will be displayed, possibly by scrolling upward if required. + While the scroller isn't adjusted by using any of the scroll methods, + it will remain following the head of the items, scrolling itself + upwards as more are added. + + shift + + @items = $scroller->shift( $count ) + + Remove the given number of items from the start of the list and returns + them. + + If any of the items are on display, the Scroller will be scrolled + upwards an amount sufficient to close the gap, ensuring the first + remaining item is now at the top of the display. + + The returned items may be re-used by adding them back into the scroller + again either by push or unshift, or may be discarded. + + pop + + @items = $scroller->pop( $count ) + + Remove the given number of items from the end of the list and returns + them. + + If any of the items are on display, the Scroller will be scrolled + downwards an amount sufficient to close the gap, ensuring the last + remaining item is now at the bottom of the display. + + The returned items may be re-used by adding them back into the scroller + again either by push or unshift, or may be discarded. + + scroll + + $scroller->scroll( $delta ) + + Move the display up or down by the given $delta amount; with positive + moving down. This will be a physical count of displayed lines; if some + items occupy multiple lines, then fewer items may be scrolled than + lines. + + scroll_to + + $scroller->scroll_to( $line, $itemidx, $itemline ) + + Moves the display up or down so that display line $line contains line + $itemline of item $itemidx. Any of these counts may be negative to + count backwards from the display lines, items, or lines within the + item. + + scroll_to_top + + $scroller->scroll_to_top( $itemidx, $itemline ) + + Shortcut for scroll_to to set the top line of display; where $line is + 0. If $itemline is undefined, it will be passed as 0. If $itemidx is + also undefined, it will be passed as 0. Calling this method with no + arguments, therefore scrolls to the very top of the display. + + scroll_to_bottom + + $scroller->scroll_to_bottom( $itemidx, $itemline ) + + Shortcut for scroll_to to set the bottom line of display; where $line + is -1. If $itemline is undefined, it will be passed as -1. If $itemidx + is also undefined, it will be passed as -1. Calling this method with no + arguments, therefore scrolls to the very bottom of the display. + + line2item + + $itemidx = $scroller->line2item( $line ) + + ( $itemidx, $itemline ) = $scroller->line2item( $line ) + + Returns the item index currently on display at the given line of the + window. In list context, also returns the line number within item. If + no window has been set, or there is no item on display at that line, + undef or an empty list are returned. $line may be negative to count + backward from the last line on display; the last line taking -1. + + item2line + + $line = $scroller->item2line( $itemidx, $itemline ) + + ( $line, $offscreen ) = $scroller->item2line( $itemidx, $itemline, $count_offscreen ) + + Returns the display line in the window of the given line of the item at + the given index. $itemidx may be given negative, to count backwards + from the last item. $itemline may be negative to count backward from + the last line of the item. + + In list context, also returns a value describing the offscreen nature + of the item. For items fully on display, this value is undef. If the + given line of the given item is not on display because it is scrolled + off either the top or bottom of the window, this value will be either + "above" or "below" respectively. If $count_offscreen is true, then the + returned $line value will always be defined, even if the item line is + offscreen. This will be negative for items "above", and a value equal + or greater than the number of lines in the scroller's window for items + "below". + + lines_above + + $count = $scroller->lines_above + + Returns the number of lines of content above the scrolled display. + + lines_below + + $count = $scroller->lines_below + + Returns the number of lines of content below the scrolled display. + + set_gen_top_indicator + + set_gen_bottom_indicator + + $scroller->set_gen_top_indicator( $method ) + + $scroller->set_gen_bottom_indicator( $method ) + + Accessors for the generators for the top and bottom indicator text. If + set, each should be a CODE reference or method name on the scroller + which will be invoked after any operation that changes the contents of + the window, such as scrolling or adding or removing items. It should + return a text string which, if defined and non-empty, will be displayed + in an indicator window. This will be a small one-line window displayed + at the top right or bottom right corner of the Scroller's window. + + $text = $scroller->$method() + + The ability to pass method names allows subclasses to easily implement + custom logic as methods without having to capture a closure. + + update_indicators + + $scroller->update_indicators + + Calls any defined generators for indicator text, and updates the + indicator windows with the returned text. This may be useful if the + functions would return different text now. + +TODO + + * Abstract away the "item storage model" out of the actual widget. + Implement more storage models, such as database-driven ones.. more + dynamic. + + * Keybindings + +AUTHOR + + Paul Evans + diff --git a/examples/richtext.pl b/examples/richtext.pl new file mode 100644 index 0000000..70be7d6 --- /dev/null +++ b/examples/richtext.pl @@ -0,0 +1,57 @@ +use strict; +use warnings; + +use Tickit; + +use Tickit::Widget::VBox; +use Tickit::Widget::Entry; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::RichText; + +use String::Tagged; + +my $scroller = Tickit::Widget::Scroller->new( gravity => "bottom" ); + +for my $i ( 0 .. 100 ) { + my $text = String::Tagged->new( ": " ); + for ( 0 .. rand( 30 ) + 3 ) { + $text->append_tagged( chr( rand( 26 ) + 0x40 ) x ( rand( 10 ) + 5 ), + fg => int( rand( 7 ) + 1 ), + b => rand > 0.8, + u => rand > 0.8, + i => rand > 0.8, + ); + $text->append( " " ); + } + + $scroller->push( + Tickit::Widget::Scroller::Item::RichText->new( $text, indent => 4 ), + ); +} + +my $entry = Tickit::Widget::Entry->new( + on_enter => sub { + my ( $self, $line ) = @_; + + $scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "You wrote: $line" ) + ); + + $self->set_text( "" ); + }, + + fg => 0, + bg => 2, +); + +my $tickit = Tickit->new; + +my $vbox = Tickit::Widget::VBox->new; + +$vbox->add( $scroller, expand => 1 ); +$vbox->add( $entry ); + +$tickit->set_root_widget( $vbox ); + +$tickit->run; diff --git a/examples/text.pl b/examples/text.pl new file mode 100644 index 0000000..00ceb35 --- /dev/null +++ b/examples/text.pl @@ -0,0 +1,62 @@ +use strict; +use warnings; + +use Tickit; + +use Tickit::Widget::VBox; +use Tickit::Widget::Entry; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "bottom", + gen_top_indicator => sub { + my $self = shift; + my $lines = $self->lines_above or return; + return sprintf "+ %d more", $lines; + }, + gen_bottom_indicator => sub { + my $self = shift; + my $lines = $self->lines_below or return; + return sprintf "+ %d more", $lines; + }, +); + +for my $i ( 0 .. 100 ) { + my $text = ": "; + for ( 0 .. rand( 30 ) + 3 ) { + $text .= chr( rand( 26 ) + 0x40 ) x ( rand( 10 ) + 5 ); + $text .= " "; + } + + $scroller->push( + Tickit::Widget::Scroller::Item::Text->new( $text, indent => 4 ), + ); +} + +my $entry = Tickit::Widget::Entry->new( + on_enter => sub { + my ( $self, $line ) = @_; + + $scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "You wrote: $line" ) + ); + + $self->set_text( "" ); + }, + + fg => 0, + bg => 2, +); + +my $tickit = Tickit->new; + +my $vbox = Tickit::Widget::VBox->new; + +$vbox->add( $scroller, expand => 1 ); +$vbox->add( $entry ); + +$tickit->set_root_widget( $vbox ); + +$tickit->run; diff --git a/lib/Tickit/Widget/Scroller.pm b/lib/Tickit/Widget/Scroller.pm new file mode 100644 index 0000000..a63c5ef --- /dev/null +++ b/lib/Tickit/Widget/Scroller.pm @@ -0,0 +1,1143 @@ +# 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::Widget::Scroller; + +use strict; +use warnings; +use base qw( Tickit::Widget ); +use Tickit::Style; +Tickit::Widget->VERSION( '0.35' ); +Tickit::Window->VERSION( '0.57' ); # ->bind_event + +use Tickit::Window; +use Tickit::Utils qw( textwidth ); +use Tickit::RenderBuffer; + +our $VERSION = '0.23'; + +use Carp; + +=head1 NAME + +C - a widget displaying a scrollable collection of +items + +=head1 SYNOPSIS + + use Tickit; + use Tickit::Widget::Scroller; + use Tickit::Widget::Scroller::Item::Text; + + my $tickit = Tickit->new; + + my $scroller = Tickit::Widget::Scroller->new; + + $scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Hello world" ), + Tickit::Widget::Scroller::Item::Text->new( "Here are some lines" ), + map { Tickit::Widget::Scroller::Item::Text->new( "" ) } 1 .. 50, + ); + + $tickit->set_root_widget( $scroller ); + + $tickit->run + +=head1 DESCRIPTION + +This class provides a widget which displays a scrollable list of items. The +view of the items is scrollable, able to display only a part of the list. + +A Scroller widget stores a list of instances implementing the +C interface. + +=head1 STYLE + +The default style pen is used as the widget pen. + +The following style pen prefixes are used: + +=over 4 + +=item indicator => PEN + +The pen used for the scroll position indicators at the top or bottom of the +display + +=back + +=cut + +style_definition base => + indicator_rv => 1; + +use constant WIDGET_PEN_FROM_STYLE => 1; + +=head1 KEYBINDINGS + +The following keys are bound + +=over 2 + +=item * Down + +Scroll one line down + +=item * Up + +Scroll one line up + +=item * PageDown + +Scroll half a window down + +=item * PageUp + +Scroll half a window up + +=item * Ctrl-Home + +Scroll to the top + +=item * Ctrl-End + +Scroll to the bottom + +=back + +=cut + +=head1 CONSTRUCTOR + +=cut + +=head2 new + + $scroller = Tickit::Widget::Scroller->new( %args ) + +Constructs a new C object. The new object will start +with an empty list of items. + +Takes the following named arguments: + +=over 8 + +=item gravity => STRING + +Optional. If given the value C, resize events and the C method +will attempt to preserve the item at the bottom of the screen. Otherwise, will +preserve the top. + +=item gen_top_indicator => CODE + +=item gen_bottom_indicator => CODE + +Optional. Generator functions for the top and bottom indicators. See also +C and C. + +=back + +=cut + +sub new +{ + my $class = shift; + my %args = @_; + + my $gravity = delete $args{gravity} || "top"; + + my $self = $class->SUPER::new( %args ); + + # We're going to cache window height because we need pre-resize height + # during resize event + $self->{window_lines} = undef; + + $self->{items} = []; + + $self->{start_item} = 0; + $self->{start_partial} = 0; + + $self->{gravity_bottom} = $gravity eq "bottom"; + + $self->set_on_scrolled( $args{on_scrolled} ) if $args{on_scrolled}; + + $self->set_gen_top_indicator( $args{gen_top_indicator} ); + $self->set_gen_bottom_indicator( $args{gen_bottom_indicator} ); + + return $self; +} + +=head1 METHODS + +=cut + +sub cols { 1 } +sub lines { 1 } + +sub _item +{ + my $self = shift; + my ( $idx ) = @_; + return $self->{items}[$idx]; +} + +sub _itemheight +{ + my $self = shift; + my ( $idx ) = @_; + return $self->{itemheights}[$idx] if defined $self->{itemheights}[$idx]; + return $self->{itemheights}[$idx] = $self->_item( $idx )->height_for_width( $self->window->cols ); +} + +sub reshape +{ + my $self = shift; + + my ( $itemidx, $itemline ) = $self->line2item( $self->{gravity_bottom} ? -1 : 0 ); + $itemline -= $self->_itemheight( $itemidx ) if $self->{gravity_bottom} and defined $itemidx; + + $self->SUPER::reshape; + + $self->{window_lines} = $self->window->lines; + + if( !defined $self->{window_cols} or $self->{window_cols} != $self->window->cols ) { + $self->{window_cols} = $self->window->cols; + + undef $self->{itemheights}; + $self->resized; + } + + if( defined $itemidx ) { + $self->scroll_to( $self->{gravity_bottom} ? -1 : 0, $itemidx, $itemline ); + } + elsif( $self->{gravity_bottom} ) { + $self->scroll_to_bottom; + } + else { + $self->scroll_to_top; + } + + $self->update_indicators; +} + +sub window_lost +{ + my $self = shift; + $self->SUPER::window_lost( @_ ); + + my ( $line, $offscreen ) = $self->item2line( -1, -1 ); + + $self->{pending_scroll_to_bottom} = 1 if defined $line; + + undef $self->{window_lines}; +} + +sub window_gained +{ + my $self = shift; + my ( $win ) = @_; + + $self->{window_lines} = $win->lines; + + $self->SUPER::window_gained( $win ); + + if( delete $self->{pending_scroll_to_bottom} ) { + $self->scroll_to_bottom; + } +} + +=head2 on_scrolled + +=head2 set_on_scrolled + + $on_scrolled = $scroller->on_scrolled + + $scroller->set_on_scrolled( $on_scrolled ) + +Return or set the CODE reference to be called when the scroll position is +adjusted. + + $on_scrolled->( $scroller, $delta ) + +This is invoked by the C method, including the C, +C and C. In normal cases it will be given the +delta offset that C itself was invoked with, though this may be +clipped if this would scroll past the beginning or end of the display. + +=cut + +sub on_scrolled +{ + my $self = shift; + return $self->{on_scrolled}; +} + +sub set_on_scrolled +{ + my $self = shift; + ( $self->{on_scrolled} ) = @_; +} + +=head2 push + + $scroller->push( @items ) + +Append the given items to the end of the list. + +If the Scroller is already at the tail (that is, the last line of the last +item is on display) and the gravity mode is C, the newly added items +will be displayed, possibly by scrolling downward if required. While the +scroller isn't adjusted by using any of the C methods, it will remain +following the tail of the items, scrolling itself downwards as more are added. + +=cut + +sub push +{ + my $self = shift; + + my $items = $self->{items}; + + my $oldsize = @$items; + + push @$items, @_; + + if( my $win = $self->window and $self->window->is_visible ) { + my $added = 0; + $added += $self->_itemheight( $_ ) for $oldsize .. $#$items; + + my $lines = $self->{window_lines}; + + my $oldlast = $oldsize ? $self->item2line( $oldsize-1, -1 ) : -1; + + # Previous tail is on screen if $oldlast is defined and less than $lines + # If not, don't bother drawing or scrolling + return unless defined $oldlast and $oldlast < $lines; + + my $new_start = $oldlast + 1; + my $new_stop = $new_start + $added; + + if( $self->{gravity_bottom} ) { + # If there were enough spare lines, render them, otherwise scroll + if( $new_stop <= $lines ) { + $self->render_lines( $new_start, $new_stop ); + } + else { + $self->render_lines( $new_start, $lines ) if $new_start < $lines; + $self->scroll( $new_stop - $lines ); + } + } + else { + # If any new lines of content are now on display, render them + $new_stop = $lines if $new_stop > $lines; + if( $new_stop > $new_start ) { + $self->render_lines( $new_start, $new_stop ); + } + } + } + + $self->update_indicators; +} + +=head2 unshift + + $scroller->unshift( @items ) + +Prepend the given items to the beginning of the list. + +If the Scroller is already at the head (that is, the first line of the first +item is on display) and the gravity mode is C, the newly added items will +be displayed, possibly by scrolling upward if required. While the scroller +isn't adjusted by using any of the C methods, it will remain following +the head of the items, scrolling itself upwards as more are added. + +=cut + +sub unshift :method +{ + my $self = shift; + + my $items = $self->{items}; + + my $oldsize = @$items; + + my $oldfirst = $oldsize ? $self->item2line( 0, 0 ) : 0; + my $oldlast = $oldsize ? $self->item2line( -1, -1 ) : -1; + + unshift @$items, @_; + unshift @{ $self->{itemheights} }, ( undef ) x @_; + $self->{start_item} += @_; + + if( my $win = $self->window and $self->window->is_visible ) { + my $added = 0; + $added += $self->_itemheight( $_ ) for 0 .. $#_; + + # Previous head is on screen if $oldfirst is defined and non-negative + # If not, don't bother drawing or scrolling + return unless defined $oldfirst and $oldfirst >= 0; + + my $lines = $self->{window_lines}; + + if( $self->{gravity_bottom} ) { + # If the display wasn't yet full, scroll it down to display any new + # lines that are visible + my $first_blank = $oldlast + 1; + my $scroll_delta = $lines - $first_blank; + $scroll_delta = $added if $scroll_delta > $added; + if( $oldsize ) { + $self->scroll( -$scroll_delta ); + } + else { + $self->{start_item} = 0; + # TODO: if $added > $lines, need special handling + $self->render_lines( 0, $added ); + } + } + else { + # Scroll down by the amount added + if( $oldsize ) { + $self->scroll( -$added ); + } + else { + my $new_stop = $added; + $new_stop = $lines if $new_stop > $lines; + $self->{start_item} = 0; + $self->render_lines( 0, $new_stop ); + } + } + } + + $self->update_indicators; +} + +=head2 shift + + @items = $scroller->shift( $count ) + +Remove the given number of items from the start of the list and returns them. + +If any of the items are on display, the Scroller will be scrolled upwards an +amount sufficient to close the gap, ensuring the first remaining item is now +at the top of the display. + +The returned items may be re-used by adding them back into the scroller again +either by C or C, or may be discarded. + +=cut + +sub shift :method +{ + my $self = shift; + my ( $count ) = @_; + + defined $count or $count = 1; + + my $items = $self->{items}; + + croak '$count out of bounds' if $count <= 0; + croak '$count out of bounds' if $count > @$items; + + my ( $lastline, $offscreen ) = $self->item2line( $count - 1, -1 ); + + if( defined $lastline ) { + $self->scroll( $lastline + 1, allow_gap => 1 ); + # ->scroll implies $win->restore + } + + my @ret = splice @$items, 0, $count; + splice @{ $self->{itemheights} }, 0, $count; + $self->{start_item} -= $count; + + if( !defined $lastline and defined $offscreen and $offscreen eq "below" ) { + $self->scroll_to_top; + # ->scroll implies $win->restore + } + + $self->update_indicators; + + return @ret; +} + +=head2 pop + + @items = $scroller->pop( $count ) + +Remove the given number of items from the end of the list and returns them. + +If any of the items are on display, the Scroller will be scrolled downwards an +amount sufficient to close the gap, ensuring the last remaining item is now at +the bottom of the display. + +The returned items may be re-used by adding them back into the scroller again +either by C or C, or may be discarded. + +=cut + +sub pop :method +{ + my $self = shift; + my ( $count ) = @_; + + defined $count or $count = 1; + + my $items = $self->{items}; + + croak '$count out of bounds' if $count <= 0; + croak '$count out of bounds' if $count > @$items; + + my ( $firstline, $offscreen ) = $self->item2line( -$count, 0 ); + + if( defined $firstline ) { + $self->scroll( $firstline - $self->window->lines ); + } + + my @ret = splice @$items, -$count, $count; + splice @{ $self->{itemheights} }, -$count, $count; + + if( !defined $firstline and defined $offscreen and $offscreen eq "above" ) { + $self->scroll_to_bottom; + } + + $self->update_indicators; + + return @ret; +} + +=head2 scroll + + $scroller->scroll( $delta ) + +Move the display up or down by the given C<$delta> amount; with positive +moving down. This will be a physical count of displayed lines; if some items +occupy multiple lines, then fewer items may be scrolled than lines. + +=cut + +sub scroll +{ + my $self = shift; + my ( $delta, %opts ) = @_; + + return unless $delta; + + my $window = $self->window; + my $items = $self->{items}; + @$items or return; + + my $itemidx = $self->{start_item}; + my $partial = $self->{start_partial}; + my $scroll_amount = 0; + +REDO: + if( $partial > 0 ) { + $delta += $partial; + $scroll_amount -= $partial; + $partial = 0; + } + + while( $delta ) { + my $itemheight = $self->_itemheight( $itemidx ); + + if( $delta >= $itemheight ) { + $partial = $itemheight - 1, last if $itemidx == $#$items; + + $delta -= $itemheight; + $scroll_amount += $itemheight; + + $itemidx++; + } + elsif( $delta < 0 ) { + $partial = 0, last if $itemidx == 0; + $itemidx--; + + $itemheight = $self->_itemheight( $itemidx ); + + $delta += $itemheight; + $scroll_amount -= $itemheight; + } + else { + $partial = $delta; + $scroll_amount += $delta; + + $delta = 0; + } + } + + return if $itemidx == $self->{start_item} and + $partial == $self->{start_partial}; + + my $lines = $self->{window_lines}; + + if( $scroll_amount > 0 and !$opts{allow_gap} ) { + # We scrolled down. See if we've gone too far + my $line = -$partial; + my $idx = $itemidx; + + while( $line < $lines && $idx < @$items ) { + $line += $self->_itemheight( $idx ); + $idx++; + } + + if( $line < $lines ) { + my $spare = $lines - $line; + + $delta = -$spare; + goto REDO; + } + } + + $self->{start_item} = $itemidx; + $self->{start_partial} = $partial; + + if( abs( $scroll_amount ) < $lines ) { + $window->scroll( $scroll_amount, 0 ); + } + else { + $self->redraw; + } + + if( my $on_scrolled = $self->{on_scrolled} ) { + $self->$on_scrolled( $scroll_amount ); + } + + $self->update_indicators; +} + +=head2 scroll_to + + $scroller->scroll_to( $line, $itemidx, $itemline ) + +Moves the display up or down so that display line C<$line> contains line +C<$itemline> of item C<$itemidx>. Any of these counts may be negative to count +backwards from the display lines, items, or lines within the item. + +=cut + +sub scroll_to +{ + my $self = shift; + my ( $line, $itemidx, $itemline ) = @_; + + my $window = $self->window or return; + my $lines = $self->{window_lines}; + + my $items = $self->{items}; + @$items or return; + + if( $line < 0 ) { + $line += $lines; + + croak '$line out of bounds' if $line < 0; + } + else { + croak '$line out of bounds' if $line >= $lines; + } + + if( $itemidx < 0 ) { + $itemidx += @$items; + + croak '$itemidx out of bounds' if $itemidx < 0; + } + else { + croak '$itemidx out of bounds' if $itemidx >= @$items; + } + + my $itemheight = $self->_itemheight( $itemidx ); + + if( $itemline < 0 ) { + $itemline += $itemheight; + + croak '$itemline out of bounds' if $itemline < 0; + } + else { + croak '$itemline out of bounds' if $itemline >= $itemheight; + } + + $line -= $itemline; # now ignore itemline + + while( $line > 0 ) { + if( $itemidx == 0 ) { + $line = 0; + last; + } + + $itemheight = $self->_itemheight( --$itemidx ); + + $line -= $itemheight; + } + $itemline = -$line; # $line = 0; + + # Now we want $itemidx line $itemline to be on physical line 0 + + # Work out how far away that is + my $delta = 0; + my $i = $self->{start_item}; + + $delta -= $self->{start_partial}; + while( $itemidx > $i ) { + $delta += $self->_itemheight( $i ); + $i++; + } + while( $itemidx < $i ) { + $i--; + $delta -= $self->_itemheight( $i ); + } + $delta += $itemline; + + return if !$delta; + + $self->scroll( $delta ); +} + +=head2 scroll_to_top + + $scroller->scroll_to_top( $itemidx, $itemline ) + +Shortcut for C to set the top line of display; where C<$line> is 0. +If C<$itemline> is undefined, it will be passed as 0. If C<$itemidx> is also +undefined, it will be passed as 0. Calling this method with no arguments, +therefore scrolls to the very top of the display. + +=cut + +sub scroll_to_top +{ + my $self = shift; + my ( $itemidx, $itemline ) = @_; + + defined $itemidx or $itemidx = 0; + defined $itemline or $itemline = 0; + + $self->scroll_to( 0, $itemidx, $itemline ); +} + +=head2 scroll_to_bottom + + $scroller->scroll_to_bottom( $itemidx, $itemline ) + +Shortcut for C to set the bottom line of display; where C<$line> is +-1. If C<$itemline> is undefined, it will be passed as -1. If C<$itemidx> is +also undefined, it will be passed as -1. Calling this method with no +arguments, therefore scrolls to the very bottom of the display. + +=cut + +sub scroll_to_bottom +{ + my $self = shift; + my ( $itemidx, $itemline ) = @_; + + defined $itemidx or $itemidx = -1; + defined $itemline or $itemline = -1; + + $self->scroll_to( -1, $itemidx, $itemline ); +} + +=head2 line2item + + $itemidx = $scroller->line2item( $line ) + + ( $itemidx, $itemline ) = $scroller->line2item( $line ) + +Returns the item index currently on display at the given line of the window. +In list context, also returns the line number within item. If no window has +been set, or there is no item on display at that line, C or an empty +list are returned. C<$line> may be negative to count backward from the last +line on display; the last line taking C<-1>. + +=cut + +sub line2item +{ + my $self = shift; + my ( $line ) = @_; + + my $window = $self->window or return; + my $lines = $self->{window_lines}; + + my $items = $self->{items}; + + if( $line < 0 ) { + $line += $lines; + + croak '$line out of bounds' if $line < 0; + } + else { + croak '$line out of bounds' if $line >= $lines; + } + + my $itemidx = $self->{start_item}; + $line += $self->{start_partial}; + + while( $itemidx < @$items ) { + my $itemheight = $self->_itemheight( $itemidx ); + if( $line < $itemheight ) { + return $itemidx, $line if wantarray; + return $itemidx; + } + + $line -= $itemheight; + $itemidx++; + } + + return; +} + +=head2 item2line + + $line = $scroller->item2line( $itemidx, $itemline ) + + ( $line, $offscreen ) = $scroller->item2line( $itemidx, $itemline, $count_offscreen ) + +Returns the display line in the window of the given line of the item at the +given index. C<$itemidx> may be given negative, to count backwards from the +last item. C<$itemline> may be negative to count backward from the last line +of the item. + +In list context, also returns a value describing the offscreen nature of the +item. For items fully on display, this value is C. If the given line of +the given item is not on display because it is scrolled off either the top or +bottom of the window, this value will be either C<"above"> or C<"below"> +respectively. If C<$count_offscreen> is true, then the returned C<$line> value +will always be defined, even if the item line is offscreen. This will be +negative for items C<"above">, and a value equal or greater than the number of +lines in the scroller's window for items C<"below">. + +=cut + +sub item2line +{ + my $self = shift; + my ( $want_itemidx, $want_itemline, $count_offscreen ) = @_; + + my $window = $self->window or return; + my $lines = $self->{window_lines}; + + my $items = $self->{items}; + @$items or return; + + if( $want_itemidx < 0 ) { + $want_itemidx += @$items; + + croak '$itemidx out of bounds' if $want_itemidx < 0; + } + else { + croak '$itemidx out of bounds' if $want_itemidx >= @$items; + } + + my $itemheight = $self->_itemheight( $want_itemidx ); + + defined $want_itemline or $want_itemline = 0; + if( $want_itemline < 0 ) { + $want_itemline += $itemheight; + + croak '$itemline out of bounds' if $want_itemline < 0; + } + else { + croak '$itemline out of bounds' if $want_itemline >= $itemheight; + } + + my $itemidx = $self->{start_item}; + + my $line = -$self->{start_partial}; + + if( $want_itemidx < $itemidx or + $want_itemidx == $itemidx and $want_itemline < $self->{start_partial} ) { + if( wantarray and $count_offscreen ) { + while( $itemidx >= 0 ) { + if( $want_itemidx == $itemidx ) { + $line += $want_itemline; + last; + } + + $itemidx--; + $line -= $self->_itemheight( $itemidx ); + } + return ( $line, "above" ); + } + return ( undef, "above" ) if wantarray; + return; + } + + while( $itemidx < @$items and ( $line < $lines or $count_offscreen ) ) { + if( $want_itemidx == $itemidx ) { + $line += $want_itemline; + + last if $line >= $lines; + return $line; + } + + $line += $self->_itemheight( $itemidx ); + $itemidx++; + } + + return ( undef, "below" ) if wantarray and !$count_offscreen; + return ( $line, "below" ) if wantarray and $count_offscreen; + return; +} + +=head2 lines_above + + $count = $scroller->lines_above + +Returns the number of lines of content above the scrolled display. + +=cut + +sub lines_above +{ + my $self = shift; + my ( $line, $offscreen ) = $self->item2line( 0, 0, 1 ); + return 0 unless $offscreen; + return -$line; +} + +=head2 lines_below + + $count = $scroller->lines_below + +Returns the number of lines of content below the scrolled display. + +=cut + +sub lines_below +{ + my $self = shift; + my ( $line, $offscreen ) = $self->item2line( -1, -1, 1 ); + return 0 unless $offscreen; + return $line - $self->window->lines + 1; +} + +sub render_lines +{ + my $self = shift; + my ( $startline, $endline ) = @_; + + my $win = $self->window or return; + $win->expose( Tickit::Rect->new( + top => $startline, + bottom => $endline, + left => 0, + right => $win->cols, + ) ); +} + +sub render_to_rb +{ + my $self = shift; + my ( $rb, $rect ) = @_; + + my $win = $self->window; + my $cols = $win->cols; + + my $items = $self->{items}; + + my $line = 0; + my $itemidx = $self->{start_item}; + + if( my $partial = $self->{start_partial} ) { + $line -= $partial; + } + + my $startline = $rect->top; + my $endline = $rect->bottom; + + while( $line < $endline and $itemidx < @$items ) { + my $item = $self->_item( $itemidx ); + my $itemheight = $self->_itemheight( $itemidx ); + + my $top = $line; + my $firstline = ( $startline > $line ) ? $startline - $top : 0; + + $itemidx++; + $line += $itemheight; + + next if $firstline >= $itemheight; + + $rb->save; + { + my $lastline = ( $endline < $line ) ? $endline - $top : $itemheight; + + $rb->translate( $top, 0 ); + $rb->clip( Tickit::Rect->new( + top => $firstline, + bottom => $lastline, + left => 0, + cols => $cols, + ) ); + + $item->render( $rb, + top => 0, + firstline => $firstline, + lastline => $lastline - 1, + width => $cols, + height => $itemheight, + ); + + } + $rb->restore; + } + + while( $line < $endline ) { + $rb->goto( $line, 0 ); + $rb->erase( $cols ); + $line++; + } +} + +my %bindings = ( + Down => sub { $_[0]->scroll( +1 ) }, + Up => sub { $_[0]->scroll( -1 ) }, + + PageDown => sub { $_[0]->scroll( +int( $_[0]->window->lines / 2 ) ) }, + PageUp => sub { $_[0]->scroll( -int( $_[0]->window->lines / 2 ) ) }, + + 'C-Home' => sub { $_[0]->scroll_to_top }, + 'C-End' => sub { $_[0]->scroll_to_bottom }, +); + +sub on_key +{ + my $self = shift; + my ( $ev ) = @_; + + if( $ev->type eq "key" and my $code = $bindings{$ev->str} ) { + $code->( $self ); + return 1; + } + + return 0; +} + +sub on_mouse +{ + my $self = shift; + my ( $ev ) = @_; + + return unless $ev->type eq "wheel"; + + $self->scroll( 5 ) if $ev->button eq "down"; + $self->scroll( -5 ) if $ev->button eq "up"; +} + +=head2 set_gen_top_indicator + +=head2 set_gen_bottom_indicator + + $scroller->set_gen_top_indicator( $method ) + + $scroller->set_gen_bottom_indicator( $method ) + +Accessors for the generators for the top and bottom indicator text. If set, +each should be a CODE reference or method name on the scroller which will be +invoked after any operation that changes the contents of the window, such as +scrolling or adding or removing items. It should return a text string which, +if defined and non-empty, will be displayed in an indicator window. This will +be a small one-line window displayed at the top right or bottom right corner +of the Scroller's window. + + $text = $scroller->$method() + +The ability to pass method names allows subclasses to easily implement custom +logic as methods without having to capture a closure. + +=cut + +sub set_gen_top_indicator +{ + my $self = shift; + ( $self->{gen_top_indicator} ) = @_; + + $self->update_indicators; +} + +sub set_gen_bottom_indicator +{ + my $self = shift; + ( $self->{gen_bottom_indicator} ) = @_; + + $self->update_indicators; +} + +=head2 update_indicators + + $scroller->update_indicators + +Calls any defined generators for indicator text, and updates the indicator +windows with the returned text. This may be useful if the functions would +return different text now. + +=cut + +sub update_indicators +{ + my $self = shift; + + my $win = $self->window or return; + + for my $edge (qw( top bottom )) { + my $text_field = "${edge}_indicator_text"; + + my $text = $self->{"gen_${edge}_indicator"} ? $self->${ \$self->{"gen_${edge}_indicator"} } + : undef; + $text //= ""; + next if $text eq ( $self->{$text_field} // "" ); + + $self->{$text_field} = $text; + + if( !length $text ) { + $self->{"${edge}_indicator_win"}->hide if $self->{"${edge}_indicator_win"}; + undef $self->{"${edge}_indicator_win"}; + next; + } + + my $textwidth = textwidth $text; + my $line = $edge eq "top" ? 0 + : $win->lines - 1; + + my $floatwin; + if( $floatwin = $self->{"${edge}_indicator_win"} ) { + $floatwin->change_geometry( $line, $win->cols - $textwidth, 1, $textwidth ); + } + elsif( $self->window ) { + $floatwin = $win->make_float( $line, $win->cols - $textwidth, 1, $textwidth ); + $floatwin->bind_event( expose => sub { + my ( $win, undef, $info ) = @_; + $info->rb->text_at( 0, 0, + $self->{$text_field}, + $self->get_style_pen( "indicator" ) + ); + } ); + $self->{"${edge}_indicator_win"} = $floatwin; + } + + $floatwin->expose; + } +} + +=head1 TODO + +=over 4 + +=item * + +Abstract away the "item storage model" out of the actual widget. Implement +more storage models, such as database-driven ones.. more dynamic. + +=item * + +Keybindings + +=back + +=cut + +=head1 AUTHOR + +Paul Evans + +=cut + +0x55AA; diff --git a/lib/Tickit/Widget/Scroller/Item.pod b/lib/Tickit/Widget/Scroller/Item.pod new file mode 100644 index 0000000..d2d2512 --- /dev/null +++ b/lib/Tickit/Widget/Scroller/Item.pod @@ -0,0 +1,62 @@ +=head1 NAME + +C - interface for renderable scroller items + +=head1 DESCRIPTION + +Items added to a C must adhere to the interface +documented here. + +=head1 METHODS + +=head2 height_for_width + + $height = $item->height_for_width( $width ) + +Returns the number of screen lines the item would occupy if rendered to the +given width. + +=head2 render + + $item->render( $rb, %args ) + +Renders the item to the given L. C<%args> will contain +the following keys: + +=over 8 + +=item firstline => INT + +=item lastline => INT + +The (inclusive) bounds of the line numbers to render. If these do not cover +the entire height of the item, then they imply that clipping will occur; the +item need draw only the lines indicated. + +These are passed for informational purposes. Item implementations are free to +ignore this if they wish, as clipping will be performed by the RenderBuffer. + +=item top => INT + +The line of C<$rc> to consider as the top of the item. This is passed for +legacy purposes and will always be zero. Item implementations are free to +ignore this value, as it will now be performed using the C facility +of the RenderBuffer. + +=item width => INT + +=item height => INT + +The width in columns and the height in lines to render the item. This will +correspond to the most recent call to C, and is passed in +for consistency and convenience of the item's render method. This is given as +the full dimensions of the item, which may be larger than the subset of lines +requested by the C and C parameters. + +=back + +=head1 AUTHOR + +Paul Evans + +=cut diff --git a/lib/Tickit/Widget/Scroller/Item/RichText.pm b/lib/Tickit/Widget/Scroller/Item/RichText.pm new file mode 100644 index 0000000..d0aa318 --- /dev/null +++ b/lib/Tickit/Widget/Scroller/Item/RichText.pm @@ -0,0 +1,76 @@ +# 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::Widget::Scroller::Item::RichText; + +use strict; +use warnings; + +use base qw( Tickit::Widget::Scroller::Item::Text ); + +our $VERSION = '0.23'; + +use Tickit::Utils qw( textwidth ); + +=head1 NAME + +C - static text with render +attributes + +=head1 SYNOPSIS + + use Tickit::Widget::Scroller; + use Tickit::Widget::Scroller::Item::RichText; + use String::Tagged; + + my $str = String::Tagged->new( "An important message" ); + $str->apply_tag( 3, 9, b => 1 ); + + my $scroller = Tickit::Widget::Scroller->new; + + $scroller->push( + Tickit::Widget::Scroller::Item::RichText->new( $str ) + ); + +=head1 DESCRIPTION + +This subclass of L draws static text +with rendering attributes, used to apply formatting. The attributes are stored +by supplying the text in an instance of a L object. + +The recognised attributes are those of L, taking the same names +and values. + +=cut + +sub _build_chunks_for +{ + my $self = shift; + my ( $str ) = @_; + + my @chunks; + + $str->iter_substr_nooverlap( + sub { + my ( $substr, %tags ) = @_; + my $pen = Tickit::Pen->new_from_attrs( \%tags ); + # Don't worry if extra tags left over, they just aren't rendering attributes + my @lines = split m/\n/, $substr, -1 or return; + my $lastline = pop @lines; + push @chunks, [ $_, textwidth( $_ ), pen => $pen, linebreak => 1 ] for @lines; + push @chunks, [ $lastline, textwidth( $lastline ), pen => $pen ]; + }, + ); + + return @chunks; +} + +=head1 AUTHOR + +Paul Evans + +=cut + +0x55AA; diff --git a/lib/Tickit/Widget/Scroller/Item/Text.pm b/lib/Tickit/Widget/Scroller/Item/Text.pm new file mode 100644 index 0000000..22408ae --- /dev/null +++ b/lib/Tickit/Widget/Scroller/Item/Text.pm @@ -0,0 +1,215 @@ +# 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::Widget::Scroller::Item::Text; + +use strict; +use warnings; + +our $VERSION = '0.23'; + +use Tickit::Utils qw( textwidth cols2chars ); + +=head1 NAME + +C - add static text to a Scroller + +=head1 SYNOPSIS + + use Tickit::Widget::Scroller; + use Tickit::Widget::Scroller::Item::Text; + + my $scroller = Tickit::Widget::Scroller->new; + + $scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Hello world" ) + ); + +=head1 DESCRIPTION + +This implementation of L displays a simple +static piece of text. It will be wrapped on whitespace (characters matching +the C regexp pattern). + +=cut + +=head1 CONSTRUCTOR + +=cut + +=head2 new + + $item = Tickit::Widget::Scroller::Item::Text->new( $text, %opts ) + +Constructs a new text item, containing the given string of text. Once +constructed, the item is immutable. + +The following options are recognised in C<%opts>: + +=over 4 + +=item indent => INT + +If the text item needs to wrap, indent the second and subsequent lines by this +amount. Does not apply to the first line. + +=back + +=cut + +sub new +{ + my $class = shift; + my ( $text, %opts ) = @_; + + my $self = bless { + lineruns => [], + }, $class; + + $self->{indent} = $opts{indent} if defined $opts{indent}; + + $self->{chunks} = [ $self->_build_chunks_for( $text ) ]; + + return $self; +} + +=head1 METHODS + +=cut + +=head2 chunks + + @chunks = $item->chunks + +Returns the chunks of text displayed by this item. Each chunk is represented +by an ARRAY reference of three fields, giving the text string, its width in +columns, and various options + + [ $text, $width, %opts ] + +Recognised options are: + +=over 8 + +=item pen => Tickit::Pen + +Pen to render the chunk with. + +=item linebreak => BOOL + +If true, force a linebreak after this chunk; the next one starts on the +following line. + +=back + +=cut + +sub _build_chunks_for +{ + my $self = shift; + my ( $text ) = @_; + + my @lines = split m/\n/, $text, -1; + my $lastline = pop @lines; + return ( map { [ $_, textwidth( $_ ), linebreak => 1 ] } @lines ), + [ $lastline, textwidth( $lastline ) ]; +} + +sub chunks +{ + my $self = shift; + return @{ $self->{chunks} }; +} + +sub height_for_width +{ + my $self = shift; + my ( $width ) = @_; + + $self->{width} = $width; + + my @chunks = $self->chunks; + $self->{lineruns} = \my @lineruns; + push @lineruns, my $thisline = []; + + my $line_remaining = $width; + + while( @chunks ) { + my $chunk = shift @chunks; + my ( $text, $textwidth, %opts ) = @$chunk; + + if( $textwidth <= $line_remaining ) { + push @$thisline, [ $text, $textwidth, $opts{pen} ]; + $line_remaining -= $textwidth; + } + else { + # Split this chunk at most $line_remaining chars + my $eol_ch = cols2chars $text, $line_remaining; + + if( $eol_ch < length $text && substr( $text, $eol_ch, 1 ) =~ m/\S/ ) { + # TODO: This surely must be possible without substr()ing a temporary + if( substr( $text, 0, $eol_ch ) =~ m/\S+$/ and + ( $-[0] > 0 or @$thisline ) ) { + $eol_ch = $-[0]; + } + } + + my $partial_text = substr( $text, 0, $eol_ch ); + my $partial_chunk = [ $partial_text, textwidth( $partial_text ), $opts{pen} ]; + push @$thisline, $partial_chunk; + + my $bol_ch = pos $text = $eol_ch; + $text =~ m/\G\s+/g and $bol_ch = $+[0]; + + my $remaining_text = substr( $text, $bol_ch ); + my $remaining_chunk = [ $remaining_text, textwidth( $remaining_text ), %opts ]; + unshift @chunks, $remaining_chunk; + + $line_remaining = 0; + } + + if( ( $line_remaining == 0 or $opts{linebreak} ) and @chunks ) { + push @lineruns, $thisline = []; + $line_remaining = $width - ( $self->{indent} || 0 ); + } + } + + return scalar @lineruns; +} + +sub render +{ + my $self = shift; + my ( $rb, %args ) = @_; + + my $cols = $args{width}; + + # Rechunk if width changed + $self->height_for_width( $cols ) if $cols != $self->{width}; + + my $lineruns = $self->{lineruns}; + + foreach my $lineidx ( $args{firstline} .. $args{lastline} ) { + my $indent = ( $lineidx && $self->{indent} ) ? $self->{indent} : 0; + + $rb->goto( $lineidx, 0 ); + $rb->erase( $indent ) if $indent; + + foreach my $chunk ( @{ $lineruns->[$lineidx] } ) { + my ( $text, $width, $chunkpen ) = @$chunk; + $rb->text( $text, $chunkpen ); + } + + $rb->erase_to( $cols ); + } +} + +=head1 AUTHOR + +Paul Evans + +=cut + +0x55AA; diff --git a/t/00use.t b/t/00use.t new file mode 100644 index 0000000..cce1829 --- /dev/null +++ b/t/00use.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use_ok( 'Tickit::Widget::Scroller' ); + +done_testing; diff --git a/t/01item-text.t b/t/01item-text.t new file mode 100644 index 0000000..ca5a5fe --- /dev/null +++ b/t/01item-text.t @@ -0,0 +1,205 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; +use Tickit::RenderBuffer; + +use Tickit::Widget::Scroller::Item::Text; + +my $term = mk_term; + +my $item = Tickit::Widget::Scroller::Item::Text->new( "My message here" ); + +isa_ok( $item, "Tickit::Widget::Scroller::Item::Text", '$item' ); + +is_deeply( [ $item->chunks ], + [ [ "My message here", 15 ] ], + '$item->chunks' ); + +is( $item->height_for_width( 80 ), 1, 'height_for_width 80' ); + +my $rb = Tickit::RenderBuffer->new( lines => $term->lines, cols => $term->cols ); + +$item->render( $rb, top => 0, firstline => 0, lastline => 0, width => 80, height => 25 ); +$rb->flush_to_term( $term ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("My message here"), + SETBG(undef), + ERASECH(65) ], + 'Termlog for render fullwidth' ); + +is_display( [ [TEXT("My message here")] ], + 'Display for render fullwidth' ); + +$term->clear; +drain_termlog; + +{ + { + $rb->save; + + $rb->clip( Tickit::Rect->new( + top => 0, + left => 0, + lines => 10, + cols => 12, + ) ); + + is( $item->height_for_width( 12 ), 2, 'height_for_width 12' ); + + $item->render( $rb, top => 0, firstline => 0, lastline => 1, width => 12, height => 10 ); + + $rb->restore; + } + + $rb->flush_to_term( $term ); + + flush_tickit; + + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("My message "), + SETBG(undef), + ERASECH(1), + GOTO(1,0), + SETPEN, + PRINT("here"), + SETBG(undef), + ERASECH(8) ], + 'Termlog for render width 12' ); + + is_display( [ [TEXT("My message")], + [TEXT("here")] ], + 'Display for render width 12' ); + + my $indenteditem = Tickit::Widget::Scroller::Item::Text->new( "My message here", indent => 4 ); + + is( $indenteditem->height_for_width( 12 ), 2, 'height_for_width 12 with indent' ); + + $indenteditem->render( $rb, top => 0, firstline => 0, lastline => 1, width => 12, height => 10 ); + $rb->flush_to_term( $term ); + + flush_tickit; + + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("My message "), + SETBG(undef), + ERASECH(1), + GOTO(1,0), + SETBG(undef), + ERASECH(4,1), + SETPEN, + PRINT("here"), + SETBG(undef), + ERASECH(4) ], + 'Termlog for render width 12 with indent' ); + + is_display( [ [TEXT("My message")], + [TEXT(" here")] ], + 'Display for render width 12 with indent' ); +} + +# Boundary condition in whitespace splitting +{ + $term->clear; + drain_termlog; + + my $item = Tickit::Widget::Scroller::Item::Text->new( "AAAA BBBB CCCC DDDD" ); + + is( $item->height_for_width( 9 ), 2, 'height_for_width 2 for splitting boundary' ); + + $item->render( $rb, top => 0, firstline => 0, lastline => 1, width => 9, height => 2 ); + $rb->flush_to_term( $term ); + + flush_tickit; + + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("AAAA BBBB"), + GOTO(1,0), + SETPEN, + PRINT("CCCC DDDD") ], + 'Termlog for render splitting boundary' ); + + is_display( [ [TEXT("AAAA BBBB")], + [TEXT("CCCC DDDD")] ], + 'Display for render splitting boundary' ); +} + +# Linefeeds +{ + $term->clear; + drain_termlog; + + my $item = Tickit::Widget::Scroller::Item::Text->new( "Some more text\nwith linefeeds" ); + + is_deeply( [ $item->chunks ], + [ [ "Some more text", 14, linebreak => 1 ], + [ "with linefeeds", 14 ] ], + '$item->chunks with linefeeds' ); + + is( $item->height_for_width( 80 ), 2, 'height_for_width 2 with linefeeds' ); + + $item->render( $rb, top => 0, firstline => 0, lastline => 1, width => 80, height => 2 ); + $rb->flush_to_term( $term ); + + flush_tickit; + + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Some more text"), + SETPEN, + ERASECH(66), + GOTO(1,0), + SETPEN, + PRINT("with linefeeds"), + SETPEN, + ERASECH(66) ], + 'Termlog for render with linefeeds' ); + + is_display( [ [TEXT("Some more text")], + [TEXT("with linefeeds")] ], + 'Display for render with linefeeds' ); +} + +# Odd Unicode +{ + use utf8; + + $term->clear; + drain_termlog; + + my $item = Tickit::Widget::Scroller::Item::Text->new( "(ノಠ益ಠ)ノ彡┻━┻" ); + + is_deeply( [ $item->chunks ], + [ [ "(ノಠ益ಠ)ノ彡┻━┻", 15 ] ], + '$item->chunks with Unicode' ); + + is( $item->height_for_width( 80 ), 1, 'height_for_width 2 with Unicode' ); + + $item->render( $rb, top => 0, firstline => 0, lastline => 0, width => 80, height => 1 ); + $rb->flush_to_term( $term ); + + flush_tickit; + + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("(ノಠ益ಠ)ノ彡┻━┻"), + SETPEN, + ERASECH(65) ], + 'Termlog for render with Unicode' ); + + is_display( [ [TEXT("(ノಠ益ಠ)ノ彡┻━┻")] ], + 'Display for render with Unicode' ); +} + +done_testing; diff --git a/t/02item-richtext.t b/t/02item-richtext.t new file mode 100644 index 0000000..a081465 --- /dev/null +++ b/t/02item-richtext.t @@ -0,0 +1,123 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test; +use Tickit::RenderBuffer; + +use String::Tagged; +use Tickit::Widget::Scroller::Item::RichText; + +my $term = mk_term; + +my $rb = Tickit::RenderBuffer->new( lines => $term->lines, cols => $term->cols ); + +my $str = String::Tagged->new( "My message here" ); +$str->apply_tag( 3, 7, b => 1 ); +$str->apply_tag( 11, 4, u => 1 ); + +my $item = Tickit::Widget::Scroller::Item::RichText->new( $str ); + +isa_ok( $item, "Tickit::Widget::Scroller::Item::Text", '$item' ); + +is_deeply( [ $item->chunks ], + [ [ "My ", 3, pen => Tickit::Pen->new() ], + [ "message", 7, pen => Tickit::Pen->new( b => 1 ) ], + [ " ", 1, pen => Tickit::Pen->new() ], + [ "here", 4, pen => Tickit::Pen->new( u => 1 ) ] ], + '$item->chunks' ); + +is( $item->height_for_width( 80 ), 1, 'height_for_width 80' ); + +$item->render( $rb, top => 0, firstline => 0, lastline => 0, width => 80, height => 25 ); +$rb->flush_to_term( $term ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("My "), + SETPEN(b => 1), + PRINT("message"), + SETPEN, + PRINT(" "), + SETPEN(u => 1), + PRINT("here"), + SETBG(undef), + ERASECH(65) ], + 'Termlog for render fullwidth' ); + +is_display( [ [TEXT("My "), TEXT("message",b=>1), BLANK(1), TEXT("here",u=>1)] ], + 'Display for render fullwidth' ); + +# Linefeeds +{ + $term->clear; + drain_termlog; + + my $str = String::Tagged->new( "Another message\nwith linefeeds" ); + $str->apply_tag( 8, 12, b => 1 ); + + my $item = Tickit::Widget::Scroller::Item::RichText->new( $str ); + + is_deeply( [ $item->chunks ], + [ [ "Another ", 8, pen => Tickit::Pen->new() ], + [ "message", 7, pen => Tickit::Pen->new( b => 1 ), linebreak => 1 ], + [ "with", 4, pen => Tickit::Pen->new( b => 1 ) ], + [ " linefeeds", 10, pen => Tickit::Pen->new() ] ], + '$item->chunks with linefeeds' ); +} + +# Word wrapping on pen changes +{ + $term->clear; + drain_termlog; + + my $str = String::Tagged->new; + foreach my $colour (qw( red blue green yellow )) { + $str->append_tagged( $colour, fg => $colour ); + $str->append( " " ); + } + + my $item = Tickit::Widget::Scroller::Item::RichText->new( $str ); + + is( $item->height_for_width( 18 ), 2, 'height_for_width 18 for wrapping pen change' ); + + $item->render( $rb, top => 0, firstline => 0, lastline => 1, width => 18, height => 2 ); + $rb->flush_to_term( $term ); + + flush_tickit; + + is_termlog( [ GOTO(0,0), + SETPEN(fg=>1), + PRINT("red"), + SETPEN, + PRINT(" "), + SETPEN(fg=>4), + PRINT("blue"), + SETPEN, + PRINT(" "), + SETPEN(fg=>2), + PRINT("green"), + SETPEN, + PRINT(" "), + SETPEN, + ERASECH(3), + GOTO(1,0), + SETPEN(fg=>3), + PRINT("yellow"), + SETPEN, + PRINT(" "), + SETPEN, + ERASECH(11) ], + 'Termlog for render wrapping pen change' ); + + is_display( [ [TEXT("red",fg=>1), BLANK(1), TEXT("blue",fg=>4), BLANK(1), TEXT("green",fg=>2)], + [TEXT("yellow",fg=>3)] ], + 'Display for render wrapping pen change' ); +} + +done_testing; diff --git a/t/10initial.t b/t/10initial.t new file mode 100644 index 0000000..e42d82f --- /dev/null +++ b/t/10initial.t @@ -0,0 +1,117 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +my $win = mk_window; + +my $scroller = Tickit::Widget::Scroller->new; + +ok( defined $scroller, 'defined $scroller' ); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( $_ ) } + "The first line", + "Another line in the middle", + "The third line", +); + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("The first line"), + SETBG(undef), + ERASECH(66), + GOTO(1,0), + SETPEN, + PRINT("Another line in the middle"), + SETBG(undef), + ERASECH(54), + GOTO(2,0), + SETPEN, + PRINT("The third line"), + SETBG(undef), + ERASECH(66), + map { GOTO($_,0), SETBG(undef), ERASECH(80) } 3 .. 24 ], + 'Termlog initially' ); + +is_display( [ "The first line", + "Another line in the middle", + "The third line" ], + 'Display initially' ); + +is( scalar $scroller->line2item( 0 ), 0, 'scalar line2item 0' ); +is_deeply( [ $scroller->line2item( 0 ) ], [ 0, 0 ], 'line2item 0' ); +is_deeply( [ $scroller->line2item( 1 ) ], [ 1, 0 ], 'line2item 1' ); +is_deeply( [ $scroller->line2item( 2 ) ], [ 2, 0 ], 'line2item 2' ); +is_deeply( [ $scroller->line2item( 3 ) ], [ ], 'line2item 3' ); + +is_deeply( [ $scroller->line2item( -1 ) ], [ ], 'line2item -1' ); +is_deeply( [ $scroller->line2item( -23 ) ], [ 2, 0 ], 'line2item -23' ); + +is( $scroller->item2line( 0 ), 0, 'item2line 0' ); +is( $scroller->item2line( 0, -1 ), 0, 'item2line 0, -1' ); +is( $scroller->item2line( 1 ), 1, 'item2line 1' ); +is( $scroller->item2line( 2 ), 2, 'item2line 2' ); + +is( $scroller->item2line( -1 ), 2, 'item2line -1' ); + +resize_term( 25, 20 ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("The first line"), + SETBG(undef), + ERASECH(6), + GOTO(1,0), + SETPEN, + PRINT("Another line in the "), + GOTO(2,0), + SETPEN, + PRINT("middle"), + SETBG(undef), + ERASECH(14), + GOTO(3,0), + SETPEN, + PRINT("The third line"), + SETBG(undef), + ERASECH(6), + map { GOTO($_,0), SETBG(undef), ERASECH(20) } 4 .. 24 ], + 'Termlog after narrowing' ); + +is_display( [ "The first line", + "Another line in the ", + "middle", + "The third line" ], + 'Display after narrowing' ); + +is_deeply( [ $scroller->line2item( 0 ) ], [ 0, 0 ], 'line2item 0' ); +is_deeply( [ $scroller->line2item( 1 ) ], [ 1, 0 ], 'line2item 1' ); +is_deeply( [ $scroller->line2item( 2 ) ], [ 1, 1 ], 'line2item 2' ); +is_deeply( [ $scroller->line2item( 3 ) ], [ 2, 0 ], 'line2item 3' ); +is_deeply( [ $scroller->line2item( 4 ) ], [ ], 'line2item 4' ); + +is_deeply( [ $scroller->line2item( -1 ) ], [ ], 'line2item -1' ); +is_deeply( [ $scroller->line2item( -22 ) ], [ 2, 0 ], 'line2item -22' ); + +is( $scroller->item2line( 0 ), 0, 'item2line 0' ); +is( $scroller->item2line( 0, -1 ), 0, 'item2line 0, -1' ); +is( $scroller->item2line( 1 ), 1, 'item2line 1' ); +is( $scroller->item2line( 1, -1 ), 2, 'item2line 1, -1' ); +is( $scroller->item2line( 2 ), 3, 'item2line 2' ); + +is( $scroller->item2line( -1 ), 3, 'item2line -1' ); + +done_testing; diff --git a/t/11scroll.t b/t/11scroll.t new file mode 100644 index 0000000..0d97fb2 --- /dev/null +++ b/t/11scroll.t @@ -0,0 +1,380 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# Tests are simpler if the terminal is much smaller +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $win ) = mk_term_and_window lines => 5, cols => 15; + +my $scrolled_delta = 0; +my $scroller = Tickit::Widget::Scroller->new( + on_scrolled => sub { $scrolled_delta += $_[1] }, +); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( "Item of text $_ which is long" ) } 1 .. 9 +); + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Item of text 1 "), + GOTO(1,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(2,0), + SETPEN, + PRINT("Item of text 2 "), + GOTO(3,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(4,0), + SETPEN, + PRINT("Item of text 3 ") ], + 'Termlog initially' ); + +is_display( [ [TEXT("Item of text 1 ")], + [TEXT("which is long")], + [TEXT("Item of text 2 ")], + [TEXT("which is long")], + [TEXT("Item of text 3 ")] ], + 'Display initially' ); + +is( $scroller->item2line( 0, 0 ), 0, 'item2line 0, 0 initially' ); +is( $scroller->item2line( 0, -1 ), 1, 'item2line 0, -1 initially' ); +is( $scroller->item2line( 1, 0 ), 2, 'item2line 1, 0 initially' ); +is( $scroller->item2line( 1, -1 ), 3, 'item2line 1, -1 initially' ); +is( $scroller->item2line( 2, 0 ), 4, 'item2line 2, 0 initially' ); +is( $scroller->item2line( 2, -1 ), undef, 'item2line 2, -1 initially offscreen' ); + +is_deeply( [ $scroller->item2line( 2, -1 ) ], [ undef, "below" ], 'list item2line 2, -1 initially below screen' ); +is_deeply( [ $scroller->item2line( 2, -1, 1 ) ], [ 5, "below" ], 'list item2line 2, -1 initially below screen with count_offscreen' ); + +is( $scroller->lines_above, 0, 'lines_above initially' ); +is( $scroller->lines_below, 13, 'lines_below initially' ); + +$scroller->scroll( +10 ); + +is( $scrolled_delta, 10, '$scrolled_delta after ->scroll' ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Item of text 6 "), + GOTO(1,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(2,0), + SETPEN, + PRINT("Item of text 7 "), + GOTO(3,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(4,0), + SETPEN, + PRINT("Item of text 8 ") ], + 'Termlog after scroll +10' ); + +is_display( [ [TEXT("Item of text 6 ")], + [TEXT("which is long")], + [TEXT("Item of text 7 ")], + [TEXT("which is long")], + [TEXT("Item of text 8 ")] ], + 'Display after scroll +10' ); + +is( $scroller->item2line( 0, 0 ), undef, 'item2line 0, 0 offscreen after scroll +10' ); +is( $scroller->item2line( 0, -1 ), undef, 'item2line 0, -1 offscreen after scroll +10' ); +is( $scroller->item2line( 5, 0 ), 0, 'item2line 5, 0 after scroll +10' ); +is( $scroller->item2line( 5, -1 ), 1, 'item2line 5, -1 after scroll +10' ); +is( $scroller->item2line( 8, 0 ), undef, 'item2line 8, 0 offscreen after scroll +10' ); + +is_deeply( [ $scroller->item2line( 0, 0 ) ], [ undef, "above" ], 'list item2line 0, 0 above screen after scroll +10' ); +is_deeply( [ $scroller->item2line( 0, 0, 1 ) ], [ -10, "above" ], 'list item2line 0, 0 above screen after scroll +10 with count_offscreen' ); +is_deeply( [ $scroller->item2line( 8, 0 ) ], [ undef, "below" ], 'list item2line 8, 0 below screen after scroll +10' ); +is_deeply( [ $scroller->item2line( 8, 0, 1 ) ], [ 6, "below" ], 'list item2line 8, 0 below screen after scroll +10 with count_offscreen' ); + +is( $scroller->lines_above, 10, 'lines_above after scroll +10' ); +is( $scroller->lines_below, 3, 'lines_below after scroll +10' ); + +$scroller->scroll( -1 ); + +is( $scrolled_delta, 9, '$scrolled_delta after ->scroll -1' ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,5,15, -1,0), + GOTO(0,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2) ], + 'Termlog after scroll -1' ); + +is_display( [ [TEXT("which is long")], + [TEXT("Item of text 6 ")], + [TEXT("which is long")], + [TEXT("Item of text 7 ")], + [TEXT("which is long")] ], + 'Display after scroll -1' ); + +is( $scroller->lines_above, 9, 'lines_above after scroll -1' ); +is( $scroller->lines_below, 4, 'lines_below after scroll -1' ); + +$scroller->scroll( +1 ); + +is( $scrolled_delta, 10, '$scrolled_delta after ->scroll +1' ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,5,15, +1,0), + GOTO(4,0), + SETPEN, + PRINT("Item of text 8 ") ], + 'Termlog after scroll +1' ); + +is_display( [ [TEXT("Item of text 6 ")], + [TEXT("which is long")], + [TEXT("Item of text 7 ")], + [TEXT("which is long")], + [TEXT("Item of text 8 ")] ], + 'Display after scroll +1' ); + +$scroller->scroll( -10 ); + +is( $scrolled_delta, 0, '$scrolled_delta after ->scroll -10' ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Item of text 1 "), + GOTO(1,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(2,0), + SETPEN, + PRINT("Item of text 2 "), + GOTO(3,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(4,0), + SETPEN, + PRINT("Item of text 3 ") ], + 'Termlog after scroll -10' ); + +is_display( [ [TEXT("Item of text 1 ")], + [TEXT("which is long")], + [TEXT("Item of text 2 ")], + [TEXT("which is long")], + [TEXT("Item of text 3 ")] ], + 'Display after scroll -10' ); + +$scroller->scroll_to_bottom; + +is( $scrolled_delta, 13, '$scrolled_delta after ->scroll_to_bottom' ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(1,0), + SETPEN, + PRINT("Item of text 8 "), + GOTO(2,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(3,0), + SETPEN, + PRINT("Item of text 9 "), + GOTO(4,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2) ], + 'Termlog after scroll_to_bottom' ); + +is_display( [ [TEXT("which is long")], + [TEXT("Item of text 8 ")], + [TEXT("which is long")], + [TEXT("Item of text 9 ")], + [TEXT("which is long")] ], + 'Display after scroll_to_bottom' ); + +$scroller->scroll_to_top; + +is( $scrolled_delta, 0, '$scrolled_delta after ->scroll_to_top' ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Item of text 1 "), + GOTO(1,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(2,0), + SETPEN, + PRINT("Item of text 2 "), + GOTO(3,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(4,0), + SETPEN, + PRINT("Item of text 3 ") ], + 'Termlog after scroll_to_top' ); + +is_display( [ [TEXT("Item of text 1 ")], + [TEXT("which is long")], + [TEXT("Item of text 2 ")], + [TEXT("which is long")], + [TEXT("Item of text 3 ")] ], + 'Display after scroll_to_top' ); + +$scroller->scroll_to( 2, 4, 0 ); # About halfway + +is( $scrolled_delta, 6, '$scrolled_delta after ->scroll_to halfway' ); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Item of text 4 "), + GOTO(1,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(2,0), + SETPEN, + PRINT("Item of text 5 "), + GOTO(3,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2), + GOTO(4,0), + SETPEN, + PRINT("Item of text 6 ") ], + 'Termlog after scroll_to middle' ); + +is_display( [ [TEXT("Item of text 4 ")], + [TEXT("which is long")], + [TEXT("Item of text 5 ")], + [TEXT("which is long")], + [TEXT("Item of text 6 ")] ], + 'Display after scroll_to middle' ); + +$scroller->scroll( +5 ); +flush_tickit; +drain_termlog; + +{ + my $pre_scroll_delta = $scrolled_delta; + + $scroller->scroll( +5 ); # over the end + + is( $scrolled_delta - $pre_scroll_delta, 2, 'on_scroll given actual delta, not requested' ); + is( $scrolled_delta, 13, '$scrolled_delta after ->scroll +5 over the end' ); +} + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,5,15, +2,0), + GOTO(3,0), + SETPEN, + PRINT("Item of text 9 "), + GOTO(4,0), + SETPEN, + PRINT("which is long"), + SETBG(undef), + ERASECH(2) ], + 'Termlog down past the end' ); + +is_display( [ [TEXT("which is long")], + [TEXT("Item of text 8 ")], + [TEXT("which is long")], + [TEXT("Item of text 9 ")], + [TEXT("which is long")] ], + 'Display after scroll down past the end' ); + +$scroller->scroll( -2 ); +$scroller->scroll( -2 ); +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,5,15, -2,0), + SETBG(undef), + SCROLLRECT(0,0,5,15, -2,0), + GOTO(0,0), SETPEN, PRINT("which is long"), SETBG(undef), ERASECH(2), + GOTO(1,0), SETPEN, PRINT("Item of text 6 "), + GOTO(2,0), SETPEN, PRINT("which is long"), SETBG(undef), ERASECH(2), + GOTO(3,0), SETPEN, PRINT("Item of text 7 "), ], + 'Termlog after ->scroll(-2) x 2' ); + +is_display( [ [TEXT("which is long")], + [TEXT("Item of text 6 ")], + [TEXT("which is long")], + [TEXT("Item of text 7 ")], + [TEXT("which is long")] ], + 'Display after ->scroll(-2) x 2' ); + +$scroller->scroll( +2 ); +$scroller->scroll( +2 ); +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,5,15, +2,0), + SETBG(undef), + SCROLLRECT(0,0,5,15, +2,0), + GOTO(1,0), SETPEN, PRINT("Item of text 8 "), + GOTO(2,0), SETPEN, PRINT("which is long"), SETBG(undef), ERASECH(2), + GOTO(3,0), SETPEN, PRINT("Item of text 9 "), + GOTO(4,0), SETPEN, PRINT("which is long"), SETBG(undef), ERASECH(2), ], + 'Termlog after ->scroll(+2) x 2' ); + +is_display( [ [TEXT("which is long")], + [TEXT("Item of text 8 ")], + [TEXT("which is long")], + [TEXT("Item of text 9 ")], + [TEXT("which is long")] ], + 'Display after ->scroll(+2) x 2' ); + +is( $scrolled_delta, 13, '$scrolled_delta before EOF' ); + +done_testing; diff --git a/t/12resize-bottom.t b/t/12resize-bottom.t new file mode 100644 index 0000000..28b2634 --- /dev/null +++ b/t/12resize-bottom.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +my ( $term, $rootwin ) = mk_term_and_window; +my $win = $rootwin->make_sub( 0, 0, 5, 40 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "bottom", +); + +$scroller->push( Tickit::Widget::Scroller::Item::Text->new( "A line of content at line $_" ) ) for 1 .. 10; + +$scroller->set_window( $win ); + +$scroller->scroll( +3 ); + +flush_tickit; + +is_display( [ "A line of content at line 4", + "A line of content at line 5", + "A line of content at line 6", + "A line of content at line 7", + "A line of content at line 8", ], + 'Display initially' ); + +$term->clear; +$win->resize( 7, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5", + "A line of content at line 6", + "A line of content at line 7", + "A line of content at line 8", ], + 'Display after resize more lines' ); + +$term->clear; +$win->resize( 5, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 4", + "A line of content at line 5", + "A line of content at line 6", + "A line of content at line 7", + "A line of content at line 8", ], + 'Display after resize fewer lines' ); + +$term->clear; +$win->resize( 5, 20 ); + +flush_tickit; + +is_display( [ "line 6", + "A line of content at", + "line 7", + "A line of content at", + "line 8", ], + 'Display after resize fewer columns' ); + +$term->clear; +$win->resize( 15, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 1", + "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5", + "A line of content at line 6", + "A line of content at line 7", + "A line of content at line 8", + "A line of content at line 9", + "A line of content at line 10" ], + 'Display after resize too big' ); + +$term->clear; +$win->resize( 5, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 6", + "A line of content at line 7", + "A line of content at line 8", + "A line of content at line 9", + "A line of content at line 10" ], + 'Display after shrink from resize too big' ); + +done_testing; diff --git a/t/12resize-top.t b/t/12resize-top.t new file mode 100644 index 0000000..2f32438 --- /dev/null +++ b/t/12resize-top.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +my ( $term, $rootwin ) = mk_term_and_window; +my $win = $rootwin->make_sub( 0, 0, 5, 40 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "top", +); + +$scroller->push( Tickit::Widget::Scroller::Item::Text->new( "A line of content at line $_" ) ) for 1 .. 10; + +$scroller->set_window( $win ); + +flush_tickit; + +is_display( [ "A line of content at line 1", + "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5", ], + 'Display initially' ); + +$term->clear; +$win->resize( 7, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 1", + "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5", + "A line of content at line 6", + "A line of content at line 7", ], + 'Display after resize more lines' ); + +$term->clear; +$win->resize( 5, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 1", + "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5", ], + 'Display after resize fewer lines' ); + +$term->clear; +$win->resize( 5, 20 ); + +flush_tickit; + +is_display( [ "A line of content at", + "line 1", + "A line of content at", + "line 2", + "A line of content at", ], + 'Display after resize fewer columns' ); + +$term->clear; +$win->resize( 15, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 1", + "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5", + "A line of content at line 6", + "A line of content at line 7", + "A line of content at line 8", + "A line of content at line 9", + "A line of content at line 10" ], + 'Display after resize too big' ); + +$term->clear; +$win->resize( 5, 40 ); + +flush_tickit; + +is_display( [ "A line of content at line 1", + "A line of content at line 2", + "A line of content at line 3", + "A line of content at line 4", + "A line of content at line 5" ], + 'Display after shrink from resize too big' ); + +done_testing; diff --git a/t/20push-bottom.t b/t/20push-bottom.t new file mode 100644 index 0000000..4185ac3 --- /dev/null +++ b/t/20push-bottom.t @@ -0,0 +1,188 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "bottom", +); + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_,0), SETBG(undef), ERASECH(20) } 0 .. 5 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +$scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "A line of text" ), +); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("A line of text"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after push' ); + +is_display( [ [TEXT("A line of text")] ], + 'Display after push' ); + +is_cursorpos( 7, 0, 'Cursor position after push' ); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 1 .. 4, +); + +flush_tickit; + +is_termlog( [ GOTO(1,0), + SETPEN, + PRINT("Another line 1"), + SETBG(undef), + ERASECH(6), + GOTO(2,0), + SETPEN, + PRINT("Another line 2"), + SETBG(undef), + ERASECH(6), + GOTO(3,0), + SETPEN, + PRINT("Another line 3"), + SETBG(undef), + ERASECH(6), + GOTO(4,0), + SETPEN, + PRINT("Another line 4"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after push 4' ); + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")] ], + 'Display after push 4' ); + +is_cursorpos( 7, 0, 'Cursor position after push 4' ); + +$scroller->push( Tickit::Widget::Scroller::Item::Text->new( "An item of text that wraps" ) ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, 1,0), + GOTO(4,0), + SETPEN, + PRINT("An item of text that"), + GOTO(5,0), + SETPEN, + PRINT("wraps"), + SETBG(undef), + ERASECH(15), + GOTO(7,0) ], + 'Termlog after push wrapping' ); + +is_display( [ [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")], + [TEXT("wraps")] ], + 'Display after push wrapping' ); + +is_cursorpos( 7, 0, 'Cursor position after push wrapping' ); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 5 .. 10, +); + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Another line 5")], + [TEXT("Another line 6")], + [TEXT("Another line 7")], + [TEXT("Another line 8")], + [TEXT("Another line 9")], + [TEXT("Another line 10")] ], + 'Display after push 6' ); + +is_cursorpos( 7, 0, 'Cursor position after push 6' ); + +$scroller->set_window( undef ); + +$scroller->push( Tickit::Widget::Scroller::Item::Text->new( "A line while offscreen" ) ); + +$scroller->set_window( $win ); + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Another line 7")], + [TEXT("Another line 8")], + [TEXT("Another line 9")], + [TEXT("Another line 10")], + [TEXT("A line while ")], + [TEXT("offscreen")] ], + 'Display after push while offscreen' ); + +is_cursorpos( 7, 0, 'Cursor position after push while offscreen' ); + +$scroller->scroll_to_top; + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after scroll_to_top' ); + +is_cursorpos( 7, 0, 'Cursor position after push scroll_to_top' ); + +$scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Unseen line" ), +); + +is_termlog( [], + 'Termlog empty after push at head' ); + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after push at head' ); + +is_cursorpos( 7, 0, 'Cursor position after push at head' ); + +done_testing; diff --git a/t/20push-top.t b/t/20push-top.t new file mode 100644 index 0000000..b900c6a --- /dev/null +++ b/t/20push-top.t @@ -0,0 +1,181 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "top", +); + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_,0), SETBG(undef), ERASECH(20) } 0 .. 5 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +$scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "A line of text" ), +); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("A line of text"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after push' ); + +is_display( [ [TEXT("A line of text")] ], + 'Display after push' ); + +is_cursorpos( 7, 0, 'Cursor position after push' ); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 1 .. 4, +); + +flush_tickit; + +is_termlog( [ GOTO(1,0), + SETPEN, + PRINT("Another line 1"), + SETBG(undef), + ERASECH(6), + GOTO(2,0), + SETPEN, + PRINT("Another line 2"), + SETBG(undef), + ERASECH(6), + GOTO(3,0), + SETPEN, + PRINT("Another line 3"), + SETBG(undef), + ERASECH(6), + GOTO(4,0), + SETPEN, + PRINT("Another line 4"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after push 4' ); + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")] ], + 'Display after push 4' ); + +is_cursorpos( 7, 0, 'Cursor position after push 4' ); + +$scroller->push( Tickit::Widget::Scroller::Item::Text->new( "An item of text that wraps" ) ); + +flush_tickit; + +is_termlog( [ GOTO(5,0), + SETPEN, + PRINT("An item of text that"), + GOTO(7,0) ], + 'Termlog after push scroll' ); + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after push scroll' ); + +is_cursorpos( 7, 0, 'Cursor position after push scroll' ); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 5 .. 10, +); + +flush_tickit; + +is_termlog( [], + 'Termlog after push 6' ); + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after push 6' ); + +is_cursorpos( 7, 0, 'Cursor position after push 6' ); + +$scroller->set_window( undef ); + +$scroller->push( Tickit::Widget::Scroller::Item::Text->new( "A line while offscreen" ) ); + +$scroller->set_window( $win ); + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after push while offscreen' ); + +$scroller->scroll_to_top; + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after scroll_to_top' ); + +is_cursorpos( 7, 0, 'Cursor position after push scroll_to_top' ); + +$scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Unseen line" ), +); + +is_termlog( [], + 'Termlog empty after push at head' ); + +is_display( [ [TEXT("A line of text")], + [TEXT("Another line 1")], + [TEXT("Another line 2")], + [TEXT("Another line 3")], + [TEXT("Another line 4")], + [TEXT("An item of text that")] ], + 'Display after push at head' ); + +is_cursorpos( 7, 0, 'Cursor position after push at head' ); + +done_testing; diff --git a/t/21shift-bottom.t b/t/21shift-bottom.t new file mode 100644 index 0000000..22ef5a7 --- /dev/null +++ b/t/21shift-bottom.t @@ -0,0 +1,177 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "bottom", +); + +$scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Existing line $_" ), +) for 1 .. 20; + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_-1,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(5) } 1 .. 6 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ [TEXT("Existing line 1")], + [TEXT("Existing line 2")], + [TEXT("Existing line 3")], + [TEXT("Existing line 4")], + [TEXT("Existing line 5")], + [TEXT("Existing line 6")] ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +$scroller->shift; + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, 1,0), + GOTO(5,0), + SETPEN, + PRINT("Existing line 7"), + SETBG(undef), + ERASECH(5), + GOTO(7,0) ], + 'Termlog after shift' ); + +is_display( [ [TEXT("Existing line 2")], + [TEXT("Existing line 3")], + [TEXT("Existing line 4")], + [TEXT("Existing line 5")], + [TEXT("Existing line 6")], + [TEXT("Existing line 7")] ], + 'Display after shift' ); + +is_cursorpos( 7, 0, 'Cursor position after shift' ); + +$scroller->shift( 3 ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, 3,0), + GOTO(3,0), + SETPEN, + PRINT("Existing line 8"), + SETBG(undef), + ERASECH(5), + GOTO(4,0), + SETPEN, + PRINT("Existing line 9"), + SETBG(undef), + ERASECH(5), + GOTO(5,0), + SETPEN, + PRINT("Existing line 10"), + SETBG(undef), + ERASECH(4), + GOTO(7,0) ], + 'Termlog after shift 3' ); + +is_display( [ [TEXT("Existing line 5")], + [TEXT("Existing line 6")], + [TEXT("Existing line 7")], + [TEXT("Existing line 8")], + [TEXT("Existing line 9")], + [TEXT("Existing line 10")] ], + 'Display after shift 3' ); + +is_cursorpos( 7, 0, 'Cursor position after shift 3' ); + +$scroller->scroll_to_bottom; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 15")], + [TEXT("Existing line 16")], + [TEXT("Existing line 17")], + [TEXT("Existing line 18")], + [TEXT("Existing line 19")], + [TEXT("Existing line 20")] ], + 'Display after scroll_to_bottom' ); + +$scroller->shift; + +flush_tickit; + +is_termlog( [], + 'Termlog empty after shift at bottom' ); + +is_display( [ [TEXT("Existing line 15")], + [TEXT("Existing line 16")], + [TEXT("Existing line 17")], + [TEXT("Existing line 18")], + [TEXT("Existing line 19")], + [TEXT("Existing line 20")] ], + 'Display unchanged after shift at bottom' ); + +$scroller->scroll_to_top; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 6")], + [TEXT("Existing line 7")], + [TEXT("Existing line 8")], + [TEXT("Existing line 9")], + [TEXT("Existing line 10")], + [TEXT("Existing line 11")] ], + 'Display after scroll_to_top' ); + +$scroller->shift( 6 ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_-12,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(4) } 12 .. 17 ), + GOTO(7,0) ], + 'Termlog after shift 6 at top' ); + +is_display( [ [TEXT("Existing line 12")], + [TEXT("Existing line 13")], + [TEXT("Existing line 14")], + [TEXT("Existing line 15")], + [TEXT("Existing line 16")], + [TEXT("Existing line 17")] ], + 'Display after shift 6 at top' ); + +$scroller->shift( 4 ); + +flush_tickit; + +is_display( [ [TEXT("Existing line 16")], + [TEXT("Existing line 17")], + [TEXT("Existing line 18")], + [TEXT("Existing line 19")], + [TEXT("Existing line 20")] ], + 'Display after shift to expose bottom' ); + +done_testing; diff --git a/t/21shift-top.t b/t/21shift-top.t new file mode 100644 index 0000000..f40ebe6 --- /dev/null +++ b/t/21shift-top.t @@ -0,0 +1,168 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "top", +); + +$scroller->push( + Tickit::Widget::Scroller::Item::Text->new( "Existing line $_" ), +) for 1 .. 20; + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_-1,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(5) } 1 .. 6 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ [TEXT("Existing line 1")], + [TEXT("Existing line 2")], + [TEXT("Existing line 3")], + [TEXT("Existing line 4")], + [TEXT("Existing line 5")], + [TEXT("Existing line 6")] ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +my ( $item ) = $scroller->shift; + +isa_ok( $item, "Tickit::Widget::Scroller::Item::Text" ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, 1,0), + GOTO(5,0), + SETPEN, + PRINT("Existing line 7"), + SETBG(undef), + ERASECH(5), + GOTO(7,0) ], + 'Termlog after shift' ); + +is_display( [ [TEXT("Existing line 2")], + [TEXT("Existing line 3")], + [TEXT("Existing line 4")], + [TEXT("Existing line 5")], + [TEXT("Existing line 6")], + [TEXT("Existing line 7")] ], + 'Display after shift' ); + +is_cursorpos( 7, 0, 'Cursor position after shift' ); + +$scroller->shift( 3 ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, 3,0), + GOTO(3,0), + SETPEN, + PRINT("Existing line 8"), + SETBG(undef), + ERASECH(5), + GOTO(4,0), + SETPEN, + PRINT("Existing line 9"), + SETBG(undef), + ERASECH(5), + GOTO(5,0), + SETPEN, + PRINT("Existing line 10"), + SETBG(undef), + ERASECH(4), + GOTO(7,0) ], + 'Termlog after shift 3' ); + +is_display( [ [TEXT("Existing line 5")], + [TEXT("Existing line 6")], + [TEXT("Existing line 7")], + [TEXT("Existing line 8")], + [TEXT("Existing line 9")], + [TEXT("Existing line 10")] ], + 'Display after shift 3' ); + +is_cursorpos( 7, 0, 'Cursor position after shift 3' ); + +$scroller->scroll_to_bottom; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 15")], + [TEXT("Existing line 16")], + [TEXT("Existing line 17")], + [TEXT("Existing line 18")], + [TEXT("Existing line 19")], + [TEXT("Existing line 20")] ], + 'Display after scroll_to_bottom' ); + +$scroller->shift; + +flush_tickit; + +is_termlog( [], + 'Termlog empty after shift at bottom' ); + +is_display( [ [TEXT("Existing line 15")], + [TEXT("Existing line 16")], + [TEXT("Existing line 17")], + [TEXT("Existing line 18")], + [TEXT("Existing line 19")], + [TEXT("Existing line 20")] ], + 'Display unchanged after shift at bottom' ); + +$scroller->scroll_to_top; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 6")], + [TEXT("Existing line 7")], + [TEXT("Existing line 8")], + [TEXT("Existing line 9")], + [TEXT("Existing line 10")], + [TEXT("Existing line 11")] ], + 'Display after scroll_to_top' ); + +$scroller->shift( 6 ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_-12,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(4) } 12 .. 17 ), + GOTO(7,0) ], + 'Termlog after shift 6 at top' ); + +is_display( [ [TEXT("Existing line 12")], + [TEXT("Existing line 13")], + [TEXT("Existing line 14")], + [TEXT("Existing line 15")], + [TEXT("Existing line 16")], + [TEXT("Existing line 17")] ], + 'Display after shift 6 at top' ); + +done_testing; diff --git a/t/22unshift-bottom.t b/t/22unshift-bottom.t new file mode 100644 index 0000000..4e56a46 --- /dev/null +++ b/t/22unshift-bottom.t @@ -0,0 +1,187 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "bottom", +); + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_,0), SETBG(undef), ERASECH(20) } 0 .. 5 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +$scroller->unshift( + Tickit::Widget::Scroller::Item::Text->new( "A line of text" ), +); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("A line of text"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after unshift' ); + +is_display( [ [TEXT("A line of text")] ], + 'Display after unshift' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift' ); + +$scroller->unshift( reverse + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 1 .. 4, +); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -4,0), + GOTO(0,0), + SETPEN, + PRINT("Another line 4"), + SETBG(undef), + ERASECH(6), + GOTO(1,0), + SETPEN, + PRINT("Another line 3"), + SETBG(undef), + ERASECH(6), + GOTO(2,0), + SETPEN, + PRINT("Another line 2"), + SETBG(undef), + ERASECH(6), + GOTO(3,0), + SETPEN, + PRINT("Another line 1"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after unshift 4' ); + +is_display( [ [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift 4' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift 4' ); + +$scroller->unshift( Tickit::Widget::Scroller::Item::Text->new( "An item of text that wraps" ) ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -1,0), + GOTO(0,0), + SETPEN, + PRINT("wraps"), + SETBG(undef), + ERASECH(15), + GOTO(7,0) ], + 'Termlog after unshift scroll' ); + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift scroll' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift scroll' ); + +$scroller->unshift( reverse + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 5 .. 10, +); + +flush_tickit; + +is_termlog( [], + 'Termlog after unshift 6' ); + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift 6' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift 6' ); + +$scroller->set_window( undef ); + +$scroller->unshift( Tickit::Widget::Scroller::Item::Text->new( "A line while offscreen" ) ); + +$scroller->set_window( $win ); + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift while offscreen' ); + +$scroller->scroll_to_bottom; + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after scroll_to_bottom' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift scroll_to_bottom' ); + +$scroller->unshift( + Tickit::Widget::Scroller::Item::Text->new( "Unseen line" ), +); + +is_termlog( [], + 'Termlog empty after unshift at head' ); + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift at head' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift at head' ); + +done_testing; diff --git a/t/22unshift-top.t b/t/22unshift-top.t new file mode 100644 index 0000000..9fe302f --- /dev/null +++ b/t/22unshift-top.t @@ -0,0 +1,190 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "top", +); + +$scroller->set_window( $win ); + +flush_tickit; + +is_termlog( [ ( map { GOTO($_,0), SETBG(undef), ERASECH(20) } 0 .. 5 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +$scroller->unshift( + Tickit::Widget::Scroller::Item::Text->new( "A line of text" ), +); + +flush_tickit; + +is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("A line of text"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after unshift' ); + +is_display( [ [TEXT("A line of text")] ], + 'Display after unshift' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift' ); + +$scroller->unshift( reverse + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 1 .. 4, +); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -4,0), + GOTO(0,0), + SETPEN, + PRINT("Another line 4"), + SETBG(undef), + ERASECH(6), + GOTO(1,0), + SETPEN, + PRINT("Another line 3"), + SETBG(undef), + ERASECH(6), + GOTO(2,0), + SETPEN, + PRINT("Another line 2"), + SETBG(undef), + ERASECH(6), + GOTO(3,0), + SETPEN, + PRINT("Another line 1"), + SETBG(undef), + ERASECH(6), + GOTO(7,0) ], + 'Termlog after unshift 4' ); + +is_display( [ [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift 4' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift 4' ); + +$scroller->unshift( Tickit::Widget::Scroller::Item::Text->new( "An item of text that wraps" ) ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -2,0), + GOTO(0,0), + SETPEN, + PRINT("An item of text that"), + GOTO(1,0), + SETPEN, + PRINT("wraps"), + SETBG(undef), + ERASECH(15), + GOTO(7,0) ], + 'Termlog after unshift wrapping' ); + +is_display( [ [TEXT("An item of text that")], + [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")] ], + 'Display after unshift wrapping' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift wrapping' ); + +$scroller->unshift( reverse + map { Tickit::Widget::Scroller::Item::Text->new( "Another line $_" ) } 5 .. 10, +); + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Another line 10")], + [TEXT("Another line 9")], + [TEXT("Another line 8")], + [TEXT("Another line 7")], + [TEXT("Another line 6")], + [TEXT("Another line 5")], ], + 'Display after unshift 6' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift 6' ); + +$scroller->set_window( undef ); + +$scroller->unshift( Tickit::Widget::Scroller::Item::Text->new( "A line while offscreen" ) ); + +$scroller->set_window( $win ); + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Another line 10")], + [TEXT("Another line 9")], + [TEXT("Another line 8")], + [TEXT("Another line 7")], + [TEXT("Another line 6")], + [TEXT("Another line 5")], ], + 'Display after unshift while offscreen' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift while offscreen' ); + +$scroller->scroll_to_bottom; + +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after scroll_to_bottom' ); + +is_cursorpos( 7, 0, 'Cursor position after scroll_to_bottom' ); + +$scroller->unshift( + Tickit::Widget::Scroller::Item::Text->new( "Unseen line" ), +); + +is_termlog( [], + 'Termlog empty after unshift at tail' ); + +is_display( [ [TEXT("wraps")], + [TEXT("Another line 4")], + [TEXT("Another line 3")], + [TEXT("Another line 2")], + [TEXT("Another line 1")], + [TEXT("A line of text")] ], + 'Display after unshift at tail' ); + +is_cursorpos( 7, 0, 'Cursor position after unshift at tail' ); + +done_testing; diff --git a/t/23pop-bottom.t b/t/23pop-bottom.t new file mode 100644 index 0000000..f9da224 --- /dev/null +++ b/t/23pop-bottom.t @@ -0,0 +1,170 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "bottom", +); + +$scroller->set_window( $win ); + +$scroller->unshift( + Tickit::Widget::Scroller::Item::Text->new( "Existing line $_" ), +) for 1 .. 20; + +flush_tickit; + +is_termlog( [ ( map { SETBG(undef), + SCROLLRECT(0,0,6,20, -1,0) } 1 .. 5, ), + ( map { GOTO(6-$_,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(5) } reverse 1 .. 6 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ [TEXT("Existing line 6")], + [TEXT("Existing line 5")], + [TEXT("Existing line 4")], + [TEXT("Existing line 3")], + [TEXT("Existing line 2")], + [TEXT("Existing line 1")] ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +my ( $item ) = $scroller->pop; + +isa_ok( $item, "Tickit::Widget::Scroller::Item::Text" ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -1,0), + GOTO(0,0), + SETPEN, + PRINT("Existing line 7"), + SETBG(undef), + ERASECH(5), + GOTO(7,0) ], + 'Termlog after pop' ); + +is_display( [ [TEXT("Existing line 7")], + [TEXT("Existing line 6")], + [TEXT("Existing line 5")], + [TEXT("Existing line 4")], + [TEXT("Existing line 3")], + [TEXT("Existing line 2")] ], + 'Display after pop' ); + +is_cursorpos( 7, 0, 'Cursor position after pop' ); + +$scroller->pop( 3 ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -3,0), + GOTO(0,0), + SETPEN, + PRINT("Existing line 10"), + SETBG(undef), + ERASECH(4), + GOTO(1,0), + SETPEN, + PRINT("Existing line 9"), + SETBG(undef), + ERASECH(5), + GOTO(2,0), + SETPEN, + PRINT("Existing line 8"), + SETBG(undef), + ERASECH(5), + GOTO(7,0) ], + 'Termlog after pop 3' ); + +is_display( [ [TEXT("Existing line 10")], + [TEXT("Existing line 9")], + [TEXT("Existing line 8")], + [TEXT("Existing line 7")], + [TEXT("Existing line 6")], + [TEXT("Existing line 5")] ], + 'Display after pop 3' ); + +is_cursorpos( 7, 0, 'Cursor position after pop 3' ); + +$scroller->scroll_to_top; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 20")], + [TEXT("Existing line 19")], + [TEXT("Existing line 18")], + [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")] ], + 'Display after scroll_to_top' ); + +$scroller->pop; + +flush_tickit; + +is_termlog( [], + 'Termlog empty after pop at top' ); + +is_display( [ [TEXT("Existing line 20")], + [TEXT("Existing line 19")], + [TEXT("Existing line 18")], + [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")] ], + 'Display unchanged after pop at top' ); + +$scroller->scroll_to_bottom; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 11")], + [TEXT("Existing line 10")], + [TEXT("Existing line 9")], + [TEXT("Existing line 8")], + [TEXT("Existing line 7")], + [TEXT("Existing line 6")] ], + 'Display after scroll_to_bottom' ); + +$scroller->pop( 6 ); + +flush_tickit; + +is_termlog( [ ( map { GOTO(17-$_,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(4) } reverse 12 .. 17 ), + GOTO(7,0) ], + 'Termlog after pop 6 at bottom' ); + +is_display( [ [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")], + [TEXT("Existing line 14")], + [TEXT("Existing line 13")], + [TEXT("Existing line 12")] ], + 'Display after pop 6 at bottom' ); + +done_testing; diff --git a/t/23pop-top.t b/t/23pop-top.t new file mode 100644 index 0000000..9e1e2e9 --- /dev/null +++ b/t/23pop-top.t @@ -0,0 +1,182 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test 0.12; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; + +# TODO: mk_window once Tickit::Test can take a size there too +my ( $term, $rootwin ) = mk_term_and_window cols => 20, lines => 8; +my $win = $rootwin->make_sub( 0, 0, 6, 20 ); + +$rootwin->focus( 7, 0 ); + +my $scroller = Tickit::Widget::Scroller->new( + gravity => "top", +); + +$scroller->set_window( $win ); + +$scroller->unshift( + Tickit::Widget::Scroller::Item::Text->new( "Existing line $_" ), +) for 1 .. 20; + +$scroller->scroll_to_bottom; + +flush_tickit; + +is_termlog( [ ( map { SETBG(undef), + SCROLLRECT(0,0,6,20, -1,0) } 1 .. 19 ), + ( map { GOTO($_,0), + SETPEN, + PRINT("Existing line " . ( 6 - $_ )), + SETBG(undef), + ERASECH(5) } 0 .. 5 ), + GOTO(7,0) ], + 'Termlog initially' ); + +is_display( [ [TEXT("Existing line 6")], + [TEXT("Existing line 5")], + [TEXT("Existing line 4")], + [TEXT("Existing line 3")], + [TEXT("Existing line 2")], + [TEXT("Existing line 1")] ], + 'Display initially' ); + +is_cursorpos( 7, 0, 'Cursor position intially' ); + +$scroller->pop; + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -1,0), + GOTO(0,0), + SETPEN, + PRINT("Existing line 7"), + SETBG(undef), + ERASECH(5), + GOTO(7,0) ], + 'Termlog after pop' ); + +is_display( [ [TEXT("Existing line 7")], + [TEXT("Existing line 6")], + [TEXT("Existing line 5")], + [TEXT("Existing line 4")], + [TEXT("Existing line 3")], + [TEXT("Existing line 2")] ], + 'Display after pop' ); + +is_cursorpos( 7, 0, 'Cursor position after pop' ); + +$scroller->pop( 3 ); + +flush_tickit; + +is_termlog( [ SETBG(undef), + SCROLLRECT(0,0,6,20, -3,0), + GOTO(0,0), + SETPEN, + PRINT("Existing line 10"), + SETBG(undef), + ERASECH(4), + GOTO(1,0), + SETPEN, + PRINT("Existing line 9"), + SETBG(undef), + ERASECH(5), + GOTO(2,0), + SETPEN, + PRINT("Existing line 8"), + SETBG(undef), + ERASECH(5), + GOTO(7,0) ], + 'Termlog after pop 3' ); + +is_display( [ [TEXT("Existing line 10")], + [TEXT("Existing line 9")], + [TEXT("Existing line 8")], + [TEXT("Existing line 7")], + [TEXT("Existing line 6")], + [TEXT("Existing line 5")] ], + 'Display after pop 3' ); + +is_cursorpos( 7, 0, 'Cursor position after pop 3' ); + +$scroller->scroll_to_top; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 20")], + [TEXT("Existing line 19")], + [TEXT("Existing line 18")], + [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")] ], + 'Display after scroll_to_top' ); + +$scroller->pop; + +flush_tickit; + +is_termlog( [], + 'Termlog empty after pop at top' ); + +is_display( [ [TEXT("Existing line 20")], + [TEXT("Existing line 19")], + [TEXT("Existing line 18")], + [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")] ], + 'Display unchanged after pop at top' ); + +$scroller->scroll_to_bottom; +flush_tickit; +drain_termlog; + +is_display( [ [TEXT("Existing line 11")], + [TEXT("Existing line 10")], + [TEXT("Existing line 9")], + [TEXT("Existing line 8")], + [TEXT("Existing line 7")], + [TEXT("Existing line 6")] ], + 'Display after scroll_to_bottom' ); + +$scroller->pop( 6 ); + +flush_tickit; + +is_termlog( [ ( map { GOTO(17-$_,0), + SETPEN, + PRINT("Existing line $_"), + SETBG(undef), + ERASECH(4) } reverse 12 .. 17 ), + GOTO(7,0) ], + 'Termlog after pop 6 at bottom' ); + +is_display( [ [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")], + [TEXT("Existing line 14")], + [TEXT("Existing line 13")], + [TEXT("Existing line 12")] ], + 'Display after pop 6 at bottom' ); + +$scroller->pop( 4 ); + +flush_tickit; + +is_display( [ [TEXT("Existing line 20")], + [TEXT("Existing line 19")], + [TEXT("Existing line 18")], + [TEXT("Existing line 17")], + [TEXT("Existing line 16")], + [TEXT("Existing line 15")] ], + 'Display after pop to expose top' ); + +done_testing; diff --git a/t/30indicator.t b/t/30indicator.t new file mode 100644 index 0000000..1a7502e --- /dev/null +++ b/t/30indicator.t @@ -0,0 +1,143 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Tickit::Test; + +use Tickit::Widget::Scroller; +use Tickit::Widget::Scroller::Item::Text; +# These tests depend on the new Window rendering behaviour added in Tickit 0.43 +# but the actual functionallity will work fine before that +eval { require Tickit::Window; Tickit::Window->VERSION( '0.43' ) } + or plan skip_all => "Tickit::Window older than 0.43; these tests won't work"; + +my $win = mk_window; + +my $scroller = Tickit::Widget::Scroller->new( + gen_top_indicator => sub { + my $self = shift; + # TODO: This is a fragile API, needs fixing + return sprintf "-- Start{%d/%d} items{%d} --", + $self->{start_item}, $self->{start_partial}, scalar @{ $self->{items} }; + }, +); + +$scroller->push( + map { Tickit::Widget::Scroller::Item::Text->new( "Line $_ of content" ) } 1 .. 50 +); + +$scroller->set_window( $win ); +flush_tickit; + +# At Tickit::Window 0.44, rendering is done in one go. +if( $Tickit::Window::VERSION >= '0.44' ) { + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Line 1 of content"), + SETBG(undef), + ERASECH(37,1), + SETPEN(rv=>1), + PRINT("-- Start{0/0} items{50} --"), + + ( map { GOTO($_-1,0), + SETPEN, + PRINT("Line $_ of content"), + SETBG(undef), + ERASECH(64-length $_), } 2 .. 25 ) ], + 'Termlog initially' ); +} +else { + is_termlog( [ GOTO(0,0), + SETPEN, + PRINT("Line 1 of content"), + SETBG(undef), + ERASECH(37), + ( map { GOTO($_-1,0), + SETPEN, + PRINT("Line $_ of content"), + SETBG(undef), + ERASECH(64-length $_), } 2 .. 25 ), + GOTO(0,54), + SETPEN(rv=>1), + PRINT("-- Start{0/0} items{50} --") ], + 'Termlog initially' ); +} + +is_display( [ [TEXT("Line 1 of content" . (" "x37)), TEXT("-- Start{0/0} items{50} --",rv=>1) ], + map { "Line $_ of content" } 2 .. 25 ], + 'Display initially' ); + +$scroller->scroll( 2 ); +flush_tickit; + +if( $Tickit::Window::VERSION >= '0.44' ) { + is_termlog( [ SETPEN, + SCROLLRECT(1,0,24,80,2,0), + GOTO(0,0), + SETPEN, + PRINT("Line 3 of content"), + SETBG(undef), + ERASECH(37,1), + SETPEN(rv=>1), + PRINT("-- Start{2/0} items{50} --"), + ( map { GOTO($_-3,0), + SETPEN, + PRINT("Line $_ of content"), + SETBG(undef), + ERASECH(64-length $_), } 26 .. 27 ) ], + 'Termlog after ->scroll' ); +} +else { + is_termlog( [ SETPEN, + SCROLLRECT(1,0,24,80,2,0), + GOTO(0,0), + SETPEN, + PRINT("Line 3 of content"), + SETBG(undef), + ERASECH(37), + GOTO(0,54), + SETPEN(rv=>1), + PRINT("-- Start{2/0} items{50} --"), + ( map { GOTO($_-3,0), + SETPEN, + PRINT("Line $_ of content"), + SETBG(undef), + ERASECH(64-length $_), } 26 .. 27 ) ], + 'Termlog after ->scroll' ); +} + +is_display( [ [TEXT("Line 3 of content" . (" "x37)), TEXT("-- Start{2/0} items{50} --",rv=>1) ], + map { "Line $_ of content" } 4 .. 27 ], + 'Display after ->scroll' ); + +$scroller->set_gen_top_indicator( undef ); +flush_tickit; + +is_termlog( [ GOTO(0,54), + SETPEN, + ERASECH(26) ], + 'Termlog after removing top indicator' ); + +is_display( [ map { "Line $_ of content" } 3 .. 27 ], + 'Display after removing top indicator' ); + +$scroller->set_gen_bottom_indicator( sub { + my $self = shift; + defined $self->item2line( -1, -1 ) ? undef : "-- more --" +} ); + +flush_tickit; + +is_termlog( [ GOTO(24,70), + SETPEN(rv=>1), + PRINT("-- more --") ], + 'Termlog after setting bottom indicator' ); + +is_display( [ ( map { "Line $_ of content" } 3 .. 26 ), + [TEXT("Line 27 of content" . (" "x52)), TEXT("-- more --",rv=>1) ] ], + 'Display after setting bottom indicator' ); + +done_testing; diff --git a/t/99pod.t b/t/99pod.t new file mode 100644 index 0000000..eb319fb --- /dev/null +++ b/t/99pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +all_pod_files_ok(); -- cgit v1.2.3