Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

A curses-based JAPH

by brian_d_foy (Abbot)
on Dec 08, 2004 at 20:50 UTC ( [id://413324]=perlmeditation: print w/replies, xml ) Need Help??

Since eyepopslikeamosquito laid out a breif history of the JAPH, I figured I might as well add one of the few that I ever wrote. I'm not much into obfus or code in sigs or what not, but I did have an idea for a JAPH after watching The Matrix a couple times, and up until then I hadn't seen anyone use the entire screen and rand() to make the right string pop up.

I did have a obfuscated version of this somewhere, but I can't find it. Just remove most of the whitespace and shorten all the variable names.

Update: fixed eyepopslikeamosquito (twice) :(

#!/usr/bin/perl -w use strict; use Curses; my @LETTERS = ( 'A' .. 'Z', 'a' .. 'z', ',', ' ' ); $SIG{TERM} = sub { exit }; my $STRING = 'Just Another Perl Hacker,'; my $LENGTH = length $STRING; initscr; my $ROW = ( LINES() % 2 ? LINES() - 1 : LINES() ) / 2; my $COLUMN = ( COLS() % 2 ? COLS() - 1 : COLS() ) / 2 - ( $LENGTH % 2 ? $LENGTH - 1 : $LENGTH ) / 2; my $END_COL = $COLUMN + $LENGTH - 1; my @array; my $count = 0; my $x = random( LINES ); my $y = random( COLS ); my $letter = sub { $LETTERS[ int( rand( @LETTERS ) ) ] }; while( 1 ) { my $x = &$x; my $y = &$y; my $letter = &$letter; next if( $x == $ROW and $array[$y] ); if( $x == $ROW and $y >= $COLUMN and $y <= $END_COL and substr( $STRING, $y - $COLUMN, 1 ) eq $letter ) { $array[$y]++; $count++; } put_letter( $letter, $x, $y ); if( $count == $LENGTH ) { @LETTERS = ' '; } } sub random { my $range = shift; sub { int ( rand ( $range ) ) } } sub put_letter { my ($letter, $x, $y) = @_; addch( $x, $y, $letter ); refresh; }
--
brian d foy <bdfoy@cpan.org>

Replies are listed 'Best First'.
Re: A curses-based JAPH
by chanio (Priest) on Dec 09, 2004 at 03:14 UTC
    Very nice + impressive!

    It reminds me one of the first naughty viruses: cascades.

    There should be an ESC exit key, 'though.

    Thanks for this good example! (and 4 some extra adrenaline!)

    .{\('v')/}
    _`(___)' __________________________
    Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established.
Re: A curses-based JAPH
by eyepopslikeamosquito (Archbishop) on Dec 09, 2004 at 09:09 UTC
    Since eyespoplikeamosquito laid out a brief history of the JAPH ...

    Thanks for the acknowledgement ... despite the spelling variation. ;-) So now I know the merlyn, the larry and the brian have all written a JAPH. What about TheDamian?

      I've never written one. I suppose if I did, my first attempt might look something like:
      #?<')I;G0G2G5S="!A;F]T:&5R(%!E<FP@:&%C:V5R)P``` eval<DATA>;sub'_{$_=unpack+u=>$_=>until/u(?{eval})/} __DATA__ seek+DATA=>$%,%$;_%;for<DATA>=~'.(.*.).'

        Thanks for that. Very evil, er, nice. /me scribbles some new obfu tricks.

        If I may make a criticism of this first attempt from a JAPH beginner, it is the title. AFAICT, by Perl Monks convention, it should read something like "My First JAPH!!!" and contain a plea to please be kind. ;-)

        Oh, and it's not canonical. To canonicalize, replace the first line with:

        #@<')I;G0G2G5S="!A;F]T:&5R(%!E<FP@:&%C:V5R+"<``
        As a bit of a spoiler, re-formatting the code like this:
        #@<')I;G0G2G5S="!A;F]T:&5R(%!E<FP@:&%C:V5R+"<`` eval<DATA>; sub X { $_ = unpack('u', $_) until /u(?{eval})/ } __DATA__ seek(DATA, 0, 0); X() for <DATA> =~ /.(.*.)./;
        makes it a bit easier to understand.

Re: A curses-based JAPH
by mkirank (Chaplain) on Dec 09, 2004 at 15:55 UTC
    Good one :-) ... How long did you take to write this program (Just curious to know)..

      I can't recall, really, since it was so long ago.

      I'm guessing it was 15 minutes or so, then minor changes such as randomizing the location on the screen. It was definitely a lunch time distraction, and I pretty much knew what I wanted to do when I started.

      --
      brian d foy <bdfoy@cpan.org>
Re: A curses-based JAPH
by sgifford (Prior) on Dec 11, 2004 at 06:30 UTC
    IMHO, a JAPH should be short enough to fit in an email sig. Here's my attempt to compress and obfuscate your code:
    use Curses;use integer;@S=split(//,'Just Another Perl Hacker,'); initscr;$C=(COLS()-@S)/2;%j=map{(LINES()/2)."/$_"=>1}($C..$C+@S-1); $x=mr(0..LINES()-1);$y=mr(0..COLS()-1);$l=mr(32..126); while(my($x,$y,$l)=(&$x,&$y,(keys%r==@S)?' ':chr(&$l))){ if($j{"$x/$y"}){next if($r{$y});$r{$y}++ if($S[$y-$C] eq $l)} addch($x,$y,$l);refresh;}sub mr{my@a=@_;sub{$a[rand @a]}}

    I couldn't get it down to 4 lines, but who's picky about USENET .sig files anymore anyways? :)

    Update: Turns out I'm still picky about USENET .sig files. This can be formatted into 4 80-column lines; it's formatted as 5 70-column lines here because otherwise PM wraps it into unreadability.

    use Curses;@S=split(//,'Just Another Perl Hacker,');initscr;$C=int(( &COLS-@S)/2);%j=map{int(&LINES/2)."/$_"=>1}($C..$C+@S-1);($X,$Y,$L)= map{my$n=$_;sub{int rand $n}}(&LINES,&COLS,95);while(($x,$y,$l)=(&$X, &$Y,chr(32+(keys%r==@S?0:&$L)))){if($j{"$x/$y"}){next if($r{$y}); $r{$y}++if($S[$y-$C] eq $l)}addch($x,$y,$l);refresh}
Re: A curses-based JAPH
by drewbie (Chaplain) on Dec 10, 2004 at 22:22 UTC
    Wicked cool! I especially love how the phrase slowly comes into being in the center, and then everything fades away after it's done. Kinda reminds me of the Matrix effect. :-)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://413324]
Approved by atcroft
Front-paged by gellyfish
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2025-06-14 21:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.