chiark / gitweb /
commodity ordering: support @..+ syntax in % defs
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 31 Oct 2009 15:51:45 +0000 (15:51 +0000)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sat, 31 Oct 2009 15:51:45 +0000 (15:51 +0000)
yarrg/Commods.pm

index 74c52f036d4742ae226b7a2d816122ce5b29a44a..d9e9d34e48214fc3bfb5bb5168dff3e3572dc76b 100644 (file)
@@ -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;
        }