home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2000 October
/
Chip_2000-10_cd1.bin
/
internet
/
Graviti
/
vlneni.exe
/
VLN2D2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1999-08-22
|
5KB
|
209 lines
Program vlneni2D; {Petr Frank (c) 1997 pro Turbo Pascal Dos 7.0 }
uses Objects, Crt, Graph, Dos;
type
TOscilatory = object
procedure PrepocitejSe( X, Z: word);
public
Rychlost,
PoziceY,
StaraPoziceY : Single;
PoziceX ,PoziceZ, SkutecnaPoziceZ: Integer;
Nulovy : Boolean;
end;
const
pocetOscilatoruX = 95;
PocetOscilatoruZ = 95;
vzdalenostX = 2;
vzdalenostZ = 2;
BodX = 30;
BodZ = 30;
{
BodX1 = pocetOscilatoruX-30;
BodZ1 = pocetOscilatoruz-30;
}
prirustky = 10;
tloustka = 1;
barva = 1; {clBlue;}
nakloneni = 1;
tuhost = 2.2;
Tlumeni = 1;
var
i: Word;
t: Integer;
pricitat : Byte;
Oscilatory: Array[0..PocetOscilatoruX+1,0..PocetOscilatoruZ+1] of ^Toscilatory;
type
typ_rastr=array [0..199,0..319] of byte;
var
rastr : typ_rastr absolute $A000:$0000;
var ch: char;
var R1,R2,R3,R4: Single;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
{$R *.DFM}
{-------------------------------------------}
var m,k: word;
procedure TOscilatory.PrepocitejSe(X,Z: Word);
begin
StaraPoziceY:=PoziceY;
R3:= Oscilatory[X+1,poziceZ]^.PoziceY - PoziceY;
R4:= Oscilatory[X,Z+1]^.PoziceY - PoziceY;
R1:= Oscilatory[X-1,Z]^.StaraPoziceY - PoziceY;
R2:= Oscilatory[X,Z-1]^.StaraPoziceY - PoziceY;
Rychlost:= Rychlost*Tlumeni + (R1 + R2 + R3 +R4) / Tuhost;
PoziceY := PoziceY + Rychlost;
Rastr[ SkutecnaPoziceZ+ Round( StaraPoziceY), PoziceX ] := 0;
Rastr[ SkutecnaPoziceZ+ Round( PoziceY), PoziceX ] := 100;
end;
{*******************************}
procedure Aktivace;
begin
for t:= 0 to PocetOscilatoruX+1 do
for i:= 0 to PocetOscilatoruZ+1 do
begin
New( Oscilatory[t,i] );
Oscilatory[t,i]^.StaraPoziceY:=0;
Oscilatory[t,i]^.PoziceX := t*vzdalenostX + i*Nakloneni-70;
Oscilatory[t,i]^.PoziceZ := i;
Oscilatory[t,i]^.PoziceY := 0;
Oscilatory[t,i]^.SkutecnaPoziceZ := -i * VzdalenostZ + 400;;
Oscilatory[t,i]^.Rychlost := 0;
Oscilatory[t,i]^.Nulovy := false;
end;
Oscilatory[BodX,BodZ]^.Nulovy := True;
{ Oscilatory[BodX1,BodZ1]^.Nulovy := True;}
{
Oscilatory[BodX1,BodZ1]^.Nulovy := True;
}
{
For t:=0 to PocetOscilatoruZ do
Oscilatory[30,t]^.Nulovy := True;
For t:=40 to 44 do
Oscilatory[30,t]^.Nulovy := False;
}
{
For t:=0 to 55 do
Oscilatory[t,BodZ+3]^.Nulovy := True;
For t:=0 to 55 do
Oscilatory[t,BodZ-3]^.Nulovy := True;
}
end;
procedure Done;
begin
for t:= 0 to PocetOscilatoruX+1 do
for i:= 0 to PocetOscilatoruZ+1 do
begin
Dispose( Oscilatory[t,i] );
end;
end;
procedure Aktualizuj;
var t: Integer;
begin
If Pricitat = 1 Then Oscilatory[BodX,BodZ]^.PoziceY:= Oscilatory[BodX,BodZ]^.PoziceY + prirustky;
If Pricitat = 2 Then Oscilatory[BodX,BodZ]^.PoziceY:= Oscilatory[BodX,BodZ]^.PoziceY - prirustky;
{ 2 bod}
{ If Pricitat = 1 Then Oscilatory[BodX1,BodZ1]^.PoziceY:= Oscilatory[BodX1,BodZ1]^.PoziceY + prirustky/4;
If Pricitat = 2 Then Oscilatory[BodX1,BodZ1]^.PoziceY:= Oscilatory[BodX1,BodZ1]^.PoziceY - prirustky/4;
}
For t:= 1 to PocetOscilatoruX do
for i:= 1 to PocetOscilatoruZ do
If not Oscilatory[t,i]^.nulovy Then Oscilatory[t,i]^.PrepocitejSe(t,i);
end;
procedure ZmacklKlavesu;
begin
{
If Pricitat = 1 Then Pricitat := 2 Else Pricitat := 1;
}
Pricitat :=0;
If Ord( ch ) = 80 then pricitat := 1;
If Ord( ch ) = 72 then pricitat := 2;
end;
Procedure InicializujGrafiku;
begin
Asm
MOV AH,00h
MOV AL,13h
INT 10h
End;
{
GrDriver:=Detect;
}
{ InitGraph( GRdRIVER, grMode,'E:\BP\BIN');
GrMode := InstallUserDriver('VGA256',nil);
}
{InitGraph( GrDriver, GrMode, '');}
{ ErrCode := GraphResult;
if ErrCode <> grOk then
Writeln('Graphics error:', GraphErrorMsg(ErrCode));
}
end;
Procedure NakopniPaletu;
type
policko=array[0..768] of byte;
Var
paleta :^policko;
regs:registers;
begin
New(Paleta);
for i := 0 to 255 do
begin
paleta^[i*3+2]:=255;
paleta^[i*3+1]:=255;
paleta^[i*3+0]:=255;
end;
paleta^[2]:=0;
paleta^[1]:=0;
paleta^[0]:=0;
regs.ah:=$10;
regs.al:=$12;
regs.bx:=0;
regs.cx:=256;
regs.es:=seg(paleta^);
regs.dx:=ofs(paleta^);
intr($10,regs);
dispose(paleta);
end;
begin
InicializujGrafiku;
NakopniPaletu;
Aktivace;
repeat
{ repeat}
Aktualizuj;
{ Until Keypressed;}
If keypressed then Ch:=Readkey;
ZmacklKlavesu;
until Ord(ch)=27;
CloseGraph;
Done;
end.