require "cam.pm" ;

{ $projects -> CPMBOPPC ; }

$? about cam.pm
$* the cam.pm list
$@ cam.pm meetings
$_ cam.pm projects
  home

In the reformattings that are posted below, the variable and function names have been kept the same, but '"."' has been squashed and the code has been reformatted with spaces to make subroutines more readable.

In the order in which the solutions were entered, Matthew Byng-Maddick sent in the draining beer glass as a non-entry (given that he was going to judge the competition):

Requirements: ANSI terminal

          /Cam.pm_-_Program_with_Beer/;sub
          r{$d=~s/^(..)//;return(hex$1)};#
         $e                              ="
         02                              0A
        10                                00
        02                                09
        02                                0F
         03                              08
         02                              10
         03                              09
          02                            0F
          04                            0A
          020E040B020D040C020C040D020B020E
          020A020E0C00";$e=~s/\s+//g;1;sub
           g{$l=shift;$d=$e;while(length(
           $d)){($n,$s1,$h,$s2)=(r,r,r,r)
           ;for(1..$n){$s++;$a=(31-$l)>$s
           ?chr(32):"@";print(chr(32)x$s1
            ,"#"x$h,${a}x($s2*2),"#"x$h,
            "\n")}}}print"\e[2J";for$t((
            reverse(2..28))){$s=0;sleep(
            1);print"\e[0;0H";g($t);}$_=
             "Qevax*Orre,*Cebtenz*Crey"
             .",*Pnz.cz\n";s/\*/chr(32)
             /eg;tr/a-zA-Z/n-za-mN-ZA-M
             /;print;m{Cam.pm_for_info_
              see_our_website_at:.....
              .http://www.cam.pm.org/.
              Real_Perl_mongers_drink_
              Real_Beer._Join_CAMRA!!}
 

For those that didn't try it, it prints the same pint glass, full, and empties it at a rate of one line per second. At the end it prints "Drink Beer, Program Perl, Cam.pm". The way it works is pretty simple, the shape of the glass is encoded in the scalar $e, in groups of 4 bytes. The first byte in each group is the number of lines, then the number of spaces, then the number of hashes, and the number of spaces to the midline of the glass. The function g() prints out the glass, using this data, and also prints `@' in the bottom $l lines of the glass. r() reads the top hex digit on the encoding, modifying it as it goes. The end is just a simple rot13 and substitute. The comments are, of course, just regexp matches in null context. This trick is thanks to BooK in his Postscript and Perl TPJ entry.

Rewritten, it looks something like:

sub r {
    $d=~s/^(..)//;
    return(hex$1)
}

$e="020A1000
    0209020F
    03080210
    0309020F
    040A020E
    040B020D
    040C020C
    040D020B
    020E020A
    020E0C00";

$e=~s/\s+//g;

sub g {
    $l=shift;
    $d=$e;
    while(length($d)) {
        ($n,$s1,$h,$s2)=(r,r,r,r);
        for(1..$n) {
            $s++;
            $a=(31-$l)>$s?chr(32):"@";
            print(chr(32)x$s1,"#"x$h,${a}x($s2*2),"#"x$h,"\n")
        }
    }
}

print"\e[2J";

for$t((reverse(2..28))) {
    $s=0;
    sleep(1);
    print"\e[0;0H";
    g($t);
}

$_="Qevax*Orre,*Cebtenz*Crey,*Pnz.cz\n";

s/\*/chr(32)/eg;
tr/a-zA-Z/n-za-mN-ZA-M/;
print;

Andy Wardley posted his to london.pm, and not with any seriousness, but it is included here for completeness:

Requirements: run from a file

#!/usr/bin/perl
           ################################
           ################################
          ##                              ##
          ##                              ##
         ##                                ##
         ##                                ##
         ##                                ##
          ##                              ##
          ##                              ##
          ##                              ##
           ##                            ##
           ##                            ##
           ################################
           ################################
            ##############################
            ##############################
            ##############################
            ##############################
             ############################
             open(ALE,$0);<ALE>;$/=undef;
             ############################
             $beer=<ALE>;$beer=~s/\S/#/g;
              ##########################
              print($beer);#############
              ##########################
              ##########################
               ########################
               ########################
               ########################
               ########################
 

Not a huge amount can be said about this, it's pretty self explanatory.

Dave Cantrell submitted this calculator for great circle distances next:

Requirements: Two command line arguments

          $foo='$spc=chr(32);$pi&=&4*atan2
          (1,1);$radius=6367000;sub&deg2ra
         d{                              $_
         [0                              ]*
        $p                                i/
        18                                0}
        su                                b&
         ac                              os
         {a                              ta
         n2                              (s
          qr                            t(
          1-                            $_
          [0]*$_[0]),$_[0])}($l1,$l3)=&dms
          2degs(shift);($l2,$l4)=&dms2degs
           (shift);printf("%8d${spc}km\n"
           ,distance($l1,$l3,$l2,$l4)/100
           0);printf("%8d${spc}miles\n",d
           istance($l1,$l3,$l2,$l4)/1609.
            344);sub&distance{$radius*ac
            os(sin($_[0])*sin($_[2])+cos
            ($_[0])*&cos($_[2])*cos($_[1
            ]-$_[3]));}sub&dms2degs{$_[0
             ]=~/(\d?\d\d):(\d\d):(\d\d
             )([NS]),(\d?\d\d):(\d\d):(
             \d\d)([EW])/i;deg2rad(($1+
             $2/60+$3/3600)*(($4eq"N")?
              1:-1)),&deg2rad(($5+$6/6
              0+$7/3600)*(($8eq"E")?1:
              -1));}';$foo=~s/\s//gi;$
              foo=~y/&/\t/;eval($foo);
 

Dave commented in his submission that he didn't think it was "that obfuscated" and this seems fairly clear. In order to understand the format for entry it needed to be de-obfuscated. Dave's approach, however, to the problem of whitespace was the one that was expected to turn up most, but was the only one of its kind. Basically, he put most of his code into a scalar ($foo) and then applied some substitutions on it, first to get rid of the space, and then to turn `&' into a tab (the reason he chose tab is obvious in this case, but it would have been possible to have the last line as being ``foo=~y/&/\040/;eval$foo;'' and that would have been just as correct. In order to run it two coordinates in degree minutes and seconds (eg. 51:31:47N,00:02:54W) are needed on the command line. I'm slightly surprised that Dave didn't make more use of the $spc variable at the beginning, but on the whole, the program is pretty self-explanatory. Amazingly, Dave doesn't seem to have needed comments at all.

$spc=chr(32);
$pi=4*atan2(1,1);
$radius=6367000;

sub deg2rad {
    $_[0]*$pi/180
}

sub acos {
    atan2(sqrt(1-$_[0]*$_[0]),$_[0])
}

($l1,$l3)= dms2degs(shift);
($l2,$l4)= dms2degs(shift);
printf("%8d${spc}km\n",distance($l1,$l3,$l2,$l4)/1000);
printf("%8d${spc}miles\n",distance($l1,$l3,$l2,$l4)/1609.344);

sub distance {
    $radius*acos(sin($_[0])*sin($_[2])+cos($_[0])*cos($_[2])*cos($_[1]-$_[3]));
}

sub dms2degs {
    $_[0]=~/(\d?\d\d):(\d\d):(\d\d)([NS]),(\d?\d\d):(\d\d):(\d\d)([EW])/i;
    deg2rad(($1+$2/60+$3/3600)*(($4eq"N")?1:-1)),
    deg2rad(($5+$6/60+$7/3600)*(($8eq"E")?1:-1));
}

And then Sebastian Bleasdale submitted a program which fitted the classic PONG game into the pint glass:

Requirements: ANSI terminal in cbreak and noecho mode (stty cbreak -echo)

          #Please_Turn_Off_Text_Buffering#
          print"\e[H\e[J";$a=$b=$n=$m=#sfb
         10                              ;#
         $_                              ="
        "#                                #"
        ."                                "#
        ."                                #"
         ;#                              "|
         $#                              =#
         $_                              x#
          24                            ,#
          $c                            =#
          $d=.03;for(;;++$->5**4?$-=0:do{#
          (select$_=chr(1),"","",0)[0]||#$
           next;sysread(STDIN,$_,1)}){/k/
           ?$n-=($n>5):/a/?$m-=($m>5):/s/
           ?$m+=($m<69):/l/?$n+=($n<69):1
           ;(($a+=$c)<2and$a=2)|($a>72and
            $a=72)and$c=-$c;($b+=$d)<1&#
            abs($a-$m)<4and$b=1.1,$d=-$d
            ,$c+=($a-$m)/50;$b>23&abs($a
            -$n)<4and$b=22.9,$d=-$d,$c+=
            ($a-$n)/50;$c*=0.9while#Pong
             abs($c)>.09;$b>=1&$b<23or#
             die;substr(($o=$#),1698+$n
             ,8)="~k~~~~l~";substr($o,#
              int($b)*74+$a,2)="()";#$
              substr($o,$m-4,8)="_a__"
              ."__s_";print"\e[;H$o"};
 

This entry is great, though it's not the easiest code in the world to decipher. Having worked out how the code works doesn't make the feat less impressive.

The recommended run command is (where pintpong.pl should be renamed by the filename to which the program is saved):

stty cbreak -echo; perl pintpong.pl; stty sane

The fact that this couldn't set the terminal itself was a bit of a problem, and there was a version which did manage it, but it didn't quite conform to the rules. The use of the enforced spaces to draw the playing area was cunning, and Sebastian is the only person who really used those spaces. The commented version may help understanding.

# clear the screen
print"\e[H\e[J";
$a=$b=$n=$m=10;
$_="\n                                   ".
   "                                     #";

# work out our playing area (contained in $#)
$#=$_ x24;

$c=$d=.03;

# this bit is complicated. after every iteration of the loop, add 1 to
# $- (starts at 0) if it reaches 625 then reset it. otherwise select on
# STDIN, and if there is something to read, then read it.
for( ; ;
    ++$->5**4 ?
        $-=0 :
        do {
            (select$_=chr(1),"","",0)[0] || next;
            sysread(STDIN,$_,1)
        }
    ) {
    # $a is the horizontal position of the ball
    # $b is the vertical position of the ball
    # $c is the horizontal velocity of the ball
    # $d is the vertical velocity of the ball
    # $_ contains the current keystroke, if there is one or a ^A if not.

    # this makes the most sense written out like this, and handles the
    # keystroke as necessary
    /k/?$n-=($n>5):
    /a/?$m-=($m>5):
    /s/?$m+=($m<69):
    /l/?$n+=($n<69):1;

    # bounce it at left and right if necessary with the side effect of
    # moving the ball with the ($a+=$c)
    # the (a and b) construction is just an expanded $a<=2 and $a>=72
    # the bitwise or is like a logical or.
    (($a+=$c)<2 and $a=2) | ($a>72 and $a=72) and $c=-$c;

    # bounce it at the top if necessary (with the side effect of moving
    # the ball with the ($b+=$d))
    ($b+=$d)<1 & abs($a-$m)<4 and $b=1.1, $d=-$d ,$c+=($a-$m)/50;

    # bounce it at the bottom if necessary
    $b>23 & abs($a-$n)<4 and $b=22.9, $d=-$d, $c+=($a-$n)/50;

    # make sure it doesn't fly off wildly to the side.
    $c*=0.9 while abs($c)>.09;

    # make sure the ball is in the playing area.
    $b>=1 & $b<23 or die;

    # draw out the current playing area.
    # first the player two bat: 1698=(23*74)-4
    substr(($o=$#),1698+$n,8)="~k~~~~l~";
    # then the ball
    substr($o,int($b)*74+$a,2)="()";
    # then the player one bat
    substr($o,$m-4,8)="_a____s_";

    # reset the cursor, and draw the playing area
    print"\e[;H$o"
};

Jonathan Amery then came up with a Mandelbrot set grapher:

Requirements: ANSI terminal upon which stty size will work

          open(S,"stty\040size\040|");$_=#
          <S>;/(\w*)#cam.pmBFOPerlPContest
         \W                              (#
         \w                              *)
        /x                                ;#
        $s                                =#
        $1                                <(
         $2                              -1
         )/                              2?
         $1                              *2
          :#                            :)
          $2                            -1
          ;$si="\e[0;3";$sij="\e[1;3";@st=
          ($si."1m",$si."2m",$si."3m",$si.
           "4m",$si."5m",$si."6m",$si.###
           "7m",$sij."0m",$sij."1m",$sij.
           "2m",$sij."3m",$sij."4m",$sij.
           "5m",$sij."6m",$sij."7m");for(
            ;$a<$s/2;$a++){print"\n";for
            ($b=0;$b<$s;$b++){$r=0;$c=0;
            for($d=0;$d<@st;$d++){$nr=$r
            *$r-$c*$c;$c=2*$r*$c+$a*(5/#
             $s)-1.25;$r=$nr+$b*(2.5/$s
             )-2;if($r*$r+$c*$c>4){#JDA
             print((@st)[$d]."@");last;
             }}if($d==@st){print$si.###
              "0m@";}}}$_=<>;#Best.run
              #in.an.ANSI.colour.term#
              ##as.large.as.possible##
              #Press<return>to.finish#
 

This one is fairly neat. The use of the size variable to work out how to fit the output into the terminal is clever. Jonathan had lots of space for comments, and there are some particularly nice ones: ``# :)''. In a similar way to part of Sebastian's entry, and unlike the others, he just works round the space. The use of the /x modifier on the regexp for the output of the size was fairly predictable, but clever. The use of the colour code array both as the output and the number of iterations was obvious, but good. The use of "\040" was another space trick that other people could have seen more. It would possibly have been better to build the map in a more interesting way, such as:

@st=map{"$si$_m"}(1..7),map{"$sij$_m"}(0..7);

but Jon's way is totally reasonable. As it was, he was left with a lot of space to use. Given that he's a mathematician, it is surprising that he used $c rather than $i for the "imaginary part" of the complex number, but the algorithm is pretty simple.

open(S,"stty\040size\040|");
$_=<S>;

/(\w*)\W(\w*)/x;

$s=$1<($2-1)/2?$1*2:$2-1;
$si="\e[0;3";
$sij="\e[1;3";

@st=(
    $si."1m",
    $si."2m",
    $si."3m",
    $si."4m",
    $si."5m",
    $si."6m",
    $si."7m",
    $sij."0m",
    $sij."1m",
    $sij."2m",
    $sij."3m",
    $sij."4m",
    $sij."5m",
    $sij."6m",
    $sij."7m"
    );

for( ; $a<$s/2 ; $a++) {
    print "\n";
    for($b=0 ; $b<$s ; $b++) {
        $r=0;
        $c=0;
        for($d=0 ; $d<@st ; $d++) {
            $nr=$r*$r-$c*$c;
            $c=2*$r*$c+$a*(5/$s)-1.25;
            $r=$nr+$b*(2.5/$s)-2;
            if($r*$r+$c*$c>4) {
                print((@st)[$d]."@");
                last;
            }
        }
        if($d==@st) {
            print $si."0m@";
        }
    }
}

$_=<>;

And then, just as it was all about to go quiet, Colin Watson came up with his Star Wars style vector graphics.

Requirements: ANSI terminal with exported LINES and COLUMNS environment variables

          ($.,$;)=@ENV{LINES,COLUMNS};$_='
          .2:2/5.=:2.69A..6:9D..6>.G;1.29J
         ..                              6;
         .M                              ;1
        .2                                9P
        ..                                6;
        .S                                6.
         .6                              9V
         ..                              0>
         .Z                              :2
          .6                            9a
          ..                            6>
          .d;1.29g..6;.j;1.29m..6;';for$w(
          0..29){$#="\e[H";for($i=$.*2;$i;
           --$i){$@=(B^b)x$;if--$|;$h=$.*
           2/($.*2-$i+1);s/\s//g;$v=($h-1
           )*$./2;while(/(.{6})/g){($t,$x
           ,$y,$r,$k,$l)=map-46+$_,unpack
            c6,$1;$p=$t?+$k:$y;$q=$t?$l:
            $y;$z=$r+.8;(next)if$v<$w+$p
            -$z||$v>$w+$q+$z;$y+=$w;for(
            0..$;*2-1){$u=($h*($_-$;)+$;
             )*32/$;;(next)if$u<$x-$z||
             $u>$x+$z;if(!$t){$d=sqrt((
             $v-$y)**2+($u-$x)**2);next
             if$d<$r-.8||$z<$d;$d=atan2
              ($y-$v,$x-$u)/atan2(0,-1
              )*4+4;(next)if$d<$k||$l<
              $d}substr$@,$_/2,1,'*'}}
              $|||($#.=$@.$/)}print$#}
 

This is hard to understand if you aren't up on the maths for vector graphics. Colin's program calculates many different values for the scaling factors. He also used the same trick as some of the others, namely to have a datastream that ignored spaces in the enforced space area of the glass. He also used a number of tricks common to the Perl Golf community --$| being the most obvious, for getting the alternate lines. He also looked at a completely different way of encoding the space. Rather than chr(32) or "\040", Colin went for an out-of-the-box approach ``(B^b)''. In the submission he offered to give the judges his commented version, but this has been left for him to publish to the list. A few brackets have been added and removed below, in the interests of clarity.

Run this as:

LINES=$LINES COLUMNS=$COLUMNS perl colin.pl

($.,$;)=@ENV{LINES,COLUMNS};

$_='.2:2/5.=:2.69A..6:9D..6>.G;1.29J..6;.M;1.29P..6;'.
   '.S6..69V..0>.Z:2.69a..6>.d;1.29g..6;.j;1.29m..6;';

# $w is our framecounter
for $w (0..29) {
    # $# is our output variable, the first thing to do is to reset the
    # cursor to 0
    $#="\e[H";
    
    # $| starts off as 0, so:
    for($i=$.*2 ; $i ; --$i) {
        # this will get executed every second time through the loop
        # (there's no assign to $| anywhere else)
        # so on the 1st, 3rd, 5th iteration, set $@ to linewidth
        # spaces
        $@=(B^b) x $; if --$|;

        # $h has a (slightly shifted) inverse relationship to $i
        $h= $.*2 / ($.*2 -$i +1);

        # turn our data into something useful
        s/\s//g;

        # $v is a scaled version of $h
        $v=($h-1) * $./2;

        # our data is:
        # ( 0, 4,12, 4, 1, 7) ( 0,15,12, 4, 0, 8) (11,19, 0, 0, 8,12)
        # (11,22, 0, 0, 8,16) ( 0,25,13, 3, 0, 4) (11,28, 0, 0, 8,13)
        # ( 0,31,13, 3, 0, 4) (11,34, 0, 0, 8,13) ( 0,37, 8, 0, 0, 8)
        # (11,40, 0, 0, 2,16) ( 0,44,12, 4, 0, 8) (11,51, 0, 0, 8,16)
        # ( 0,54,13, 3, 0, 4) (11,57, 0, 0, 8,13) ( 0,60,13, 3, 0, 4)
        # (11,63, 0, 0, 8,13)

        while(/(.{6})/g) {
            # actually do the read. This trick works because of the /g
            # modifier, which means that the regexp keeps track of where
            # the last match was.
            ($t,$x,$y,$r,$k,$l)=map {$_-46} unpack c6,$1;
            # for each datapoint
            # $t is 0 for a circle and has a value for a rectangle
            # $p is either the 5th or the 3rd digit
            #   (The top of the object?)
            $p=$t?$k:$y;
            # $q is either the 6th or the 3rd digit
            #   (The bottom of the object?)
            $q=$t?$l:$y;
            # $z is the 4th digit + 0.8
            $z=$r+.8;

            # this condition is true if the current scanline (represented
            # by $v) is outside the bounding box of the object
            next if $v<$w+$p-$z || $v>$w+$q+$z;

            $y+=$w;

            # note that the for implicitly localises the loop variable,
            # so $_ at the end of the loop is our dataset
            # iterate $_ over twice the width of the screen
            for (0 .. $;*2-1) {
                # $u is a step in increments of $h*32/<width>, from
                # negative to positive.
                $u=($h*($_-$;)+$;) * 32/$; ;

                # don't do anything if we're to the left or to the right
                # of this object
                next if $u<$x-$z || $u>$x+$z;

                # if $t is 0 then it's a circle, rather than a rectangle,
                # so use it as one.
                if(!$t) {
                    # this is an ellipse formula at ($x,$y), but scaled by
                    # $u and $v in the x and y directions
                    $d=sqrt(($v-$y)**2 + ($u-$x)**2);

                    # draws if it's in the circle which has a hole in it.
                    next if $d<$r-.8 || $z<$d;

                    # $d is in the range 0,8 (scaling by 4/pi)
                    # this allows us to draw only an arc of a circle,
                    # instead of the full thing (hence the ``c'' and
                    # the tops of the ``m''s)
                    $d=atan2($y-$v, $x-$u) / atan2(0, -1) *4 +4;
                    next if $d<$k || $l<$d
                }
                # replace item at position $_/2 with a * (remember that
                # $_ is going to twice the width of the screen)
                substr $@, $_/2, 1, '*'
            }
        }
        # on every second line, append the contents of $# (our output)
        # with $@.$/ ($/ is a "\n" by default).
        $| || ($#.=$@.$/)
    }
    print $#
}

$Id: cpmboppc-summary.shtml,v 1.3 2002/06/02 15:16:37 mbm Exp $