SPB109@psuvm.psu.edu (sean brennan) (02/21/90)
Program Mega2 (input,output);
{sean brennan spb109@psuvm 2/15/90}
uses
Crt, Dos, Graph;
{********I didn't use any global variables. these are property of ****}
{********turbo pascal*************************************************}
var
GraphDriver : integer; { The Graphics device driver }
GraphMode : integer; { The Graphics mode value }
MaxX, MaxY : word; { The maximum resolution of the screen }
ErrorCode : integer; { Reports any graphics errors }
MaxColor : word; { The maximum color value available }
OldExitProc : Pointer; { Saves exit procedure address }
{*********** i didn't write the following procedure*****************}
procedure Initialize;
{ Initialize graphics and report any errors that may occur }
var
InGraphicsMode : boolean; { Flags initialization of graphics mode }
PathToDriver : string; { Stores the DOS path to *.BGI & *.CHR }
begin
{ when using Crt and graphics, turn off Crt's memory-mapped writes }
filemode:=0;
DirectVideo := False;
OldExitProc := ExitProc; { save previous exit proc }
PathToDriver := 'n:\turbo\graphics\';
filemode:=0;
repeat
GraphDriver := Detect; { use autodetection }
InitGraph(GraphDriver, GraphMode, PathToDriver);
ErrorCode := GraphResult; { preserve error return }
if ErrorCode <> grOK then { error? }
begin
Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
if ErrorCode = grFileNotFound then { Can't find driver file }
begin
Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
Readln(PathToDriver);
Writeln;
end
else
Halt(1); { Some other error: terminate }
end;
until ErrorCode = grOK;
Randomize; { init random number generator }
MaxColor := GetMaxColor; { Get the maximum allowable drawing color }
MaxX := GetMaxX; { Get screen resolution values }
MaxY := GetMaxY;
end; { Initialize }
{************************************************************************}
{*****I DID NOT WRITE THE ABOVE PROCEDURE. IT'S ONLY FUNCTION IS TO******}
{*****SET UP THE GRAPHICS SCREEN IN TURBO PASCAL GRAPHICS. **************}
{************************************************************************}
procedure rotate (var px,py,pz,qx,qy,qz,xy,xz,yz:real);
{this handles the rotation of the camera so it can point in any direction}
{the matrix for this can be found in any linear algrbra book. essentially,}
{the xy rotation doesn't effect the z coord., and the xz rotation doesn't }
{change the y coord. etc...}
var
x1,y1,z1,x2,y2,z2:real;
begin
x1:=-sin(xy)*py+cos(xy)*px; y1:=sin(xy)*px+cos(xy)*py;
x2:=-sin(xz)*pz+cos(xz)*x1; z1:=sin(xz)*x1+cos(xz)*pz;
y2:=-sin(yz)*z1+cos(yz)*y1; z2:=sin(yz)*y1+cos(yz)*z1;
px:=x2; py:=y2; pz:=z2;
x1:=-sin(xy)*qy+cos(xy)*qx; y1:=sin(xy)*qx+cos(xy)*qy;
x2:=-sin(xz)*qz+cos(xz)*x1; z1:=sin(xz)*x1+cos(xz)*qz;
y2:=-sin(yz)*z1+cos(yz)*y1; z2:=sin(yz)*y1+cos(yz)*z1;
qx:=x2; qy:=y2; qz:=z2;
end;
procedure shadow (xp3,yp3,zp3,xq3,yq3,zq3:real;var xp,yp,xq,yq:integer);
{this is the heart of the 3-d program. it transforms the 3d image into the 2d}
{image using a pinhole camera as a model. the x-axis is the horizon.}
{the farther down the x-axis you are, the farther away from the camera you are}
{the smaller you appear on the screen. (see function). maxx/2 and maxy/2 are}
{the center of the screen, since the image's points can be either positive}
{or negative. the "1.31" in the calculation of the 2d"y" points is to offset}
{the natural distortion of the computer screen. (we're not dealing with}
{square pixels)}
begin
xp:=round(maxx*(yp3/xp3)+maxx/2); yp:=round(-maxy*(zp3/xp3)*1.31+maxy/2);
xq:=round(maxx*(yq3/xq3)+maxx/2); yq:=round(-maxy*(zq3/xq3)*1.31+maxy/2);
end;
function zee(x,y:real;choice:integer):real;
{this is the surface function the the program plots}
begin
case choice of
1:zee:=x*y*cos(x*y); {4-legged spider? burr? I have no idea}
2:if (x=0) or (y=0) then zee:=0 {this is a beautiful graph of a}
else zee:=x*y*(x*x-y*y)/(x*x+y*y); {single pedal flower-a must!}
3:zee:=2*y*y*sin(2*x); {this one is pretty dull.}
4:zee:=1/(x*x+y*y+0.35)*cos(x*x+y*y); {a pool after a drop of water hits
it}
5:zee:=-1/(x*x+y*y+0.0001); {looks like a black hole}
6:zee:=x*x+y*y; {a steep bowl}
end;
end;
procedure sphere(ex,ey,ez,xy,xz,yz,il,ii:real; up,lf:boolean);
{this is a parametric representation of a sphere. see the comments in the}
{next procedure to understand this one}
var
x1,x2,y1,y2,z1,z2:real;
xa,xb,ya,yb:integer;
loop1,loop2:real;
yjust,inc1,inc2,inc:real;
begin
inc1:=0; inc2:=0;
inc:=0.3141592654;
if up then inc1:=0.3141592654 else inc2:=ii;
if lf then yjust:=-0.13 else yjust:=0.13;
loop1:=0;
loop2:=-il;
repeat
loop1:=0;
repeat
x1:=cos(loop1)*il*sin((loop2-il)*3.141592654/il/2)-ex;
x2:=cos(loop1+inc1)*il*sin((loop2-il+inc2)*3.141592654/il/2)-ex;
y1:=sin(loop1)*il*sin((loop2-il)*3.141592654/il/2)-ey;
y2:=sin(loop1+inc1)*il*sin((loop2-il+inc2)*3.141592654/il/2)-ey;
z1:=il*cos((loop2-il)*3.141592654/il/2)-ez;
z2:=il*cos((loop2-il+inc2)*3.141592654/il/2)-ez;
rotate(x1,y1,z1,x2,y2,z2,xy,xz,yz);
y1:=y1+yjust;
y2:=y2+yjust;
shadow(x1,y1,z1,x2,y2,z2,xa,ya,xb,yb);
line(xa,ya,xb,yb);
loop1:=loop1+inc;
until (loop1>(6.28318));
loop2:=loop2+ii;
until loop2>(il-ii);
end;
procedure looper (eyex,eyey,eyez,xy,xz,yz,inter,inten:real;
updn,lfteye:boolean;choice:integer);
{This is the bear that steps through the interval using proper incrimentation}
{eyex...inten are obvious. updn decides if the lines being drawn go along the}
{x-axis or the y-axis. lfteye tells if the image is for the left eye or the}
{right.}
var
xl,yl,x1,x2,y1,y2,z1,z2,xinc,yinc,yjust:real;
x2d1,y2d1,x2d2,y2d2,thing:integer;
begin
xl:=-inter;{set the x-counter}
xinc:=0; yinc:=0; {reset the x and y dispacements to 0}
if updn then xinc:=inten else yinc:=inten; {decide which shall be
displaced}
if lfteye then yjust:=-0.1 else yjust:=0.1;{offset the eye to the left if}
repeat {it's the left eye and
vice-ver}a}
yl:=-inter; {set the y-counter}
repeat
x1:=xl-eyex; {x1,y1,z1 and x2,y2,z2 are the endpoints of}
x2:=x1+xinc; {the line segment to be drawn.}
y1:=yl-eyey;
y2:=y1+yinc;
z1:=zee(xl,yl,choice)-eyez;
z2:=zee(xl+xinc,yl+yinc,choice)-eyez;
rotate(x1,y1,z1,x2,y2,z2,xy,xz,yz); {rotates the points about
the eye}
y1:=y1+yjust; {yjust is the distance between the left and}
y2:=y2+yjust; {right eyes.}
shadow(x1,y1,z1,x2,y2,z2,x2d1,y2d1,x2d2,y2d2);{this is what}
{transforms the 3-d image into the 2d image}
line(x2d1,y2d1,x2d2,y2d2); {draws the line}
yl:=yl+inten; {incriments the y-loop}
until (yl>(inter-yinc)); {until it has stepped though the y-interv} }
xl:=xl+inten; {incriments the x-loop}
until (xl>(inter-xinc)); {until it has stepped through the y-unterval}
end;
function angle(theta:real):real;
{computers think in radians. People think in degrees. This function}
{changes the angle of rotation that the user types in into radians,}
{so the computer can handle it}
begin
angle:=theta*3.141592654/180;
end;
procedure instruct; {Free information!}
begin
writeln('This program will plot a 3-d surface (i.e. z=f(x,y) )');
writeln('in perspective. It will draw it from any angle, at any');
writeln('distance. you can literally look at the graph any way ');
writeln('you want to. it uses 3-d glasses (blue on left, red');
writeln('on right) and VGA graphics. In order to see the graph,');
writeln('you must tell the program how, where, and how much of');
writeln('the graph you wish to see. initially, you are at the ');
writeln('point (0,0,0) looking along the x-axis in the positive');
writeln('direction:');
writeln(' | (y-) | (x+) ');
writeln(' | | ');
writeln(' | :(facing up)');
writeln('(x-)---+>------(x+) ----------+---------- ');
writeln(' | (facing right) (z-) | (z+)');
writeln(' | | ');
writeln(' |(y+) | (x-) ');
writeln('Press <enter> to continue...');
readln;
writeln('you are first asked to enter your 3-d coordinants.');
writeln(' i.e. your "eye"s position is entered as the first 3');
writeln(' questions. The next part is the rotations. ');
writeln('NOTE: ROTATIONS MUST BE ORDERED! they are NOT commutitive.');
{I can NOT spell worth a darn.}
writeln('the first is the xy-rotation. if you shake your head like');
writeln('you were saying "no", this is the xy-rotation. you are ');
writeln('rotating to the left. (a 90 degree rotation would face you');
writeln('toward the negative y axis) the xz rotation is similar to ');
writeln('head movements when saying "yes". (shake shake) you are ');
writeln('rotating down. a 90 rotation would face you along the z-');
writeln('axis in the negative direction. Lastly, the yz-rotation');
writeln('is simial to being strapped to a windmill propeller. you');
writeln('are rotating counterclockwise. This concludes "eye" placement');
writeln('press <enter> .....');
readln;
writeln('the last question askes you for the interval length. This ');
writeln('is done in both the X and Y directions, positive and negative');
writeln('centered about the origin. for example, a value of 3 would go');
writeln('from -3 to 3 in the x- direction, -3 to 3 on the y direction');
writeln('and the z component is dependant on z=f(x,y)');
writeln('the intensity is just a bad way of asking for how much you');
writeln('want to incriment the interval by. (it is usually a decimal)');
writeln('for example, an interval of 1 and an intensity of 0.5 would');
writeln('proceed as: -1,-0.5,0,0.5,1 ');
writeln('Lastly, function number is simply the function you wish to see.'); ;
writeln('Two good ones are #2 and #4.');
writeln('press <enter> .....');
readln;
writeln('A good example picture will result from the following data:');
writeln('Enter the eye''s x coord:-4');
writeln('Enter the eye''s y coord:4');
writeln('Enter the eye''s z coord:4');
writeln('Enter the xy rotation:45');
writeln('Enter the xz rotation:35');
writeln('Enter the yz rotation:0');
writeln('Enter the interval:1.6');
writeln('Enter the intensity:0.25');
writeln('Enter function number:2');
writeln;
writeln('I hope you enjoy the program. Please send all comments to:');
writeln(' Sean Brennan');
writeln(' 245 Marple rd.');
writeln(' Haverford, Pa');
writeln(' 19041 -USA or SPB109@psuvm');
writeln('press <enter> to enter values....');
readln;
end; {information}
procedure getinfo;
{ this procedure get's all the necessary information in order to run }
{ program. coordinants of the eye are taken, as well as rotations and}
{ function number. the interval over which the graph is drawn is also}
{ entered, as well as the incrimentation of the interval. If you wish}
{to see the sphere, remove the comment delimeters around the calling }
{statements, and put the "looper" statements in comments so only the }
{sphere is drawn.}
var
ex,ey,ez,xy,xz,yz,ival,tens:real;
choice:integer;
key:char;
begin
clrscr;
writeln('Neat Program written by Sean Brennan (spb109@psuvm)');
writeln('You are looking allong the x-axis, toward the positive');
writeln('For a fuller explanation of how the program works, press');
writeln('"I" at the prompt. (<Enter> proceeds with program exicution');
if keypressed then key:=readkey; {this will clear the keyboard buffer}
t-of}
write('Enter "I" or <Enter> now:====>');
while not keypressed do; {wait for a key to be pressed}
key:=readkey;
writeln;
if key in ['i','I'] then instruct;
write('Enter the eye''s x coord:');
readln(ex);
write('Enter the eye''s y coord:');
readln(ey);
write('Enter the eye''s z coord:');
readln(ez);
write('Enter the xy rotation:');
readln(xy);
xy:=angle(xy);
write('Enter the xz rotation:');
readln(xz);
xz:=angle(xz);
write('Enter the yz rotation:');
readln(yz);
yz:=angle(yz);
write('Enter the interval:');
readln(ival);
write('Enter the intensity:');
readln(tens);
write('Enter function number:');
readln(choice);
initialize;
setcolor(3);
{
sphere (ex,ey,ez,xy,xz,yz,ival,tens,false,false);
sphere (ex,ey,ez,xy,xz,yz,ival,tens,true,false);
setcolor(4);
sphere (ex,ey,ez,xy,xz,yz,ival,tens,false,true);
sphere (ex,ey,ez,xy,xz,yz,ival,tens,true,true);
}
setcolor(3);
looper(ex,ey,ez,xy,xz,yz,ival,tens,false,false,choice);
looper(ex,ey,ez,xy,xz,yz,ival,tens,true,false,choice);
setcolor(4);
looper(ex,ey,ez,xy,xz,yz,ival,tens,false,true,choice);
looper(ex,ey,ez,xy,xz,yz,ival,tens,true,true,choice);
readln;
end;
begin
getinfo;
end.