]>
Commit | Line | Data |
---|---|---|
01ba3ddc MG |
1 | package App::NAOdash; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use re '/saa'; | |
7 | use utf8; | |
8 | ||
9 | our $VERSION = '0.001'; | |
10 | ||
11 | use Encode qw/encode/; | |
12 | use File::Slurp; | |
13 | use NetHack::NAOdash; | |
14 | use Term::ANSIColor ':constants'; | |
15 | ||
16 | my @order = qw/ | |
17 | achieve_sokoban achieve_luckstone achieve_medusa achieve_bell achieve_gehennom achieve_candelabrum achieve_book achieve_invocation achieve_amulet achieve_endgame achieve_astral achieve_ascended | |
18 | ||
19 | combo_arc_hum_law combo_arc_hum_neu combo_arc_dwa_law combo_arc_gno_neu | |
20 | combo_bar_hum_neu combo_bar_hum_cha combo_bar_orc_cha | |
21 | combo_cav_hum_law combo_cav_hum_neu combo_cav_dwa_law combo_cav_gno_neu | |
22 | combo_hea_hum_neu combo_hea_gno_neu | |
23 | combo_kni_hum_law | |
24 | combo_mon_hum_law combo_mon_hum_neu combo_mon_hum_cha | |
25 | combo_pri_hum_law combo_pri_hum_neu combo_pri_hum_cha combo_pri_elf_cha | |
26 | combo_ran_hum_neu combo_ran_hum_cha combo_ran_elf_cha combo_ran_gno_neu combo_ran_orc_cha | |
27 | combo_rog_hum_cha combo_rog_orc_cha | |
28 | combo_sam_hum_law | |
29 | combo_tou_hum_neu | |
30 | combo_val_hum_law combo_val_hum_neu combo_val_dwa_law | |
31 | combo_wiz_hum_neu combo_wiz_hum_cha combo_wiz_elf_cha combo_wiz_gno_neu combo_wiz_orc_cha | |
32 | ||
33 | conduct_foodless conduct_vegan conduct_vegetarian conduct_atheist conduct_weaponless conduct_pacifist conduct_illiterate conduct_genocideless conduct_polypileless conduct_polyselfless conduct_wishless conduct_artiwishless | |
34 | ||
35 | uconduct_survivor uconduct_boneless uconduct_minscore/; | |
36 | ||
37 | sub naodash_to_ansi { | |
38 | my ($dash) = @_; | |
39 | my @checks = @{$dash->{checks}}; | |
40 | my %numbers = %{$dash->{numbers}}; | |
41 | ||
42 | my $base = <<"EOF"; | |
43 | ACHIEVEMENTS | |
44 | ============ | |
45 | #Sokoban #Luckstone #Medusa #Bell #Gehennom #Candelabrum | |
46 | #Book #Invocation #Amulet #Endgame #Astral #Ascended | |
47 | ||
48 | STARTING COMBOS | |
49 | =============== | |
50 | #Arc-Hum-Law #Arc-Hum-Neu #Arc-Dwa-Law #Arc-Gno-Neu | |
51 | #Bar-Hum-Neu #Bar-Hum-Cha #Bar-Orc-Cha | |
52 | #Cav-Hum-Law #Cav-Hum-Neu #Cav-Dwa-Law #Cav-Gno-Neu | |
53 | #Hea-Hum-Neu #Hea-Gno-Neu | |
54 | #Kni-Hum-Law | |
55 | #Mon-Hum-Law #Mon-Hum-Neu #Mon-Hum-Cha | |
56 | #Pri-Hum-Law #Pri-Hum-Neu #Pri-Hum-Cha #Pri-Elf-Cha | |
57 | #Ran-Hum-Neu #Ran-Hum-Cha #Ran-Elf-Cha #Ran-Gno-Neu #Ran-Orc-Cha | |
58 | #Rog-Hum-Cha #Rog-Orc-Cha | |
59 | #Sam-Hum-Law | |
60 | #Tou-Hum-Neu | |
61 | #Val-Hum-Law #Val-Hum-Neu #Val-Dwa-Law | |
62 | #Wiz-Hum-Neu #Wiz-Hum-Cha #Wiz-Elf-Cha #Wiz-Gno-Neu #Wiz-Orc-Cha | |
63 | ||
64 | CONDUCTS | |
65 | ======== | |
66 | #Foodless #Vegan #Vegetarian #Atheist | |
67 | #Weaponless #Pacifist #Illiterate #Genocideless | |
68 | #Polypileless #Polyselfless #Wishless #Artiwishless | |
69 | ||
70 | UNOFFICIAL CONDUCTS | |
71 | =================== | |
72 | #Survivor #Boneless #Minscore | |
73 | ||
74 | NUMBERS | |
75 | ======= | |
76 | Time played: $numbers{totalrealtime} | |
77 | Games: $numbers{games} | |
78 | Ascensions: $numbers{ascensions} | |
79 | Most HP: $numbers{maxhp} | |
80 | Most points: $numbers{maxpoints} | |
81 | Most conducts: $numbers{maxconducts} | |
82 | Least turns: $numbers{minturns} | |
83 | Least time: $numbers{minrealtime} | |
84 | EOF | |
85 | ||
86 | my $rst = RESET; | |
87 | for my $check (@order) { | |
88d87be7 | 88 | my $color = (grep { $_ eq $check } @checks) ? GREEN UNDERLINE : RED; |
01ba3ddc MG |
89 | $base =~ s/#([a-zA-Z-]+)/$color$1$rst/; |
90 | } | |
88d87be7 | 91 | $base =~ s/([A-Z ]+)\n=*/BOLD($1).RESET/ge; |
01ba3ddc MG |
92 | |
93 | $base | |
94 | } | |
95 | ||
96 | sub run { | |
97 | my ($user_or_path) = @_; | |
98 | my $stats; | |
99 | if ($user_or_path =~ /^\w+$/) { # Looks like a user | |
100 | $stats = naodash_user $user_or_path | |
101 | } else { | |
102 | $stats = naodash_xlog read_file $user_or_path | |
103 | } | |
104 | print encode 'UTF-8', naodash_to_ansi $stats ## no critic (RequireCheckedSyscalls) | |
105 | } | |
106 | ||
107 | 1; | |
108 | __END__ | |
109 | ||
110 | =encoding utf-8 | |
111 | ||
112 | =head1 NAME | |
113 | ||
114 | App::NAOdash - Analyze NetHack xlogfiles and extract statistics (command-line interface) | |
115 | ||
116 | =head1 SYNOPSIS | |
117 | ||
118 | use App::NAOdash; | |
119 | App::NAOdash::run(@ARGV); | |
120 | ||
121 | =head1 DESCRIPTION | |
122 | ||
123 | App::NAOdash is the backend of the L<naodash> script, a command-line | |
124 | interface to L<NetHack::NAOdash>. | |
125 | ||
126 | It defines two functions: | |
127 | ||
128 | =over | |
129 | ||
130 | =item B<naodash_to_ansi>(I<$stats>) | |
131 | ||
132 | Takes the result of B<naodash_user> or B<naodash_xlog> and presents it | |
133 | in a text form, using ANSI color escape sequences and unicode ticks | |
134 | (✓) and X marks (✗) to indicate the presence/absence of checks. | |
135 | ||
136 | =item B<run>(I<$user_or_path>) | |
137 | ||
138 | Analyzes the xlogfile for the given user / at the given path, passes | |
139 | the result through B<naodash_to_ansi> and prints the result. | |
140 | ||
141 | If the argument contains non-word characters, it is interpreted as a | |
142 | path. Otherwise it is interpreted as a NAO username. | |
143 | ||
144 | =back | |
145 | ||
146 | =head1 SEE ALSO | |
147 | ||
148 | L<naodash>, L<NetHack::NAOdash>, L<App::Web::NAOdash> | |
149 | ||
150 | =head1 AUTHOR | |
151 | ||
152 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
153 | ||
154 | =head1 COPYRIGHT AND LICENSE | |
155 | ||
156 | Copyright (C) 2015 by Marius Gavrilescu | |
157 | ||
158 | This library is free software; you can redistribute it and/or modify | |
159 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
160 | at your option, any later version of Perl 5 you may have available. | |
161 | ||
162 | ||
163 | =cut |