Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Morphological Japh

by liverpole (Monsignor)
on May 28, 2006 at 18:51 UTC ( [id://552203]=obfuscated: print w/replies, xml ) Need Help??

Morphological (adj):

    Relating to or concerned with the formation of admissible words in a language.

Morph (noun,verb):

    Computer-assisted process in which an image (or video) is gradually transformed (morphosed) into another.

This program has been tested under both Linux and Windows with the following syntax, where "[...]" indicates an optional argument:

In Linux:  perl morph.pl  [[entropy-radius]  delay-factor]

In Windows:  morph.pl  [[entropy-radius]  delay-factor]

Without options, default values are supplied (delay-factor = 0, entropy-radius=240).  A single option is taken to be a delay-factor in fractions of a second (eg. "0.05" for five hundredths of a second).  If two options are provided, the second is the delay-factor, and the first is an entropy-radius, which dictates how far from the center to position elements in the most random frame.  Try experimenting with different values for each to see what results are produced.

sub J{print"\e[H",$_[0];$d&&select$D,$D,$D,$d} sub A{$V={};@V=split$/, pop;for($w=$y=0;$y<@V;$y++){$Y=$V[$y];@_=split(//,$Y);map{$_[$_]eq$"or $V->{$w++}=[$_,$y]}0..@_-1}$V->{_}=$w;$V}sub P{my($X,$E)=@_;$E+=$W?31: 101;$e = $W? "\e[4;7;${E}m": "\e[${E}m";$X=~s/( +)/\e[m$1$e/g&&$X}eval {require Win32::Console::ANSI};sub H{int rand pop}sub _{($j,$c,$n)=@_; $h=$j->{_};@J=($"x79)x22;$|=0;map{$Q=$j->{$_%$h};$q=$s->{$_%$s->{_}};( $M,$m)=(@$Q);($O,$o)=(@$q);if($M!=$O||$m!=$o){$M=($Q->[0]-=($M<=>$O)); $m=($Q->[1]-=($m<=>$o));++$|}substr($ J[$m],$M,1,chr 33+H 93)}0..$h-1; push@$c,P(join($/,@J),$n%6);$|}s''>?!O"?GIIAA??C!L!DC.?AAIGG??Aaa"_#?@ DDC??!O>?!O"?GIIAA??CLLl!d!c,?Aaigg__!a&_?@DDC??!O>?!O!?OYYi!a_ckkG!`" c)?__aaigg__!a\'_@DDC??!O>?!O!?OYyi!q_ckkyrrhim}}woOP@BE]}|llqqa!yqov~ ~hjeeiggxxzVFFBIWWOAII?OQQ!O>?!O"?!I!Q?Ckkyrzji!}yWORRnm}}~~|}qa!yqp"~ vfmiywxzz~vvBIYWW!I"Q"O>?!O!?QYYGWYYi!kyrzjquu}iGwrv~k{qrvt{uayww``nmm uu~miyoqij~|saiYYWIIY!QA?"O>?!O!?QYYGWYyi!k}vvdssuaigir~|koorbfceayww` hnneoowiyqoaajl|soiyyOAAQOO"?!O>?!O!?QYYGOQQackk}vvd{{!ywyr~|kssvffcea ywwhhnffppwiyywiijn~uqiyyoaAQ\'O>?!O!?QYYI!QAckkyrrhww!ywyr~|kssvffcea ywwghnnfppxiyywiijn~uqiyyoaaQ\'O>?!O??AQYYIA!QEK{yrjhwoqaigibnlkoorbb_ aaywwow}}~pphiyqoaabdtsogWwoaaQOO>?!O??AQYWG??QQU[[ZBjhwoqqiggbf~l|rrb `geaywwpo!}p`hiiyoqabv|s_GWYoaaQ!O#?O>??!O?AQYWG??ARV\\\\JBJGGW!Ywwrr~ n!~Nlkea!yb`fnnh`_iiyWWyzz~vfJIyoqAAOO!W"O>!?OOQAQWWG!?BV^LJBA!GYQYwwo pbf~}\Llc_a!ya`FNnhg_aiIGWWyzbffnMKOQQA?#WOO>:?$_!?"_!o_"?#_$?#_%?"G>% ?3O#o"Oo!_oOO!?OO#o%O"o\'OWWO>%?4O"o#O!_ooO!?#o\'O"o&OWWOO>;?"_&?!o#_* ?!_%?GG>:?"_(?\'_\'?"_>9?"_&?%_?"_&?$_>7?$_9?%_';$d=pop||0;$r=pop||240 ;$W=($^O=~/win/i);s/\n//gs;s/>/\n/g;$I=$_;map{$K=$_;$k= chr$K+30;map{$ S=chr($_+63);$I=~s/\Q$k$S\E/$S x$K/eg;}(0..63)}(3..32);@L=map{$A=$_;$; ="";map{$_.='?'x(79-(y///c));map{$;.=1<<$A&(-63+ord$_)?'@':$"}split//; $;.=$/}split$/,$I;$/.$;}(0..5);print"\e[2J\n";{$F=$L[$a++%6];$T=$L[$a% 6];$f=$F;$t=$T;$l=$C++%6;$u=A$f;$v=A$t;@b=@B=();$R=$v->{_};$s={};for($ L=0;$L<$R;$L++){{$g=H 78;$G=H 21;(($g-40)**2+($G-10)**2)>$r and redo;$ s->{$L}=[$g,$G]}}$s->{_}=$R;while(_$u,\@b,$l){}while(_$v,\@B,$l+01){}J P$f,$l;sleep 1;map{J$_}(@b,reverse@B);J P$t,($l+1)%6;redo}#~liverpole~

Update:  Added parentheses to 79-(y///c), as per teamster_jr's helpful observation below.

Update 2:  Fixed a typo (thanks fenLisesi!)


s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Replies are listed 'Best First'.
Re: Morphological Japh
by teamster_jr (Curate) on May 30, 2006 at 13:18 UTC
    i've seen this not compiling in versions <5.8 at line 26 - it thinks the 79-y///c is an "unrecognized file test: -y".
    a patched version follows (which i've tested on 5.6.1 and 5.8.3)- it just needed some brackets :
    sub J{print"\e[H",$_[0];$d&&select$D,$D,$D,$d} sub A{$V={};@V=split$/, pop;for($w=$y=0;$y<@V;$y++){$Y=$V[$y];@_=split(//,$Y);map{$_[$_]eq$"or $V->{$w++}=[$_,$y]}0..@_-1}$V->{_}=$w;$V}sub P{my($X,$E)=@_;$E+=$W?31: 101;$e = $W? "\e[4;7;${E}m": "\e[${E}m";$X=~s/( +)/\e[m$1$e/g&&$X}eval {require Win32::Console::ANSI};sub H{int rand pop}sub _{($j,$c,$n)=@_; $h=$j->{_};@J=($"x79)x22;$|=0;map{$Q=$j->{$_%$h};$q=$s->{$_%$s->{_}};( $M,$m)=(@$Q);($O,$o)=(@$q);if($M!=$O||$m!=$o){$M=($Q->[0]-=($M<=>$O)); $m=($Q->[1]-=($m<=>$o));++$|}substr($ J[$m],$M,1,chr 33+H 93)}0..$h-1; push@$c,P(join($/,@J),$n%6);$|}s''>?!O"?GIIAA??C!L!DC.?AAIGG??Aaa"_#?@ DDC??!O>?!O"?GIIAA??CLLl!d!c,?Aaigg__!a&_?@DDC??!O>?!O!?OYYi!a_ckkG!`" c)?__aaigg__!a\'_@DDC??!O>?!O!?OYyi!q_ckkyrrhim}}woOP@BE]}|llqqa!yqov~ ~hjeeiggxxzVFFBIWWOAII?OQQ!O>?!O"?!I!Q?Ckkyrzji!}yWORRnm}}~~|}qa!yqp"~ vfmiywxzz~vvBIYWW!I"Q"O>?!O!?QYYGWYYi!kyrzjquu}iGwrv~k{qrvt{uayww``nmm uu~miyoqij~|saiYYWIIY!QA?"O>?!O!?QYYGWYyi!k}vvdssuaigir~|koorbfceayww` hnneoowiyqoaajl|soiyyOAAQOO"?!O>?!O!?QYYGOQQackk}vvd{{!ywyr~|kssvffcea ywwhhnffppwiyywiijn~uqiyyoaAQ\'O>?!O!?QYYI!QAckkyrrhww!ywyr~|kssvffcea ywwghnnfppxiyywiijn~uqiyyoaaQ\'O>?!O??AQYYIA!QEK{yrjhwoqaigibnlkoorbb_ aaywwow}}~pphiyqoaabdtsogWwoaaQOO>?!O??AQYWG??QQU[[ZBjhwoqqiggbf~l|rrb `geaywwpo!}p`hiiyoqabv|s_GWYoaaQ!O#?O>??!O?AQYWG??ARV\\\\JBJGGW!Ywwrr~ n!~Nlkea!yb`fnnh`_iiyWWyzz~vfJIyoqAAOO!W"O>!?OOQAQWWG!?BV^LJBA!GYQYwwo pbf~}\Llc_a!ya`FNnhg_aiIGWWyzbffnMKOQQA?#WOO>:?$_!?"_!o_"?#_$?#_%?"G>% ?3O#o"Oo!_oOO!?OO#o%O"o\'OWWO>%?4O"o#O!_ooO!?#o\'O"o&OWWOO>;?"_&?!o#_* ?!_%?GG>:?"_(?\'_\'?"_>9?"_&?%_?"_&?$_>7?$_9?%_';$d=pop||0;$r=pop||240 ;$W=($^O=~/win/i);s/\n//gs;s/>/\n/g;$I=$_;map{$K=$_;$k= chr$K+30;map{$ S=chr($_+63);$I=~s/\Q$k$S\E/$S x$K/eg;}(0..63)}(3..32);@L=map{$A=$_;$; =""; map{$_.='?'x(79-(y///c));map{$;.=1<<$A&(-63+ord$_)?'@':$"}split// ;$;.=$/}split$/,$I;$/.$;}(0..5);print"\e[2J\n";{$F=$L[$a++%6];$T=$L[$a %6];$f=$F;$t=$T;$l=$C++%6;$u=A$f;$v=A$t;@b=@B=();$R=$v->{_};$s={};for( $L=0;$L<$R;$L++){{$g=H 78;$G=H 21;(($g-40)**2+($G-10)**2)>$r and redo; $s->{$L}=[$g,$G]}}$s->{_}=$R;while(_$u,\@b,$l){}while(_$v,\@B,$l+01){} J P$f,$l;sleep 1;map{J$_}(@b,reverse@B);J P$t,($l+1)%6;redo}#liverpole
    al
          it just needed some brackets

      Actually, they're parentheses  ;-)

      Thanks for catching that, and fixing it.  I was impressed that you reformatted it in such a way as to preserve the original structure.  There's actually an even simpler way, which is just to remove the 2 extra whitespaces within that line.  (I will go ahead and update the original so as to avoid the problem for anyone who downloads it directly).


      s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
        it just needed some brackets
        Actually, they're parentheses ;-)

        well quite *cough* pedant *cough* :)
        And of course in true perl fashion TAMWTDI - there are other ways of fixing it, including adding a whitespace between - and y///.
        al
Re: Morphological Japh
by wulvrine (Friar) on May 30, 2006 at 11:12 UTC
    . o O (How does he doooo that!)
    Definite ++ !!
    Too bad I can't give more than one vote for this 'scatter'ing of code!
    Most impressive.

    s&&VALKYRIE &&& print $_^q|!4 =+;' *|
Re: Morphological Japh
by liverpole (Monsignor) on Jun 02, 2006 at 15:00 UTC
    Several people have asked me for the source code, so I'm posting it here.  This is the original code, which both creates the "multiple-layer" image, and the final compressed image, and then uncompresses and "peels" each layer off to provide individual the individual image frames which are morphed in progression.

    You can make any changes to the array @layers, and it will create the corresponding frames in the output "morph".


    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
Re: Morphological Japh
by Anonymous Monk on Jun 02, 2006 at 09:29 UTC
    sub J { print("\e[H", $_[0]); ($d and select($D, $D, $D, $d)); } sub A { ($V = {}); (@V = split(m[$/], pop(@_), 0)); for (($w = ($y = 0)); ($y < @V); (++$y)) { ($Y = $V[$y]); (@_ = split(//, $Y, 0)); map({(($_[$_] eq $") or ($$V{$w++} = [$_, $y]));} (0 .. (@_ - +1))); } ($$V{'_'} = $w); $V; } sub P { (my($X, $E) = @_); ($E += ($W ? 31 : 101)); ($e = ($W ? "\e[4;7;${E}m" : "\e[${E}m")); (($X =~ s/( +)/\e[m$1$e/g) and $X); } eval { do { require Win32::Console::ANSI } }; sub H { int(rand(pop(@_))); } sub _ { (($j, $c, $n) = @_); ($h = $$j{'_'}); (@J = ((($" x 79)) x 22)); ($| = 0); map({($Q = $$j{$_ % $h}); ($q = $$s{$_ % $$s{'_'}}); (($M, $m) = @$Q); (($O, $o) = @$q); if ((($M != $O) or ($m != $o))) { ($M = ($$Q[0] -= ($M <=> $O))); ($m = ($$Q[1] -= ($m <=> $o))); (++$|); } substr($J[$m], $M, 1, chr((33 + H(93))));} (0 .. ($h - 1))); push(@$c, P(join($/, @J), ($n % 6))); $|; } s//>?!O"?GIIAA??C!L!DC.?AAIGG??Aaa"_#?\@\nDDC??!O>?!O"?GIIAA??CLLl!d!c +,?Aaigg__!a&_?\@DDC??!O>?!O!?OYYi!a_ckkG!`"\nc)?__aaigg__!a'_\@DDC??! +O>?!O!?OYyi!q_ckkyrrhim}}woOP\@BE]}|llqqa!yqov~\n~hjeeiggxxzVFFBIWWOA +II?OQQ!O>?!O"?!I!Q?Ckkyrzji!}yWORRnm}}~~|}qa!yqp"~\nvfmiywxzz~vvBIYWW +!I"Q"O>?!O!?QYYGWYYi!kyrzjquu}iGwrv~k{qrvt{uayww``nmm\nuu~miyoqij~|sa +iYYWIIY!QA?"O>?!O!?QYYGWYyi!k}vvdssuaigir~|koorbfceayww`\nhnneoowiyqo +aajl|soiyyOAAQOO"?!O>?!O!?QYYGOQQackk}vvd{{!ywyr~|kssvffcea\nywwhhnff +ppwiyywiijn~uqiyyoaAQ'O>?!O!?QYYI!QAckkyrrhww!ywyr~|kssvffcea\nywwghn +nfppxiyywiijn~uqiyyoaaQ'O>?!O??AQYYIA!QEK{yrjhwoqaigibnlkoorbb_\naayw +wow}}~pphiyqoaabdtsogWwoaaQOO>?!O??AQYWG??QQU[[ZBjhwoqqiggbf~l|rrb\n` +geaywwpo!}p`hiiyoqabv|s_GWYoaaQ!O#?O>??!O?AQYWG??ARV\\\\JBJGGW!Ywwrr~ +\nn!~Nlkea!yb`fnnh`_iiyWWyzz~vfJIyoqAAOO!W"O>!?OOQAQWWG!?BV^LJBA!GYQY +wwo\npbf~}\\Llc_a!ya`FNnhg_aiIGWWyzbffnMKOQQA?#WOO>:?\$_!?"_!o_"?#_\$ +?#_%?"G>%\n?3O#o"Oo!_oOO!?OO#o%O"o'OWWO>%?4O"o#O!_ooO!?#o'O"o&OWWOO>; +?"_&?!o#_*\n?!_%?GG>:?"_(?'_'?"_>9?"_&?%_?"_&?\$_>7?\$_9?%_/; ($d = (pop(@ARGV) || 0)); ($r = (pop(@ARGV) || 240)); ($W = ($^O =~ /win/i)); s/\n//gs; s/>/\n/g; ($I = $_); map({($K = $_); ($k = chr(($K + 30))); map({($S = chr(($_ + 63))); ($I =~ s/\Q$k$S\E/($S x $K);/eg);} (0..63));} (3..32)); (@L = map({($A = $_); ($; = ''); map({($_ .= ('?' x (79 - tr//\000-\377/c))); map({($; .= (((1 << $A) & ((-63) + ord($_))) ? '@' : $"));} split(//, +$_, 0)); ($; .= $/);} split(m[$/], $I, 0)); ($/ . $;);} (0..5))); print("\e[2J\n"); { ($F = $L[($a++) % 6]); ($T = $L[$a % 6]); ($f = $F); ($t = $T); ($l = (($C++) % 6)); ($u = A($f)); ($v = A($t)); (@b = (@B = ())); ($R = $$v{'_'}); ($s = {}); for (($L = 0); ($L < $R); (++$L)) { { ($g = H(78)); ($G = H(21)); ((((($g - 40) ** 2) + (($G - 10) ** 2)) > $r) and redo); ($$s{$L} = [$g, $G]); } } ($$s{'_'} = $R); while (_($u, (\@b), $l)) { (); } while (_($v, (\@B), ($l + 1))) { (); } J(P($f, $l)); sleep(1); map({J($_);} @b, reverse(@B)); J(P($t, (($l + 1) % 6))); redo; } # ae
Re: Morphological Japh
by Ray Smith (Beadle) on Jun 09, 2006 at 12:37 UTC
    Very picturesque!

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2024-03-28 12:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found