SPB109@psuvm.psu.edu (sean brennan) (02/17/90)
Program Mega2 (input,output,picfile);
{sean brennan spb109@psuvm 2/15/90}
uses
Crt, Dos, Graph;
var
picfile:text;
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 }
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 }
procedure rotate (var px,py,pz,qx,qy,qz,xy,xz,yz:real);
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);
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):real;
begin
zee:=x*y*cos(x*y);
{if (x=0) or (y=0) then zee:=0
else zee:=x*y*(x*x-y*y)/(x*x+y*y);
zee:=2*y*y*sin(2*x);
zee:=1/(x*x+y*y+0.35){*cos(x*x+y*y);}
end;
procedure sphere(ex,ey,ez,xy,xz,yz,il,ii:real; up,lf:boolean);
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);
var
xl,yl,x1,x2,y1,y2,z1,z2,xinc,yinc,yjust:real;
x2d1,y2d1,x2d2,y2d2,thing:integer;
begin
xl:=-inter; yl:=-inter;
xinc:=0; yinc:=0;
if updn then xinc:=inten else yinc:=inten;
if lfteye then yjust:=-0.1 else yjust:=0.1;
repeat
yl:=-inter;
repeat
x1:=xl-eyex;
x2:=x1+xinc;
y1:=yl-eyey;
y2:=y1+yinc;
z1:=zee(xl,yl)-eyez;
z2:=zee(xl+xinc,yl+yinc)-eyez;
rotate(x1,y1,z1,x2,y2,z2,xy,xz,yz);
y1:=y1+yjust;
y2:=y2+yjust;
shadow(x1,y1,z1,x2,y2,z2,x2d1,y2d1,x2d2,y2d2);
line(x2d1,y2d1,x2d2,y2d2);
yl:=yl+inten;
until (yl>(inter-yinc));
xl:=xl+inten;
until (xl>(inter-xinc));
end;
function angle(theta:real):real;
begin
angle:=theta*3.141592654/180;
end;
procedure getinfo;
var
ex,ey,ez,xy,xz,yz,ival,tens:real;
begin
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);
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);
{
looper(ex,ey,ez,xy,xz,yz,ival,tens,false,false);
looper(ex,ey,ez,xy,xz,yz,ival,tens,true,false);
setcolor(4);
looper(ex,ey,ez,xy,xz,yz,ival,tens,false,true);
looper(ex,ey,ez,xy,xz,yz,ival,tens,true,true); }
readln;
end;
begin
getinfo;
end.