Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
This camel keeps the time! It's a JAPH, a timepiece, and a really nice drawing of our beloved dromedary all rolled into one.

#!perl -w use strict; $_=' $,=$/;$|=@_ =split//,"Justan othe rPerl.hacker";$/=\'$~= (local tim e)[$.]*($.==0||$.==1?1:5);s ubstr($_,eval \\\'$^=$~*2*atan2(1,1)/15;int(- cos($^) *($=+ 1)+11.5)*25+int(sin($^)*($=+1)+12.5)\\\',1, $_[$=+(11,4,0)[$.]])\';do{$_=("."x287). "#"."."x287;for$=(0..10){$.=0;eval$/; $=<7&&($.=1,e val$/);$=<4& &($.=2,ev al$/);}p rint(p ack(" c3 ", 27,9 1, 72 ),(/ .{ 25 }/g) ,s ca lar( lo cal time) );} whil e(slee p(1))';s/\s+//g;eval
Download and run this one in a vt102 compatible terminal for best results. I tested it in cygwin rxvt and Linux xterm and it runs smoothly.

I started this one as a challenge to myself to learn more about the power of the Perl interpreter internals. I also kept snapshots of my working scripts so that I could share my experience with you, my fellow monks. The final script above is just obfuscated enough to be a pain in the butt for a novice to understand yet still entertain the seasoned Perl hacker. Let's start with the first non-obfuscated script...

#!perl
$|=1;
$w = 25;
$h = 25;
$hm=pack"c3",27,91,72;
$img="."x($w*$h-1);
substr($img,11*$w+12,1,"#"); # in the middle
$,="\n";
@hour=split//,"Just";
@min =split//,"another";
@sec =split//,"Perl hacker";
while(1){
@t = localtime;
$_=$img;
for $hidx(0..3) {
	$newx=newx($t[2]%12*30+180,0,2+$hidx)+12;
	$newy=newy($t[2]%12*30+180,0,2+$hidx)+11;
	$vx = sprintf("%d", $newx);
	$vy = sprintf("%d", $newy);
	substr($_,$vy*$w+$vx,1,$hour[$hidx]);
}
for $midx(0..$#min) {
	$newx=newx($t[1]*6,0,-4-$midx)+12;
	$newy=newy($t[1]*6,0,-4-$midx)+11;
	$vx = sprintf("%d", $newx);
	$vy = sprintf("%d", $newy);
	substr($_,$vy*$w+$vx,1,$min[$midx]);
}
for $sidx(0..$#sec) {
	$newx=newx($t[0]*6,0,-1-$sidx)+12;
	$newy=newy($t[0]*6,0,-1-$sidx)+11;
	$vx = sprintf("%d", $newx);
	$vy = sprintf("%d", $newy);
	substr($_,$vy*$w+$vx,1,$sec[$sidx]);
}
  print $hm,(/.{$w}/g),scalar localtime;
  sleep 1;
}
sub newx {
  my($ang,$x,$y) = @_;
  my $a=$ang * atan2(1,1)/45;# angle in radians
  return 
    ($x)*cos($a) - ($y)*sin($a);
}
sub newy {
  my($ang,$x,$y) = @_;
  my $a=$ang * atan2(1,1)/45;# angle in radians
  return 
    ($x)*sin($a) + ($y)*cos($a);
}
exit 0;
...since I was in hack mode i did not use -w nor 'use strict.' Basically, the script creates a 25x25 matrix of dots and then calculates the positions of the clock hands based on localtime and adds them to the matrix. The vt100 codes for 'move to the home position' are printed followed by the matrix. Feel free to /msg me if you have any questions about how this works.

Ok, back to our obfuscation. My first thought after looking at this script was that this script is too long and that I should focus my effort on shortening the script as much as possible through refactoring and any Perl tricks that I could think of and apply. So after a good deal of refactoring and using eval to call my subroutines, I shortened it to the following code.

#!perl
$|=$b=1;
$,=$/;
@B=split//,"Just another Perl hacker";
$n='$a=$X*2*atan2(1,1)/15;int(-cos($a)*($i+1)+11.5)*25+int(sin($a)*($i+1)+12.5)';
$o='$X=(localtime)[$r]*$b;substr($_,eval $n,1,$B[$i+$c])';
do{
    $_="."x287 ."#"."."x287;
    for $i(0..10) {
		$r=0;$c=13;$b=1;eval $o;
	  $i<7&&($r=1,$c=5 ,$b=1,eval $o);
	  $i<4&&($r=2,$c=0 ,$b=5,eval $o);
    }
    print pack("c3",27,91,72),(/.{25}/g),scalar localtime;
}while(sleep 1);
Nice! Now I have a short enough script to obfuscate. :) The next step is where I learned a lot about builtin variables. Making the script run with -w and use strict; without using my was a bit of a challenge. Since I wanted to use builtin variables, I needed to reduce the number of scalars that I was using because there is a limited number of read/write builtins that I could use. I removed $b and $c by mapping their values using $r as an index into an array that returned the values I needed, e.g. (1,2,3)[$r]. There are still places in the script where things could be shortened, for instance scalar localtime is there as a visual cue only and could be removed.

Preparing the script for "shape change" brought about an interesting problem; if you have escaped quotes in your eval string, you will need to add additional back-slashes to compensate for the translation. I found that using a color syntax hiliting editor such as vim helped tremendously in discovering this problem. Here is the script after substituting builtin variables for my regular variables and after preparation for drawing, e.g. wrapping it in $_='code with spaces';s/ //g;eval allowing me to add spaces whereever I need to.

#!perl  -w
use strict;
$_='
$,=$/;$|=@_=split//,"JustanotherPerl.hacker";$/=\'
$~=(localtime)[$.]*($.==0||$.==1?1:5);substr($_,ev
al\\\'$^=$~*2*atan2(1,1)/15;int(-cos($^)*($=+1)+11
.5)*25+int(sin($^)*($=+1)+12.5)\\\',1,$_[$=+(11,4,
0)[$.]])\';do{$_=("."x287)."#"."."x287;for$=(0..10
){$.=0;eval$/;$=<7&&($.=1,eval$/);$=<4&&($.=2,eval
$/);}print(pack("c3",27,91,72),(/.{25}/g),scalar(l
ocaltime));}while(sleep(1))
';s/\s+//g;
eval
After removing all the spaces, I tested the script and ran into a few problems that parens fixed, such as "."x287."#" will flag an error because the interpreter thinks 287." is a floating point number. I put parens around the expression ("."x287)."#" to fix it.

The other issue that I found while preparing this script for a shape change is that all the backslashes and quotes that make up the escaped quote could not be separated in the drawing itself because that would terminate the beginning quote, e.g. keep \' together without spaces. Keeping that in mind, load the script in your favorite editor and move things around until you have a drawing that you like. Go back to the beginning of this article to see the final result!

There you have it! JAPH, Camel, and a timepiece, and as always TMTOWTDI!

--
hiseldl

P.S. Only the camel code at the beginning is wrapped in <code> tags to make downloading easier. That means you will have to cut/paste the rest of the code, which is there for illustrative purposes only anyway ;)


In reply to Camel Time by hiseldl

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2024-03-29 10:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found