diff options
| author | Andrej Shadura <andrewsh@debian.org> | 2018-07-28 16:54:34 +0100 |
|---|---|---|
| committer | Andrej Shadura <andrewsh@debian.org> | 2018-07-28 16:54:34 +0100 |
| commit | d38ea3c6312e8075383c3e53004d53db8198446f (patch) | |
| tree | 1256fab2f0ad29e0bee80ab3441a9934927c34ca | |
Import original source of Tickit-Widget-Scroller 0.23
| -rw-r--r-- | Build.PL | 31 | ||||
| -rw-r--r-- | Changes | 123 | ||||
| -rw-r--r-- | LICENSE | 379 | ||||
| -rw-r--r-- | MANIFEST | 31 | ||||
| -rw-r--r-- | META.json | 56 | ||||
| -rw-r--r-- | META.yml | 35 | ||||
| -rw-r--r-- | Makefile.PL | 18 | ||||
| -rw-r--r-- | README | 294 | ||||
| -rw-r--r-- | examples/richtext.pl | 57 | ||||
| -rw-r--r-- | examples/text.pl | 62 | ||||
| -rw-r--r-- | lib/Tickit/Widget/Scroller.pm | 1143 | ||||
| -rw-r--r-- | lib/Tickit/Widget/Scroller/Item.pod | 62 | ||||
| -rw-r--r-- | lib/Tickit/Widget/Scroller/Item/RichText.pm | 76 | ||||
| -rw-r--r-- | lib/Tickit/Widget/Scroller/Item/Text.pm | 215 | ||||
| -rw-r--r-- | t/00use.t | 10 | ||||
| -rw-r--r-- | t/01item-text.t | 205 | ||||
| -rw-r--r-- | t/02item-richtext.t | 123 | ||||
| -rw-r--r-- | t/10initial.t | 117 | ||||
| -rw-r--r-- | t/11scroll.t | 380 | ||||
| -rw-r--r-- | t/12resize-bottom.t | 102 | ||||
| -rw-r--r-- | t/12resize-top.t | 100 | ||||
| -rw-r--r-- | t/20push-bottom.t | 188 | ||||
| -rw-r--r-- | t/20push-top.t | 181 | ||||
| -rw-r--r-- | t/21shift-bottom.t | 177 | ||||
| -rw-r--r-- | t/21shift-top.t | 168 | ||||
| -rw-r--r-- | t/22unshift-bottom.t | 187 | ||||
| -rw-r--r-- | t/22unshift-top.t | 190 | ||||
| -rw-r--r-- | t/23pop-bottom.t | 170 | ||||
| -rw-r--r-- | t/23pop-top.t | 182 | ||||
| -rw-r--r-- | t/30indicator.t | 143 | ||||
| -rw-r--r-- | t/99pod.t | 11 |
31 files changed, 5216 insertions, 0 deletions
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; @@ -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. + @@ -0,0 +1,379 @@ +This software is copyright (c) 2017 by Paul Evans <leonerd@leonerd.org.uk>. + +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 <leonerd@leonerd.org.uk>. + +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. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + 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. + + <signature of Ty Coon>, 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 <leonerd@leonerd.org.uk>. + +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 <leonerd@leonerd.org.uk>" + ], + "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 <leonerd@leonerd.org.uk>' +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' => {} +) +; @@ -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( "<Line $_>" ) } 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 <leonerd@leonerd.org.uk> + 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( "<Rand $i>: " ); + 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 = "<Rand $i>: "; + 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<Tickit::Widget::Scroller> - 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( "<Line $_>" ) } 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<Tickit::Widget::Scroller::Item> 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<Tickit::Widget::Scroller> 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<bottom>, resize events and the C<push> 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<set_gen_top_indicator> and C<set_gen_bottom_indicator>. + +=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<scroll> method, including the C<scroll_to>, +C<scroll_to_top> and C<scroll_to_bottom>. In normal cases it will be given the +delta offset that C<scroll> 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<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 C<scroll> 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<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 C<scroll> 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<push> or C<unshift>, 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<push> or C<unshift>, 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<scroll_to> 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<scroll_to> 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<undef> 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<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 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 <leonerd@leonerd.org.uk> + +=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<Tickit::Widget::Scroller::Item> - interface for renderable scroller items + +=head1 DESCRIPTION + +Items added to a C<Tickit::Widget::Scroller> 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<Tickit::RenderBuffer>. 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<translate> 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<height_for_width>, 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<firstline> and C<lastline> parameters. + +=back + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=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<Tickit::Widget::Scroller::Item::RichText> - 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<Tickit::Widget::Scroller::Item::Text> draws static text +with rendering attributes, used to apply formatting. The attributes are stored +by supplying the text in an instance of a L<String::Tagged> object. + +The recognised attributes are those of L<Tickit::Pen>, 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 <leonerd@leonerd.org.uk> + +=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<Tickit::Widget::Scroller::Item::Text> - 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<Tickit::Widget::Scroller::Item> displays a simple +static piece of text. It will be wrapped on whitespace (characters matching +the C</\s/> 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 <leonerd@leonerd.org.uk> + +=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(); |