From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sat, 31 Oct 2009 15:51:45 +0000 (+0000)
Subject: commodity ordering: support @..+ syntax in % defs
X-Git-Tag: 6.0~29
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=commitdiff_plain;h=9140d5a3e99e6b98d3f792cb1f82e4d7a0e116d7

commodity ordering: support @..+ syntax in % defs
---

diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm
index 74c52f0..d9e9d34 100644
--- a/yarrg/Commods.pm
+++ b/yarrg/Commods.pm
@@ -92,6 +92,7 @@ our %commods;
 # eg $commods{'Fine black cloth'}{Srcs}= $sources;
 # eg $commods{'Fine black cloth'}{Mass}= 700 [g]
 # eg $commods{'Fine black cloth'}{Volume}= 1000 [ml]
+# eg $commods{'Fine black cloth'}{Ordval}= 203921
 
 our (%pctb_commodmap,@pctb_commodmap);
 
@@ -120,11 +121,13 @@ sub parse_info1 ($$$) {
 	if (m/^\%(\w+)$/) {
 	    my $colourkind= $1;
 	    @ctx= (sub {
-		m/^(\S[^\t@]+\S)(?:\t+\@(\d+))?$/ or die;
+		m/^(\S[^\t@]*\S)(?:\t+\@(\d+\+?))?$/ or die "$_ ?";
 		my ($colour,$order)=($1,$2);
 		$colours{$colourkind}{$colour} .= $src;
-		$colour_ordvals{$colourkind}{$colour}= $order
-		    if defined $order;
+		if (defined $order) {
+		    $order =~ s/^(\d+)\+$/ $1  + $. * 10 /e;
+		    $colour_ordvals{$colourkind}{$colour}= $order;
+		}
 	    });
 	} elsif (m/^commods$/) {
 	    @ctx= (sub { push @rawcm, lc $_; });
@@ -210,7 +213,7 @@ sub parse_info1 ($$$) {
 		} elsif ($prop =~ m/^\*([-a-z]+)$/) {
 		    $c->{Class}= $1;
 		    die "$1" unless exists $commodclasses{$1};
-		    $ordclassval= $commodclasses{$1} * 1000000;
+		    $ordclassval= 1e7 + $commodclasses{$1} * 1e7;
 		} elsif ($prop =~ m/^\@(\d+)$/) {
 		    $ordval= $1;
 		} else {
@@ -220,9 +223,9 @@ sub parse_info1 ($$$) {
 	    if (defined $ordbase && defined $ordval && defined $ordclassval) {
 		my $ordvalout= $ordbase + $ordval + $ordclassval;
 		$c->{Ordval}= $ordvalout;
-print STDERR "ordval $ordvalout $name OV=$ordval OB=$ordbase OCV=$ordclassval\n";
+#print STDERR "ordval $ordvalout $name OV=$ordval OB=$ordbase OCV=$ordclassval\n";
 	    } else {
-print STDERR "ordval NONE $name\n";
+#print STDERR "ordval NONE $name\n";
             }
 	    return;
 	}