Article 4637 of comp.lang.perl:
Xref: feenix.metronet.com alt.3d:1002 comp.lang.perl:4637
Newsgroups: alt.3d,comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!wupost!eclnews!vader!flan
From: flan@vader.wustl.edu (Ian Flanigan)
Subject: Perl Script for Generating Text Stereograms (was Re: Text SIRDS)
Message-ID: <1993Jul29.061017.24015@wuecl.wustl.edu>
Summary: (see above)
Keywords: SIRDS, stereo, random, perl
Sender: usenet@wuecl.wustl.edu (News Administrator)
Organization: Washington University, St. Louis MO
References: <1993Jul28.054623.20843@wuecl.wustl.edu>
Date: Thu, 29 Jul 1993 06:10:17 GMT
Lines: 229

As promised, here is the perl script that makes Random Letter
Stereograms.

In its current incarnation this script creates stereo images of
functions of two variables, x and y.  I did it this way because I
didn't want to have to go through the trouble of creating a disparity
map by hand.  As a consequence, most of the script deals with
generating the map.

The function can be any valid perl expression that uses the variables
$x and $y.  Perl supplies all of the basic trigonometric functions as
well as exponentiation.  Some examples of cool functions are listed in
the comments in the script.  For more details on perl, look at the man
page or buy the "Camel Book" from your favorite bookstore.

The stereogram generated by the script does not have fine detail, but
then we're dealing with characters, so what can you expect?  ;-)  I
get the best results when I use a *really* big xterm (190x56).  A
small font helps get more detail as well.  For a really whacky
display, try using the unreadable font.  Mind you, this makes it take
quite a while.

Anyway, try it out & see how you like it.  If you find some cool
functions, please send them to me or post them to the net.

--
Ian Flanigan

Washington University in St. Louis	"You can never have too many napkins."
flan@arl.wustl.edu

--- Cut Here ---
#!/pkg/gnu/bin/perl
#
# Text Random Letter Stereogram Generator
#
# by Ian Flanigan (flan@cs.wustl.edu)
#
#     Copyright (C) 1993 Ian T. M. Flanigan
#     
#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 1, or (at your option)
#     any later version.
#     
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
#     
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#     For more information write:
#       Ian Flanigan
#       Department of Computer Science
#       Campus Box 1045
#       Washington University
#       St. Louis, MO  63130-4899
#
#    Please send all comments, suggestions, changes and/or enhancements to:
#       flan@cs.wustl.edu
#
#    Thanks much.
#
#    Usage:  rlsg [-rows <rows>] [-cols <cols>] [-f <function>]
#                 [-s <sep>] [-t <top>] [-b <bottom>] [-r <right>]
#                 [-l <left>]
#
#       <rows> is the number of rows the output image will have.  This
#           defaults to 56 for file output and the size of the terminal
#           for tty output;
#       <cols> is the number of columns the output image will have. This
#           defaults to 190 for file output and the size of the terminal
#           for tty output;
#       <function> a function of two variables, $x and $y.  This *must*
#           be in valid perl syntax.  "rlsg -f '(0)' will give a flat
#           background.
#       <sep> is the base separation to wich the output of <function>
#           is added.
#       <top> is the maximum y coordinate of the function calculated.
#       <bottom> is the minimum y coordinate of the funtion calculated.
#       <left> is the maximum x coordinate of the funtion calculated.
#       <right> is the minimum x coordinate of the funtion calculated.
#
#    Examples:
#
#       rlsg -f '$x' -s 20 -t 3
#       rlsg -f '$y**2 - $x**2' -t 3
#       rlsg -f '3 * cos($x**2 + $y**2)'
#       

require "newgetopt.pl";		# You may have to get this from the Perl
				# FTP site.

$res = &NGetOpt( ("rows:i","cols:i","f:s","s:i","t:f","b:f","l:f","r:f") );

if (!$res)
{
    print q/
    Usage:  rlsg [-rows <rows>] [-cols <cols>] [-f <function>]
                 [-s <sep>] [-t <top>] [-b <bottom>] [-r <right>]
                 [-l <left>]/;
    print "\n\n";
    die;
}

#
# Find out the number of Rows and Columns for the ouput
#

$rows = 56;			# These are the defaults since that's the
$cols = 190;			# size of the biggest xterm on my screen.

if (-t STDOUT)			# System V users may have to change the
{				# "stty" syntax or remove it altogether.
    system "stty -a > /tmp/rlsg$$";
    open(STTY,"</tmp/rlsg$$");	# Yes, this is a hack.  Solaris stty does
    @stty_out = <STTY>;		# not like giving its output to pipes, so
    close(STTY);		# we must use the silly file.  It's a pain.
    $stty_out = "@stty_out";
    ($null,$rows) = ($stty_out =~ /rows(\s|=)+([0-9]+)/);
    ($null,$cols) = ($stty_out =~ /columns(\s|=)+([0-9]+)/);
    $cols--;			# Keep it from overflowing a line.
}

$rows = $opt_rows if $opt_rows;	# This makes the command line override the
$cols = $opt_cols if $opt_cols;	# best guess we could make.


#
# Find the default maximum seperation
#
# The value here should be between 20 and 40.  The bigger the number, the
# farther back the image will be placed.  If it's too big (wider than your
# eyes), you won't be able to see it at all.
#

$sep = 25;			# This is an easy value to see.
$sep = $opt_s if $opt_s;	# Command line override.


#
# Find the function to plot
#
# Any function will do, but the best looking ones usually are combinations
# of trig functions.  It should be a function of $x and $y.
#

$func = '(5 * sin($x*2) * cos($y*2))'; # Egg carton-like
$func = $opt_f if $opt_f;


#
# Find the boundries of the function to plot
#
# These are good values for the default function.  Note that if just the
# top of the box is specified, it is centered around 0,0.  Likewise, if
# the right is set, but not left, the left defaults to -right.
#

$top = atan2(1,0);
$top = $opt_t if $opt_t;

$bot = -$top;
$bot = $opt_b if $opt_b;

$right = $top;
$right = $opt_r if $opt_r;

$left = -$right;
$left = $opt_l if $opt_l;


srand;				# Seed random numbers . . .

$#screen = $rows-1;		# Allocate the @screen array

for $row (0..$rows-1)		# Fill it in with garbage
{
    for(0..$cols-1)
    {
	$screen[$row] .= sprintf("%c", 65 + rand 26);
    }
}

$rstep = ($top - $bot) / $rows;	      # Row step size
$cstep = ($right - $left) / $cols;    # Column step size

				# To make the disparity map,
$loop = q/			# This gets collected and evaluated:
for $row (0..$rows-1)
{
    $y = $top - ($row * $rstep);
    for $col (0..$cols)
    {
	$x = $left + ($col * $cstep);
	$disp{$row,$col} = $sep + / . $func . q/; # <- User function here
    }
}/;

eval $loop;			# Evaluate the loop.

die $loop . "\n" . $@ if $@;	# Quit if there was an error

for $row (0..$rows-1)		# Use the disparity map to manipulate the
{				# random image created before
    for $col (0..$cols-1)
    {
	$foo = $col + $disp{$row,$col};
	substr($screen[$row],$col+$disp{$row,$col},1) =
	    substr($screen[$row], $col, 1);
    }
}

for $row (1..$rows-1)		# Print it all out
{
	print substr($screen[$row],0,$cols) . "\n";
}

exit 0;

__END__
-- 
Ian Flanigan

Washington University in St. Louis	"You can never have too many napkins."
flan@arl.wustl.edu


Article 4658 of comp.lang.perl:
Xref: feenix.metronet.com alt.3d:1015 comp.lang.perl:4658
Newsgroups: alt.3d,comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!wupost!eclnews!vader!flan
From: flan@vader.wustl.edu (Ian Flanigan)
Subject: Re: Perl Script for Generating Text Stereograms (was Re: Text SIRDS)
Message-ID: <1993Jul29.213652.16064@wuecl.wustl.edu>
Summary: Patch 01
Keywords: SIRDS, stereo, random, perl
Sender: usenet@wuecl.wustl.edu (News Administrator)
Organization: Washington University, St. Louis MO
References: <1993Jul28.054623.20843@wuecl.wustl.edu> <1993Jul29.061017.24015@wuecl.wustl.edu>
Date: Thu, 29 Jul 1993 21:36:52 GMT
Lines: 26


Well, there was a small bug in the first version I posted.  The
temporary file that was created never got removed.  The following is a
very small context diff that will patch it up.  You can use patch or
just enter the line in by hand.

Sorry 'bout that folks.

*** rlsg	Thu Jul 29 16:31:17 1993
--- rlsg.old	Thu Jul 29 16:30:50 1993
***************
*** 87,93 ****
      open(STTY,"</tmp/rlsg$$");	# Yes, this is a hack.  Solaris stty does
      @stty_out = <STTY>;		# not like giving its output to pipes, so
      close(STTY);		# we must use the silly file.  It's a pain.
-     unlink("/tmp/rlsg$$");
      $stty_out = "@stty_out";
      ($null,$rows) = ($stty_out =~ /rows(\s|=)+([0-9]+)/);
      ($null,$cols) = ($stty_out =~ /columns(\s|=)+([0-9]+)/);
--- 87,92 ----

-- 
Ian Flanigan

Washington University in St. Louis	"You can never have too many napkins."
flan@arl.wustl.edu