Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

package Geo::Transform;

use strict;
use Data::Dumper;
use Cwd;


sub DELIVER { 2 }

#**************************************************


sub new {
   
   my $class             = shift;
   my $self              = {};
   $self->{'GEO'}        = shift;
   $self->{'BIN_LENGTH'} = shift || 12;
   $self->{'BIN_ZERO'}   = "0" x ($self->{'BIN_LENGTH'});
   $self->{'BIN_MAX'}    = 2**($self->{'BIN_LENGTH'});
   bless($self,$class);
   return($self);

}

#******************************************************

sub ch_bin {

   my $self = shift;
   my $n    = shift;
   my $z    = "\%0" . $self->{'BIN_LENGTH'} . "b";
   $n       = sprintf($z,($self->{'BIN_MAX'} * $n));
   return($n);
   
}

#******************************************************

sub compute_octets {

   my $self  = shift;

   my $o; my $o1; my $x; my $y; my $inside; my $zeile;

   my $grid0 = $self->{'GEO'}->grid();
   my $grid  = [];
   
   foreach $o (@$grid0) {  #  transform the grid to binary format
      $zeile = [];
      if ($#$zeile < 6) {  #  point inside/outside method
         foreach $o1 (0,1,2) {
            push(@$zeile,$self->ch_bin($o->[$o1]));
         }
         push(@$zeile,$o->[3]);
      } else {             #  triangulation method
         foreach $o1 (0,1,2,3,4,5,6,7,8,9) {
            push(@$zeile,$self->ch_bin($o->[$o1]));
         }
      }
      push(@$grid,$zeile);
   }
   $self->{'GRID_BIN'} = $grid;

   my $oct = $self->rec_oct('','','');
   return($oct);
   
}

#***************************************************************************

sub flatten {

   my $self = shift;
   my $oct  = shift;  #  Deep array stucture of octets

   my $flat_list = []; # 2,'X','X','X',7,'X','X','X'];   #  near jump / far jump
   $self->flatten1($oct,$flat_list);
   my $o;
   
   my $text = "";
   foreach $o (@$flat_list) {
      $text = $text . join(",",@$o) . "\n";
   }

#   $flat_list = $self->flatten_postprocess($flat_list);
   return($text);


}

#***************************************************************************

sub flatten1 {

   my $self     = shift;
   my $oct      = shift;
   my $hex_list = shift;
   
   my $o; my $o1;
   push(@$hex_list,$oct);
   foreach $o (0,1,2,3,4,5,6,7) {
      $o1 = $#$hex_list;
      if (ref($oct->[$o])) {
         $self->flatten1($oct->[$o],$hex_list);
         $oct->[$o] = $o1 + 1;
      } else {
         $oct->[$o] = - $oct->[$o];
      }
   }
   
}


#********************************************************

sub is_inside_flatten {

   my $self = shift;
   my $x    = shift;
   my $y    = shift;
   my $z    = shift;
   
}


#********************************************************

sub bin_jumps {   #  Einfuegen der richtigen Sprungadressen
                  #  Hierbei werden die Oktette zu einem einzigen Array
                  #  zusammengefasst. In das Array werden soviele Leerstellen
                  #  eingefuegt, dass die entsprechenden relativen
                  #  Sprungadressen mit einer gewissen Anzahl von
                  #  Binaerpaaren (0,1,2,3) dargestellt werden.
                  #  Dazu werden Leerstellen in das Array eingefuegt,
                  #  die dann entsprechend mitgezaehlt werden muessen.

   my $self = shift;
   my $text = shift;
   $text =~ s/-3/-1/g;
   my $near_jump = shift;   #   2^$near_jump: Laenge des maximalen Near Jump
   my $far_jump  = shift;   #   2^$far_jump:  Laenge des maximalen Far  Jump
   my $jump1     = 2**$near_jump - ($far_jump - $near_jump - 1);  #  Obergrenze near jump
   my $jump2     = 2**$far_jump  - $far_jump - 2;                 #  Obergrenze far  jump

   $self->{'NEAR_JUMP'} = $near_jump;
   $self->{'FAR_JUMP'}  = $far_jump;

   $text = [reverse split(/\n/,$text)];
   
   my $zeile_offset = [];  #   Abstand bis zur jeweiligen Zeile
   my $bin_text     = [];
   my $akt_octett   = $#$text;

   my $jump_offset; my $zeile; my $zeile1; my $o; my $o1; my $posnr;

   foreach $zeile (@$text) {  #  alle Oktette werden von hinten durchgegangen
#print "XX: $zeile\n";
      unshift(@$zeile_offset,0);
#      print Dumper($zeile_offset);
      $zeile1 = [];
      $akt_octett = $akt_octett - 1;
      $posnr = 0;
      foreach $o (reverse split(/,/,$zeile)) {
         $posnr = $posnr + 1;
         if ($o == 0 or $o == -1) {   #  direkte Angabe inside/outside
            $o = -7 if (!$o);
            unshift(@$zeile1,$o);
         } else {
#   In $o1 wird jetzt die Anzahl der Binaerpaare berechnet, die bis zum Sprung-Oktett
#   benoetigt werden. $o bedeutet hier den Sprung zur entsprechenden Zeile
            $o1 = $zeile_offset->[$o-$akt_octett-2];  #  Anzahl der Binaerpaare
            $o1 = 0 if ($o == -3); # Kodierung von -3 als Near Jump
#print "XXX:  "  . $zeile_offset->[$o-$akt_octett-2] . "\n";
#print "Entry: $o Octett-Nr: $akt_octett --- $o1 --- $posnr\n";
            $jump_offset = $near_jump/2;  #  erste Annhame: man kann den Sprung mit einem Near Jump kodieren
#            return("___NO_BIN___") if ($o1 % 2);
#            $jump_offset = $far_jump/2          if ($o1 + $jump_offset > $jump1);  #  wenn das nicht reicht: Far Jump
#            return("___FAR_JUMP_TOO_SMALL___")  if ($o1 + $jump_offset > $jump2);  #  das muss aber reichen, sonst Error
            $posnr       = $posnr + $jump_offset; #  - 1;
            $o1          = $o1    + $posnr;
            if (2**$near_jump < $o1) {
               $o1          = $o1 - $posnr;
               $posnr       = $posnr - $jump_offset;
               $jump_offset = $far_jump/2;  # mit Far Jump versuchen
               $posnr       = $posnr + $jump_offset; #  - 1;
               $o1          = $o1    + $posnr;
               return("___FAR_JUMP_TOO_SMALL___") if (2**$far_jump <= $o1);
            }
#            print "POSNR: $posnr\n";
#print "   Jump offset  $jump_offset   Sum  offset $sum_offset,  Entire Jump:  $o1\n";
#print "hier\n";
            while (0 == 0) {
#print "ZZ: $jump_offset\n";
               $jump_offset = $jump_offset - 1;
               last if ($jump_offset < 0);
               unshift(@$zeile1,-9);   #  Leerfelder einfuegen, als -9 kodiert
            }
            $o1 = -3 if ($o == -3);
            unshift(@$zeile1,$o1);
         }
      }
      foreach $o1 (@$zeile_offset) {
         $o1 = $o1 + $posnr;
#      print "RR: $o1 " . $zeile_offset->[$o1] . "\n";
      }
#print "GESAMT: " . join(",",@$zeile1) . "\n\n";
#      print join(" ---- " , @$zeile1) . "\n";
      $o1 =  join(",",@$zeile1,"");
      $o  =  $o1;
      $o  =~ s/[0123456789\-]//g;
      $o1 = sprintf("%2u",length($o)) . "  " . $o1;
      push(@$bin_text,$o1);
#      sleep 1;
   }
   
   $o = join("\n",reverse @$bin_text);
#print $o . "\n";
   $o =~ s/,\-9/,/gs;
   return($o);
   
}

#********************************************************

sub assembler {

   my $self = shift;
   my $text = shift;
   
   my $cr; my $o; my $o1; my $exp; my $entry;
   my $bin_text = [];
   $text =~ s/-7/0/g;

   my $o    = ",";
   while (0 == 0) {    #  Ermitteln der Laenge des Far Jump;
      last if ($text !~ /$o/);
      $o = $o . ",";
   }
   my $far_jump = length($o) - 2;
#print "FFF: $far_jump\n";
#   return("___NO_BIN___") if ($far_jump % 2);
   $text =~ s/ *\d+ +/ /g;
   $text =~ s/(,+\n?)/$1q/gs;
   $text =~ s/ //g;
   $text =  [split(/q/,$text)];
#   print Dumper($text);
#   while ($text =~ s/^(.*?)(,+)(\n?)(.*)$/$4/s) {
   foreach $entry (@$text) {
      next if ($entry !~ /^(.*?)(,+)(\n?)$/);
      $o    = $1;
      $exp  = length($2) - 1;
      $cr   = $3;
      $o    =~ s/^(.*?) +(.*)$/$2/;
      $cr   = " " if (!$cr);
      $o1   = "";
      if ($exp == 0) {
         $o1 = "0" . sprintf("%1u",abs($o));   #  inside/outside
      } else {
#         return("___NO_BIN___") if ($exp % 2);
         $o   = 0 if ($o < 0);
         $o1  = "NJ ";
         $o1  = "FJ " if ($exp == $far_jump);
         $o1  = $o1 . sprintf("%0".sprintf("%1u",2*$exp)."b",$o);
      }
      push(@$bin_text,$o1 . $cr);
   }
   
   return(join("",@$bin_text));
   
}


#********************************************************

sub jumps0 { #  Ermitteln der optimalen Kombination für next und far jumps

   my $self  = shift;
   my $text0 = shift;

   my $minset = "",
   my $minlen = -1;

   my $nr1; my $text;

   my $nr2   = 22;
   while (0 == 0) {
      $nr2 = $nr2 - 2;
      $nr1 = $nr2;
      while (0 == 0) {
         $nr1  = $nr1 - 2;
         last if ($nr1 < 1);
         $text = $self->bin_jumps($text0,$nr1,$nr2);
         next if ($text =~ /\_/);
         $text = $self->assembler($text);
         next if ($text =~ /\_/);
         $text = $self->hex_geo($text);
         next if ($text =~ /\_/);
         $text =~ s/\n//gs;
         next if ($text =~ /\_/);
         $text = length($text);
         print "$nr1 - $nr2 - $text\n";
         if ($minlen < 0 or $minlen > $text) {
            $minlen = $text;
            $minset = "$nr1,$nr2";
         }
      }
      last if ($nr2 < 1);
   }

   return($minset);
   
}


#********************************************************

sub hex_geo {

   my $self = shift;
   my $text = shift;
   
   return("___NO_NEAR_JUMP___") if ($text !~ /NJ ([01]+)/);
   my $hex_text = sprintf("%1x",length($1)/2);
   return("___NO_FAR_JUMP___") if ($text !~ /FJ ([01]+)/);
   $hex_text    = uc($hex_text . sprintf("%1x",length($1)/2));
   
   $text =~ s/ //gs;
   $text =~ s/\n//gs;
   $text =~ s/NJ/10/gs;
   $text =~ s/FJ/11/gs;
   $text = $text . "00";
   
   my $zaehler = 5;
   my $o;

   while (0 == 0) {
      last if ($text !~ s/^([01][01][01][01])//);
      $o = "0b" . $1;
      $o = eval($o);
      $o = uc(sprintf("%1x",$o));
      $hex_text = $hex_text . $o;
      if ($zaehler == 80) {
         $zaehler = 0;
         $hex_text = $hex_text . "\n";
      }
      $zaehler = $zaehler + 1;
   }
   
   return($hex_text);
   
}

#********************************************************

sub progr_geo {

   my $self = shift;
   my $text = shift;
   
   my $progr_text = $self->hex_geo($text);
   
   $progr_text = "\$data = <<'TEXT_ENDE';\n" . $progr_text . "\nTEXT_ENDE\n\n";
   $progr_text = $progr_text . <<'TEXT_ENDE';
$x = shift;
$y = shift;
$z = shift;
$x = sprintf("%020b",$x * 1048576);
$y = sprintf("%020b",$y * 1048576);
$z = sprintf("%020b",$z * 1048576);
   
$data =~ s/0/oooo/gs;
$data =~ s/1/oooi/gs;
$data =~ s/2/ooio/gs;
$data =~ s/3/ooii/gs;
$data =~ s/4/oioo/gs;
$data =~ s/5/oioi/gs;
$data =~ s/6/oiio/gs;
$data =~ s/7/oiii/gs;
$data =~ s/8/iooo/gs;
$data =~ s/9/iooi/gs;
$data =~ s/A/ioio/gs;
$data =~ s/B/ioii/gs;
$data =~ s/C/iioo/gs;
$data =~ s/D/iioi/gs;
$data =~ s/E/iiio/gs;
$data =~ s/F/iiii/gs;
$data =~ s/o/0/gs;
$data =~ s/i/1/gs;
$data =~ s/\n//gs;

$jump = [eval("0b".substr($data,0,4))*2,eval("0b".substr($data,4,4))*2];
$nr   = 8;
while ($x) {
   $o  = (substr($x,0,1))*1 + (substr($y,0,1))*2 + (substr($z,0,1))*4;
   while ($o != 0) {
      if (substr($data,$nr,2) =~ /^1([01])$/) { $nr = $nr + $jump->[$1] }
      $o = $o - 1;
      $nr = $nr + 2;
   }
   last if (length($data) < $nr);
   if (substr($data,$nr,1) eq "0") { print substr($data,$nr+1,1)."\n"; exit }
   if (substr($data,$nr,2) =~ /^1([01])$/) { $nr = $nr + eval("0b".substr($data,$nr+2,$jump->[$1]))*2 }
   $x = substr($x,1);
   $y = substr($y,1);
   $z = substr($z,1);
}
print "9\n";
TEXT_ENDE
   
   return($progr_text);
   
}

#********************************************************

sub is_defined_inside_outside {

   my $self = shift;
   my $erg  = shift;
   my $p    = [@_];
   return($erg) if ($erg == 3);

   my $o; my $o1;
   my $id     = join(",",@$p);
   while ($id =~ s/12/20/) { 1; }   #  incrementing
   $id        =~ s/02/10/g;
   $p         = [split(/,/,$id)];
   $self->{'INSIDE'}->{$id} = 0 if ($id =~ /2/); # edges of global cube are always outside
  
   if (!($self->{'INSIDE'}->{$id})) {
      foreach $o (0,1,2) {  #  Umrechnen auf genormte dezimale Werte zwischen 0 und 1
         $p->[$o] = substr($p->[$o] . $self->{'BIN_ZERO'},0,$self->{'BIN_LENGTH'});
         $p->[$o] = eval("0b".$p->[$o]);
         $p->[$o] = $p->[$o] / $self->{'BIN_MAX'};
      }
# print "PP: " . Dumper($p);
      $self->{'INSIDE'}->{$id} = $self->{'GEO'}->is_inside(@$p);

   }
   if ($erg == 2)                        { $erg = $self->{'INSIDE'}->{$id}; }
#   print "XXERG: $erg  $id  $self->{'INSIDE'}->{$id}\n";
   if ($erg != $self->{'INSIDE'}->{$id}) { $erg = 3; }
   
   return($erg);

}   
   
#********************************************************

sub rec_oct {

   my $self    = shift;
   
   my $x       = shift;
   my $y       = shift;
   my $z       = shift;

   my $point; my $offset;

   my $erg     = $self->is_defined_inside_outside(2,   $x.'0',$y.'0',$z.'0');
   $erg        = $self->is_defined_inside_outside($erg,$x.'0',$y.'0',$z.'2');  #  increment edges
   $erg        = $self->is_defined_inside_outside($erg,$x.'0',$y.'2',$z.'0');
   $erg        = $self->is_defined_inside_outside($erg,$x.'0',$y.'2',$z.'2');
   $erg        = $self->is_defined_inside_outside($erg,$x.'2',$y.'0',$z.'0');
   $erg        = $self->is_defined_inside_outside($erg,$x.'2',$y.'0',$z.'2');
   $erg        = $self->is_defined_inside_outside($erg,$x.'2',$y.'2',$z.'0');
   $erg        = $self->is_defined_inside_outside($erg,$x.'2',$y.'2',$z.'2');
   
   foreach $point (@{$self->{'GRID_BIN'}}) {
      foreach $offset (0,3,6) {
         last if ($#$point < 5 and $offset > 1);
         last if ($erg == 3);
         next if ($point->[0+$offset] !~ /^$x/);
         next if ($point->[1+$offset] !~ /^$y/);
         next if ($point->[2+$offset] !~ /^$z/);
         next if ($point->[3+$offset] == $erg);
         $erg = 3;
      }
      last if ($erg == 3);
   }
   print "$x  $y  $z  $erg\n" if (length($x) < 5);
   
   return($erg) if ($erg < 2);
   return($erg) if (length($x) == $self->{'BIN_LENGTH'}-1);
   return([
      $self->rec_oct($x.'0',$y.'0',$z.'0'),
      $self->rec_oct($x.'0',$y.'0',$z.'1'),
      $self->rec_oct($x.'0',$y.'1',$z.'0'),
      $self->rec_oct($x.'0',$y.'1',$z.'1'),
      $self->rec_oct($x.'1',$y.'0',$z.'0'),
      $self->rec_oct($x.'1',$y.'0',$z.'1'),
      $self->rec_oct($x.'1',$y.'1',$z.'0'),
      $self->rec_oct($x.'1',$y.'1',$z.'1')
   ]);

}

#********************************************************


1;