Skip to main content
5 of 9
deleted 17 characters in body; deleted 20 characters in body
Peter Taylor
  • 43.4k
  • 4
  • 72
  • 179

Perl, 269 269 262 256 245 244 237 227 chars

 sub p{y/xS/+\//;print;y/+\//xS/}$b=/2;$a=$b;$_=' x';s/x/ x--/while($a--);s/$/x\n/;until(/^S/){p;s/ [xS]/S /g;s/-x/S|/;y/-/ /}s/ (?= *S)/-/g;y/S/x/;p;y/-x/ |/;p while(--$b);while(!/\|S/){s/ [xS]/S/;s/\|$/x/;p}y/ |/-x/;s/S//;p 

The basic idea is to do everything with regex substitutions. Because two of the characters used (+ and /) are special characters and turn up a lot in the regexes, it's worthwhile using other characters and substituting them to print.

Slightly more legible version:

 # Subroutine to substitute, print, and unsubstitute as described above sub p{y/xS/+\//;print;y/+\//xS/} # Read from stdin and set up the initial line $b=<>/2;$a=$b;$_=' x'; s/x/ x--/ while($a--); s/$/x\n/; # Print the top face until(/^S/) { p; s/ [xS]/S /g; # First time round: left + -> /; subsequent times move / left s/-x/S|/; # Only relevant first time round the loop y/-/ / # Only relevant first time round the loop } # Prepare and print the line containing second horizontal line s/ (?= *S)/-/g; y/S/x/; p; # Now print (n-1)/2 identical lines y/-x/ |/; p while (--$b); # Bring the right edge in while (!/\|S/) { s/ [xS]/S/; s/\|$/x/; p } # Prepare and print the final line y/ |/-x/; s/S//; p 

In a sense I'm cheating by using $b as a counter in the intermediate loop - I could instead append whitespace in the loop over $a and then use regex replaces for that loop too - but I'm going to allow that slight deviation from a pure-regex solution.

No doubt some scary person can turn this into a much shorter sed script.

Peter Taylor
  • 43.4k
  • 4
  • 72
  • 179