«K12/K13» Visualisierung magnetischer Feldlinien.pl «PDF», «POD»

#!/usr/bin/perl

use warnings;
use strict;

use Tk;
use Math::Complex;

{
  package Conductor;

  use Math::Complex;

  use constant MU_0 => 1.25663706 * 10**-6;
  use constant PI   => 3.14159265;

  sub new { bless { @_[1..$#_] } => shift }

  sub B_abs { MU_0 / (2 * PI) * $_[0]->current / $_[1] }

  sub B {
    my ($self, $pos) = @_;

    my $r   = abs($pos - $self->pos);
    my $d   = $pos - $self->pos;
    my $phi = atan2 Im($d), Re($d);
    $phi = -$phi;
    $phi = PI/2 - $phi;
    $phi += 2*PI if $phi < 0;

    my $B   = $self->B_abs($r) * (cos $phi + i*sin $phi);
    $B = Re($B) - Im($B)*i if Re($pos) < Re($self->pos);

    $B;
  }

  sub current :lvalue { $_[0]->{current} }
  sub pos     :lvalue { $_[0]->{pos}     }
}

{
  package Space;

  use Math::Complex;
  use List::Util qw< reduce >;

  sub new { bless {} => shift }

  sub B {
    my ($self, $pos) = @_;
    local $_;

    my $B = 0;
    $B += $_->B($pos) for $self->conductors;

    return $B;
  }

  sub conductors    { values %{ $_[0] } }
  sub add_conductor { $_[0]->{$_[1]} = $_[1] }
}

my $space = Space->new;

use constant RADIUS   => 10;
use constant DOT      => 1;
use constant CROSS    => RADIUS / sqrt(2);
use constant ORIGIN_X => 200;
use constant ORIGIN_Y => 200;
use constant SCALE    => 10**9;

my $mw = MainWindow->new;
my $c  = $mw->Canvas(-width => ORIGIN_X * 2, -height => ORIGIN_Y * 2)->pack;
my $s  = $mw->Label(-text => "Ready.")->pack(-side => "bottom", -anchor => "w");

#$c->createGrid(ORIGIN_X, ORIGIN_Y, 10, 10, -lines => 1, -color => "black");
draw_cond($_) for $space->conductors;

$c->CanvasBind("<Button-1>", [sub {
  my (undef, $x,$y) = @_;
  $s->configure(-text => "Waiting for user input...");
  $mw->idletasks();

  my $cond = Conductor->new(pos => $x - ORIGIN_X + ($y - ORIGIN_Y)*i);

  printf "Neuer Leiter an Position (%d,%d); I = ", Re($cond->pos), -Im($cond->pos);
  my $I = 0+<STDIN>;
  $cond->current = $I;

  $space->add_conductor($cond);
  draw_cond($cond);
  $s->configure(-text => "Ready.");
}, Ev("x"), Ev("y")]);

$c->CanvasBind("<Button-2>", [sub {
  my (undef, $x,$y) = @_;

  my $B = $space->B($x - ORIGIN_X + ($y - ORIGIN_Y)*i);
  draw_vector($x,$y, $B);
}, Ev("x"), Ev("y")]);

$c->CanvasBind("<Button-3>", [sub {
  my (undef, $x,$y) = @_;

  draw_line($x - ORIGIN_X, $y - ORIGIN_Y);
}, Ev("x"), Ev("y")]);

MainLoop();

sub draw_cond {
  my ($cond) = @_;

  my ($x,$y) = (Re($cond->pos) + ORIGIN_X, Im($cond->pos) + ORIGIN_Y);

  $c->delete("$cond");
  $c->createOval(
    $x - RADIUS/2, $y - RADIUS/2, $x + RADIUS/2, $y + RADIUS/2,
    -tags => ["$cond"],
  );

  if($cond->current < 0) {
    $c->createOval(
      $x - DOT/2, $y - DOT/2, $x + DOT/2, $y + DOT/2,
      -tags => ["$cond"],
    );
  } else {
    $c->createLine(
      $x - CROSS/2, $y - CROSS/2,
      $x + CROSS/2, $y + CROSS/2,
      -tags => ["$cond"],
    );

    $c->createLine(
      $x - CROSS/2, $y + CROSS/2,
      $x + CROSS/2, $y - CROSS/2,
      -tags => ["$cond"],
    );
  }
}

sub draw_vector {
  my ($x,$y, $B) = @_;
  
  $c->createLine(
    $x,$y,
    $x + SCALE*Re($B), $y - SCALE*Im($B),
    -arrow => "last",
  );
}

sub draw_line {
  my ($x,$y) = @_;
  local $_;

  $s->configure(-text => "Calculating...");
  $mw->idletasks();

  my @pos = [$x,$y];
  for(1..100) {
    my $F         = $space->B($x + i*$y) * 10**8;
    my ($dx, $dy) = (Re($F), Im($F));

    push @pos, [$x += $dx, $y -= $dy];
  }

  $c->createLine(map { $_->[0] + ORIGIN_X, $_->[1] + ORIGIN_Y } @pos);
  $s->configure(-text => "Ready.");
}