SPB109@psuvm.psu.edu (sean brennan) (02/23/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 } choice:char; begin write('Enter Graphics Mode: 1=vga 2=ega.'); repeat write('Enter mode:'); readln(choice); until choice in ['1','2']; { 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 if choice='1' then GraphDriver := Detect { use autodetection } else begin graphdriver:=3; graphmode:=0; end; 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 if xp3<0.0001 then xp3:=0.0001; if xq3<0.0001 then xq3:=0.0001; 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-versa} 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-interval} 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; writeln('Last note: the values given above will point you at just about'); writeln('Any function. Have Fun!'); 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; done,showsphere:boolean; begin done:=false; repeat 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, sort-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); writeln('1:A burr or bug or something.Take interval less than 1.6'); writeln('2:Neat wave graph. Nice. Take interval less than 2'); writeln('3:Like a saddle sorta. Take interval less than 1.4'); writeln('4:My favorite. A ripple wave like water. neat. Less than 4.5'); writeln('5:A black hole. Interesting. Take interval less than 4'); write('Enter function number(or a non-numeric for the sphere):'); readln(key); if key in ['1'..'9'] then begin choice:=ord(key)-ord('1')+1; showsphere:=false; end else showsphere:=true; setcolor(black); setbkcolor(black); setfillstyle(solidfill,black); bar(0,0,maxx,maxy); setcolor(3); if showsphere then begin 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); end else begin 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); end; readln; write('Enter "q" to quit or any other key to see another:'); while not keypressed do; key:=readkey; writeln; if key in ['q','Q'] then done:=true; until done; end; begin initialize; setbkcolor(0); getinfo; end.