#!/usr/bin/perl

use strict;

use Getopt::Long;
use File::Basename qw/basename/;
use File::Path qw/make_path/;
use File::Spec::Functions qw/catfile/;

use constant DEBUG => 0;

my $script = basename(__FILE__);

my %o = (
  width     => 320,
  height    => 240,
  name      => 'bitmap',
  alpha     => -1,
  ops       => '',
  format    => 'yuv444',
  pack      => 0,
  load      => 'right',
  bandwidth => 64,
  threshold => 128,
  help      => 0,
);

my %fmt = (
  argb   => \&pixel_to_argb,
  rgb888 => \&pixel_to_rgb888,
  yuv444 => \&pixel_to_yuv444,
  yuyv   => \&pixel_to_yuyv,
  uyvy   => \&pixel_to_uyvy,
);

my %ops = (blend => \&blend_bitmap, vflip => \&vfilp_bitmap,
  hflip => \&hflip_bitmap,);

GetOptions(
  "width|w=i"     => \$o{width},
  "height|h=i"    => \$o{height},
  "name|n=s"      => \$o{name},
  "alpha|a=i"     => \$o{alpha},
  "ops|o=s"       => \$o{ops},
  "format|f=s"    => \$o{format},
  "pack|p"        => \$o{pack},
  "load|l=s"      => \$o{load},
  "bandwidth|b=i" => \$o{bandwidth},
  "threshold|t=i" => \$o{threshold},
  "help|?"        => \$o{help},
);

usage() if $o{help};

die "unsupported format: $o{format}" unless $fmt{$o{format}};

# main

my $dir = shift || '.';
make_path($dir) if $dir ne '.' && !-e $dir;

my %paths = map { ($_, catfile($dir, "$o{name}_$_.txt")) }
  (qw/base arg info/, keys %ops);

print "generate bitmaps...\n";
my %bitmaps = (
  base => gen_bitmap(@o{qw/width height alpha/}),
  arg  => gen_bitmap(@o{qw/width height/}, 0),
);

for my $op (split /,/, $o{ops}) {
  if ($ops{$op}) {
    print "process operation: $op\n";
    $bitmaps{$op} = $ops{$op}->(@bitmaps{qw/base arg/});
  }
  else {
    die "unsupported operation: $op";
  }
}

# information for base bitmap only
my %infos
  = map { $_ => {name => $_, width => $o{width}, height => $o{height}} }
  qw/base/;

print "output bitmaps: " . join(', ', sort keys %bitmaps), "\n";
print_bitmap($bitmaps{$_}, $paths{$_}, $infos{$_}) for keys %bitmaps;
print "done\n";

print "output information\n";
print_info($infos{base}, $paths{info});
print "done\n";

# subs

sub usage {
  print <<"HELP";
NAME
  $script - generate bitmap for test

SYNOPSIS
  $script [<options>] [directory]

DESCRIPTION
  <direcory>: the out put direcory, default as '.'

OPTIONS
  --width -w (default: @{[$o{width}]})
    width of the bitmap

  --height -h (default: @{[$o{height}]})
    height of the bitmap

  --name -n (default: @{[$o{name}]})
    name of the output file

  --alpha -a (default: @{[$o{alpha}]})
    alpha value [0 .. 255], random value will be used if the
    given value is out of the valid range

  --ops -o (default: @{[$o{ops}]})
    operations applied to the generated bitmap, support multiple ones
    which joined by ",", e.g. "vflip,hflip", all the supported ones are:
    [@{[join ", ", sort keys %ops]}]

  --format -f (default: @{[$o{format}]})
    output format, the supported ones are:
    [@{[join ", ", sort keys %fmt]}]

  --pack -p (default: @{[$o{pack}]})
    output the packed value for each pixel, otherwise one byte for each line

  --load -l (default: @{[$o{load}]})
    supported load direction are:
    [left, right]

  --bandwidth -b (default: @{[$o{bandwidth}]})
    bandwidth of the bus

  --threshold -t (default: @{[$o{threshold}]})
    threshold of the pixel value

  --help -?
    you got it
HELP

  exit;
}

sub gen_rand_val { int(rand(0xff + 1)) }

sub gen_one_pixel {
  my $alpha = shift || 0;

  return {
    r => gen_rand_val,
    g => gen_rand_val,
    b => gen_rand_val,
    a => $alpha < 0 || $alpha > 0xff ? gen_rand_val : $alpha,
  };
}

sub blend_one_pixel {
  my $b = shift or die;
  my $a = shift or die;
  my $c = {a => 0};

  # only use base's alpha
  my $alpha = $b->{a};
  for (qw/r g b/) {
    $c->{$_} = int(($b->{$_} * $alpha + $a->{$_} * (0xff - $alpha)) / 0xff);
  }

  return $c;
}

sub gen_bitmap {
  my $w = shift or die;
  my $h = shift or die;
  my $a = shift || 0;

  my @bitmap;
  for (1 .. $h) {
    push @bitmap, [map { gen_one_pixel($a) } 1 .. $w];
  }
  return \@bitmap;
}

sub blend_bitmap {
  my $b = shift or die;
  my $a = shift or die;

  my $c = [];
  for my $i (0 .. $#{$b}) {
    push @$c,
      [map { blend_one_pixel($b->[$i][$_], $a->[$i][$_]) } 0 .. $#{$b->[$i]}];
  }

  return $c;
}

sub vfilp_bitmap {
  my $b = shift or die;

  my $c = [reverse @$b];

  return $c;
}

sub hflip_bitmap {
  my $b = shift or die;

  my $c = [];
  for my $l (@$b) {
    push @$c, [reverse @$l];
  }

  return $c;
}

sub print_bitmap {
  my $bitmap = shift or die;
  my $path   = shift or die;
  my $info   = shift;

  my $shader = $fmt{$o{format}} or die;
  my $pack = $o{pack};

  open my $fh, '>', $path or die;
  my $oldfh = select $fh;
  for my $l (@$bitmap) {
    $shader->($_, $pack, $info) for @$l;
  }
  select $oldfh;
  close $fh;
}

sub get_shift_op {
  my $left = shift;
  if ($left) {
    return sub {
      shift @{$_[0]};
      push @{$_[0]}, $_[1];
    };
  }
  else {
    return sub {
      pop @{$_[0]};
      unshift @{$_[0]}, $_[1];
    };
  }
}

sub load_data {
  my $list = shift or die;
  my $size = shift || 64;
  my $left = shift;         # shift left or not
  my $dval = shift;         # default value

  # default values
  $left = 1 unless defined $left;
  $dval = 0 unless defined $dval;

  $list = [@{$list}[0 .. $size]] if @$list > $size;

  my @result = ($dval) x $size;
  my $op     = get_shift_op($left);

  $op->(\@result, $_) for @$list;

  return \@result;
}

sub print_info {
  my $info = shift or die;
  my $path = shift or die;

  open my $fh, '>', $path or die;
  my $oldfh = select $fh;

  print "WORD qr_calc_counter[256]={\n";
  print
    join(",\n", map { sprintf '%06x', $info->{count}{$_} } reverse 0 .. 255);
  print "\n}\n";

  my $left = $o{load} eq 'left';
  my $bw   = $o{bandwidth};
  my $w    = $info->{width};

  my $mask = $info->{mask};
  print "\nmask={\n";
  for (my $i = 0; $i < length $mask; $i += $w) {
    my $line = substr($mask, $i, $w);
    for (my $j = 0; $j < $w; $j += $bw) {
      my $shot = substr $line, $j, $bw;

      if (DEBUG) {
        print "[DEBUG] input  bin: $shot\n";
      }
      $shot = join '', @{load_data([split(//, $shot)], $bw, $left)};
      if (DEBUG) {
        print "[DEBUG] output bin: $shot\n";
      }

      print unpack("H*", pack("B$bw", $shot)), "\n";
    }
  }
  print "}\n";

  my @list = @{$info->{luma}};
  my $size = $o{bandwidth} / 8;
  print "\nluma={\n";
  while (my @l = splice @list, 0, $w) {
    while (my @p = splice @l, 0, $size) {
      if (DEBUG) {
        my $s = join '', map { sprintf '%02x', $_ } @p;
        print "[DEBUG] input  hex: $s\n";
      }
      my $d = load_data(\@p, $size, $left);

      print join('', map { sprintf '%02x', $_ } @$d), "\n";
    }
  }
  print "}\n";

  select $oldfh;
  close $fh;
}

sub print_pixel {
  my ($attr, $pixel, $pack, $info) = @_;

  if ($info) {

    # only check luma channel
    if (defined(my $v = $pixel->{y})) {
      push @{$info->{luma}}, $v;
      $info->{count}{$v}++;
      $info->{mask} .= $v > $o{threshold} ? 1 : 0;
    }
  }

  local $\ = "\n";

  if ($pack) {
    print sprintf('%02x' x @$attr, @{$pixel}{@$attr});
  }
  else {
    print sprintf('%02x', $_) for @{$pixel}{@$attr};
  }
}

sub pixel_to_argb   { print_pixel([qw/a r g b/], @_) }
sub pixel_to_rgb888 { print_pixel([qw/r g b/],   @_) }

sub pixel_to_yuv444 {
  print_pixel([qw/y u v/], rgb2yuv(shift), @_);
}

sub pixel_to_yuyv {
  print_pixel([qw/y u/], rgb2yuv(shift), @_);
}

sub pixel_to_uyvy {
  print_pixel([qw/u y/], rgb2yuv(shift), @_);
}

sub rgb2yuv {
  my ($r, $g, $b) = @{$_[0]}{qw/r g b/};
  return {
    y => 0xff & (((66 * $r + 129 * $g + 25 * $b + 128) >> 8) + 16),
    u => 0xff & (((-38 * $r - 74 * $g + 112 * $b + 128) >> 8) + 128),
    v => 0xff & (((112 * $r - 94 * $g - 18 * $b + 128) >> 8) + 128),
  };
}