From: Ian Jackson Date: Thu, 28 Feb 2019 19:03:21 +0000 (+0000) Subject: wip X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?a=commitdiff_plain;h=3cdf0e17a17f360281ec5c68608a72303a979c3d;p=pandemic-rising-tide.git wip --- diff --git a/generate-board b/generate-board index 08208cb..b45155c 100755 --- a/generate-board +++ b/generate-board @@ -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; }); }