1: =pod
   2: Well, I was bored the other day and started playing around with one of the silly pastimes that I
   3: amuse myself with (ASCII art).  Then I thought, "Hey, I can incorporate another one of the things
   4: I amuse myself with!"  That was Perl, and so I started fiddling aroud with Perl scripts to make
   5: ASCII Art.  Then I though, "Hey, I can incorporate another one of the things I amuse myself with!"
   6: That was n-dimensional geometry, and that was also 4 days ago.  This is the net-result.
   7: 
   8: Just run this little puppy, and it will happily print out objects up to 6 dimensions.  It can
   9: only draw cubes, and at the moment it can't go higher than 6 dimensions (since there aren't many
  10: characters after that that look good unless you want to duplicate things)
  11: 
  12: I'm sure this could be written more prettily, compactly, extensibly, and so on.  It's fairly dumb
  13: at the moment.  But gosh-darn it, it does do this one thing pretty well.
  14: 
  15: And I just *know* that you've been dying to see an ASCII hyper cube, so take a look at it.  :)
  16: 
  17: The thing that I'm most pleased with, is that they're actually drawn by their mathematical definitions.
  18: So a point is zero dimensional, a line is a moving point, a plane a moving line, and so on.  It 
  19: places the objects and then connects them to form the next higher dimension.  No lame-o caching
  20: of previously created ASCII for me!  No sir.
  21: 
  22: If, for some arcane reason, someone wants a more robust version of this thing, I may look into it.  But,
  23: realistically, such endeavors are best left as an exercise for the reader.  ;)
  24: 
  25: More intelligent methods to add are the ability to have more complex objects, the difference between
  26: 'front' and 'back' and a couple of other things.  I'll email ideas I have about it, if you'd like, but
  27: otherwise the weekend is over and I'm done with this little diversion.
  28: 
  29: =cut
  30: 
  31: use strict;
  32: 
  33: #define the ascii characters for each direction
  34: my @hor = qw(- =);
  35: my @ver = qw(| !);
  36: my @ud  = qw(/);
  37: my @dd  = qw(\\);
  38: 
  39: #create our universe
  40: make_space();
  41: 
  42: #well, a zero dimensional object is a point
  43: my $point = "+";        
  44: 
  45: #take a point,
  46: place_in_space($point, 0, 0);  
  47: #move it somewhere else,
  48: place_in_space($point, 7,0);  
  49: #and draw a line between them, and you have:
  50: make_path();          
  51: 
  52: #a one dimensional object (a line)
  53: my $line = space_rip();      
  54: 
  55: #take a line,
  56: place_in_space($line, 4, 5);  
  57: #move it somewhere else,
  58: place_in_space($line, 4, 10);  
  59: #and draw a line between them, and you have:
  60: make_path();          
  61: 
  62: #a two dimensional object (a square)
  63: my $square = space_rip();    
  64: 
  65: #take a square,
  66: place_in_space($square, 4, 5);  
  67: #move it somwhere else,
  68: place_in_space($square, 7, 8);  
  69: #and draw a line between them, and you have:
  70: make_path();          
  71: 
  72: #a three dimensional object (a cube)
  73: my $cube = space_rip();      
  74: 
  75: #take a cube,
  76: place_in_space ($cube,5,12);  
  77: #move it somewhere else,
  78: place_in_space ($cube,15,2);   
  79: #and draw a line between them, and you have:
  80: make_path();          
  81: 
  82: #a four dimensional object (a hyper cube)
  83: my $hypercube = space_rip();  
  84: 
  85: #take a hypercube,
  86: place_in_space($hypercube, 5, 12);  
  87: #move it somewhere else,
  88: place_in_space($hypercube, 30, 12);  
  89: #and draw a line between them, and you have:
  90: make_path();            
  91: 
  92: #a five dimensional object (hyper hyper cube)
  93: my $cube5d = space_rip();      
  94: 
  95: #take a 5d cube,
  96: place_in_space($cube5d, 5, 12);    
  97: #move it somewhere else,
  98: place_in_space($cube5d, 5, 34);    
  99: #and draw a line between them, and you have:
 100: make_path();            
 101: 
 102: #a six dimensional object (hyper hyper hyper cube)
 103: my $cube6d = space_rip();      
 104: 
 105: #and we'll just stop at 6 dimensions, what with 
 106: #the lack of good ascii characters and all...
 107: 
 108: #let's see what we made!
 109: 
 110: print "=====\nPoint:\n=====\n\n$point\n\n=====\n\n\n";
 111: print "=====\nLine:\n=====\n$line\n\n=====\n\n\n";
 112: print "=====\nSquare:\n=====\n$square\n\n=====\n\n\n";
 113: print "=====\nCube:\n=====\n$cube\n\n=====\n\n\n";
 114: print "=====\nHyper Cube:\n=====\n$hypercube\n\n=====\n\n\n";
 115: print "=====\n5d Cube:\n=====\n$cube5d\n\n=====\n\n\n";
 116: print "=====\n6d Cube:\n=====\n$cube6d\n\n=====";              
 117: 
 118: BEGIN {
 119: 
 120:   my @space = ();
 121: 
 122:   sub make_space () {
 123:     foreach my $x (0..100){
 124:       foreach my $y (0..100){
 125:         $space[$x]->[$y] = " ";
 126:       };
 127:     };
 128:   };
 129:   
 130:   my %space  = ();
 131:   my $which  = 0;
 132:   my $node   = 0;
 133:   my $min_x = 10000;
 134:   
 135:   sub place_in_space {
 136:     my ($cube, $x, $y) = @_;
 137:     
 138:     $min_x = $x if $x < $min_x;
 139:     
 140:     my @cube = map {[split // ]} split(/\n/,$cube);
 141:     
 142:     my $node = 0;
 143:     
 144:     foreach (@cube){
 145:       foreach my $z (0..$#$_){
 146:         next if $_->[$z] =~ /^\s*$/;
 147:         my $i = $x + $z;
 148:         $space[$y]->[$i] = $_->[$z];
 149:         $space{"space" . $which . "p" . $node++} 
 150:           = [$y, $i] if $_->[$z] eq "+";
 151:       };
 152:       $y++;
 153:     };
 154:     
 155:     $which++;
 156:     
 157:   };
 158:   
 159:   sub space_rip() {
 160:     my $rip = undef;
 161:     foreach (@space){
 162:       my $dim = join ("", @$_);
 163:       next if $dim =~ /^\s*$/;
 164:       $dim =~ s/(^\s{$min_x}|\s+$)//g;
 165:       $rip .= "\n$dim";
 166:     };
 167:     make_space();
 168:     $min_x = 100000;
 169:     return $rip;
 170:   };
 171:   
 172:   sub make_path() {
 173:     my $htoken = shift @hor;
 174:     my $vtoken = shift @ver;
 175:     my $utoken = shift @ud;
 176:     my $dtoken = shift @dd;
 177:     my ($use_h, $use_v, $use_ud, $use_dd) = (0,0,0,0);
 178:     foreach my $cube (0..$which){
 179:       my $node = 0;
 180:       
 181:       while (defined (my $alpha_node = 
 182:           $space{"space" . $cube . "p" . $node})){
 183:         my $cube2 = $cube + 1;
 184:         my $beta_node = 
 185:           $space{"space" . $cube2 . "p" . $node} or last;
 186:         
 187:         my ($ax, $ay) = @$alpha_node;
 188:         my ($bx, $by) = @$beta_node;
 189:         
 190:         
 191:         my $max_y = max($ay, $by);
 192:         my $min_y = min($ay, $by);
 193:         
 194:         my $max_x = max($ax, $bx);
 195:         my $min_x = min($ax, $bx);
 196:       
 197:         if ($ax == $bx){  #horizontal
 198:           $use_h++;
 199:           foreach (1..($max_y - $min_y - 1)){
 200:             $space[$ax]->[$min_y + $_] = $htoken
 201:               unless $space[$ax]->[$min_y + $_] 
 202:                 =~ /[$htoken@hor+]/o;
 203:           };
 204:         }
 205:         elsif ($ay == $by){  #vertical
 206:           $use_v++;
 207:           foreach (1..($max_x - $min_x - 1)){
 208:             $space[$min_x + $_]->[$ay] = $vtoken
 209:               unless $space[$min_x + $_]->[$ay] 
 210:                 =~ /[$vtoken@ver+]/o;
 211:           };
 212:         }
 213:         elsif ($by > $ay && $bx > $ax) {  #down diagonal
 214:           return undef unless delta($ax, $bx) == 
 215:             delta($ay, $by);
 216:           $use_dd++;
 217:           foreach (1..($max_x - $min_x - 1)){
 218:               $space[$min_x + $_]->[$min_y + $_] = $dtoken
 219:                 unless $space[$min_x + $_]->[$min_y + $_] 
 220:                   =~ /[$dtoken@dd+]/o;
 221:           };
 222:         }
 223:         else {        #up diagonal
 224:           return undef unless delta($ax, $bx) == 
 225:             delta($ay, $by);
 226:           $use_ud++;
 227:           foreach (1..($max_x - $min_x - 1)){
 228:               $space[$min_x + $_]->[$max_y - $_] = $utoken
 229:                 unless $space[$min_x + $_]->[$max_y - $_] 
 230:                   =~ /[$utoken@ud+]/o;
 231:           };
 232:         };
 233:         delete $space{"space" . $cube2 . "p" . $node};
 234:         delete $space{"space" . $cube . "p" . $node};
 235:         $node++;
 236:       };
 237:     };
 238:     
 239:     unshift @hor, $htoken unless $use_h;
 240:     unshift @ver, $vtoken unless $use_v;
 241:     unshift @dd, $dtoken unless $use_dd;
 242:     unshift @ud, $utoken unless $use_ud;
 243:   };
 244:   
 245:   sub max {
 246:     my ($a, $b) = @_;
 247:     return $a > $b ? $a : $b;
 248:   };
 249:   
 250:   
 251:   sub min {
 252:     my ($a, $b) = @_;
 253:     return $a > $b ? $b : $a;
 254:   };
 255:   
 256:   
 257:   sub delta {
 258:     my ($a, $b) = @_;
 259:     return abs($a - $b);
 260:   };
 261: };
 262: