home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Megahits 4
/
MegaHits_Vol.4.iso
/
amiga_magazin
/
amiga_magazin_ii
/
6_94_2
/
einstein
/
einstein.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-10-23
|
8KB
|
256 lines
program einstein;
(****03.02.94*******************************************
* *
* DeepSpace9 *
* *
* (c) 1994 by Daniel Gembris *
* *
* Dieses Programm berechnet die Ansicht eines fast *
* mit Lichtgeschwindigkeit fliegenden Würfels für *
* einen ruhenden Beobachter. *
* *
* Das Programm basiert auf folgendem Artikel, der *
* in den "Proceedings auf the SIGGRAPH convention" *
* (1990) erschienen ist: *
* " T-Buffer: Fast Visualization of Relativistic *
* Effects in Spacetime", Pink-Kang Hsiung, *
* Robert H. Thibadeau, Michael Wu (Carnegie Mellon *
* University; Pittsburgh, Pennsylvania 15213) *
* *
********************************************************)
uses graphics,intuition;
const YRES = 512;
XRES = 640;
c = 299792.5; (* Lichtgeschwindigkeit in km/s *)
pi=3.14159;
anzpunkte=8;
anzkanten=12;
schrittweite=10; (* alle <schrittweite> km ein Foto *)
type tpunkt = record
x,y,z:longint;
end;
tpunkte=array[0..anzpunkte-1,0..2] of longint;
tkanten=array[0..anzkanten-1,0..1] of longint;
var vx,vy,vz: real; (* Objekt-Geschwindigkeitsvektor *)
r,r1:real;
punkte:tpunkte;
kanten:tkanten;
viewx,viewy,viewz,viewt:real;
(* xz-Ebene ist Projektionsebene *)
i,steps:integer; (* in soviele Stücke wird eine Kante zerlegt *)
frames:integer; (* Anzahl der Animations-Frames *)
shandle,shandle2:^screen;
whandle,whandle2:^Window;
rhandle,rhandle2,msg:ptr;
dummy:LONG;
stri:string;
erg:boolean;
a,b:real; (* Winkel der Flugbahn *)
PROCEDURE Graphik_einschalten;
BEGIN
(* OpenLib(gfxbase,"graphics.library",0);
OpenLib(_intuitionbase,"intuition.library",0); *)
shandle:=Open_Screen(0,0,XRES+1,YRES+1,1,0,1,LACE+HIRES,"STARTREK");
SetRGB4(^Shandle^.ViewPort,0,0,0,0);
SetRGB4(^Shandle^.ViewPort,1,15,15,15);
whandle:=Open_Window(0,0,XRES+1,YRES+1,1,ACTIVEWINDOW,BACKDROP+BORDERLESS,"DeepSpace9",shandle,0,0,xres+1,yres+1);
rhandle:=^shandle^.rastport;
shandle2:=Open_Screen(0,0,XRES+1,YRES+1,1,0,1,LACE+HIRES,"STARTREK");
SetRGB4(^Shandle2^.ViewPort,0,0,0,0);
SetRGB4(^Shandle2^.ViewPort,1,15,15,15);
whandle2:=Open_Window(0,0,XRES+1,YRES+1,1,ACTIVEWINDOW,BACKDROP+BORDERLESS,"DeepSpace9",shandle2,0,0,xres+1,yres+1);
rhandle2:=^shandle2^.rastport;
END; {Ende von PROCEDURE Graphik_einschalten}
procedure eingabe;
begin
viewx:=XRES/2.0; (* Beobachtungsereignis *)
viewy:=-450.0;
viewz:=YRES/2.0;
viewt:=0.0;
(* xz-Ebene ist Projektionsebene *)
steps:=5; (* in soviele Stücke wird eine Kante zerlegt *)
punkte:= tpunkte(
(100,0,0),
(300,0,0),
(300,200,0),
(100,200,0),
(100,0,200),
(300,0,200),
(300,200,200),
(100,200,200)); (* Die Koordinaten beziehen sich auf das Objekt-Inertialsystem *)
kanten:=tkanten(
(0,1),(1,2),(2,3),(3,0),(4,5),(5,6),(6,7),(7,4),(0,4),(1,5),(2,6),(3,7)
);
clrscr;
writeln(' DeepSpace9');
writeln(' ==========');
writeln;
writeln('Dieses Programm berechnet die Ansicht eines fast mit ');
writeln('Lichtgeschwindigkeit fliegenden Würfels für einen ruhenden');
writeln('Beobachter.');
writeln;
writeln('(c) 1994 by Daniel Gembris');
writeln;
write('Wieviele Animationsframes sollen erzeugt werden ? ');
readln(frames);
writeln('Bitte geben Sie die Geschwindigkeit des Quaders in x% der Licht-');
write('geschwindigkeit ein:');
readln(r1);
writeln;
writeln(' z ^ y ');
writeln(' |/ ');
writeln(' --> x ');
writeln;
write('xz-Winkel (in Grad, z.B.: 0) : ');
readln(a);
write('xy-Winkel (in Grad, z.B.:-180) : ');
readln(b);
r:=r1*c/100.0;
a:=a*2.0*pi/360.0;
b:=b*2.0*pi/360.0;
vx:=cos(b)*cos(a)*r;
vy:=sin(b)*cos(a)*r;
vz:=sin(a)*r;
end;
(* forward Lorentz transformation -
Umwandlung von Kamera- in Objekt-Ereignisse *)
procedure fLorenz(var x,y,z,t:real);
var gamma,coef,vsqr,xv:real;
begin
vsqr:=vx*vx+vy*vy+vz*vz;
xv:=x*vx+y*vy+z*vz;
gamma:=1.0/sqrt(1.0-vsqr/(c*c));
coef:=(gamma-1)/vsqr*xv-gamma*t;
x:=x+coef*vx;
y:=y+coef*vy;
z:=z+coef*vz;
t:=gamma*(t-xv/(c*c));
end;
(* inverse Lorentz-Transformation -
Umwandlung von Objekt- in Kamera-Ereignisse *)
procedure iLorenz(var x,y,z,t:real);
var gamma,coef,vsqr,xv:real;
begin
vsqr:=vx*vx+vy*vy+vz*vz;
xv:=-x*vx-y*vy-z*vz;
gamma:=1.0/sqrt(1.0-vsqr/(c*c));
coef:=(gamma-1)/vsqr*xv-gamma*t;
x:=x-coef*vx;
y:=y-coef*vy;
z:=z-coef*vz;
t:=gamma*(t-xv/(c*c));
end;
procedure projektion(x,y,z:real;var xscreen,yscreen:integer);
var alpha:real;
begin
alpha:=viewy/(y-viewy);
x:=viewx+alpha*(viewx-x);
z:=viewz+alpha*(viewz-z);
y:=YRES-z;
if((y<YRES)and(y>=0)and(x>=0)and(x<XRES)) then begin
xscreen:=trunc(x);
yscreen:=trunc(y);
end
else xscreen:=-1;
end;
procedure deepspace9(nr:integer);
var viewx2,viewy2,viewz2,viewt2,x,y,z,x2,y2,z2,t,dx,dy,dz:real;
ddx,ddy,ddz:real;
punktnr:longint;
xscreen,yscreen,i,j:integer;
startok:boolean;
rh:ptr;
begin
if(odd(nr)) then begin
rh:=rhandle;
ScreenToFront(shandle2);
end
else begin
rh:=rhandle2;
ScreenToFront(shandle);
end;
Move(rh,0,0);
SetAPen(rh,0);
RectFill(rh,0,0,XRES,YRES);
SetAPen(rh,1);
Move(rh,200,20);
stri:=intstr(trunc(r1))+'% der Lichtgeschwindigkeit';
erg:=_text(rh,stri,length(stri));
ddx:=nr*schrittweite*cos(a)*cos(b);
ddy:=nr*schrittweite*sin(b)*cos(a);
ddz:=nr*schrittweite*sin(a);
viewx2:=viewx;
viewy2:=viewy;
viewz2:=viewz;
viewt2:=viewt;
fLorenz(viewx2,viewy2,viewz2,viewt2);
for i:=0 to (anzkanten-1) do begin
punktnr:=kanten[i][0];
x:=punkte[punktnr][0];
y:=punkte[punktnr][1];
z:=punkte[punktnr][2];
punktnr:=kanten[i][1];
dx:=(punkte[punktnr][0]-x)/steps;
dy:=(punkte[punktnr][1]-y)/steps;
dz:=(punkte[punktnr][2]-z)/steps;
x:=x+ddx;
y:=y+ddy;
z:=z+ddz;
startok:=FALSE;
for j:=0 to steps do begin
t:=viewt2-sqrt((x-viewx2)*(x-viewx2)+(y-viewy2)*(y-viewy2)+(z-viewz2)*(z-viewz2))/c;
x2:=x; y2:=y; z2:=z;
iLorenz(x2,y2,z2,t);
projektion(x2,y2,z2,xscreen,yscreen);
if(xscreen<>-1) then begin
if(startok) then Draw(rh,xscreen,yscreen)
else Move(rh,xscreen,yscreen);
startok:=TRUE;
end
else startok:=FALSE;
x:=x+dx;
y:=y+dy;
z:=z+dz;
end;
end;
end;
begin (* Hauptprogramm *)
eingabe;
Graphik_einschalten;
SetAPen(rhandle,1);
for i:=1 to frames do deepspace9(i);
if(odd(frames)) then begin
ScreenToFront(shandle);
msg:=waitport(whandle^.userport);
msg:=getmsg(whandle^.userport);
replymsg(msg);
end
else begin
ScreenToFront(shandle2);
msg:=waitport(whandle2^.userport);
msg:=getmsg(whandle2^.userport);
replymsg(msg);
end;
end.