manticore/uniworx.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Tk;

use Data::Dumper;

# Wir wollen keine , in Dezimalbruechen. Wer kommt nur auf solche Ideen?
use POSIX;
setlocale(LC_NUMERIC, "C");

BEGIN {
  unshift @INC, '.';
};

use Manticore::Mantis;

#my %font = ();

my $logoDist = 0;
my $logoDist2 = 0;

sub refont {
  Manticore::Mantis::fontLoader(dir => "fonts/uwx");
}

refont();

my $graysim = 0;

sub col {
  my ($R,$G,$B,$mkgray) = @_;
  if($mkgray) {
    my $mid = ($R+$G+$B)/3;
    $R = $mid;
    $G = $mid;
    $B = $mid;
  }
  my $r = int($R*255);
  my $g = int($G*255);
  my $b = int($B*255);
  for($r,$g,$b) { $_=0 if $_<0; $_=255 if $_>255 }
  sprintf("#%02x%02x%02x",$r,$g,$b);
}

my $main = MainWindow->new();

my $can = $main->Canvas(-background=>'#ffffff',-width=>700,-height=>700)->pack(-side=>'left');
my $scrolls = $main->Frame(-width=>350,-height=>300,-background=>'#000000')->pack(-side=>'left',-expand=>0);

#$scrolls->Label(-text=>"                                      ")->pack;

#renderOutline(5, 425,200,30, "X", '#000000');
#render(425,200,30, "X", '#ff0000');
#renderOutline(5, 200,200,30, "W", '#000000');
#render(200,200,30, "W", '#ff0000');
#renderOutline(5, 185,200,30, "U", '#000000');
#render(185,200,30, "U", '#ff0000');


#renderOutline(5, 415,200,30, "X", '#000000');
#render(415,200,30, "X", '#553080');
#renderOutline(5, 200,200,30, "W", '#000000');
#render(200,200,30, "W", '#88409e');
#renderOutline(5, 195,200,30, "U", '#000000');
#render(195,200,30, "U", '#aa50bb');

#my $r1 = 0.3;
#my $g1 = 0.3;
#my $b1 = 0.8;
#my $r0 = 0.55;
#my $g0 = 0.15;
#my $b0 = 0.15;

#$scrolls->Checkbutton(-text=>'draw grayscale',-variable=>\$graysim,-command=>sub {renderAll()})->pack;

my $r1 = 0.4;
my $g1 = 0.4;
my $b1 = 0.8;
my $r0 = 0.2;
my $g0 = 0.2;
my $b0 = 0.5;

for(
  ['r',\$r0,'#ff0000'],
  ['g',\$g0,'#00ff00'],
  ['b',\$b0,'#0000ff'],
  ['r',\$r1,'#ff0000'],
  ['g',\$g1,'#00ff00'],
  ['b',\$b1,'#0000ff'],
) {
  #$scrolls->Scrollbar(-orient=>'horizontal')->pack(-fill=>'x');
  my $row = $scrolls->Frame->pack(-fill=>'x');
  $row->Label(-text=>$_->[0],-width=>2,-background=>$_->[2])->pack(-side=>'left');
  #$row->Scrollbar(-orient=>'horizontal',-command=>sub {print "[[ @_ ]]\n"; return 1})->pack(-expand=>1,-fill=>'x',-side=>'left');
  my $vb = $_->[1];
  $row->Scale(-orient=>'horizontal',-length=>200,-variable=>$vb,-resolution=>-1,-from=>0,-to=>1,
  -command=>sub {
    my $v = shift;
    #print "[[ @_ ]]\n"; return 1
    #$$vb = $v/100;
    renderAll();
  })->pack(-side=>'left')
}

$scrolls->Scale(-orient=>'horizontal',-length=>200,-variable=>\$logoDist,-resolution=>-1,-from=>0,-to=>100,
  -command=>sub {
    renderAll();
  })->pack();
$scrolls->Scale(-orient=>'horizontal',-length=>200,-variable=>\$logoDist2,-resolution=>-1,-from=>-20,-to=>20,
  -command=>sub {
    renderAll();
  })->pack();

my $dunkelbg = '#333333';
my $hellbg = '#cccccc';

sub renderAll {
  $can->delete('all');
	
  renderOutline(5, 415+$logoDist,120,30, "X", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  render(415+$logoDist,120,30, "X", col($r0,$g0,$b0,0));
  renderOutline(5, 200,120,30, "W", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  render(200,120,30, "W", col(($r0+$r1)/2,($g0+$g1)/2,($b0+$b1)/2,0));
  renderOutline(5, 165-$logoDist,120,30, "U", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  render(165-$logoDist,120,30, "U", col($r1,$g1,$b1,0));
	
  renderOutline(5, 415+$logoDist,340,30, "X", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  render(415+$logoDist,340,30, "X", col($r0,$g0,$b0,1));
  renderOutline(5, 200,340,30, "W", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  render(200,340,30, "W", col(($r0+$r1)/2,($g0+$g1)/2,($b0+$b1)/2,1));
  renderOutline(5, 165-$logoDist,340,30, "U", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  render(165-$logoDist,340,30, "U", col($r1,$g1,$b1,1));

  #  renderOutline(5, 120,220,50, "R", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
  #render(120,220,50, "R", col(0.5,1,0,0)); 

  my $i = 0;
  for my $c(reverse (
      [185,0.0,"U"],
      [235,0.1666,"N"],
      [285,0.3333,"I"],
      [320,0.5,"W2"],
      [410,0.6666,"O"],
      [450,0.8333,"R"],
      [502,1,"X"],
    )) {
    my $dx = $i*$logoDist2;
    $i++;
    renderOutline(2, $c->[0]+$dx,570,10, $c->[2], [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
    render($c->[0]+$dx,570,10, $c->[2], col($r0*$c->[1]+$r1*(1-$c->[1]),$g0*$c->[1]+$g1*(1-$c->[1]),$b0*$c->[1]+$b1*(1-$c->[1]),0));
  }
}

renderAll();



MainLoop;

sub renderOutline {
  my ($diff, $x, $y, $size, $letter, $col) = @_;
  my @where = (
            [$diff,-$diff],
            [-$diff,-$diff],
            [-$diff,$diff],
            [$diff,$diff],
    );
  for(0..$#where) {
    my ($dx, $dy) = @{$where[$_]};
    my $scol = ref $col ? $col->[$_] : $col;
    render($dx+$x, $dy+$y, $size, $letter, $scol);
  }
}

sub render {
  my ($x,$y,$scale,$t, $col) = @_;
  my $font = Manticore::Mantis::glyphemDisplay($t) or die "Letter not found: $t";
  #print Data::Dumper::Dumper($font);
  for my $frag(@{$font}) {
    my @newpoly = map {$scale*$_} @{$frag};
    for(0..$#newpoly) {
      $newpoly[$_] += ($_ % 2) == 0 ? $x : $y
    }
    $can->createPolygon(@newpoly, -fill=>$col, -outline=>undef);
  }
}