core
vgcore.*
+*.orig
+*.rej
yarrg/*.o
yarrg/t.*
use strict;
use warnings;
+no warnings qw(exec);
+
BEGIN {
use Exporter ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
chomp($l) or &$bad_data('missing end-of-line');
- $l !~ m/\P{IsPrint}/ or &$bad_data('nonprinting char(s)');
+ $l =~ m/[\t [:graph:]]/ or &$bad_data('nonprinting char(s) '.sprintf "%#x", ord $&);
my @v= split /\t/, $l, -1;
@v==6 or &$bad_data('wrong number of fields');
+ $v[1] =~ s/^\s+//; $v[1] =~ s/\s+$//; # ooo don't check :-(
my ($commod,$stall) = @v;
!keys %commods or
defined $commods{$commod} or
&$bad_data("unknown commodity ".errsan($commod));
- $stall =~ m/^\p{IsUpper}|^[0-9]/ or
- &$bad_data("stall not capitalised ".errsan($stall));
+ $stall =~ m/\p{IsAlnum}/ or
+ &$bad_data("stall does not contain with alphanumeric".errsan($stall));
!exists $check_tsv_done{$commod,$stall} or
&$bad_data("repeated data ".errsan($commod).",".errsan($stall));
$check_tsv_done{$commod,$stall}= 1;
use DBI;
use POSIX;
+use DBD::SQLite;
use Commods;
sub db_connect_core ($) {
my ($fn)= @_;
- my $h= DBI->connect("dbi:SQLite:$fn",'','',
- { AutoCommit=>0,
- RaiseError=>1, ShowErrorStatement=>1,
- unicode=>1 })
+ my $opts = { AutoCommit=>0,
+ RaiseError=>1, ShowErrorStatement=>1,
+ sqlite_unicode=>1 };
+
+ # DBI now wants to start a transaction whenever we even say
+ # SELECT. But this doesn't work if the DB is readonly. We can
+ # work around this by setting autocommit, in which case there is
+ # no need for a transaction for read-only db commands. Autocommit
+ # is (obviously) safe with readonly operations. But callers in
+ # yarrg do not specify to us whether they intend to write. So we
+ # decide, by looking at the file mode. And as belt-and-braces we
+ # set sqlite's own readonly flag as well.
+ # http://stackoverflow.com/questions/30082008/attempt-to-write-a-readonly-database-but-im-not
+ # http://stackoverflow.com/questions/35208727/can-sqlite-db-files-be-made-read-only
+ # http://cpansearch.perl.org/src/ISHIGAKI/DBD-SQLite-1.39/Changes
+ # (see entry for 1.38_01)
+ # http://stackoverflow.com/questions/17793672/perl-dbi-treats-setting-sqlite-db-cache-size-as-a-write-operation-when-subclassi
+ # https://rt.cpan.org/Public/Bug/Display.html?id=56444#
+ my $readonly =
+ (access $fn, POSIX::W_OK) ? 0 :
+ ($! == EACCES) ? 1 :
+ ($! == ENOENT) ? 0 :
+ die "$fn access(,W_OK) $!";
+ if ($readonly) {
+ $opts->{sqlite_open_flags} = DBD::SQLite::OPEN_READONLY;
+ $opts->{AutoCommit}=1;
+ }
+
+ my $h= DBI->connect("dbi:SQLite:$fn",'','',$opts)
or die "$fn $DBI::errstr ?";
return $h;
# default timeout is 30s which is plenty
nooutput(<<END);
# Every buy/sell must refer to an entry in commods, islands, and stalls:
- SELECT * FROM $bs NATURAL LEFT JOIN commods WHERE commodname IS NULL;
- SELECT * FROM $bs NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- SELECT * FROM $bs LEFT JOIN STALLS USING (stallid) WHERE stallname IS NULL;
+ SELECT * FROM $bs LEFT JOIN commods USING (commodid) WHERE commodname IS NULL;
+ SELECT * FROM $bs LEFT JOIN islands USING (islandid) WHERE islandname IS NULL;
+ SELECT * FROM $bs LEFT JOIN stalls USING (stallid, islandid)
+ WHERE stallname IS NULL;
# Every buy/sell must be part of an upload:
- SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;
+ SELECT * FROM $bs LEFT JOIN uploads USING (islandid) WHERE timestamp IS NULL;
# The islandid in stalls must be the same as the islandid in buy/sell:
SELECT * FROM $bs JOIN stalls USING (stallid)
nooutput(<<END);
# Every stall and upload must refer to an island:
- SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
+ SELECT * FROM stalls LEFT JOIN islands USING (islandid)
+ WHERE islandname IS NULL;
+ SELECT * FROM uploads LEFT JOIN islands USING (islandid)
+ WHERE islandname IS NULL;
END
if ($full) {
WHERE dist IS NULL;
# Every commod must refers to a commodclass and vice versa:
- SELECT * FROM commods NATURAL LEFT JOIN commodclasses
+ SELECT * FROM commods LEFT JOIN commodclasses USING (commodclassid)
WHERE commodclass IS NULL;
- SELECT * FROM commodclasses NATURAL LEFT JOIN commods
+ SELECT * FROM commodclasses LEFT JOIN commods USING (commodclassid)
WHERE commodname IS NULL;
# Ordvals which are not commodclass ordvals are unique:
# For every class, posinclass is dense from 1 to maxposinclass,
# apart from the commods for which it is zero.
SELECT commodclass,commodclassid,posinclass,count(*)
- FROM commods NATURAL JOIN commodclasses
+ FROM commods JOIN commodclasses USING (commodclassid)
WHERE posinclass > 0
GROUP BY commodclassid,posinclass
HAVING count(*) > 1;
SELECT commodclass,commodclassid,count(*)
- FROM commods NATURAL JOIN commodclasses
+ FROM commods JOIN commodclasses USING (commodclassid)
WHERE posinclass > 0
GROUP BY commodclassid
HAVING count(*) != maxposinclass;
SELECT *
- FROM commods NATURAL JOIN commodclasses
+ FROM commods JOIN commodclasses USING (commodclassid)
WHERE posinclass < 0 OR posinclass > maxposinclass;
END
s/^\s*//; chomp; s/\s+$//; s/\s+/ /g;
s/\<\/?(?:b|em)\>//g;
s/\{\{(?:chart\ style|Chart league difficulty)\|[^{}]*\}\}//gi;
+ s/^\{\{(?:testing|current)\}\}//;
next unless m/\{\{/; # only interested in chart template stuff
if (($x,$y,$arch) =
m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
(?: \<(?: big|center )\>)* \'+
(?: \[\[ | \{\{ )
- [^][\']* \| ([^][\'|]+)\ archipelago
+ [^][]* \| ([^][|]+)\ archipelago
(?: \]\] | \}\} )
\'+ (?: \<\/(?: big|center )\>)* \}\}$/xi) {
printf $debugfh "%2d,%-2d arch %s\n", $x,$y,$arch;
The PCTB server is a project of Joel Lord and various others.
The YARRG server was inspired by PCTB and is a project of the crew
-Special Circumstances (on the Midnight Ocean) and of the Sinister
+Special Circumstances (on the Cerulean Ocean) and of the Sinister
Greenend Organisation.
PCTB and YARRG are both completely unofficial and Three Rings, the
- Ian Jackson
ijackson@chiark.greenend.org.uk
- Aristarchus on the Midnight ocean
+ Aristarchus on the Cerulean ocean
See README.privacy.
If you need help please ask me (ijackson@chiark.greenend.org.uk, or
-Aristarchus on Midnight in game if I'm on line, or ask any pirate of
+Aristarchus on Cerulean in game if I'm on line, or ask any pirate of
the crew Special Circumstances if they happen to know where I am
and/or can get in touch).
Uploads checked and accepted by the yarrg server are distributed by
email to operator(s) of databases doing interesting commodity stuff.
Currently there's only one such database, the yarrg pirate trader
-website. (Work in progress.)
+website.
But if you want to get copies, please just email us saying what you
plan to do.
Contacting the yarrg server operator
------------------------------------
-Talk to Aristarchus on Midnight, or ask any officer of the crew
+Talk to Aristarchus on Cerulean, or ask any officer of the crew
Special Circumstances, or email ijackson@chiark.greenend.org.uk.
Then, in your YPP client:
* go to the docks of any island
* click on the button "Where are my vessels"
+ * click anywhere in the main part of the screen
* press Ctrl-A Ctrl-C
In where-vessels, click "Acquire"
my $selfdir= $0;
$selfdir =~ s,/+[^/]*$,,;
chdir("$selfdir") or die "$selfdir $!";
+
+ unshift @INC, qw(.);
}
use Commods;
# print "\n";
db_chkcommit(0);
+ # Warning! Below runes are bogus. Do not use NATURAL JOIN!
# select * from ((buy natural join commods) natural join stalls) natural join islands;
# select * from ((sell natural join commods) natural join stalls) natural join islands;
# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
+BEGIN { unshift @INC, qw(.) }
use strict (qw(vars));
use HTTP::Request;
my $islandid;
while ($resptxt =~
- m/^islands\[\d+\]\[\d+\]\=new\s+option\(\"(.*)\"\,(\d+)\)\s*$/mig
+ m/^islands\[(\d+)\]\[\d+\]\=new\s+option\(\"(.*)\"\,(\d+)\)\s*$/mig
) {
- next unless $1 eq $island;
- $islandid= $2;
+ next unless $1 eq $oceanids[0];
+ next unless $2 eq $island;
+ $islandid= $3;
}
defined $islandid or die;
die "@filenames ?" if grep { $_ ne $filename } @filenames;
die "@forcerls ?" if grep { $_ ne $forcerl } @forcerls;
- my $setisland= {
- };
-
print STDERR "Setting ocean and island...\n";
my $siurl= ($url . "?action=setisland".
# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
+BEGIN { unshift @INC, qw(.) }
+
use strict (qw(vars));
use POSIX;
use MIME::Entity;
use Commods;
+no warnings qw(exec);
+
$CGI::POST_MAX= 3*1024*1024;
use CGI qw/:standard -private_tempfiles/;
#include <pam.h>
#include <time.h>
#include <limits.h>
+#include <ctype.h>
#include <sys/time.h>
# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
+BEGIN { unshift @INC, qw(.) }
+
use strict (qw(vars));
use JSON;
#use Data::Dumper;
# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
+BEGIN { unshift @INC, qw(.) }
+
use strict (qw(vars));
use DBI;
# This specific file is hereby placed in the public domain, or nearest
# equivalent in law, by me, Ian Jackson. 5th July 2009.
+BEGIN { unshift @INC, qw(.) }
+
use IO::File;
use strict (qw(vars));
$|=1;
+sub chk_ascending ($$$) {
+ my ($this,$lastref,$desc) = @_;
+ printf "# WARNING - $desc $this < $$lastref\n"
+ if defined($$lastref) and $this < $$lastref;
+ $$lastref= $this;
+}
+
foreach my $bs qw(Buy Sell) {
my $alloffers_want= getint("Buy ncommods");
my $alloffers_done=0;
+ my $commodix_last;
+ my $price_last;
while ($alloffers_done < $alloffers_want) {
my $commodix= getint("Buy $alloffers_done/$alloffers_want commodix");
+ $price_last=undef unless
+ defined($commodix_last) && $commodix == $commodix_last;
my $offers= getint("Buy $commodix offers");
my $offernum;
for ($offernum=0; $offernum<$offers; $offernum++) {
$bs,
inmap('commod',@pctb_commodmap,$commodix),
inmap('stall',@stalls,$stallix)) or die $!;
- if ($bs eq 'Sell') { print "\t\t" or die $!; }
+ my $chk_asc_price_neg;
+ my $pricesort;
+ if ($bs eq 'Sell') { $pricesort=1; print "\t\t" or die $!; }
printf("\t%d\t%d", $price, $qty) or die $!;
- if ($bs eq 'Buy') { print "\t\t" or die $!; }
+ if ($bs eq 'Buy') { $pricesort=-1; print "\t\t" or die $!; }
print "\n" or die $!;
+ chk_ascending($commodix,\$commodix_last,'commodix');
+ chk_ascending($pricesort*$price,\$price_last,'price');
$alloffers_done++;
die if $alloffers_done > $alloffers_want;
}
# 0060 01 00 1e 00 OI 30
# 0070 02 00 qty 2
#
+# buy offers need to be sorted first by commodity index, then by
+# prices (prices ascending)
+# sell offers need to be sorted first by commodity index, then by
+# prices (prices descending)
+# [ however, it seems that this is wrong and the price sort order is
+# supposed to be descending for buy and ascending for sell ]
# YPPSC_YARRG_DICT_UPDATE=./ YPPSC_YARRG_DICT_SUBMIT=./ ./yarrg --ocean midnight --pirate aristarchus --find-island --same --raw-tsv >raw.tsv
# ./dictionary-manager --debug --approve-updates '' . .
+BEGIN { unshift @INC, qw(.) }
+
use strict (qw(vars));
use POSIX;
+no warnings qw(exec);
+
$CGI::POST_MAX= 1024*1024;
$CGI::DISABLE_UPLOADS= 1;
--- /dev/null
+#define fc_width 12
+#define fc_height 10
+static unsigned char fc_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0x60, 0x00, 0x98, 0x01, 0x60, 0x00,
+ 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
smsloop am sl Sloop
lgsloop bm ct Cutter
dhow cm dh Dhow
+ fanchuan cw fc Fanchuan
longship dm ls Longship
baghlah em bg Baghlah
junk eo jk Junk
verdant V {Verdant class}
inferno I {Inferno class}
fancy M {Midas class}
+ phantom G {Phantom class}
+ imperial P {Imperial class}
+ fortune O {Fortune class}
+ lagoon L {Lagoon class}
}
# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
+BEGIN { unshift @INC, qw(.) }
+
use strict (qw(vars));
use CommodsDatabase;
|----------------+--------+-------+-------|
|Dhow |medium |20,250 |13,500 |
|----------------+--------+-------+-------|
+ |Fanchuan |large |20,250 |13,500 |
+ |----------------+--------+-------+-------|
|Longship |small |20,250 |13,500 |
|----------------+--------+-------+-------|
|Baghlah |medium |27,000 |18,000 |
*enamel
*forageables
+# Commodities are defined in `commods` sections
+# Each line is
+# <name> <facts>
+# and the <facts> can be
+# <mass>kg
+# <volume>l
+# *<class> (see commodclasses, above)
+# @<sort-number> sort order value, for where in the commods list it goes
+# @<sort-number>+ sort order value; 10x line number is added
+# The <name> can contain `%<reference>` which is then defined in
+# a `%<reference>` section.
+# Volume defaults to 1l.
+
commods
kraken's blood 1kg *dye @105
%d dye 1kg *dye @0
lapis lazuli @200000+
quartz @200000+
tigereye @200000+
+ topaz @200000+
commods
swill 1kg *ship_supplies @0+
grog 1kg *ship_supplies @0+
fine rum 1kg *ship_supplies @0+
+ rum spice 800g *ship_supplies @0+
small cannon balls 7100g *ship_supplies @0+
medium cannon balls 14200g 2l *ship_supplies @0+
large cannon balls 21300g 3l *ship_supplies @0+
+ lifeboats 25kg 100l *ship_supplies @0+
madder 400g *herbs @0+
old man's beard 800g *herbs @0+
lily of the valley 300g *herbs @0+
nettle 300g *herbs @0+
butterfly weed 100g *herbs @0+
+ allspice 800g *herbs @0+
bananas 125kg 100l *forageables @300000+
carambolas 125kg 100l *forageables @300000+
hemp oil 1kg *basic_commodities @160
varnish 1kg *basic_commodities @180
lacquer 1kg *basic_commodities @190
+ kraken's ink 100g 1l *basic_commodities @200
client ypp-sc-tools yarrg
lastpage
client jpctb greenend
-
+ bug-094
#---------- OCEANS ----------
# subscriber oceans
-ocean Midnight
-
-ocean Cobalt
+ocean Cerulean
Garnet
Jubilee Island
-ocean Ice
- Vilya
- Winking Wall Island
-
# doubloon oceans
-ocean Hunter
- Eagle
- Ix Chel
- Manu Island
-
-ocean Malachite
- Draco
- Cetus Island
- Threewood Island
-
-ocean Sage
+ocean Emerald
+ Crab
+ The Beaufort Islands
Osprey
Scurvy Reef
Gauntlet Island
+ Pleiades
+ Morgana Island
-ocean Viridian
-
-# family oceans
-
-ocean Crimson
+ocean Meridian
+ Draco
+ Cetus Island
+ Threewood Island
+ Wyvern Island
+ Basilisk
+ Zechstein Island
+ Komodo
+ Buyan's Vortice
# International oceans (doubloon oceans)
# Canis
# Atchafalaya-Insel
+# Test ocean
+
+ocean Ice
+ Vilya
+ Winking Wall Island
+
+ocean Obsidian
+ Ye Bloody Bounding Main
+ Loggerhead Island
+ Melanaster Island
+ Picklepine Ridge
+ Woodtick Island
# are used without permission. This program is not endorsed or
# sponsored by Three Rings.
+BEGIN { unshift @INC, qw(.) }
+
use strict (qw(vars));
use DBI;
use Commods;
</%doc><%perl>
+no warnings qw(exec);
+
use CommodsWeb;
my $printable= printable($m);
<h2>Resources for developers</h2>
-For information about the YARRG JPCTB uploader, see the
-<a href="upload">page about the uploader</a>.
-
<h3>Source code</h3>
<kbd>git clone git://git.yarrg.chiark.net/ypp-sc-tools.main.git</kbd><br>
an up-to-date of its actually-running source code. So this link
gives you the source code for the pages you are now looking at.
+<p>All of the above trees are available via the
+<a href="http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git">gitweb
+source code and history browser</a>.
+
+<h4>Uploader</h4>
+
+The uploader is also Free Software, but under a slightly different
+licence. The <a href="upload">uploader page</a> has
+<a href="upload#source">complete information on how to get its source code</a>.
+
<h3>YARRG website code instances</h3>
<h4>Lookup website</h4>
<h3>Data</h3>
<kbd>rsync rsync.yarrg.chiark.net::yarrg/</kbd><br>
-accesses files published for the benefit of the yarrg upload client,
+accesses files published for the benefit of the old yarrg upload client
+and other members of the ypp-sc-tools family.
<p>
If you would like to run a (perhaps modified) copy of the YARRG
website it would be very easy for us to make our system send you
-copies of updates submitted by users of the official YARRG client, in
-the format expected by the YARRG code. Please just ask us - at our
-end it's just a matter of us adding your database instance's special
-email address to our alias file.
+copies of updates submitted by users of the YARRG clients including
+JARRG, in the format expected by the YARRG code. Please just
+ask us - at our end it's just a matter of us adding your database
+instance's special email address to our alias file.
<p>
Email Ian Jackson ijackson (at) chiark.greenend.org.uk. Or talk to
any Fleet Officer or above of the crew Special Circumstances on the
-Midnight Ocean.
+Cerulean Ocean.
<p>
</div>
In the Voyage Trading Plan, YARRG indicates after the commodity name
where in the YPP commodity UI each commodity can be found. First
comes the initial letter of the category:
-% my $dbh= dbw_connect('Midnight');
+% my $dbh= dbw_connect('Cerulean');
% my $getclasses= $dbh->prepare(
% "SELECT commodclass FROM commodclasses ORDER BY commodclass");
% $getclasses->execute();
<hr>
<address>
YARRG is Yet Another Revenue Research Gatherer, a project of the
-crew Special Circumstances on the Midnight Ocean
+crew Special Circumstances on the Cerulean Ocean
and of the Sinister Greenend Organisation.
<p>
Email Ian Jackson ijackson (at) chiark.greenend.org.uk. Or talk to
any Fleet Officer or above of the crew Special Circumstances on the
-Midnight Ocean.
+Cerulean Ocean.
<p>
</div>
<%init>
use CommodsWeb;
-db_setocean('Midnight');
+db_setocean('Cerulean');
db_connect();
</%init>
<%init>
use CommodsWeb;
-my $dbh= dbw_connect('Midnight');
+my $dbh= dbw_connect('Cerulean');
</%init>
text string parsers/checkers like check_routestring.
# typical url for this script:
-# http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/qtextstring?what=routestring?format=json&ocean=Midnight&string=d
+# http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/qtextstring?what=routestring?format=json&ocean=Cerulean&string=d
</%doc>
my $now= time;
my $sth= $dbh->prepare("SELECT archipelago, islandid, islandname, timestamp
- FROM uploads NATURAL JOIN islands
+ FROM uploads JOIN islands USING (islandid)
ORDER BY archipelago, islandname");
$sth->execute();
my $offers= $dbh->prepare(
"SELECT stallname, price, qty
- FROM $bs NATURAL JOIN stalls
+ FROM $bs JOIN stalls USING (stallid, islandid)
WHERE commodid = ? AND islandid = ?
ORDER BY price $ascdesc"
);
</%args>
<%perl>
+no warnings qw(exec);
+
use BSD::Resource;
my $emsg;
my $destspec;
-my @maxmaxdist= qw(35 35 60);
+my @maxmaxdist= qw(100 100 100);
my $maxcpu=90;
my $concur_lim=5;
}
push @rsargs, defined $routeparams->{LossPerLeaguePct}
? $routeparams->{LossPerLeaguePct}*0.01 : 1e-9;
-push @rsargs, $routeparams->{MinProfit};
+push @rsargs, $routeparams->{MinProfit} // 0;
push @rsargs, 'search',$maxdist, $maxcountea,$maxcountea;
push @rsargs, $destspec;
push @rsargs, @islandids;
}
die unless m/^ \@ *\d+ ([ap])\# *\d+ \|.*\| *(\d+)lg *\| *\d+ +(\d+) +(\d+) *\| ([0-9 ]+)$/;
my ($ap,$isles) = (uc $1,$5);
- next if $results{$ap} && %{$results{$ap}} >= $maxcountea;
+ next if $results{$ap} && keys %{$results{$ap}} >= $maxcountea;
my $item= { A => $3, P => $4, Leagues => $2 };
my (@i, @fi, @a);
foreach (split / /, $isles) {
--- /dev/null
+<%flags>
+inherit => undef
+</%flags>
+<%perl>
+$r->content_type('text/plain');
+</%perl>
+User-Agent: *
+Disallow: /lookup
+Disallow: /test/code/lookup
+Disallow: /test/data/lookup
+Disallow: /test/both/lookup
<%perl>
my $sth_i= $dbh->prepare(<<END);
SELECT archipelago, islandid, islandname, timestamp
- FROM uploads NATURAL JOIN islands
+ FROM uploads JOIN islands USING (islandid)
WHERE islandid = ?
END
my $sth_a= $dbh->prepare(<<END);
SELECT archipelago, islandid, islandname, timestamp
- FROM uploads NATURAL JOIN islands
+ FROM uploads JOIN islands USING (islandid)
WHERE archipelago = ?
ORDER BY islandname
END
<h1>"yarrg" screenscraper for YARRG and PCTB</h1>
There is an obsolete screenscraper for Linux, known as "yarrg". It is
-much slower and less reliable than JPCTB. We recommend you use
-<a href="upload">YARRG JPCTB</a> instead.
+much slower and less reliable than JARRG. We recommend you use
+<a href="upload">JARRG</a> instead.
<h2>Instructions for using obsolete "yarrg"</h2>
</%doc>
<& docshead &>
-<%perl>
-my $url_base_base= 'http://yarrg.chiark.net/download/jpctb';
-my $download_version= 'test';
-my $url_base= "$url_base_base/$download_version";
-</%perl>
+<%shared>
+my $url_base_base= 'http://yarrg.chiark.net/download/jarrg';
+</%shared>
+<%def downloadurl><%args>
+$leaf
+$test => 0
+# ^ change this to change the default version
+</%args><%perl>
+my $download_version= $test ? '/test' : '';
+my $url_base= "$url_base_base$download_version";
+my $url= $url_base.'/'.$leaf;
+</%perl><a href="<% $url %>"><%
+ $m->has_content ? $m->content : $url
+%></a></%def>
<h1>Uploading to YARRG</h1>
<p>
The YARRG system has two main parts: this website which maintains a
searchable database of commodity prices, and an upload client (known
-as YARRG JPCTB), which screenscrapes the commodity data from the
+as JARRG), which screenscrapes the commodity data from the
Puzzle Pirates game client and uploads it to the database.
<p>
<p>
-The YARRG JPCTB upload client uploads both to YARRG and
+The JARRG upload client uploads both to YARRG and
<a href="http://pctb.crabdance.com/">PCTB</a>. It is intended to
replace both the <a href="scraper">"yarrg"</a> and "PPAOCR" screenscrapers.
<h2>Instructions</h2>
-First you must install YARRG JPCTB, following the instructions for
+First you must install JARRG, following the instructions for
your operating system, below. This will not modify your Puzzle
Pirates installation. Instead, it provides you with a new way to run
-Puzzle Pirates which integrates it with JPCTB to provides a YARRG/PCTB
+Puzzle Pirates which integrates it with JARRG to provides a YARRG/PCTB
Upload facility.
<p>
-To upload data, run the Puzzle Pirates client with JPCTB (as detailed
-below). You should see both the Puzzle Pirates window and the JPCTB
+To upload data, run the Puzzle Pirates client with JARRG (as detailed
+below). You should see both the Puzzle Pirates window and the JARRG
window appear. Log in normally, and visit a commodity trading screen
(at a market, shoppe or vessel hold). Select "All Commodities" in the
-YPP client. Then press "Upload" in the JPCTB window.
+YPP client. Then press "Upload Market Data" in the JARRG window.
<p>
-The JPCTB integration is done via fully supported Java Accessibility
+It is OK to switch away from the commodity list in Puzzle Pirates as
+soon as the Jarrg progress bar appears. The uploader has taken a copy
+of the data, so you can do something else while the upload takes
+place.
+
+<p>
+
+The JARRG integration is done via fully supported Java Accessibility
interfaces, and should not disturb the normal running of Puzzle
Pirates. However, please make sure that if your YPP client misbehaves
-at all, you try starting it in the vanilla way (without JPCTB
-integration) before asking for help. In particular, if the JPCTB
+at all, you try starting it in the vanilla way (without JARRG
+integration) before asking for help. In particular, if the JARRG
startup does not work, but the ordinary Puzzle Pirates startup does,
report the problem to us, not to Three Rings.
<h3>Installing and running on Linux</h3>
Download
-<a href="<% $url_base %>/jpctb.tar.gz"><% $url_base %>/jpctb.tar.gz</a>
-and unpack it. You run jpctb from the command line. Change
-(<code>cd</code>) to the top level <code>jpctb</code> directory
+<& downloadurl, leaf => 'jarrg-linux.tar.gz' &>
+and unpack it. You run jarrg from the command line. Change
+(<code>cd</code>) to the top level <code>jarrg</code> directory
which was created when you unpacked the tarball, and then run
<pre>
-./jpctb /path/to/yohoho/yohoho
+./jarrg /path/to/yohoho/yohoho
</pre>
where <code>/path/to/yohoho/yohoho</code> is the location of the
ordinary Puzzle Pirates startup script, which is normally
<h3>Installing on Windows</h3>
Download
-<a href="<% $url_base %>/jpctb-setup.exe"><% $url_base %>/jpctb-setup.exe</a>
+<& downloadurl, leaf => 'jarrg-setup.exe' &>
and double-click on it. It will either:
<ol>
<li>Just work, in which case you'll have a new icon on your desktop which
- runs Puzzle Pirates with JPCTB integrated.
+ runs Puzzle Pirates with JARRG integrated.
<li>Fail, and tell you what to do next. Usually this means installing a
Java Runtime Environment (or JVM) and then uninstalling and re-
installing Puzzle Pirates. (Don't worry about reinstalling; you
<h3>Installing on Macs</h3>
We believe that it should be straightforward for a MacOS expert to get
-YARRG JPCTB working properly on MacOS but we have not been able to
+JARRG working properly on MacOS but we have not been able to
test this ourselves. The Linux installation method is probably the
best starting point.
<h2>How does it work? Is it a violation of the Terms of Service?</h2>
-Essentially, JPCTB is a specialised "screen reader" which instead of
+JARRG (and the old OCR clients) comply with Three Rings' official
+<a href="http://yppedia.puzzlepirates.com/Official:Third_Party_Software">Third Party Software Policy</a>.
+
+<p>
+
+Essentially, JARRG is a specialised "screen reader" which instead of
reading information out loud, uploads it to the YARRG and PCTB
databases.
<p>
-YARRG JPCTB uses the Java Accessibility API, which is a part of the
+JARRG uses the Java Accessibility API, which is a part of the
Java platform. It's a facility in Java, available for all Java
programs, intended to help make applications available to users with
disabilities: for example, it permits hooking in screen readers. The
<p>
-Installing YARRG JPCTB does not modify any game files, and does not
+Installing JARRG does not modify any game files, and does not
hook into the game itself. It makes no permanent or global changes to
your overall computer, operating system or Java configuration. And it
does not access (indeed, we don't think it could access) any of the
<p>
-JPCTB runs the unmodified Puzzle Pirates game, but with a separate
+JARRG runs the unmodified Puzzle Pirates game, but with a separate
copy of your system's JVM (Java Virtual Machine); that copy of the JVM
-is configured to use the JPCTB accessibility plugin. We do this
+is configured to use the JARRG accessibility plugin. We do this
(rather than configuring the computer's main JVM to use the
accessibility plugin) to avoid interfering with other uses of Java on
your computer - in particular, so that it is always possible to launch
-Puzzle Pirates <em>without</em> JPCTB (for example, in case the plugin
+Puzzle Pirates <em>without</em> JARRG (for example, in case the plugin
should cause any kind of problem).
-<h2>Authorship, source code and other versions</h2>
+<h2><a name="source">Authorship, source code and other versions</a></h2>
-Thanks to Burninator for writing the core of the JPCTB client. Ian
-Jackson and Owen Dunn adapted it to improve the installation setup (in
-particular, to avoid modifying any of the YPP client's startup files).
-Owen Dunn added support for uploading to YARRG, updated the build
-system, and wrote a Windows installer.
+Thanks to Burninator for writing the core of the JARRG client. Ian
+Jackson and Owen Dunn adapted it to fix bugs and to improve the
+installation setup (in particular, to avoid modifying any of the YPP
+client's startup files). Owen Dunn added support for uploading to
+YARRG, updated the build system, and wrote a Windows installer.
<p>
-YARRG JPCTB is
+JARRG is
Copyright 2006-2009 Burninator,
Copyright 2009-2010 Owen Dunn and
-Copyright 2009-2010 Ian Jackson.
+Copyright 2009-2011 Ian Jackson.
It is Free Software with <strong>NO WARRANTY</strong>, released under
the MIT-style two-clause licence.
<p>
-The download directory can contains other versions (eg unreleased test
-versions), which you can see here:
- <a href="<% $url_base_base %>/"><% $url_base_base %>/</a> .
+The code for the downloadable binaries is in
+in <& downloadurl, leaf=>'jarrg-source.tar.gz' &>.
+The download directory also sometimes contains other versions
+(eg unreleased test versions), which you can see here:
+ <& downloadurl, leaf => '', test => 0 &>
<p>
-The source code for the downloadable released binaries is in the
-<a href="<% $url_base %>/jpctb.tar.gz">Linux
-tarball</a>. We maintain YARRG JPCTB in git, and you can get
-source code for recent and perhaps unreleased versions from
-<code>git://git.yarrg.chiark.net/jpctb.git</code> and/or
-<code>git://git.chiark.greenend.org.uk/~ijackson/jpctb.git</code> .
+We maintain JARRG in git, and you can get
+source code for recent and perhaps unreleased versions from one of:
+<pre>
+git://git.yarrg.chiark.net/jarrg-ian.git</code> <a href="http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=jarrg-ian.git;a=summary">(gitweb)</a>
+git://git.yarrg.chiark.net/jarrg-owen.git</code> <a href="http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=jarrg-owen.git;a=summary">(gitweb)</a>
+</pre>
</div>
set cmd {./yarrg --find-window-only --quiet}
if {[info exists ocean]} { lappend cmd --ocean $ocean }
if {[info exists pirate]} { lappend cmd --pirate $pirate }
- manyset [split [eval exec $cmd] " "] ocean pirate
+ if {[catch {
+ manyset [split [eval exec $cmd] " "] ocean pirate
+ } emsg]} {
+ puts stderr "yarrg: [string trim $emsg]"
+ puts stderr "Alternatively pass, --ocean and perhaps --pirate options to where-vessels"
+ exit 1
+ }
if {![llength $ocean] || ![llength $pirate]} {
error "$ocean $pirate ?"
}
proc smash-prepare {} {
global vc_codes smash_sizemap smash_size smash_sizeinexact
set mapto {}
- catch { unset smash_sizeplus }
+ catch { unset smash_sizeinexact }
foreach size $vc_codes {
if {!$smash_size($size)} {
set mapto $size
}
+#---------- info toplevel ----------
+
+proc info-toplevel-create {info title} {
+ toplevel $info
+ wm withdraw $info
+ wm title $info "where-vessels - $title"
+ wm protocol $info WM_DELETE_WINDOW [list wm withdraw $info]
+
+ button $info.close -text Close -command [list wm withdraw $info]
+ pack $info.close -side bottom
+}
+
#---------- parser error reporting ----------
proc parser-control-create {w base invokebuttontext etl_title} {
pack $w.resframe -side top -expand y -fill both
set eb .err_$base
- toplevel $eb
- wm withdraw $eb
- wm title $eb "where-vessels - $etl_title"
- wm protocol $eb WM_DELETE_WINDOW [list wm withdraw $eb]
+ info-toplevel-create $eb $etl_title
label $eb.title -text $etl_title
pack $eb.title -side top
- button $eb.close -text Close -command [list wm withdraw $eb]
- pack $eb.close -side bottom
-
frame $eb.emsg -bd 2 -relief groove
label $eb.emsg.lab -anchor nw -text "Error:"
text $eb.emsg.text -height 1
$offset [expr {$offset+$maxchars-1}]]
}
+#---------- print to postscript ----------
+
+proc print-to-postscript {} {
+ global canvas ocean
+ set postscript_fontmap(fixed) {Courier 12}
+ manyset [$canvas bbox all] xmin ymin xmax ymax
+ set file where-vessels.$ocean.ps
+ $canvas postscript -file $file -rotate 1 \
+ -width [expr {$xmax-$xmin}] \
+ -height [expr {$ymax-$ymin}] \
+ -fontmap postscript_fontmap
+ .printed.info configure -text "Printed to $file
+
+Usually, the next thing would be something like"
+ set text "epsffit 0 0 595.276 841.89 <$file >t.ps"
+ .printed.rune configure -state normal
+ .printed.rune delete 1.0 end
+ .printed.rune insert end $text
+ .printed.rune configure -width [string length $text] -state disabled
+ update idletasks
+ wm deiconify .printed
+}
+
#---------- main user interface ----------
proc widgets-setup {} {
if {![have-notes]} {
.cp.ctrl.notes.do configure -state disabled
- }
+ }
+
+ button .cp.ctrl.print -text {Print to file} -command print-to-postscript
+ pack .cp.ctrl.print -side top
+ #----- message saying we've printed -----
+
+ info-toplevel-create .printed "printed"
+
+ label .printed.info
+ text .printed.rune -state disabled -height 1 -borderwidth 0
+ pack .printed.info -side top
+ pack .printed.rune -side top
+
#----- island name count and copy -----
label .islands.count
next unless exists $winode2island{$vertex};
my $ccix= $wiarchs->connected_component_by_vertex($vertex);
my @cc= $wiarchs->connected_component_by_index($ccix);
- my ($vx,$vy) = split /,/, $vertex;
+ my ($vx,$vy) = split /,/, $vertex; # /
my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
my $cmp= $best_d2 <=> $d2;
printf $debugfh "%2d,%-2d arch-island-search %5s d2=%4d cc%-2d".
not essential and is therefore unnecessary.
END
+ # `
printf $debugfh "spr %s before %d\n", $what, scalar($g->edges());
die unless defined $arch;
$wtisland2arch{$'}= $arch;
} elsif (m/^ /) {
- $arch= $';
+ $arch= $'; # '
} else {
die;
}
soup = BeautifulSoup(dataf)
title_arch_re = regexp.compile('(\\S.*\\S) Archipelago \\((\\S+)\\)$')
-title_any_re = regexp.compile('(\\S.*\\S) \((\\S+)\\)$')
+title_any_re = regexp.compile('(\\S.*\\S) \((\\S+)\\)(?: \(page does not exist\))?$')
href_img_re = regexp.compile('\\.png$')
def title_arch_info(t):
import curses
import termios
import random
+import subprocess
+import copy
from optparse import OptionParser
from StringIO import StringIO
if ti < 86400: return '%dh' % (ti / 3600)
return '%dd' % (ti / 86400)
+def yppsc_dir():
+ lib = os.getenv("YPPSC_YARRG_SRCBASE")
+ if lib is not None: return lib
+ lib = sys.argv[0]
+ lib = regexp.sub('/[^/]+$', '', lib)
+ os.environ["YPPSC_YARRG_SRCBASE"] = lib
+ return lib
+
+soup_massage = copy.copy(BeautifulSoup.MARKUP_MASSAGE)
+soup_massage.append(
+ (regexp.compile('(\<td.*") ("center")'),
+ lambda m: m.group(1)+' align='+m.group(2))
+ )
+
+def make_soup(*args, **kwargs):
+ return BeautifulSoup(*args,
+ convertEntities=BeautifulSoup.HTML_ENTITIES,
+ markupMassage=soup_massage,
+ **kwargs)
+
#---------- caching and rate-limiting data fetcher ----------
class Fetcher:
- def __init__(self, ocean, cachedir):
+ def __init__(self, cachedir):
debug('Fetcher init %s' % cachedir)
- self.ocean = ocean
self.cachedir = cachedir
try: os.mkdir(cachedir)
except (OSError,IOError), oe:
if oe.errno != errno.EEXIST: raise
self._cache_scan(time.time())
- def default_ocean(self, ocean='ice'):
- if self.ocean is None:
- self.ocean = ocean
+ def _match_url_normalise(self, url):
+ without_scheme = regexp.sub('^[a-z]+://', '', url)
+ without_tail = regexp.sub('/.*', '', without_scheme)
+ return without_tail
- def _cache_scan(self, now):
+ def _cache_scan(self, now, match_url=None):
# returns list of ages, unsorted
+ if match_url is not None:
+ match_url = self._match_url_normalise(match_url)
ages = []
debug('Fetcher scan_cache')
for leaf in os.listdir(self.cachedir):
if not leaf.startswith('#'): continue
+ if match_url is not None:
+ leaf_url = urllib.unquote_plus(leaf.strip('#'))
+ leaf_url = self._match_url_normalise(leaf_url)
+ if leaf_url != match_url:
+ continue
path = self.cachedir + '/' + leaf
try: s = os.stat(path)
except (OSError,IOError), oe:
ages.append(age)
return ages
- def need_wait(self, now, imaginary=[]):
- ages = self._cache_scan(now)
+ def need_wait(self, now, imaginary=[], next_url=None):
+ ages = self._cache_scan(now, match_url=next_url)
ages += imaginary
ages.sort()
debug('Fetcher ages ' + `ages`)
(min_age, age))
need_wait = max(need_wait, min_age - age)
min_age += 3
- min_age *= 1.25
if need_wait > 0:
need_wait += random.random() - 0.5
return need_wait
- def _rate_limit_cache_clean(self, now):
- need_wait = self.need_wait(now)
+ def _rate_limit_cache_clean(self, now, next_url=None):
+ need_wait = self.need_wait(now, next_url=next_url)
if need_wait > 0:
- debug('Fetcher wait %d' % need_wait)
+ debug('Fetcher wait %f' % need_wait)
sleep(need_wait)
def fetch(self, url, max_age):
return data
debug('Fetcher fetch')
- self._rate_limit_cache_clean(now)
+ self._rate_limit_cache_clean(now, next_url=url)
stream = urllib2.urlopen(url)
data = stream.read()
debug('Fetcher stored')
return data
+class Yoweb(Fetcher):
+ def __init__(self, ocean, cachedir):
+ debug('Yoweb init %s' % cachedir)
+ self.ocean = ocean
+ Fetcher.__init__(self, cachedir)
+
+ def default_ocean(self, ocean='ice'):
+ if self.ocean is None:
+ self.ocean = ocean
+
def yoweb(self, kind, tail, max_age):
self.default_ocean()
+ assert(self.ocean)
url = 'http://%s.puzzlepirates.com/yoweb/%s%s' % (
self.ocean, kind, tail)
return self.fetch(url, max_age)
+class Yppedia(Fetcher):
+ def __init__(self, cachedir):
+ debug('Yoweb init %s' % cachedir)
+ self.base = 'http://yppedia.puzzlepirates.com/'
+ self.localhtml = opts.localhtml
+ Fetcher.__init__(self, cachedir)
+
+ def __call__(self, rhs):
+ if self.localhtml is None:
+ url = self.base + rhs
+ debug('Yppedia retrieving YPP '+url);
+ return self.fetch(url, 3000)
+ else:
+ return file(opts.localhtml + '/' + rhs, 'r')
+
#---------- logging assistance for troubled screenscrapers ----------
class SoupLog:
def __init__(self, kind, tail, max_age):
SoupLog.__init__(self)
html = fetcher.yoweb(kind, tail, max_age)
- self._soup = BeautifulSoup(html,
- convertEntities=BeautifulSoup.HTML_ENTITIES
- )
+ self._soup = make_soup(html)
#---------- scraper for pirate pages ----------
class CrewInfo(SomethingSoupInfo):
# Public data members:
+ # ci.crewid
# ci.crew = [ ('Captain', ['Pirate', ...]),
# ('Senior Officer', [...]),
# ... ]
# pi.msgs = [ 'message describing problem with scrape' ]
def __init__(self, crewid, max_age=300):
+ self.crewid = crewid
SomethingSoupInfo.__init__(self,
'crew/info.wm?crewid=', crewid, max_age)
self._find_crew()
def __str__(self):
return `(self.crew, self.msgs)`
+class FlagRelation():
+ # Public data members (put there by hand by creater)
+ # other_flagname
+ # other_flagid
+ # yoweb_heading
+ # this_declaring
+ # other_declaring_min
+ # other_declaring_max
+ # where {this,other}_declaring{,_min,_max} are:
+ # -1 {this,other} is declaring war
+ # 0 {this,other} is not doing either
+ # +1 {this,other} is allying
+ def __repr__(self):
+ return '<FlagRelation %s %d/%d..%d %s %s>' % (
+ self.yoweb_heading, self.this_declaring,
+ self.other_declaring_min, self.other_declaring_max,
+ self.other_flagname, self.other_flagid)
+
+class FlagInfo(SomethingSoupInfo):
+ # Public data members (after init):
+ #
+ # flagid
+ # name # string
+ #
+ # relations[n] = FlagRelation
+ # relation_byname[otherflagname] = relations[some_n]
+ # relation_byid[otherflagname] = relations[some_n]
+ #
+ # islands[n] = (islandname, islandid)
+ #
+ def __init__(self, flagid, max_age=600):
+ self.flagid = flagid
+ SomethingSoupInfo.__init__(self,
+ 'flag/info.wm?flagid=', flagid, max_age)
+ self._find_flag()
+
+ def _find_flag(self):
+ font2 = self._soup.find('font',{'size':'+2'})
+ self.name = font2.find('b').contents[0]
+
+ self.relations = [ ]
+ self.relation_byname = { }
+ self.relation_byid = { }
+ self.islands = [ ]
+
+ magnate = self._soup.find('img',{'src':
+ '/yoweb/images/repute-MAGNATE.png'})
+ warinfo = (magnate.findParent('table').findParent('tr').
+ findNextSibling('tr').findNext('td',{'align':'left'}))
+
+ def warn(m):
+ print >>sys.stderr, 'WARNING: '+m
+
+ def wi_warn(head, waritem):
+ warn('unknown warmap item: %s: %s' %
+ (`head`, ``waritem``))
+
+ def wihelp_item(waritem, thing):
+ url = waritem.get('href', None)
+ if url is None:
+ return ('no url for '+thing,None,None)
+ m = regexp.search('\?'+thing+'id=(\d+)$', url)
+ if not m: return ('no '+thing+'id',None,None)
+ tid = m.group(1)
+ tname = waritem.string
+ if tname is None:
+ return (thing+' name not just string',None,None)
+ return (None,tid,tname)
+
+ def wi_alwar(head, waritem, thisdecl, othermin, othermax):
+ (err,flagid,flagname) = wihelp_item(waritem,'flag')
+ if err: return err
+ rel = self.relation_byid.get(flagid, None)
+ if rel: return 'flag id twice!'
+ if flagname in self.relation_byname:
+ return 'flag name twice!'
+ rel = FlagRelation()
+ rel.other_flagname = flagname
+ rel.other_flagid = flagid
+ rel.yoweb_heading = head
+ rel.this_declaring = thisdecl
+ rel.other_declaring_min = othermin
+ rel.other_declaring_max = othermax
+ self.relations.append(rel)
+ self.relation_byid[flagid] = rel
+ self.relation_byname[flagid] = rel
+
+ def wi_isle(head, waritem):
+ (err,isleid,islename) = wihelp_item(waritem,'island')
+ if err: return err
+ self.islands.append((isleid,islename))
+
+ warmap = {
+ 'Allied with': (wi_alwar,+1,+1,+1),
+ 'Declaring war against': (wi_alwar,-1, 0,+1),
+ 'At war with': (wi_alwar,-1,-1,-1),
+ 'Trying to form an alliance with': (wi_alwar,+1,-1,0),
+ 'Islands controlled by this flag': (wi_isle,),
+ }
+
+ how = (wi_warn, None)
+
+ for waritem in warinfo.findAll(['font','a']):
+ if waritem is None: break
+ if waritem.name == 'font':
+ colour = waritem.get('color',None)
+ if colour.lstrip('#') != '958A5F':
+ warn('strange colour %s in %s' %
+ (colour,``waritem``))
+ continue
+ head = waritem.string
+ if head is None:
+ warn('no head string in '+``waritem``)
+ continue
+ head = regexp.sub('\\s+', ' ', head).strip()
+ head = head.rstrip(':')
+ how = (head,) + warmap.get(head, (wi_warn,))
+ continue
+ assert(waritem.name == 'a')
+
+ debug('WARHOW %s(%s, waritem, *%s)' %
+ (how[1], `how[0]`, `how[2:]`))
+ bad = how[1](how[0], waritem, *how[2:])
+ if bad:
+ warn('bad waritem %s: %s: %s' % (`how[0]`,
+ bad, ``waritem``))
+
+ def __str__(self):
+ return `(self.name, self.islands, self.relations)`
+
+#---------- scraper for ocean info incl. embargoes etc. ----------
+
+class IslandBasicInfo():
+ # Public data attributes:
+ # ocean
+ # name
+ # Public data attributes maybe set by caller:
+ # arch
+ def __init__(self, ocean, islename):
+ self.ocean = ocean
+ self.name = islename
+ def yppedia(self):
+ def q(x): return urllib.quote(x.replace(' ','_'))
+ url_rhs = q(self.name) + '_(' + q(self.ocean) + ')'
+ return yppedia(url_rhs)
+ def __str__(self):
+ return `(self.ocean, self.name)`
+
+class IslandExtendedInfo(IslandBasicInfo):
+ # Public data attributes (inherited):
+ # ocean
+ # name
+ # Public data attributes (additional):
+ # islandid
+ # yoweb_url
+ # flagid
+ def __init__(self, ocean, islename):
+ IslandBasicInfo.__init__(self, ocean, islename)
+ self.islandid = None
+ self.yoweb_url = None
+ self._collect_yoweb()
+ self._collect_flagid()
+
+ def _collect_yoweb(self):
+ debug('IEI COLLECT YOWEB '+`self.name`)
+ self.islandid = None
+ self.yoweb_url = None
+
+ soup = make_soup(self.yppedia())
+ content = soup.find('div', attrs = {'id': 'content'})
+ yoweb_re = regexp.compile('^http://\w+\.puzzlepirates\.com/'+
+ 'yoweb/island/info\.wm\?islandid=(\d+)$')
+ a = soup.find('a', attrs = { 'href': yoweb_re })
+ if a is None:
+ debug('IEI COLLECT YOWEB '+`self.name`+' NONE')
+ return
+
+ debug('IEI COLLECT YOWEB '+`self.name`+' GOT '+``a``)
+ self.yoweb_url = a['href']
+ m = yoweb_re.search(self.yoweb_url)
+ self.islandid = m.group(1)
+
+ def _collect_flagid(self):
+ self.flagid = None
+
+ yo = self.yoweb_url
+ debug('IEI COLLECT FLAGID '+`self.name`+' URL '+`yo`)
+ if yo is None: return None
+ dataf = fetcher.fetch(yo, 1800)
+ soup = make_soup(dataf)
+ ruler_re = regexp.compile(
+ '/yoweb/flag/info\.wm\?flagid=(\d+)$')
+ ruler = soup.find('a', attrs = { 'href': ruler_re })
+ if not ruler:
+ debug('IEI COLLECT FLAGID '+`self.name`+' NONE')
+ return
+ debug('IEI COLLECT FLAGID '+`self.name`+' GOT '+``ruler``)
+ m = ruler_re.search(ruler['href'])
+ self.flagid = m.group(1)
+
+ def __str__(self):
+ return `(self.ocean, self.islandid, self.name,
+ self.yoweb_url, self.flagid)`
+
+class IslandFlagInfo(IslandExtendedInfo):
+ # Public data attributes (inherited):
+ # ocean
+ # name
+ # islandid
+ # yoweb_url
+ # flagid
+ # Public data attributes (additional):
+ # flag
+ def __init__(self, ocean, islename):
+ IslandExtendedInfo.__init__(self, ocean, islename)
+ self.flag = None
+ self._collect_flag()
+
+ def _collect_flag(self):
+ if self.flagid is None: return
+ self.flag = FlagInfo(self.flagid, 1800)
+
+ def __str__(self):
+ return IslandExtendedInfo.__str__(self) + '; ' + str(self.flag)
+
+class NullProgressReporter():
+ def doing(self, msg): pass
+ def stop(self): pass
+
+class TypewriterProgressReporter():
+ def __init__(self):
+ self._l = 0
+ def doing(self,m):
+ self._doing(m + '...')
+ def _doing(self,m):
+ self._write('\r')
+ self._write(m)
+ less = self._l - len(m)
+ if less > 0:
+ self._write(' ' * less)
+ self._write('\b' * less)
+ self._l = len(m)
+ sys.stdout.flush()
+ def stop(self):
+ self._doing('')
+ self._l = 0
+ def _write(self,t):
+ sys.stdout.write(t)
+
+class OceanInfo():
+ # Public data attributes:
+ # oi.islands[islename] = IslandInfo(...)
+ # oi.arches[archname][islename] = IslandInfo(...)
+ def __init__(self, isleclass=IslandBasicInfo):
+ self.isleclass = isleclass
+ self.ocean = fetcher.ocean.lower().capitalize()
+
+ progressreporter.doing('fetching ocean info')
+
+ cmdl = ['./yppedia-ocean-scraper']
+ if opts.localhtml is not None:
+ cmdl += ['--local-html-dir',opts.localhtml]
+ cmdl += [self.ocean]
+ debug('OceanInfo collect running ' + `cmdl`)
+ oscraper = subprocess.Popen(
+ cmdl,
+ stdout = subprocess.PIPE,
+ cwd = yppsc_dir()+'/yarrg',
+ shell=False, stderr=None,
+ )
+ h = oscraper.stdout.readline()
+ debug('OceanInfo collect h '+`h`)
+ assert(regexp.match('^ocean ', h))
+ arch_re = regexp.compile('^ (\S.*)')
+ island_re = regexp.compile('^ (\S.*)')
+
+ oscraper.wait()
+ assert(oscraper.returncode == 0)
+
+ self.islands = { }
+ self.arches = { }
+ archname = None
+
+ isles = [ ]
+ progressreporter.doing('parsing ocean info')
+
+ for l in oscraper.stdout:
+ debug('OceanInfo collect l '+`l`)
+ l = l.rstrip('\n')
+ m = island_re.match(l)
+ if m:
+ assert(archname is not None)
+ islename = m.group(1)
+ isles.append((archname, islename))
+ continue
+ m = arch_re.match(l)
+ if m:
+ archname = m.group(1)
+ assert(archname not in self.arches)
+ self.arches[archname] = { }
+ continue
+ assert(False)
+
+ for i in xrange(0, len(isles)-1):
+ (archname, islename) = isles[i]
+ progressreporter.doing(
+ 'fetching isle info %2d/%d (%s: %s)'
+ % (i, len(isles), archname, islename))
+ isle = self.isleclass(self.ocean, islename)
+ isle.arch = archname
+ self.islands[islename] = isle
+ self.arches[archname][islename] = isle
+
+ def __str__(self):
+ return `(self.islands, self.arches)`
+
#---------- pretty-printer for tables of pirate puzzle standings ----------
class StandingsTable:
else:
return None
+ def local_command(self, metacmd):
+ # returns None if all went well, or problem message
+ return self._command(self._myself.name, metacmd,
+ "local", time.time(),
+ (lambda m: debug('CMD %s' % metacmd)))
+
+ def _command(self, cmdr, metacmd, chan, timestamp, d):
+ # returns None if all went well, or problem message
+ metacmd = regexp.sub('\\s+', ' ', metacmd).strip()
+ m2 = regexp.match(
+ '/([adj]) (?:([A-Za-z* ]+)\\s*:)?([A-Za-z ]+)$',
+ metacmd)
+ if not m2: return "unknown syntax or command"
+
+ (cmd, pattern, targets) = m2.groups()
+ dml = ['cmd', chan, cmd]
+
+ if cmd == 'a': each = self._onboard_event
+ elif cmd == 'd': each = disembark
+ else: each = lambda *l: self._onboard_event(*l,
+ **{'jobber':'applied'})
+
+ if cmdr == self._myself.name:
+ dml.append('self')
+ how = 'cmd: %s' % cmd
+ else:
+ dml.append('other')
+ how = 'cmd: %s %s' % (cmd,cmdr)
+
+ if cmd == 'j':
+ if pattern is not None:
+ return "/j command does not take a vessel"
+ v = None
+ else:
+ v = self._find_matching_vessel(
+ pattern, timestamp, cmdr,
+ dml, create=True)
+
+ if cmd == 'j' or v is not None:
+ targets = targets.strip().split(' ')
+ dml.append(`len(targets)`)
+ for target in targets:
+ each(v, timestamp, target.title(), how)
+ self._vessel_updated(v, timestamp)
+
+ dm = ' '.join(dml)
+ return d(dm)
+
+ return None
+
def chatline(self,l):
rm = lambda re: regexp.match(re,l)
d = lambda m: self._debug_line_disposition(timestamp,l,m)
def chat_metacmd(chan):
(cmdr, metacmd) = m.groups()
- metacmd = regexp.sub('\\s+', ' ', metacmd).strip()
- m2 = regexp.match(
- '/([adj]) (?:([A-Za-z* ]+)\\s*:)?([A-Za-z ]+)$',
- metacmd)
- if not m2: return chat(chan)
-
- (cmd, pattern, targets) = m2.groups()
- dml = ['cmd', chan, cmd]
-
- if cmd == 'a': each = self._onboard_event
- elif cmd == 'd': each = disembark
- else: each = lambda *l: self._onboard_event(*l,
- **{'jobber':'applied'})
-
- if cmdr == self._myself.name:
- dml.append('self')
- how = 'cmd: %s' % cmd
+ whynot = self._command(
+ cmdr, metacmd, chan, timestamp, d)
+ if whynot is not None:
+ return chat(chan)
else:
- dml.append('other')
- how = 'cmd: %s %s' % (cmd,cmdr)
-
- if cmd == 'j':
- if pattern is not None:
- return chat(chan)
- v = None
- else:
- v = self._find_matching_vessel(
- pattern, timestamp, cmdr,
- dml, create=True)
-
- if cmd == 'j' or v is not None:
- targets = targets.strip().split(' ')
- dml.append(`len(targets)`)
- for target in targets:
- each(v, timestamp, target.title(), how)
- self._vessel_updated(v, timestamp)
-
- dm = ' '.join(dml)
- chat_core(cmdr, 'cmd '+chan)
- return d(dm)
+ chat_core(cmdr, 'cmd '+chan)
m = rm('(\\w+) (?:issued an order|ordered everyone) "')
if m: return ob1('general order');
print '%s: %s,' % (`pirate`, info)
print '}'
-def prep_crew_of(args, bu, max_age=300):
- if len(args) != 1: bu('crew-of takes one pirate name')
+def prep_crewflag_of(args, bu, max_age, selector, constructor):
+ if len(args) != 1: bu('crew-of etc. take one pirate name')
pi = PirateInfo(args[0], max_age)
- if pi.crew is None: return None
- return CrewInfo(pi.crew[0], max_age)
+ cf = selector(pi)
+ if cf is None: return None
+ return constructor(cf[0], max_age)
+
+def prep_crew_of(args, bu, max_age=300):
+ return prep_crewflag_of(args, bu, max_age,
+ (lambda pi: pi.crew), CrewInfo)
+
+def prep_flag_of(args, bu, max_age=300):
+ return prep_crewflag_of(args, bu, max_age,
+ (lambda pi: pi.flag), FlagInfo)
def do_crew_of(args, bu):
ci = prep_crew_of(args, bu)
print ci
+def do_flag_of(args, bu):
+ fi = prep_flag_of(args, bu)
+ print fi
+
def do_standings_crew_of(args, bu):
ci = prep_crew_of(args, bu, 60)
tab = StandingsTable(sys.stdout)
pi = PirateInfo(p, random.randint(900,1800))
tab.pirate(pi)
+def do_ocean(args, bu):
+ if (len(args)): bu('ocean takes no further arguments')
+ fetcher.default_ocean()
+ oi = OceanInfo(IslandFlagInfo)
+ print oi
+ for islename in sorted(oi.islands.keys()):
+ isle = oi.islands[islename]
+ print isle
+
+def do_embargoes(args, bu):
+ if (len(args)): bu('ocean takes no further arguments')
+ fetcher.default_ocean()
+ oi = OceanInfo(IslandFlagInfo)
+ wr = sys.stdout.write
+ print ('EMBARGOES: Island | Owning flag'+
+ ' | Embargoed flags')
+
+ def getflname(isle):
+ if isle.islandid is None: return 'uncolonisable'
+ if isle.flag is None: return 'uncolonised'
+ return isle.flag.name
+
+ progressreporter.stop()
+
+ for archname in sorted(oi.arches.keys()):
+ print 'ARCHIPELAGO: ',archname
+ for islename in sorted(oi.arches[archname].keys()):
+ isle = oi.islands[islename]
+ wr(' %-20s | ' % isle.name)
+ flname = getflname(isle)
+ wr('%-30s | ' % flname)
+ flag = isle.flag
+ if flag is None: print ''; continue
+ delim = ''
+ for rel in flag.relations:
+ if rel.this_declaring >= 0: continue
+ wr(delim)
+ wr(rel.other_flagname)
+ delim = '; '
+ print ''
+
+def do_embargoes_flag_of(args, bu):
+ progressreporter.doing('fetching flag info')
+ fi = prep_flag_of(args, bu)
+ if fi is None:
+ progressreporter.stop()
+ print 'Pirate is not in a flag.'
+ return
+
+ oi = OceanInfo(IslandFlagInfo)
+
+ progressreporter.stop()
+ print ''
+
+ any = False
+ for islename in sorted(oi.islands.keys()):
+ isle = oi.islands[islename]
+ flag = isle.flag
+ if flag is None: continue
+ for rel in flag.relations:
+ if rel.this_declaring >= 0: continue
+ if rel.other_flagid != fi.flagid: continue
+ if not any: print 'EMBARGOED:'
+ any = True
+ print " %-30s (%s)" % (islename, flag.name)
+ if not any:
+ print 'No embargoes.'
+ print ''
+
+ war_flag(fi)
+ print ''
+
+def do_war_flag_of(args, bu):
+ fi = prep_flag_of(args, bu)
+ war_flag(fi)
+
+def war_flag(fi):
+ any = False
+ for certain in [True, False]:
+ anythis = False
+ for rel in fi.relations:
+ if rel.this_declaring >= 0: continue
+ if (rel.other_declaring_max < 0) != certain: continue
+ if not anythis:
+ if certain: m = 'SINKING PvP'
+ else: m = 'RISK OF SINKING PvP'
+ print '%s (%s):' % (m, rel.yoweb_heading)
+ anythis = True
+ any = True
+ print " ", rel.other_flagname
+ if not any:
+ print 'No sinking PvP.'
+
+#----- modes which use the chat log parser are quite complex -----
+
class ProgressPrintPercentage:
def __init__(self, f=sys.stdout):
self._f = f
self._f.write(' \r')
self._f.flush()
-#----- modes which use the chat log parser are quite complex -----
-
def prep_chat_log(args, bu,
progress=ProgressPrintPercentage(),
max_myself_age=3600):
rotate_nya = '/-\\'
sort = NameSorter()
+ clicmd = None
+ clierr = None
+ cliexec = None
while True:
track.catchup()
now = time.time()
- (vn, s) = find_vessel()
- s = track.myname() + s
- s += " at %s" % time.strftime("%Y-%m-%d %H:%M:%S")
- s += kreader.info()
+ (vn, vs) = find_vessel()
+
+ s = ''
+ if cliexec is not None:
+ s += '...'
+ elif clierr is not None:
+ s += 'Error: '+clierr
+ elif clicmd is not None:
+ s += '/' + clicmd
+ else:
+ s = track.myname() + vs
+ s += " at %s" % time.strftime("%Y-%m-%d %H:%M:%S")
+ s += kreader.info()
s += '\n'
tbl_s = StringIO()
displayer.show(s)
tbl_s.close()
+ if cliexec is not None:
+ clierr = track.local_command("/"+cliexec.strip())
+ cliexec = None
+ continue
+
k = kreader.getch()
if k is None:
rotate_nya = rotate_nya[1:3] + rotate_nya[0]
continue
+ if clierr is not None:
+ clierr = None
+ continue
+
+ if clicmd is not None:
+ if k == '\r' or k == '\n':
+ cliexec = clicmd
+ clicmd = clicmdbase
+ elif k == '\e' and clicmd != "":
+ clicmd = clicmdbase
+ elif k == '\33':
+ clicmd = None
+ elif k == '\b' or k == '\177':
+ clicmd = clicmd[ 0 : len(clicmd)-1 ]
+ else:
+ clicmd += k
+ continue
+
if k == 'q': break
elif k == 'g': sort = SkillSorter('Gunning')
elif k == 'c': sort = SkillSorter('Carpentry')
elif k == 'd': sort = SkillSorter('Battle Navigation')
elif k == 't': sort = SkillSorter('Treasure Haul')
elif k == 'a': sort = NameSorter()
+ elif k == '/': clicmdbase = ""; clicmd = clicmdbase
+ elif k == '+': clicmdbase = "a "; clicmd = clicmdbase
else: pass # unknown key command
#---------- individual keystroke input ----------
#---------- main program ----------
def main():
- global opts, fetcher
+ global opts, fetcher, yppedia, progressreporter
pa = OptionParser(
'''usage: .../yoweb-scrape [OPTION...] ACTION [ARGS...]
yoweb-scrape [--ocean OCEAN ...] crew-of PIRATE
yoweb-scrape [--ocean OCEAN ...] standings-crew-of PIRATE
yoweb-scrape [--ocean OCEAN ...] track-chat-log CHAT-LOG
+ yoweb-scrape [--ocean OCEAN ...] ocean|embargoes
+ yoweb-scrape [--ocean OCEAN ...] war-flag-of|embargoes-flag-of PIRATE
yoweb-scrape [options] ship-aid CHAT-LOG (must be .../PIRATE_OCEAN_chat-log*)
display modes (for --display) apply to ship-aid:
ao('--display', action='store', dest='display',
type='choice', choices=['dumb','overwrite'],
help='how to display ship aid')
+ ao('--local-ypp-dir', action='store', dest='localhtml',
+ help='get yppedia pages from local directory LOCALHTML'+
+ ' instead of via HTTP')
ao_jt = lambda wh, t: ao(
'--timeout-sa-'+wh, action='store', dest='timeout_'+wh,
else:
opts.display = 'overwrite'
- fetcher = Fetcher(opts.ocean, opts.cache_dir)
+ fetcher = Yoweb(opts.ocean, opts.cache_dir)
+ yppedia = Yppedia(opts.cache_dir)
+
+ if opts.debug or not os.isatty(0):
+ progressreporter = NullProgressReporter()
+ else:
+ progressreporter = TypewriterProgressReporter()
mode_fn(args[1:], pa.error)
are weaker. This functionality is disabled if stdin is not a tty.
Other keystrokes:
q: quit the program (^C works too)
+ /: start entering a local extra commands (see below)
+ +: start entering local extra commands starting "/a"
+ ESC: clear local extra command or abandon local extra commands entry
Things you need to know:
next unless $size;
last if $size==$lastsize;
$lastsize= $size;
- select undef,undef,undef, 0.100;
+ select undef,undef,undef, 0.300;
}
$child= fork; defined $child or die $!;
--- /dev/null
+#!/usr/bin/wish
+
+proc manyset {list args} {
+ foreach val $list var $args {
+ upvar 1 $var my
+ set my $val
+ }
+}
+
+set progname ypp-chatlog-alerter
+set height 5
+
+proc menuent {w l a x} {
+ set c [list .mbar.$w add command -label $l -command $x]
+ if {[string length $a]} { lappend c -accel Command-$a }
+ eval $c
+}
+proc menus {} {
+ global height
+
+ menu .mbar -tearoff 0
+ foreach w {file edit} l {File Edit} {
+ menu .mbar.$w -tearoff 0
+ .mbar add cascade -menu .mbar.$w -label $l
+ }
+ foreach l {Open Quit} a {O Q} x {newfile exit} {
+ menuent file $l $a $x
+ }
+ foreach l {Cut Copy Paste Clear} a {X C V {}} {
+ menuent edit $l $a [list event generate {[focus]} <<$l>>]]
+ }
+ . configure -menu .mbar
+}
+
+proc nonportability {} {
+ global progname defaultfile
+
+ switch -exact [tk windowingsystem] {
+ aqua {
+ set defaultfile ~/Library/Preferences/$progname.prefs
+ }
+ x11 {
+ set defaultfile ~/.$progname.rc
+ }
+ default {
+ error ?
+ }
+ }
+}
+
+set lw_ls {times pirates messages}
+set lw_ws {.time .pirate .msg}
+
+proc widgets {} {
+ global height lw_ws prtimes
+ listbox .time -width 5 -background black \
+ -listvariable prtimes -foreground white
+ listbox .pirate -width 14 -background black
+ listbox .msg -width 80
+ for_lw {
+ $w configure -height $height -borderwidth 0 -activestyle none \
+ -highlightthickness 0
+ }
+ eval pack $lw_ws -side left
+ label .overlay -relief raised -foreground white
+}
+
+proc shownotice {colour message} {
+ .overlay configure -text $message -background $colour
+ place .overlay -relx 0.5 -rely 0.5 -anchor center
+}
+proc hidenotice {} {
+ place forget .overlay
+}
+
+proc newfile {} {
+ global currentfile defaultfile logfile
+
+ set newfile [tk_getOpenFile -multiple 0 -initialfile $currentfile \
+ -title "Select YPP log to track"]
+ if {![string length $newfile]} return
+
+ catch { close $logfile }
+ catch { unset logfile }
+
+ set currentfile $newfile
+ set newdefaults [open $defaultfile.new w]
+ puts $newdefaults "[list set currentfile $currentfile]"
+ close $newdefaults
+ file rename -force $defaultfile.new $defaultfile
+
+ clearlists
+ pollfile
+}
+
+proc for_lw {args} {
+ global lw_ls lw_ws
+ set body [lindex $args end]
+ set args [lreplace $args end end]
+ uplevel 1 [list \
+ foreach l $lw_ls \
+ w $lw_ws] \
+ $args \
+ [list $body]
+}
+
+set e_life 120
+set tint_switch 90
+set bell_again 60
+set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
+
+proc retint {} {
+ global times e_life retint_after otherevent prtimes
+ catch { after cancel $retint_after }
+ set i 0
+ set now [clock seconds]
+ set latest $otherevent
+ set newprtimes {}
+ foreach time $times {
+ set age [expr {$now-$time}]
+ if {!$time} {
+ lappend newprtimes {}
+ } elseif {$age < 60} {
+ lappend newprtimes [format "%3ds" $age]
+ } elseif {$age < 3600} {
+ lappend newprtimes [format "%3dm" [expr {$age/60}]]
+ } else {
+ lappend newprtimes [format "%3dh" [expr {$age/3600}]]
+ }
+ set latest [expr { $time > $latest ? $time : $latest }]
+ set tint [expr { exp( (-($age >= 0 ? $age : 0) + 0.0) / $e_life ) }]
+#puts "AGE $age LA $latest TI $tint"
+ tintentries .msg $i $tint
+ incr i
+ }
+ set prtimes $newprtimes
+ set next [expr { ($now - $latest < 10 ? 10 :
+ $now - $latest > 3000 ? 3000 :
+ $now - $latest
+ ) * 10 }]
+#puts "nexting $latest $now $next"
+ set retint_after [after $next retint]
+}
+
+proc tintentries {ws y tint} {
+ global tint_switched
+ #puts "$tint $tint_switched"
+ set yellow [format "%02x" [expr {round( 255 *
+ ( $tint >= $tint_switched ? $tint : 0 )
+ )}]]
+ set black [format "%02x" [expr {round( 255 *
+ ( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
+ )}]]
+ set fg [format "#${black}${black}${black}"]
+ set bg [format "#${yellow}${yellow}00"]
+ foreach w $ws { $w itemconfigure $y -foreground $fg -background $bg }
+}
+
+proc clearlists {} {
+ global height otherevent
+ global times prtimes pirates messages
+ set currentfile {}
+
+ for_lw { $w delete 0 end; set $l {} }
+ set ntimes {}
+ set prtimes {}
+ for {set i 0} {$i<$height} {incr i} {
+ for_lw { lappend $l {}; $w insert end {} }
+ lappend ntimes 0
+ lappend prtimes {}
+ }
+ set times $ntimes
+ set otherevent [clock seconds]
+ retint
+}
+
+proc showtints {} {
+ global e_life
+ set divs 20
+ listbox .tints -width 60 -height [expr {$divs+1}]
+ for {set y 0} {$y <= $divs} {incr y} {
+ set tint [expr {($y+0.0)/$divs}]
+ .tints insert end \
+ "[format "#%2d %6f %4ds" $y $tint [expr {round(
+ $tint > 0 ? -log($tint) * $e_life : "9999"
+ )}]] The quick brown fox jumped over the lazy dog"
+ tintentries .tints $y $tint
+ }
+ pack .tints -side bottom
+}
+
+proc file-read-lines {lvar body} {
+ upvar 1 $lvar l
+ global logfile poll_after lastactivity bufdata
+
+#puts f-r-l
+ if {![info exists logfile]} {
+ return
+ }
+ while 1 {
+ if {[catch { read $logfile } got]} {
+ file-error $got
+ return
+ }
+#puts "f-r-l [string length $got]"
+ if {![string length $got] && [eof $logfile]} {
+ set ago [expr { [clock seconds] - $lastactivity }]
+ set interval [expr {( $ago < 10 ? 10 :
+ $ago > 3000 ? 3000 :
+ $ago ) * 10}]
+#puts "requeue filepoll $interval"
+ set poll_after [after $interval pollfile]
+ return
+ }
+ set lastactivity [clock seconds]
+
+ while {[regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
+ set l "$bufdata$lhs"
+ set bufdata {}
+ set got $rhs
+#puts ">>$l<<"
+ uplevel 1 $body
+ }
+ append bufdata $got
+ }
+}
+
+proc file-error {emsg} {
+ global logfile
+
+ shownotice red "Error reading logfile $currentfile:\n$emsg"
+ catch { close $logfile }
+ catch { unset logfile }
+}
+
+proc pollfile {} {
+ global poll_after logfile currentfile
+ global errorCode errorInfo bufdata lastactivity
+
+ catch { after cancel $poll_after }
+ if {![string length $currentfile]} {
+ shownotice red "No log file selected. Use File / Open."
+ return
+ }
+ if {![info exists logfile]} {
+ set bufdata {}
+ set lastactivity [clock seconds]
+ if {[catch { set logfile [open $currentfile r] } emsg]} {
+ shownotice red "Error opening logfile $currentfile:\n$emsg"
+ return
+ }
+ shownotice \#000080 "Reading $currentfile"
+ if {[catch {
+ seek $logfile -1024 end
+ } emsg]} {
+ if {![string match {POSIX EINVAL *} $errorCode]} {
+ file-error $emsg
+ }
+ }
+ file-read-lines l { }
+ }
+ file-read-lines l {
+ hidenotice
+ if {[regexp {^\[\d+:\d+:\d+\] (.*)} $l dummy rhs]} {
+#puts PROCLINE
+ process-line $rhs
+ }
+ }
+}
+
+proc process-line {l} {
+ if {[regexp {^(\w+) tells ye, \"(.*)\"$} $l dummy pirate msg]} {
+#puts "MESSAGE $l"
+ message $pirate $msg
+ }
+}
+
+proc message {pirate msg} {
+ global times pirates messages height
+ global lw_ls lw_ws bell_again
+
+ set ix [lsearch -exact $pirates $pirate]
+ set now [clock seconds]
+
+ if {$bell_again > -2 &&
+ ($ix<0 || [lindex $times $ix] < $now-$bell_again)} {
+ bell -nice
+ }
+ if {$ix < 0} {
+ set cix 0
+ set oldest $now
+ foreach time $times {
+ if {$time < $oldest} {
+ set oldest $time
+ set ix $cix
+ }
+ incr cix
+ }
+ for_lw {
+ set $l [lreplace [set $l] $ix $ix]
+ lappend $l {}
+ $w delete $ix
+ $w insert end {}
+ }
+ set ix [expr {$height-1}]
+ }
+ for_lw new [list $now $pirate $msg] {
+ set $l [lreplace [set $l] $ix $ix $new]
+ $w delete $ix
+ $w insert $ix $new
+ }
+#puts "TIMES $times"
+ .pirate itemconfigure $ix -foreground white
+ retint
+}
+
+proc parseargs {} {
+ global argv
+ foreach arg $argv {
+ if {![string compare $arg --test-tints]} {
+ showtints
+ } elseif {![string compare $arg --no-bell]} {
+ set bell_again -2
+ } else {
+ error "unknown option $arg"
+ }
+ }
+}
+
+menus
+nonportability
+parseargs
+widgets
+clearlists
+
+if {[file exists $defaultfile]} {
+ source $defaultfile
+}
+
+pollfile
~yarrgweb / ypp-sc-tools.db-live.git / commitdiff