layout/layout

   1 #!/usr/bin/perl
   2
   3 use POSIX;
   4
   5 # Data structures:
   6 #  $loc{$id}{X}
   7 #  $loc{$id}{Y}
   8 #  $loc{$id}{A}  may be undef
   9
  10 sub canf ($$) {
  11     my ($converter,$defaulter)=@_;
  12     my ($spec);
  13     &$defaulter unless @al;
  14     $spec= shift @al;
  15     return &$converter($spec);
  16 }
  17
  18 sub can ($) { my ($conv)=@_; canf($c, sub { die "too few args"; }); }
  19 sub cano ($$) { my ($conv,$def)=@_; canf($c, sub { return $def }); }
  20
  21 $pi= atan2(0,-1);
  22
  23 %units_len= qw(- mm  mm 0  cm 10  m 1000);
  24 %units_ang= qw(- d   r 1); $units_ang{'d'}= 2*$pi/360;
  25
  26 sub cva_len ($) { my ($sp)=@_; cva_units($sp,\%units_len); }
  27 sub cva_ang ($) { my ($sp)=@_; cva_units($sp,\%units_ang); }
  28 sub cva_units ($$) {
  29     my ($sp,$ua,$n,$u)=@_;
  30     $sp =~ s/^([-0-9eE.]+)([A-Za-z]*)$/;
  31     ($n,$u)= ($1,$1);
  32     $u=$u{'-'} unless length $u;
  33     defined $ua->{$u} or die "unknown unit $u";
  34     return $n * $ua->{$u};
  35 }
  36 sub cva_idstr ($) { my ($sp)=@_; die unless m/^[-0-9a-z]+$; return $&; }
  37 sub cva_idex ($) {
  38     my ($sp,$id)=@_;
  39     $id=cva_idstr($sp);
  40     die "unknown $id" unless defined $loc{$id};
  41     return $loc{$id};
  42 }
  43 sub cva_idnew ($) {
  44     my ($sp,$id)=@_;
  45     $id=cva_idstr($sp);
  46     die "duplicate $id" if defined $loc{$id};
  47     keys %{ $loc{$id} };
  48     return $loc{$id};
  49 }
  50
  51 sub cmd_mark {
  52     $mark= 1;
  53     &cmd__do;
  54 }
  55
  56 sub cmd_abs {
  57     $nl= can(\&cva_idnew);
  58     $nl->{X}= can(\&cva_len);
  59     $nl->{Y}= can(\&cva_len);
  60     $nl->{A}= cano(\&cva_ang, undef);
  61 }
  62
  63 sub cmd_extend {
  64     $from= can(\&cva_idex);
  65     $to= can(\&cva_idnew);
  66     die "no ang" unless defined $from->{A};
  67     $how= can(cva_enum(qw(len upto ang)));
  68     if ($how eq 'len') { $len= can(\&cva_len); }
  69     elsif ($how eq 'ang') { $ang= can(\&cva_ang); }
  70     elsif ($how eq 'upto') { $upto= can(\&cva_id); }
  71     $radius= cano(\&cva_ang, 'Inf'); # +ve is right hand bend
  72     if ($radius eq 'Inf') {
  73         if ($how eq 'ang') { die "len of straight spec by angle"; }
  74         if ($how eq 'upto') {
  75             $len= ($upto->{X} - $from->{X}) * cos($from->{a})
  76                 + ($upto->{Y} - $from->{Y}) * sin($from->{a});
  77         }
  78         $to->{X}= $from->{X} + $len * cos($from->{A});
  79         $to->{Y}= $from->{Y} + $len * sin($from->{A});
  80         $to->{A}= $from->{A};
  81         # fixme mark
  82     } else {
  83         $signum= $radius / abs($radisu);
  84         $ctr->{X}= $from->{X} + $radius * sin($from->{A});
  85         $ctr->{Y}= $from->{Y} - $radius * cos($from->{A});
  86         if ($how eq 'upto') {
  87             $beta= atan2(-$signum * ($upto->{X} - $ctr->{X}),
  88                          $signum * ($upto->{Y} - $ctr->{Y}));
  89         } else {
  90             if ($how eq 'len') { $ang= $len / abs($radius); }
  91             $beta= $from->{A} - $signum * $ang;
  92         }
  93         $to->{A}= $beta;
  94         $to->{X}= $ctr->{X} + $radius * cos($beta);
  95         $to->{Y}= $ctr->{Y} - $radius * sin($beta);
  96
  97
  98     die "point only" unless defined $from->{A};
  99     join($from,$to);
 100 }
 101
 102 sub cmd__do {
 103
 104
 105 sub cmd_str_asfar {
 106     $from= can(\&cva_idex);
 107     $to= can(\&cva_idex);
 108
 109
 110 while (<>) {
 111     next if m/^\s*\#/;
 112     chomp; s/^\s+//; s/\s+$//;
 113     @al= split /\s+/, $_;
 114     next unless @al;
 115     $mark= 0;
 116     $cmd= can(\&cva_cmd);
 117 shift @al;    $cmd =~ y/-_/_-/;
 118     &{ "cmd_$cmd" };
 119 }