chiark / gitweb /
wip
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Thu, 28 Feb 2019 19:03:21 +0000 (19:03 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Thu, 28 Feb 2019 19:03:21 +0000 (19:03 +0000)
generate-board

index 08208cb4f598c799f88acbe54a5a0beefd28fe21..b45155cfc64518202dfaa3aef89ebba0957f8613 100755 (executable)
@@ -3,9 +3,10 @@
 use strict;
 use Carp;
 use Data::Dumper;
-use Math::GSL::Vector;
+use Math::GSL::Vector qw/:all/;
 use Math::GSL::Matrix qw/:all/;
 use Math::GSL::Const;
+use Math::GSL::BLAS qw/:all/;
 use Math::GSL::CBLAS qw/:all/;
 use Math::GSL::Machine qw/:all/;
 
@@ -144,53 +145,73 @@ sub calculate_centres () {
 
 sub for_each_pos ($) {
   my ($f) = @_;
+  my $call = sub {
+    my ($pr) = @_;
+    return unless defined $$pr;
+    $f->($pr);
+  };
   foreach my $rr (values %region) {
-    $f->( \ $rr->{Centre} );
+    $call->( \ $rr->{Centre} );
     foreach my $vertex (@{ $rr->{Polygon} }) {
-      $f->( \ $vertex->{Pos} );
+      $call->( \ $vertex->{Pos} );
     }
   }
 }
 
+sub prvec ($) {
+  my ($v) = @_;
+  sprintf "%g,%g", $v->get(0), $v->get(1);
+}
+
 sub transform_coordinates () {
   # Adjusts coordinates in graph to be [0,0] .. top right (scaled)
   # until it's all in PostScript points
-  my @or = map { $region{$_}{Centre} } $c{OrientRegions};
+  my @or = map { $region{$_}{Centre} } @{ $c{OrientRegions} };
   my $dir = $or[1] - $or[0];
-  my $theta = atan2 $dir->[1], $dir->[0];
-  my $rotateby = (90 - $c{OrientBearing}) * TAU - $theta;
-  $rotateby += TAU*2;
-  $rotateby %= TAU;
+  my $theta = atan2 $dir->get(1), $dir->get(0);
+  my $rotateby = (90. - $c{OrientBearing}) * ((TAU)/360.) - $theta;
   my $s = sin($rotateby);
   my $c = cos($rotateby);
-  my $transform = Math::GSL::Matrix->new([[  $c,  $s ],
-                                         [ -$s,  $c ]]);
+  my $transform = Math::GSL::Matrix->new(2,2);
+  $transform->set_row(0, [  $c,  $s ]);
+  $transform->set_row(1, [ -$s,  $c ]);
+  print STDERR "rotate was=",prvec($dir)," theta=$theta",
+      " rotateby=$rotateby s=$s c=$c\n";
   my @lims;
   foreach my $topend (qw(0 1)) {
-    my $v = $topend ? $GSL_DBL_MAX : $GSL_DBL_MIN;
-    push @lims, Math::GSL::new([$v,$v]);
+    my $v = $topend ? -$GSL_DBL_MAX : $GSL_DBL_MAX;
+    $lims[$topend] = Math::GSL::Vector->new([$v,$v]);
   }
+  print STDERR "lims ",prvec($lims[0])," .. ",prvec($lims[1]),"\n";
   for_each_pos(sub {
     my ($pr) = @_;
     my $y = Math::GSL::Vector->new(2);
-    gsl_blas_dgemv($CblasNoTrans, 1.0, $transform, $$pr, 0., $y) or confess;
-    gsl_blas_dcopy($$pr, $y) or confess;
+    gsl_blas_dgemv($CblasNoTrans,
+                  1.0, $transform->raw,
+                  $$pr->raw,
+                  0, $y->raw)
+       and confess;
+    gsl_blas_dcopy($$pr->raw, $y->raw)
+       and confess;
     foreach my $topend (qw(0 1)) {
       foreach my $xy (qw(0 1)) {
        my $now = $y->get($xy);
        my $lim = $lims[$topend]->get($xy);
+       #print STDERR "?set $topend $xy $now $lim\n";
        next if $topend ? ($now <= $lim) : ($now >= $lim);
-       $lims[$topend]->set($xy, $now);
+       $lims[$topend]->set([$xy], [$now]);
+       #print STDERR "set $topend $xy $now\n";
       }
     }
   });
+  print STDERR "lims ",prvec($lims[0])," .. ",prvec($lims[1]),"\n";
   my $translate = -$lims[0];
-  print STDERR "translate $translate\n";
+  print STDERR "translate ",prvec($translate),"\n";
   my $scale = $c{GraphScale} * MM2PT;
   for_each_pos(sub {
     my ($pr) = @_;
-    gsl_vector_add($$pr, $translate) or confess;
-    gsl_vector_scale($$pr, $scale) or confess;
+    gsl_vector_add($$pr->raw, $translate->raw) and confess;
+    gsl_vector_scale($$pr->raw, $scale) and confess;
   });
 }