# $ctx->{Loc}{$id}{X}
# $ctx->{Loc}{$id}{Y}
# $ctx->{Loc}{$id}{A}
-# $ctx->{Trans}{X0} } transformation
-# $ctx->{Trans}{Y0} } matrix
-# $ctx->{Trans}{XY} }
-# $ctx->{Trans}{YX} }
-# $ctx->{Trans}{XX} }
-# $ctx->{Trans}{YY} }
-# $ctx->{Trans}{AA} }
-# $ctx->{Trans}{AS} }
+# $ctx->{Trans}{X} # transformation. is ev representing
+# $ctx->{Trans}{Y} # new origin. (is applied at _input_
+# $ctx->{Trans}{A} # not at plot-time)
+# $ctx->{Trans}{R} # but multiply all y coords by this!
#
# $objs{$id}{CmdLog}
# $objs{$id}{Loc}
select(STDOUT); $|=1;
}
+# ev_... functions
+#
+# Operate on Enhanced Vectors which are a location (coordinates) and a
+# direction at that location. Representation is a hash with members X
+# Y and A (angle of the direction in radians, anticlockwise from
+# East). May be absolute, or interpreted as relative, according to
+# context.
+#
+# Each function's first argument is a hashref whose X Y A members will
+# be created or overwritten; this hashref will be returned (so you can
+# use it `functionally' by passing {}). The other arguments may be ev
+# hashrefs, or other info. The results are in general undefined if
+# one of the arguments is the same hash as the result.
+
+sub ev_byang ($$;$) {
+ # ev_byang(R, ANG,[LEN])
+ # result is evec of specified angle and length (default=1.0)
+ my ($res,$ang,$len)=@_;
+ $len=1.0 unless defined $len;
+ $res->{X}= $len * cos($ang);
+ $res->{Y}= $len * sin($ang);
+ $res->{A}= $ang;
+ $res;
+}
+sub ev_compose ($$$) {
+ # ev_compose(SUM_R, A,B);
+ # appends B to A, result is end of B'
+ # A may have a member R, which if provided then it should be 1.0 or -1.0,
+ # and B's Y and A will be multiplied by R first (ie, we can reflect);
+ my ($sum,$a,$b) = @_;
+ my ($r);
+ $r= defined $a->{R} ? $a->{R} : 1.0;
+ $sum->{X}= $a->{X} + $b->{X} * cos($a->{A}) - $r * $b->{Y} * sin($a->{A});
+ $sum->{Y}= $a->{Y} + $r * $b->{Y} * cos($a->{A}) + $b->{X} * sin($a->{A});
+ $sum->{A}= $a->{A} + $r * $b->{A};
+ $sum;
+}
+sub ev_decompose ($$$) {
+ # ev_decompose(B_R, A,SUM)
+ # computes B_R s.t. ev_compose({}, A, B_R) gives SUM
+ my ($b,$a,$sum)=@_;
+ my ($r,$brx,$bry);
+ $r= defined $a->{R} ? $a->{R} : 1.0;
+ $brx= $sum->{X} - $a->{X};
+ $bry= $r * ($sum->{Y} - $a->{Y});
+ $b->{X}= $brx * cos($a->{A}) + $bry * sin($a->{A});
+ $b->{Y}= $bry * cos($a->{A}) - $brx * sin($a->{A});
+ $b->{A}= $r * ($sum->{A} - $a->{A});
+ $b;
+}
+sub ev_lincomb ($$$$) {
+ # ev_linkcomb(RES,A,B,P)
+ # gives P*A + (1-P)*B
+ my ($r,$a,$b,$p) = @_;
+ my ($q) = 1.0-$p;
+ map { $r->{$_} = $q * $a->{$_} + $p * $b->{$_} } qw(X Y A);
+ $r;
+}
+
sub canf ($$) {
my ($converter,$defaulter)=@_;
my ($spec,$v);
sub cano ($$) { my ($c,$def)=@_; canf($c, sub { return $def }); }
$pi= atan2(0,-1);
+sub signum ($) { return ($_[0] > 0) - ($_[0] < 0); }
%units_len= qw(- mm mm 1 cm 10 m 1000);
%units_ang= qw(- d r 1); $units_ang{'d'}= 2*$pi / 360;
sub cvam_enum { my (@e) = @_; return sub { cva__enum($_[0],\@e); }; }
sub cmd_abs {
- my ($x,$y);
+ my ($i,$nl);
$nl= can(\&cva_idnew);
- $x= can(\&cva_len);
- $y= can(\&cva_len);
- ($nl->{X}, $nl->{Y})= input_abscoords($x,$y);
- $nl->{A}= can(\&cva_absang);
+ $i->{X}= can(\&cva_len);
+ $i->{Y}= can(\&cva_len);
+ $i->{A}= can(\&cva_ang);
+ ev_compose($nl, $ctx->{Trans}, $i);
}
-
sub cmd_rel {
+ my ($from,$to,$len,$right,$turn);
$from= can(\&cva_idex);
$to= can(\&cva_idnew);
$len= can(\&cva_len);
$right= can(\&cva_len);
- $turn= cano(\&cva_ang, 0);
- $to->{X}= $from->{X} + $len * cos($from->{A}) + $right * sin($from->{A});
- $to->{Y}= $from->{Y} + $len * sin($from->{A}) - $right * cos($from->{A});
- $to->{A}= $from->{A} + $turn;
+ $turn= cano(\&cva_absang, 0);
+ my ($u)= ev_compose({}, $from, { X => $len, Y => -$right, A => 0 });
+ ev_compose($to, $u, { X => 0, Y => 0, A => $turn });
+ $to= $u2;
}
-sub evreff ($) {
+sub dv__evreff ($) {
my ($pfx) = @_;
$pfx . ($pfx =~ m/\}$|\]$/ ? '' : '->');
}
-sub evr ($) {
+sub dv__evr ($) {
my ($v) = @_;
+ return 'undef' if !defined $v;
return $v if $v !~ m/\W/ && $v =~ m/[A-Z]/ && $v =~ m/^[a-z_]/i;
return $v if $v =~ m/^[0-9.]+/;
$v =~ s/[\\\']/\\$&/g;
$any=1;
my ($v)= &$ixmapfn($ix);
#print STDERR "dv1_kind($pfx,$expr,$ref,$ref_exp,$ixmapfn) ix=$ix v=$v\n";
- dv1($pfx,$expr.sprintf($ixfmt,evr($ix)),$v);
+ dv1($pfx,$expr.sprintf($ixfmt,dv__evr($ix)),$v);
}
if (!$any) {
printf DEBUG "%s%s= $ixfmt\n", $pfx, $expr, ' ';
$ref= ref $v;
#print STDERR "dv1 >$pfx|$ref<\n";
if (!$ref) {
- printf DEBUG "%s%s= %s\n", $pfx,$expr, evr($v);
+ printf DEBUG "%s%s= %s\n", $pfx,$expr, dv__evr($v);
return;
} elsif ($ref eq 'SCALAR') {
dv1($pfx, ($expr =~ m/^\$/ ? "\$$expr" : '${'.$expr.'}'), $$v);
}
}
-sub loc_lin_comb ($$$) {
- my ($a,$b,$p) = @_;
- my ($q,$r) = 1.0-$p;
- map { $r->{$_} = $q * $a->{$_} + $p * $b->{$_} } qw(X Y A);
-# dv("loc_lin_comb ",'$a',$a,'$b',$b,'$p',$p,'$r',$r);
- return $r;
-}
-
$psu_ulen= 4.5;
$psu_edgelw= 0.5;
$psu_ticklw= 0.1;
}
sub cmd_extend {
- my ($from,$to,$radius,$ctr,$beta,$ang,$how,$signum);
+ my ($from,$to,$radius,$ctr,$beta,$ang,$how,$sign_r);
$from= can(\&cva_idex);
$to= can(\&cva_idnew);
printf DEBUG "from $from->{X} $from->{Y} $from->{A}\n";
$to->{X}= $from->{X} + $len * cos($from->{A});
$to->{Y}= $from->{Y} + $len * sin($from->{A});
$to->{A}= $from->{A};
- parametric_segment(II, 0.0, 1.0, $len, sub {
- loc_lin_comb($from, $to, $p);
+ parametric_segment(II, 0.0, 1.0, abs($len), sub {
+ ev_lincomb({}, $from, $to, $p);
});
} else {
print DEBUG "radius >$radius<\n";
- $radius *= $ctx->{Trans}{AA};
- $signum= $radius / abs($radius);
+ $radius *= $ctx->{Trans}{R};
+ $sign_r= signum($radius);
+ $sign_ang= 1;
$ctr->{X}= $from->{X} + $radius * sin($from->{A});
$ctr->{Y}= $from->{Y} - $radius * cos($from->{A});
if ($how eq 'upto') {
- $beta= atan2(-$signum * ($upto->{X} - $ctr->{X}),
- $signum * ($upto->{Y} - $ctr->{Y}));
+ $beta= atan2(-$sign_r * ($upto->{X} - $ctr->{X}),
+ $sign_r * ($upto->{Y} - $ctr->{Y}));
$beta_interval= 1.0;
} elsif ($how eq 'parallel') {
$beta= $upto->{A};
$beta= input_absang($ang);
$beta_interval= 2.0;
} elsif ($how eq 'len') {
- $beta= $from->{A} - $signum * $len / abs($radius);
+ $sign_ang= signum($len);
+ $beta= $from->{A} - $sign_r * $len / abs($radius);
$beta_interval= 2.0;
} else {
- $beta= $from->{A} - $signum * $ang;
+ $sign_ang= signum($ang);
+ $beta= $from->{A} - $sign_r * $ang;
$beta_interval= 2.0;
}
printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
- $beta += $signum * 4.0 * $pi;
+ $beta += $sign_ang * $sign_r * 4.0 * $pi;
for (;;) {
$delta= $beta - $from->{A};
- last if $signum * $delta <= 0;
- $beta -= $signum * $beta_interval * $pi;
+ last if $sign_ang * $sign_r * $delta <= 0;
+ $beta -= $sign_ang * $sign_r * $beta_interval * $pi;
}
printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
$to->{A}= $beta;
printf DEBUG "to $to->{X} $to->{Y} $to->{A}\n";
}
-sub cmd__do {
- my ($id, $cmd, $loc);
- $ctx->{LocsMade}= [ ];
- $cmd= can(\&cva_cmd);
- &{ "cmd_$cmd" };
- die "too many args" if @al;
- foreach $id (@{ $ctx->{LocsMade} }) {
- $loc= $ctx->{Loc}{$id};
- o("% point $id $loc->{X} $loc->{Y} ".ang2deg($loc->{A})."\n");
- }
-}
-
-sub cmd__one {
- cmd__do();
-}
-
sub ang2deg ($) {
return $_[0] * 180 / $pi;
}
sub input_absang ($) {
- return $_[0] * $ctx->{Trans}{AA} + $ctx->{Trans}{A0};
+ return $_[0] * $ctx->{Trans}{R} + $ctx->{Trans}{A};
}
sub input_abscoords ($$) {
- my ($in,$out, $i);
- ($in->{X}, $in->{Y})= @_;
- foreach $o (qw(X Y)) {
- $out->{$o}= $ctx->{Trans}{$o.0};
- foreach $i (qw(X Y)) {
- $out->{$o} += $ctx->{Trans}{"$i$o"} * $in->{$i};
- }
- }
+ my ($in,$out);
+ ($in->{X}, $in->{Y}) = @_;
+ $in->{A}= 0.0;
+ $out= ev_compose({}, $ctx->{Trans}, $in);
return ($out->{X}, $out->{Y});
}
sub newctx () {
- $ctx= { Trans => { X0 => 0.0, Y0 => 0.0,
- XY => 0.0, YX => 0.0,
- A0 => 0.0, AA => 1.0,
- XX => 1.0, YY => 1.0 } }
+ $ctx= {
+ Trans => { X => 0.0, Y => 0.0, A => 0.0, R => 1.0 },
+ InRunObj => ""
+ };
}
sub cmd_defobj {
sub cmd_objflip { cmd__obj(-1); }
sub cmd__obj ($) {
my ($flipsignum)=@_;
- my ($obj_id, $ctx_save, $pfx);
+ my ($obj_id, $ctx_save, $pfx, $actual, $formal_id, $formal, $formcv);
+ my ($c, $ctx_inobj);
$obj_id= can(\&cva_idstr);
$actual= can(\&cva_idex);
$formal_id= can(\&cva_idstr);
die "unknown formal $formal_id" unless $formal;
$ctx_save= $ctx;
newctx();
- o("% obj $obj_id\n");
- $ctx->{Trans}{AA}= $flipsignum;
- $ctx->{Trans}{A0}= $actual->{A} - $formal->{A}/$flipsignum;
- $ctx->{Trans}{XX}= cos($ctx->{Trans}{A0});
- $ctx->{Trans}{YY}= $flipsignum * cos($ctx->{Trans}{A0});
- $ctx->{Trans}{XY}= $flipsignum * sin($ctx->{Trans}{A0});
- $ctx->{Trans}{YX}= -$flipsignum * sin($ctx->{Trans}{A0});
- ($xformcv,$yformcv)= input_abscoords($formal->{X}, $formal->{Y});
-print STDERR ">$xformcv|$yformcv<\n";
- $ctx->{Trans}{X0}= $actual->{X} - $xformcv;
- $ctx->{Trans}{Y0}= $actual->{Y} - $yformcv;
+ $ctx->{Trans}{R}= $flipsignum;
+ $ctx->{Trans}{A}= $actual->{A} - $formal->{A}/$flipsignum;
+ $formcv= ev_compose({}, $ctx->{Trans},$formal);
+ $ctx->{Trans}{X}= $actual->{X} - $formcv->{X};
+ $ctx->{Trans}{Y}= $actual->{Y} - $formcv->{Y};
+ $ctx->{InRunObj}= $ctx_save->{InRunObj}."${obj_id}::";
+dv("cmd__obj $obj_id ",'$ctx',$ctx);
{
local (@al);
foreach $c (@{ $obj->{CmdLog} }) {
next if $al[0] eq 'enddefobj';
cmd__one();
}
- }
+ };
$pfx= cano(\&cva_idstr,'');
+ $ctx_inobj= $ctx;
+ $ctx= $ctx_save;
if (length $pfx) {
- foreach $id (keys %{ $ctx->{Loc} }) {
+ foreach $id (keys %{ $ctx_inobj->{Loc} }) {
$newid= $pfx.$id;
next if exists $ctx_save->{Loc}{$newid};
- $pt= $ctx->{Loc}{$id};
- $newpt= { A => input_absang($pt->{A}) };
- ($newpt->{X}, $newpt->{Y})= input_abscoords($pt->{X}, $pt->{Y});
- $ctx_save->{Loc}{$newid}= $newpt;
+ $newpt= cva_idnew($newid);
+ %$newpt= %{ $ctx_inobj->{Loc}{$id} };
}
}
- $ctx= $ctx_save;
+}
+
+sub cmd__do {
+ my ($cmd);
+dv("cmd__do $ctx @al ",'$ctx',$ctx);
+ $cmd= can(\&cva_cmd);
+ my ($id,$loc,$io);
+ $io= defined $ctx->{InDefObj} ? "$ctx->{InDefObj}!" : $ctx->{InRunObj};
+ o("%L cmd $io $cmd @al\n");
+ $ctx->{LocsMade}= [ ];
+ &{ "cmd_$cmd" };
+ die "too many args" if @al;
+ foreach $id (@{ $ctx->{LocsMade} }) {
+ $loc= $ctx->{Loc}{$id};
+ o("%L point $io$id $loc->{X} $loc->{Y} ".ang2deg($loc->{A})."\n");
+ }
+}
+
+sub cmd__one {
+ cmd__do();
}
$ptscale= 72/25.4 / 5.0;
~ijackson / trains.git / commitdiff