P is for Practical PerlMonks

### Morphological Japh

by liverpole (Monsignor)
 on May 28, 2006 at 18:51 UTC Need Help??

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]

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 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!

Create A New User
Node Status?
node history
Node Type: obfuscated [id://552203]
Approved by Arunbear
Front-paged by teamster_jr
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (2)
As of 2018-04-21 03:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (81 votes). Check out past polls.

Notices?