File Coverage

blib/lib/Story/Interact/Syntax.pm
Criterion Covered Total %
statement 42 60 70.0
branch 4 10 40.0
condition 3 4 75.0
subroutine 18 26 69.2
pod 0 19 0.0
total 67 119 56.3


line stmt bran cond sub pod time code
1 5     5   87 use 5.010001;
  5         16  
2 5     5   27 use strict;
  5         36  
  5         156  
3 5     5   27 use warnings;
  5         11  
  5         337  
4              
5             package Story::Interact::Syntax;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.001014';
9              
10 5     5   35 use Story::Interact::Page ();
  5         15  
  5         132  
11              
12 5     5   46 use List::Util ();
  5         20  
  5         124  
13 5     5   2828 use match::simple qw( match );
  5         14308  
  5         50  
14              
15 5     5   3833 use Exporter::Shiny;
  5         2341  
  5         42  
16              
17             our @EXPORT = qw(
18             text
19             next_page
20             at
21             abstract
22             todo
23             world
24             location
25             player
26             npc
27             define_npc
28             visited
29             params
30             true
31             false
32             match
33             random
34             INTERNAL_STATE
35             INTERNAL_PAGE
36             );
37              
38             my ( $page, $state );
39              
40             sub START {
41 45     45 0 109 ( $state, my $page_id ) = @_;
42 45         898 $page = Story::Interact::Page->new( id => $page_id );
43             }
44              
45             sub text {
46 65     65 0 230 $page->add_text( @_ );
47             }
48              
49             sub next_page {
50 74     74 0 213 $page->add_next_page( @_ );
51             }
52              
53             sub at {
54 52 100   52 0 156 if ( @_ ) {
55 40         98 my ( $code ) = @_;
56 40         979 $page->_set_location( $code );
57             }
58 52         1995 return $page->location;
59             }
60              
61             sub todo {
62 0 0   0 0 0 if ( @_ ) {
63 0         0 my ( $value ) = @_;
64 0         0 $page->_set_todo( $value );
65             }
66             else {
67 0         0 $page->_set_todo( 1 );
68             }
69 0         0 return;
70             }
71              
72             sub abstract {
73 0 0   0 0 0 if ( @_ ) {
74 0         0 my ( $value ) = @_;
75 0         0 $page->_set_abstract( $value );
76             }
77 0         0 return $page->abstract;
78             }
79              
80             sub world () {
81 0     0 0 0 return $state->world;
82             }
83              
84             sub location {
85 12 50   12 0 43 my ( $code ) = @_ ? @_ : ( at() );
86 12   100     341 $state->location->{$code} //= {};
87             }
88              
89             sub player () {
90 10     10 0 39 return $state->player;
91             }
92              
93             sub npc ($) {
94 1     1 0 6 my ( $code ) = @_;
95 1         24 return $state->character->{$code};
96             }
97              
98             sub define_npc {
99 1     1 0 9 my ( $code, %attrs ) = @_;
100 1         7 return $state->define_npc( $code, %attrs );
101             }
102              
103             sub visited {
104 6 50   6 0 53 my ( $code ) = @_ ? @_ : ( $page->id );
105 6   50     66 $state->visited->{$code} //= 0;
106             }
107              
108             sub params () {
109 2     2 0 89 return $state->params;
110             }
111              
112             sub FINISH {
113 45     45 0 183 $state->update_from_page( $page );
114 45         71 my $return = $page;
115 45         74 undef $page;
116 45         163 return $return;
117             }
118              
119             sub pp {
120 0     0 0   require JSON::PP;
121 0           print JSON::PP
122             ->new
123             ->pretty( 1 )
124             ->canonical( 1 )
125             ->convert_blessed( 1 )
126             ->encode( shift ), "\n";
127             }
128              
129             sub DEBUG {
130 0     0 0   eval( shift() . ";" );
131             }
132              
133             sub true () {
134             !!1;
135             }
136              
137             sub false () {
138             !!0;
139             }
140              
141             sub INTERNAL_STATE () {
142 0     0 0   return $state;
143             }
144              
145             sub INTERNAL_PAGE () {
146 0     0 0   return $page;
147             }
148              
149             sub random ($) {
150 0     0 0   my ( $array ) = @_;
151 0           my ( $item ) = List::Util::sample( 1, @$array );
152 0           return $item;
153             }
154              
155             1;