PPD: Constraints

ppd/PPD.pm

@@ -4,10 +4,11 @@ use strict;
 use warnings;
 
 use Exporter 'import';
-our @EXPORT = qw(define_group define_ui_group switch_group declare get set maybe_set option gen_values generate);
+our @EXPORT = qw(define_group define_ui_group switch_group declare get set maybe_set option constrain gen_values generate);
 
 ### PPD data model ###
 
+### Keywords ###
 # Key => {
 #	Key => key,
 #	Name => name,		# descriptive name (default: same as Key)
@@ -36,6 +37,7 @@ our @EXPORT = qw(define_group define_ui_group switch_group declare get set maybe
 # }
 my %keywords = ();
 
+### Groups ###
 # Key => {
 #	Key => key,
 #	UI => 1,		# if a UI group
@@ -48,6 +50,18 @@ my @ui_groups = ();
 my @nonui_groups = ();
 my $current_group_key;
 
+### Constraints ###
+# {
+# 	Name => name,
+# 	Pairs => [{
+#		K1 => key,
+#		V1 => value,
+#		K2 => key,
+#		V2 => value,
+#	}],
+# ]
+my @constraints = ();
+
 sub define_group($$) {
 	my ($key, $g) = @_;
 	!defined $groups{$key} or die "Group $key already exists\n";
@@ -137,6 +151,26 @@ sub option($) {
 	push @{$g->{Keywords}}, $o;
 }
 
+sub constrain($$$$) {
+	my ($name, $k1, $k2, $condition) = @_;
+	$name //= "$k1 vs. $k2";
+	my $kw1 = $keywords{$k1} or die "Want to create constraint for unknown keyword $k1\n";
+	my $kw2 = $keywords{$k2} or die "Want to create constraint for unknown keyword $k2\n";
+	$kw1->{Type} eq 'o' && $kw2->{Type} eq 'o' or die "Want to create constraint between non-option keywords $k1 and $k2\n";
+	my @c = ();
+	for my $vv1 (@{$kw1->{Values}}) {
+		for my $vv2 (@{$kw2->{Values}}) {
+			my $v1 = $vv1->{Key};
+			my $v2 = $vv2->{Key};
+			if (! &{$condition}($v1, $v2)) {
+				push @c, { K1 => $k1, V1 => $v1, K2 => $k2, V2 => $v2 };
+				push @c, { K1 => $k2, V1 => $v2, K2 => $k1, V2 => $v1 };
+			}
+		}
+	}
+	push @constraints, { Name => $name, Pairs => [@c] } if @c;
+}
+
 ### Auxiliary functions ###
 
 sub gen_values($@) {
@@ -291,7 +325,21 @@ sub emit_group($) {
 	for my $k (@$keywords) {
 		emit_keyword($k);
 	}
-	if ($g->{UI}) { print "\n", '*CloseGroup: ', $g->{Key}, "\n"; }
+	if ($g->{UI}) { print '*CloseGroup: ', $g->{Key}, "\n"; }
+}
+
+sub emit_constraints() {
+	for my $cc (@constraints) {
+		heading($cc->{Name});
+		for my $c (@{$cc->{Pairs}}) {
+			printf "*%sUIConstraints: *%s %s *%s %s\n",
+				((!$keywords{$c->{K1}}->{Choice} || !$keywords{$c->{K2}}->{Choice})) ? "Non" : "",
+				$c->{K1},
+				$c->{V1},
+				$c->{K2},
+				$c->{V2};
+		}
+	}
 }
 
 sub fill_defaults() {
@@ -331,6 +379,8 @@ sub generate() {
 	for my $g (@head_groups, @ui_groups, @nonui_groups) {
 		emit_group($groups{$g});
 	}
+
+	emit_constraints();
 }
 
 42;

ppd/gen-hp

@@ -122,4 +122,15 @@ option({
 	],
 });
 
+constrain(undef, 'InputSlot', 'MediaType', sub {
+	my ($is, $mt) = @_;
+	return !(($is eq 'Tray2' || $is eq 'Tray3') &&
+		 ($mt eq 'Labels' || $mt eq 'Envelope'));
+});
+
+constrain(undef, 'Duplex', 'MediaType', sub {
+	my ($dp, $mt) = @_;
+	return !($dp ne 'None' && $mt =~ /^(Labels|Transparency|Bond)$/);
+});
+
 generate();