From d21a862f7404ceaf95052334363777e9f5e040fa Mon Sep 17 00:00:00 2001 From: ian Date: Sat, 24 Jan 2004 19:47:15 +0000 Subject: [PATCH] subthings --- layout/layout | 228 ++++++++++++++++++++++++++++++------------------- layout/testobj | 18 ++-- 2 files changed, 150 insertions(+), 96 deletions(-) diff --git a/layout/layout b/layout/layout index c2107e8..68b82fa 100755 --- a/layout/layout +++ b/layout/layout @@ -9,14 +9,10 @@ use POSIX; # $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} @@ -29,6 +25,65 @@ if ($debug) { 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); @@ -42,6 +97,7 @@ sub can ($) { my ($c)=@_; canf($c, sub { die "too few args"; }); } 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; @@ -95,31 +151,32 @@ sub cva__enum ($$) { 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; @@ -135,7 +192,7 @@ sub dv1_kind ($$$$$$$) { $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, ' '; @@ -148,7 +205,7 @@ sub dv1 ($$$) { $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); @@ -173,14 +230,6 @@ sub dv { } } -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; @@ -287,7 +336,7 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n"; } 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"; @@ -307,18 +356,19 @@ sub cmd_extend { $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}; @@ -327,18 +377,20 @@ sub cmd_extend { $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; @@ -354,45 +406,25 @@ sub cmd_extend { 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 { @@ -421,7 +453,8 @@ sub cmd_obj { cmd__obj(1); } 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); @@ -432,17 +465,13 @@ sub cmd__obj ($) { 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} }) { @@ -450,19 +479,38 @@ print STDERR ">$xformcv|$yformcv<\n"; 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; diff --git a/layout/testobj b/layout/testobj index f96274d..eab887d 100644 --- a/layout/testobj +++ b/layout/testobj @@ -1,14 +1,20 @@ defobj po abs c 100 100 0 -extend c a len 87 -extend c b ang 22.5d -228 +extend c a ang 15d 900 +extend c b ang 30d 450 enddefobj -abs r 200 350 180 -abs rf 200 150 180 +abs s 200 450 60 +abs rf 400 350 30 -obj po r b po_ -objflip po po_c b pof_ +extend rf rb len -250 +extend rf rc ang -15 315 + +obj po s a po_ + +extend po_a pr len 100 + +#objflip po po_c b pof_ #rel po_c po2c 0 0 180 #objflip po po2c c po2_ -- 2.30.2