Armenian Knowledge Base

Armenian Knowledge Base (https://forum.armkb.com/)
-   Algorithms (https://forum.armkb.com/algorithms/)
-   -   Snow effect (https://forum.armkb.com/algorithms/3336-snow-effect.html)

SMoKE 15.02.2002 22:12

Snow effect
 
Program Snow;
const
Flakes = 500; { mec = shat patilner (3000)}
Fastest = 1000; { poqr tiv=dandax patilner (240)}
Explosion = False;
Type FlakeyRec = Record x,y:Byte;
p:Word;
end;
var i:longint;
r,CurFlake,s,pf:Word;
Flake:Array[0..Flakes] of Flakeyrec;

Procedure vidMode(mode : byte);assembler;
asm
mov ah,$00;
mov al,mode;
int 10h;
end;

Function KeyPressed:boolean;assembler;
asm
mov ax,0100h;
int 16h;
jnz @1;
xor ax,ax;
ret;
@1:
inc ax;
end;

Procedure Perturb;assembler;
asm
mov dx,r;
xor dx,0AA55h;
shl dx,1;
adc dx,118h;
mov r,dx;
end;

Procedure Delay(CX1,DX2:WORD);Assembler;
asm
mov ah, 86h
mov cx, CX1
mov dx, DX2
int 15h
end;

Procedure GotoXY(x,y:integer; Str:String);
var i:integer;
begin
for i:=1 to y do
writeln;
for i:=1 to x do
write(' ');
write(str);
end;

Procedure SnowFall;
begin
GotoXY(13,11,'SMoKE in 2001');
Delay($F,$4240);
repeat
for CurFlake:= 1 to flakes do
with Flake[CurFlake] do
begin
Perturb;
Mem[$A000:p]:=0;
If x>=lo(r) then
Inc(p);
If y>=Hi(r) then
Inc(p,320);
Mem[$A000:p]:=y SHR 5 + $18;
end;
Repeat Until (port[$3DA] and $08) = $08;
until keypressed;
end;

Begin
for CurFlake:=0 to Flakes do
with Flake[curflake] do
begin
Perturb;
inc(s,r);
y:=Hi(Hi(r)*Fastest)+5;
x:=Hi(Lo(r)*y)+1;
If explosion = False then
p:=s;
end;
vidMode($13);
SnowFall;
vidMode($03);
end.

A.V. 17.02.2002 12:17

tozhe krasivo no flag mne bolee ponravilsya <img src="smooch-1.gif" border="0">


All times are GMT. The time now is 17:35.

Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.