manticore/manticore.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Tk;

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

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

use Manticore::Mantis;

my $sticky = 0;
my $helplines = "1:2";

#my @display = ();
my @edit = ();
#(
#  [2.3,3, 3.3,3, 4.8,6, 3.8,6],
#  [0,6, 1,6, 4,0, 3,0],
#  [2,2.5, 4,2.5, 4,3.5, 2,3.5],
#  [5,1, 3,1, 3,0, 5.5,0, 6,0.5, 6.25,1, 5.125,3.25, 4.5,3.5, 3,3.5, 3,2.5, 4.575,2.5, 5.2,1.25,],
#);
my $fgi = 1;

my $gl = shift @ARGV;
$gl = 'W' unless defined $gl;
if(defined $gl) {
  my $path = "fonts/uwx";
  my $icon = $gl;
  if($gl=~m#(.*)/(.*)\.mant#) {
    $path = $1;
    $icon = $2;
  }
  Manticore::Mantis::fontLoader(dir=>$path);
  #@bg = @{$Manticore::Mantis::font{$gl}{data}};
  #@display = @{Manticore::Mantis::glyphemDisplay($gl)};
  @edit = @{Manticore::Mantis::glyphemData($icon)};
  $fgi = 0;
}

my $offset = 60;

my $scale = 80;

my $main = MainWindow->new();

my $can = $main->Canvas(-background=>'#ffffff',-width=>700,-height=>700)->pack(-side=>'left');

my $frame = $main->Frame->pack(-side=>'left');

for my $i(0..$#edit) {
  #my $rowdata = $display[$i];
  my $row = $frame->Frame->pack;
  $row->Radiobutton(-value=>$i, -variable=>\$fgi, -command=>sub {draw(); loadtextblock()})->pack;
}

my $textarea = $frame->Text->pack();

$frame->Button(-text=>'apply', -command=>sub { usetextblock(); draw() })->pack();

$frame->Label(-text=>'Sticky')->pack;
my $stickyframe = $frame->Frame->pack;

for(['None', 0], [1,1], [2,2], [4,4], [8,8]) {
  $stickyframe->Radiobutton(-text=>$_->[0],-value=>$_->[1],-variable=>\$sticky)->pack(-side=>'left');
}

$frame->Label(-text=>'Help lines')->pack;
my $helplineframe = $frame->Frame->pack;
for("1:2", "1:1") {
  $helplineframe->Radiobutton(-text=>$_,-value=>$_,-variable=>\$helplines, -command=>sub {draw()})->pack(-side=>'left');
}

sub one {
  my ($data, $col, $hl) = @_;
  my $display = Manticore::Mantis::rowData2display($data);
  $can->createPolygon((map {$_*$scale+$offset} @$display), -fill=>$col, -outline=>undef);
  if($hl) {
    for(0..$#$data) {
      my $xy0 = $data->[$_-1];
      my $xy1 = $data->[$_];
      next unless 'ARRAY' eq ref $xy0;
      next unless 'ARRAY' eq ref $xy1;
      my $x0 = $xy0->[0];
      my $y0 = $xy0->[1];
      my $x1 = $xy1->[0];
      my $y1 = $xy1->[1];
      my $dx = abs($x1-$x0);
      my $dy = abs($y1-$y0);
      my $epsilon = 0.0000001;
      my $horvert = $dx < $epsilon || $dy < $epsilon;
      my $diag = sub {'1:2' eq $helplines
        ? abs($dx/$dy-2) < $epsilon || abs($dy/$dx-2) < $epsilon
	: abs($dx/$dy-1) < $epsilon && abs($dy/$dx-1) < $epsilon
        }
	;
      if($horvert || $diag->()) {
        $can->createLine((map {$_*$scale+$offset} ($x0,$y0,$x1,$y1)), -fill=>'#0000ff', -width=>4);
      } else {
        $can->createLine((map {$_*$scale+$offset} ($x0,$y0,$x1,$y1)), -fill=>'#888888', -width=>2);
      }
    }
  }
}

sub draw {
  $can->delete('all');
  one($_,'#444444', 0) for @edit;
  one($edit[$fgi], '#aaaa00', 1);
  for my $cx(0..20) {
    my $x = $cx*$scale+$offset;
    for my $cy(0..20) {
      my $y = $cy*$scale+$offset;
      $can->createOval($x-5,$y-5,$x+5,$y+5,-fill=>'#0000aa',-outline=>undef);
    }
  }
  my $fg = $edit[$fgi];
  for my $i(0..$#$fg) {
    my $xy = $fg->[$i];
    next unless 'ARRAY' eq ref $xy;
    my $cx = $xy->[0];
    my $cy = $xy->[1];
    my $x = $cx*$scale+$offset;
    my $y = $cy*$scale+$offset;
    $can->createOval($x-7,$y-7,$x+7,$y+7,-fill=>'#bb0000',-outline=>undef);
    $i += 2;
  }
}

draw();
loadtextblock();

my $pressed = 0;
my $pressedInd = undef;

$can->Tk::bind('<1>'=>[sub {
  my (undef,$x,$y) = @_;
  ($x,$y) = map {($_-$offset)/$scale} ($x,$y);
  my ($eins) = closest($x,$y);
  $pressedInd = $eins;
  $pressed = 1;
  #@{$display[$fgi]}[$pressedInd,$pressedInd+1] = ($x,$y);
  $edit[$fgi][$pressedInd] = makeSticky([$x,$y]);
  draw();
}, Ev('x'), Ev('y')]);
$can->Tk::bind('<Motion>'=>[sub {
  return unless $pressed;
  my (undef,$x,$y) = @_;
  ($x,$y) = map {($_-$offset)/$scale} ($x,$y);
  #@{$display[$fgi]}[$pressedInd,$pressedInd+1] = ($x,$y);
  $edit[$fgi][$pressedInd] = makeSticky([$x,$y]);
  draw();
}, Ev('x'), Ev('y')]);
$can->Tk::bind('<ButtonRelease-1>'=>sub {$pressed = 0});
$can->Tk::bind('<3>'=>[sub {
  my (undef,$x,$y) = @_;
  ($x,$y) = map {($_-$offset)/$scale} ($x,$y);
  my ($eins,$zwei) = closest($x,$y);
  my $fg = $edit[$fgi];
  my $xy1 = $fg->[$eins];
  my ($x1,$y1) = @{$xy1};
  my $dx = $x-$x1;
  my $dy = $y-$y1;
  if($dx*$dx + $dy*$dy < 0.01) {
    splice(@$fg, $eins, 1);
  } else {
    print "<$eins $zwei>\n";
    my $newind = 0;
    if($zwei > $eins || 0==$zwei) {
      $newind = $eins+1
    } else {
      $newind = $zwei+1
    }
    splice(@$fg, $newind, 0, [$x,$y]);
  }
  draw();
}, Ev('x'), Ev('y')]);

# return the ids from the closet entry to the farest
sub closest {
  my ($x,$y) = @_;
  my $fg = $edit[$fgi];
  my @dists = ();
  for my $i(0..$#$fg) {
    my $txy = $fg->[$i];
    next unless 'ARRAY' eq ref $txy;
    my $tx = $txy->[0];
    my $ty = $txy->[1];
    my $dx = $x-$tx;
    my $dy = $y-$ty;
    push @dists, [$dx*$dx+$dy*$dy, $i, $tx,$ty];
  }
  @dists = sort {$a->[0] <=> $b->[0]} @dists;
  map {$_->[1]} @dists
}

MainLoop;

sub makeSticky {
  my $xy = shift;
  my $x = $xy->[0];
  my $y = $xy->[1];
  if($sticky > 0.5) {
    $_ = POSIX::floor($_*$sticky+0.5)/$sticky for $x,$y
  }
  return [$x,$y]
}

sub loadtextblock {
  $textarea->delete('1.0','end');
  $textarea->insert('end', Manticore::Mantis::rowData2text($edit[$fgi]));
}

sub usetextblock {
  my $content = $textarea->get('1.0', 'end');
  $edit[$fgi] = Manticore::Mantis::rowText2data($content);
}