dueland@isucs1.UUCP (07/31/85)
The program sends the plotter codes to the standard output. To
use the program you must redirect the output to a file and then
send the file to the appropriate plotting device. For example:
pc surf.p ; compile it first
surf > surf.gra ; run it and redirect the output
qpr -q surf.gra ; send the output to the plotter
-------------------------------------------------------------------
program surf( input, output );
{
This is a simple surface plotter that uses the line drawing
capabilities of the QMS laser printer. It is unsophisticated,
you must recompile every time you change the function, and
there is no hiding of unviewable lines. It is fairly portable
to other devices - you just need to rewrite the plot and move
procedures, and set the constants to there appropriate values.
If anyone adds the facility to input new functions without
recompiling, or adds hidden line capability, please send me a
copy. Thanks - Ray Dueland at Iowa State University
Bugs - well, kind of a bug. When the plot is tipped at more of
an angle, the height of the lines on the z axis (y on the 2D
plot) should get smaller. Actually: z = z*cos(view_angle);
I haven't set up the view angle in terms of degrees, so I just
didn't add this.
}
const
{ these must be set for a given plotter }
XPLOTMEDIAN = 5500; { don't change this once set }
XPLOTWIDTH = 9000; { make this smaller to narrow the surface }
YPLOTWIDTH = 6000; { monkey with the sz/bz to change the }
YPLOTBASE = -1000; { height of the plot, leave this once set }
{ plot characteristics }
RESLNS = 35; { lines (-1) in each direction on plot }
TICS = 3; { number of lines that make up each box side }
LIFTFRACT = 0.40; { angle the plot is viewed at }
{ limits of function for the plot }
sx = -15.3; sy = -15.3; sz = -25;
bx = 15.3; by = 15.3; bz = 25;
{ --- plotter independent stuff first --- }
procedure plot( x, y : integer ); forward;
procedure move( x, y : integer ); forward;
function fofxy( x, y : real ): real;
begin
{fofxy := ln( (cos(x+y)/sin(x*y)) );}
{fofxy := -x*y*x;}
fofxy := 15*cos(sqrt(x*x+y*y))/(sqrt(x*x + y*y) + 0.1);
{fofxy := (x-1)/(y*y-4);}
end;
function xlift( x : real ): real;
begin
xlift := ((x-sx)/(bx-sx))*LIFTFRACT*YPLOTWIDTH;
end;
function ylift( y : real ): real;
begin
ylift := ((y-sy)/(by-sy))*LIFTFRACT*YPLOTWIDTH;
end;
function xoff( x : real ): real;
begin
xoff := ((x-sx)/(bx-sx))*(XPLOTWIDTH/2);
end;
function yoff( y : real ): real;
begin
yoff := ((y-sy)/(by-sy))*(XPLOTWIDTH/2);
end;
procedure yzplot( y, z, x : real; action : char );
var plotx, ploty : integer;
begin
plotx := round( (XPLOTMEDIAN -
((y-sy)/(by-sy))*(XPLOTWIDTH/2) + xoff(x)) );
ploty := round( (((z-sz)/(bz-sz))*YPLOTWIDTH + YPLOTBASE +
ylift(y) + xlift(x)) );
if action = 'm' then
move( plotx, ploty )
else
plot( plotx, ploty );
end;
procedure xzplot( x, z, y : real; action : char );
var plotx, ploty : integer;
begin
plotx := round( (XPLOTMEDIAN +
((x-sx)/(bx-sx))*(XPLOTWIDTH/2) - yoff(y)) );
ploty := round( (((z-sz)/(bz-sz))*YPLOTWIDTH + YPLOTBASE +
ylift(y) + xlift(x)) );
if action = 'm' then
move( plotx, ploty )
else
plot( plotx, ploty );
end;
procedure xz;
var a, b : integer;
x, y : real;
begin
for a := 0 to RESLNS do
begin
y := sy + (a/RESLNS)*(by-sy);
for b := 0 to RESLNS*TICS do
begin
x := sx + (b/(RESLNS*TICS))*(bx-sx);
if b = 0 then
xzplot( x, fofxy(x,y), y, 'm')
else
xzplot( x, fofxy(x,y), y, 'p');
end;
end;
end;
procedure yz;
var a, b : integer;
x, y : real;
begin
for a := 0 to RESLNS do
begin
x := sx + (a/RESLNS)*(bx-sx);
for b := 0 to RESLNS*TICS do
begin
y := sy + (b/(RESLNS*TICS))*(by-sy);
if b = 0 then
yzplot( y, fofxy(x,y), x, 'm')
else
yzplot( y, fofxy(x,y), x, 'p');
end;
end;
end;
{ --- plotter dependent code --- }
function log( n : integer ): integer;
{ hmmm, where are the pascal libraries ... }
var i : integer;
begin
i := 0;
while ((n div 10) > 0) do
begin
i := i + 1;
n := n div 10;
end;
log := i;
end;
procedure print5( n : integer );
var i : integer;
begin
for i := 1 to (4-log(n)) do
write('0');
write( n:1 );
end;
procedure plot{( x, y : integer )};
begin
write('^D');
print5( y );
write(':');
print5( x );
write( chr(10) );
end;
procedure move{( x, y : integer )};
begin
write('^U');
print5( y );
write(':');
print5( x );
write( chr(10) );
end;
procedure init;
begin
write('^PY^-', chr(10), '^IGV^PW03', chr(10) );
end;
procedure reset;
begin
write('^IGE^O^-', chr(10), '^PN^-', chr(10), chr(12) );
end;
begin
init;
xz;
yz;
reset;
end.