fogeval.pl

   1 use strict;
   2 use warnings;
   3
   4 # generates the blendfunc flags function in gl_rmain.c
   5
   6 my %blendfuncs =
   7 (
   8         GL_ONE                 => sub { (1, 1); },
   9         GL_ZERO                => sub { (0, 0); },
  10         GL_SRC_COLOR           => sub { ($_[0], $_[1]); },
  11         GL_ONE_MINUS_SRC_COLOR => sub { (1-$_[0], 1-$_[1]); },
  12         GL_SRC_ALPHA           => sub { ($_[1], $_[1]); },
  13         GL_ONE_MINUS_SRC_ALPHA => sub { (1-$_[1], 1-$_[1]); },
  14         GL_DST_COLOR           => sub { ($_[2], $_[3]); },
  15         GL_ONE_MINUS_DST_COLOR => sub { (1-$_[2], 1-$_[3]); },
  16         GL_DST_ALPHA           => sub { ($_[3], $_[3]); },
  17         GL_ONE_MINUS_DST_ALPHA => sub { (1-$_[3], 1-$_[3]); },
  18 );
  19
  20 sub evalblend($$$$$$)
  21 {
  22         my ($fs, $fd, $s, $sa, $d, $da) = @_;
  23         my @fs = $fs->($s, $sa, $d, $da);
  24         my @fd = $fd->($s, $sa, $d, $da);
  25         return (
  26                 $fs[0] * $s  + $fd[0] * $d,
  27                 $fs[1] * $sa + $fd[1] * $da
  28         );
  29 }
  30
  31 sub isinvariant($$$$)
  32 {
  33         my ($fs, $fd, $s, $sa) = @_;
  34         my ($d, $da) = (rand, rand);
  35         my ($out, $outa) = evalblend $fs, $fd, $s, $sa, $d, $da;
  36         return abs($out - $d) < 0.0001 && abs($outa - $da) < 0.0001;
  37 }
  38
  39 sub isfogfriendly($$$$$)
  40 {
  41         my ($fs, $fd, $s, $sa, $foghack) = @_;
  42         my ($d, $da) = (rand, rand);
  43         my $fogamount = rand;
  44         my $fogcolor = rand;
  45
  46         # compare:
  47         # 1. blend(fog(s), sa, fog(d), da)
  48         # 2. fog(blend(s, sa, d, da))
  49
  50         my ($out1, $out1a) = evalblend $fs, $fd, $s + ((defined $foghack ? $foghack eq 'ALPHA' ? $fogcolor*$sa : $foghack : $fogcolor) - $s) * $fogamount, $sa, $d + ($fogcolor - $d) * $fogamount, $da;
  51         my ($out2, $out2a) = evalblend $fs, $fd, $s, $sa, $d, $da;
  52                 $out2 = $out2 + ($fogcolor - $out2) * $fogamount;
  53
  54         return abs($out1 - $out2) < 0.0001 && abs($out1a - $out2a) < 0.0001;
  55 }
  56
  57 use Carp;
  58 sub decide(&)
  59 {
  60         my ($sub) = @_;
  61         my $good = 0;
  62         my $bad = 0;
  63         for(;;)
  64         {
  65                 for(1..200)
  66                 {
  67                         my $r = $sub->();
  68                         ++$good if $r;
  69                         ++$bad if not $r;
  70                 }
  71                 #print STDERR "decide: $good vs $bad\n";
  72                 return 1 if $good > $bad + 150;
  73                 return 0 if $bad > $good + 150;
  74                 warn "No clear decision, continuing to test ($good : $bad)";
  75         }
  76 }
  77
  78 #die isfogfriendly $blendfuncs{GL_ONE}, $blendfuncs{GL_ONE}, 1, 0, 0;
  79 # out1 = 0 + fog($d)
  80 # out2 = fog(1 + $d)
  81
  82 sub willitblend($$)
  83 {
  84         my ($fs, $fd) = @_;
  85         for my $s(0, 0.25, 0.5, 0.75, 1)
  86         {
  87                 for my $sa(0, 0.25, 0.5, 0.75, 1)
  88                 {
  89                         if(decide { isinvariant($fs, $fd, $s, $sa); })
  90                         {
  91                                 if(!decide { isinvariant($fs, $fd, 0, $sa); })
  92                                 {
  93                                         return 0; # no colormod possible
  94                                 }
  95                         }
  96                 }
  97         }
  98         return 1;
  99 }
 100
 101 sub willitfog($$)
 102 {
 103         my ($fs, $fd) = @_;
 104
 105         FOGHACK:
 106         for my $foghack(undef, 0, 'ALPHA')
 107         {
 108                 for my $s(0, 0.25, 0.5, 0.75, 1)
 109                 {
 110                         for my $sa(0, 0.25, 0.5, 0.75, 1)
 111                         {
 112                                 if(!decide { isfogfriendly($fs, $fd, $s, $sa, $foghack); })
 113                                 {
 114                                         next FOGHACK;
 115                                 }
 116                         }
 117                 }
 118                 return (1, $foghack);
 119         }
 120         return (0, undef);
 121 }
 122
 123 print "\tr |= BLENDFUNC_ALLOWS_COLORMOD;\n";
 124 for my $s(sort keys %blendfuncs)
 125 {
 126         for my $d(sort keys %blendfuncs)
 127         {
 128                 #print STDERR "$s $d\n";
 129                 if(!willitblend $blendfuncs{$s}, $blendfuncs{$d})
 130                 {
 131                         print "\tif(src == $s && dst == $d) r &= ~BLENDFUNC_ALLOWS_COLORMOD;\n";
 132                 }
 133                 my ($result, $h) = willitfog $blendfuncs{$s}, $blendfuncs{$d};
 134                 if($result)
 135                 {
 136                         if(defined $h)
 137                         {
 138                                 print "\tif(src == $s && dst == $d) r |= BLENDFUNC_ALLOWS_FOG_HACK$h;\n";
 139                         }
 140                         else
 141                         {
 142                                 print "\tif(src == $s && dst == $d) r |= BLENDFUNC_ALLOWS_FOG;\n";
 143                         }
 144                 }
 145         }
 146 }
 147