[NetBehaviour] Your do is of reference the they with be theynone work
Alan Sondheim
sondheim at panix.com
Mon Jul 6 23:25:05 CEST 2009
Thanks for asking, some code below, which is all a mess, kludged, etc. One
advantage for me of perl/awk/ is that it _is_ surface and amenable to easy
experimenting.
Words backwards in a line:
awk -f
{
for ( i = NF; i >= 1; i-- )
printf "%s ", $i;
printf "\n";
}
Eliminating all but the first instance of a string (usually word):
#!/usr/local/bin/perl5
while (<STDIN>) {
@words = split /[\s]+/, $_;
@spaces = split /[\S]+/, $_;
for ($x=0; $x <= $#words; $x++) {
$word_count{$words[$x]}++;
if ($word_count{$words[$x]} == 1)
{print $words[$x],$spaces[$x+1]}
}
}
Florian Cramer's antiorp script -
#!/usr/local/bin/perl5.6.0
while (<STDIN>) {
s/love/lv/g;
s/Love/Lv/gi;
s/(\W)s([aeiouy])/\1tz\2/g;
s/Be([e]*[^aeiouy][aeiouy])/B\1/g;
s/be([e]*[^aeiouy][aeiouy])/b\1/g;
s/B[e]+(\W)/B\1/g;
s/b[e]+(\W)/b\1/g;
s/ce(\W)/sz\1/g;
#s/ec[]/sz\1/g;
#s/([^aeiouy][^aeiouy])e(\s)/\1\2/g;
#s/([^aeiouy])e([^aeiouy][^aeiouy])/\1\2/g;
s/0/o/g;
s/([\W]*)one(\W)/\1\\0\\1\2/g;
s/([\W]*)and(\W)/\1+\2/g;
s/([\W]*)you(\W)/\1u\2/g;
s/([\W]*)You(\W)/\1U\2/g;
s/([\W]*)are(\W)/\1r\2/g;
s/([\W]*)are(\W)/\1R\2/gi;
s/([\W]*)there(\W)/\1da\2/g;
s/([\W]*)There(\W)/\1Da\2/gi;
s/([\W]*)t[o]+(\W)/\1\\2\2/gi;
s/(\W)w/\1u/g;
s/(\W)W/\1U/g;
s/w(\W)/u\1/g;
s/W(\W)/U\1/g;
s/fo[u]*r/4/gi;
s/[tc]ion/zion/gi;
s/([\W]*)are(\W)/\1=\2/gi;
s/([\W]*)is(\W)/\1=\2/gi;
s/([\W]*)is that(\W)/\1=\2/gi;
s/([\W]*)were(\W)/\1=\2/gi;
s/([\W]*)was(\W)/\1=\2/gi;
s/([\W]*)am(\W)/\1=\2/gi;
s/[\W]*\?/ \+\?/gi;
s/al(\W)/l\1/g;
s/uce/usz/g;
s/ll/l/g;
s/s([^zh])/z\1/g;
s/S([^ZH])/Z\1/gi;
s/ck/-k/g;
s/c([iey])/z\1/g;
s/c/k/g;
s/C/K/gi;
s/th([aeiouy])/dz\1/g;
s/Th([aeiouy])/Dz\1/gi;
s/q/k/g;
s/Q/K/gi;
s/ter/tr/g;
# i rules
s/in([de])/9n\1/gi;
s/i/!/gi;
s/y([\W])/!\1/gi;
# f rules
s/f(\W)/v\1/g;
s/F(\W)/V\1/g;
s/f/ph/g;
s/er/r/g;
s/(\W)ph/\1f/g;
s/\\([0-9])/\1/g;
s/z[e][ea](\W)/z\1/g;
s/x/kx/g;
s/'//g;
print $_;
}
Fun script for John Giorno-like texts (similar to the others) -
#!/usr/local/bin/perl5
while (<STDIN>) {
@words = split /[\s]+/, $_;
@spaces = split /[\S]+/, $_;
for ($x=0; $x <= $#words; $x++) {
$word_count{$words[$x]}++;
if ($word_count{$words[$x]} == 1)
{print $words[$x],$spaces[$x+1],$words[$x-8],"\n"}
}
}
Using mathematical functions to parse a text (function variable):
&parse_file_into_words("zz", 6000, " \$i*.5 - 4 * sin(\$i * 2)");
sub parse_file_into_words
{
print "\n"; #blank line
my ($extract_filename, $iterations, $formula) = @_;
open(IN, "< $extract_filename") or die("can't open
$extract_filename:
$!");
my $line, $i, $index;
my $full_file = "";
while ($line = <IN>)
{
chomp($line);
$full_file = join " ", $full_file, $line;
}
close(IN);
my @words = split(/\s+/, $full_file);
for ($i=1; $i<=$iterations; $i++)
{
$index = word_index($i, $formula)-1;
print "$words[$index] ";
}
print "\n"; #blank line
}
sub word_index
{
my $ret_val;
my ($i, $formula) = @_;
$ret_val = eval($formula);
return int $ret_val;
}
Another
&parse_file_into_words("zz", 1000, " \$i - 2 * sin(\$i * 3)");
sub parse_file_into_words
{
print "\n"; #blank line
my ($extract_filename, $iterations, $formula) = @_;
open(IN, "< $extract_filename") or die("can't open
$extract_filename:
$!");
my $line, $i, $index;
my $full_file = "";
while ($line = <IN>)
{
chomp($line);
$full_file = join " ", $full_file, $line;
}
close(IN);
my @words = split(/\s+/, $full_file);
for ($i=1; $i<=$iterations; $i++)
{
$index = word_index($i, $formula)-1;
print "$words[$index] ";
}
print "\n"; #blank line
}
sub word_index
{
my $ret_val;
my ($i, $formula) = @_;
$ret_val = eval($formula);
return int $ret_val;
}
Etc.
Also using awk -f to create long text substitutions (part shown)
{
for ( i = NF; i >= 1; i-- )
printf "%s ", $i;
printf "\n";
}
/^$/ { print "1" }
/[a]+/ { print "10" }
/[b]+/ { print "11" }
/[c]+/ { print "100" }
... etc. etc.
/[z]+/ { print "emptied 10011" }
/[a]+/ { print "10100 10101" }
/[e]+/ { print "untethered" }
/[i]+/ { print "the language" }
/[o]+/ { print "11111 11111" }
etc. etc.
There's also some really clumsy stuff that I use for 'pushing' texts I
write into like
#!/usr/local/bin/perl5 -w
# Makes new gender lines in a trace file
# which represent the striations of user's desire
$t = time;
$| = 1;
srand time;
@a=("hard", "soft", "velvet", "cotton", "linen", "flax", "pure",
"black", "dirty", "clean", "soiled", "sexy", "wet", "sleazy",
"wayward", "nice", "feminine", "lovely", "used", "fashionable", "small",
"death-like", "lively", "protruding", "penetrating", "thrusting",
"giving", "forgiving", "poor", "rich", "sedate", "wanton", "contrary",
"nervous", "wandering", "ill", "uneasy", "spry", "florid", "edgy",
"neurotic", "psychotic", "catatonic", "loose", "taut", "tight",
"depressed", "manic");
@verb=("thrusts", "turns", "surrounds", "oozes", "inherits", "splays",
"plays", "mixes", "amuses", "runs", "flows", "repairs");
@prep=("beneath or within", "beyond", "throughout", "confusing",
"staining", "accompanying");
@noun=("breast", "love", "passion", "womb", "being", "your penis",
"your vagina", "your makeup", "your masquerade", "my makeup",
"my masquerade");
@nnn=("flower", "thing", "hole", "stick", "frock", "jumper", "skin");
$nnnn= int rand(8);
$non = int rand(11);
$non1 = int rand(7);
$pre = int rand(6);
$gen = int(48*rand);
$gen1 = int(48*rand);
$gen2 = 49 - int(40*rand);
$time = int(time/3600);
$g = int(8*rand);
if ($sign=fork) {print "\nOpen your mouth...\n";}
else {sleep(1); print "\nAh... speak... speak...\n";
exit(0);}
sleep(2);
print "\nJennifer, what do they call you, when they call you...\n";
chop($that=<STDIN>);
print "\nAre you dressed as $that? Is $that dressed as you?\n";
print "Are you in your @nnn[$nnnn], are you in your flesh, ah don't answer...\n"; sleep(1);
print "Ah...\n";
sleep(2);
print "\nIs Julu wearing your ... , are you wearing your @nnn[$non1]? \n";
chop($str=<STDIN>);
if ($str eq "no") {print "\nShow me your panties...\n"; sleep(10); goto FINAL;}
else {print "\nI love your feelings, $that ...\n";}
print "Would $that mind you partying?", "\n" if 1==$g;
print "Your thighs are moist and inviting", "\n" if 5==$g;
print "Your breasts call me to them...", "\n" if 6== $g;
print "Your tongue speaks so sweetly, turning me grrrl", "\n" if 4==$g;
sleep(1);
print "\n at noun[$non1] @verb[$non] me @prep[$nnnn] your @nnn[$non1]!\n";
print "\nWhat do you call your @a[$gen2] @nnn[$nnnn]?\n";
$name=<STDIN>;
chop $name;
print "\n";
print "$that, $name turns my @nnn[$g] ", "\n" if 3==$g;
print "$that, $name opens me totally to you!", "\n" if 7==$g;
print "Nothing moves, river deep...", "\n" if 5==$g;
print "Your $name is mine, my sweet $that, I am yours!", "\n" if 2==$g;
sleep(1);
print "Your body parts, mine, in a dark list, list them... \n";
print "one by one, each on a line alone, typing Control-d when done.\n";
@adj=<STDIN>;
chop(@adj);
$size=@adj;
$pick=int(rand($size));
srand;
$newpick=int(rand($size));
print "\nMy @adj[$pick] is yours...\n";
$be=int(rand(4));
open(APPEND, ">> enfolding");
print APPEND
join(":",$name,$str,$that, at adj[$pick + 1], @adj[$newpick + 1]), "\n";
# join(":", at adj,$name,$str,$sign,$g,$that,$name, at adj[$pick]), "\n";
print APPEND "Would $that mind you partying, $name, with us?\n" if 3==$be;
print APPEND "Come home with me, $name, julu-of-the-fast-crowd!\n" if 2==$be;
print APPEND "Your @a[$gen1] @adj[$pick] is in my @a[$gen] @adj[$newpick]\n" if 1 > $b3;
print APPEND "Your @noun[$non1] seeps into my @adj[$newpick] - turning me Julu-Jennifer\n" if 0==$be;
print APPEND "Ah, @noun[$non] eaten by julu-of-the-open-arms and julu-depressed\n" if (2 < $be);
print APPEND "Devour @a[$gen1] @adj[$pick] julu-of-the partying $name!\n" if 1==$be;
close(APPEND);
open(STDOUT);
if ($pid = fork) {
$diff=$pid - $$;
print "$name makes me thoughtful $diff times!", "\n" if 5 < $g;
print <<Construct;
$name calls forth @a[$gen1] @noun[$non], eating, excreting memory.
@prep[$pre] the @a[$gen], $name is @a[$diff], @a[$gen], $str?
... @noun[$non] is @adj[$newpick] here, it's @noun[$non]?
Construct
} else {
close (STDOUT);
system("touch .trace; rev enfolding >> .trace");
system("rm enfolding");
exit(0);
}
sleep(1);
print "Are you becoming close to Jennifer's $name?\n";
chop($answer=<STDIN>);
if ($answer eq "no") {print "You're dealing with @a[10+$pre] Jennifer.\n";}
if ($answer eq "yes") {print "Ah, a @a[10+$pre] and @a[15+$pre] fantasy!\n";}
print "You melt into Julu's skin forever...", "\n\n" if 3 < $g;
print "I think $name $pid is your scar, your wound, your brand.", "\n\n" if 3==$g;
print "... @a[$non] $name $$ is Julu's gift to you ...", "\n\n" if 6==$g;
print "Your $name $diff is darling Jennifer's flesh", "\n\n" if 4==$g;
print "You wore her frock for $time hours?", "\n" if 2==$g;
sleep(1);
print "$name and $$ and $pid - and you knew that all along!", "\n\n" if 2==$g;
sleep(1);
print "Wait! $name and $pid are gone forever!", "\n\n" if 1==$g;
FINAL: {
$d = int((gmtime)[6]);
$gen3 = 48 - int(20*rand);
print "For $d @a[$gen2] days, I have been @a[$gen3] Julu ...";
print "\n";
$u = (time - $t)/60;
printf "and it has taken you just %2.3f minutes turning Jennifer ...", "$u";
print "\n\n";
print `rev .trace`, "\n\n";
}
exit(0);
- I don't use these much any nore. I also did some substitution stuff in
the lisp doctor program, 'aiming' it towards Nikuko and avatars instead of
psychoanalysis.
That's pretty much it or the range of it. I use rev and tac sometimes or
this substitution in vi -
for tac use vi :g/^/mo0
- that's about it, thanks for asking.
None of these progras are elegant except Florian's and Eliminate.pl which
I think Jim Reith wrote for me, but they work, more or less..
- Alan
More information about the NetBehaviour
mailing list