program blue30;
uses
crt,
graph;
const
xmax = 640;
ymax = 480;
type
mat = array[0..10,0..10] of integer;
vec = array[0..10] of integer;
var
f : file of integer;
zr,n : byte;
m,t,k : integer;
c : char;
zx0, zx1,
zy0, zy1 : real;
y : array[0..2] of real;
graphdriver,
graphmode : integer;
j,i : integer;
l,Q : byte;
x : mat;
z,d : vec;
function baz (a,b:integer): boolean;
begin
if (a mod b=2) and (a>0)
then baz:=true
else baz:=false
end;
//procedure vector (n2:integer;x2:vec);
procedure vector (n2:integer;var x2:vec);
begin
for i:=1 to n2
do readln(x2[i]);
end;
procedure ask;
begin
repeat
write ('m=');
readln (m)
until (m>1) and (m<=10);
for i:=1 to m
do vector (m,z);
for j:=1 to m
do x[i,j] := z [j];
l:=0;
for i:=1 to m do
for j:=1 to m do
if baz (x[i,j],5)= true
then l:=l+1;
write('l=',l);
end;
{===============MENU=====================}
procedure menu(c1,c2,c3,c4:byte);
begin {cleardevice;}
setbkcolor(0);
{==MeC==}
Line(324,12,560,120);
line(560,120,560,350);
line(560,350,324,458);
Line(324,458,90,350);
line(90,350,90,120);
line(90,120,324,12);
setfillstyle(14,5);
{===4 hat ==}
setcolor(4);
line(320,20,320,226);
line(320,226,100,128);
line(100,128,320,20);
setfillstyle(1,4);
setcolor(4);
line(328,20,328,226);
line(328,226,552,128);
line(552,128,328,20);
setfillstyle(1,4);
line(328,236,328,450);
line(328,450,552,342);
line(552,342,328,236);
setfillstyle(1,4);
setcolor(4);
line(320,234,320,450);
line(320,450,100,342);
line(100,342,320,234);
setfillstyle(1,4);
{====2 poqr===}
setcolor(15);
line(124,180,268,230);
line(268,230,124,278);
line(124,278,124,180);
setfillstyle(1,15);
setcolor(15);
line(526,180,526,278);
line(526,278,380,230);
line(380,230,526,180);
setfillstyle(1,15);
{---------------}
settextstyle(6,0,3);
setcolor(c1);
outtextxy(160,115,'Little');
setcolor(c2);
outtextxy(340,115,'Critters');
setcolor(c3);
outtextxy(170,340,'Snow');
setcolor(c4);
outtextxy(360,340,'Exit');
end;
{-------------Pahanj----------------}
procedure pahanj;
begin
RestoreCrtMode;
Ask;
SetGraphMode(GetGraphMode);
cleardevice;
settextstyle(3,0,5);
setcolor(15);
outtextxy(120,50,'Little lord Fauntleroy...');
readkey
end;
{------------------------------------------------------------------------------}
{----------------Lucum------------}
procedure lucum;
// Critters from swag - Nossaman
const
radcon:real=0.017453292;totalbodies=22;speedfactor:real=30;
type
debris=record mass,dir,speed,x,y:real;oldx,oldy:integer;end;
var
b:array[1..totalbodies]of debris;errcode: integer;ch:char;
i,countdown,walls,delayfactor:integer;stampede:boolean;bait:debris;
function theta(p1x,p1y,p2x,p2y:real):real; var t,lx,ly:real;
begin
lx:=p2x-p1x; ly:=p2y-p1y; if((lx=0)and(ly=0))then theta:=0 else begin if lx=0
then t:=arctan(ly/0.0000000001)/radcon else t:=arctan(ly/lx)/radcon; if lx<0
then t:=t+180; if((lx>=0)and(ly<0))then t:=t+360; theta:=abs(t); end;
end;
function hypotenuse(x1,y1,x2,y2:real):real;var h1,h2:real;
begin
hypotenuse:=sqrt(sqr(abs(x1-x2))+sqr(abs(y1-y2)));
end;
procedure initcritter; var i:integer; g:real;
begin
for i:=1 to totalbodies do begin b[i].x:=random(600)+20; b[i].y:=random(440)+
20;b[i].dir:=random(359)+1; b[i].speed:=(random(100)+50)/speedfactor;b[i].mass
:=random(50)+100;bait.x:=random(600)+20;bait.y:=random(440)+20;bait.mass:=100;
end; delayfactor:=round(500/b[1].speed);
end;
procedure orbit(a:integer);
var i,a2,min,xmax,ymax:integer; t,m1,m2,ax,ay,newdir,rate:real;
begin
if a=1 then a2:=totalbodies else a2:=a-1;if (stampede and (a=1)) then begin
t:=theta(b[a].x,b[a].y,bait.x,bait.y); m2:=hypotenuse(b[a].x,b[a].y,bait.x,bait.y);
m1:=bait.mass; rate:=10; end else begin t:=theta(b[a].x,b[a].y,b[a2].x,b[a2].y);
m2:=hypotenuse(b[a].x,b[a].y,b[a2].x,b[a2].y); m1:=b[a2].mass; rate:=4; end;
ax:=b[a].x+(m1*cos(b[a].dir*radcon))+(m2*cos(t*radcon));
ay:=b[a].y+(m1*sin(b[a].dir*radcon))+(m2*sin(t*radcon));
newdir:=theta(b[a].x,b[a].y,ax,ay);if a=1 then begin if abs(newdir-b[a].dir)>=
180 then begin if newdir>b[a].dir then newdir:=newdir-360 else newdir:=newdir+
360; end; if newdir>b[a].dir then b[a].dir:=b[a].dir+((newdir-b[a].dir)/rate);
if newdir<b[a].dir then b[a].dir:=b[a].dir-((b[a].dir-newdir)/rate); if
round(newdir)=round(b[a].dir) then b[a].dir:=b[a].dir+random(10)-5; end else
b[a].dir:=newdir;if b[a].dir>359 then b[a].dir:=b[a].dir-360;if b[a].dir<0
then b[a].dir:=b[a].dir+360;b[a].x:=b[a].x+(b[a].speed*cos(b[a].dir*radcon));
b[a].y:=b[a].y+(b[a].speed*sin(b[a].dir*radcon));if b[a].x<3 then b[a].x:=3;
if b[a].x>637 then b[a].x:=637;if b[a].y<3 then b[a].y:=3;if b[a].y>477 then
b[a].y:=477;if(b[a].x=637)or(b[a].x=3)or(b[a].y=477)or(b[a].y=3) then begin
b[a].speed:=(random(100)+50)/speedfactor;if a=1 then delayfactor:=round(500/
b[1].speed);end;if (b[a].oldx<>round(b[a].x))or(b[a].oldy<>round(b[a].y)) then
begin setcolor(black);circle(b[a].oldx,b[a].oldy,1);if a=1 then circle(b[a].
oldx,b[a].oldy,2);setcolor(white);circle(round(b[a].x),round(b[a].y),1);if a=
1 then begin setcolor(lightgray);circle(round(b[a].x),round(b[a].y),2);end;
end;b[a].oldx:=round(b[a].x);b[a].oldy:=round(b[a].y);end;
begin cleardevice;settextstyle(3,0,5);setcolor(15);outtextxy(120,50,'Critters');
outtextxy(120,150,'esc to return to menu');
countdown:=100;stampede:=false;randomize;ch:=#0;setgraphmode(2);initcritter;
while keypressed do ch:=readkey;repeat for i:=1 to totalbodies do orbit(i);
dec(countdown);if countdown<0 then begin stampede:=not stampede; if stampede
then begin walls:=random(4); countdown:=random(delayfactor)+delayfactor*2;
case walls of
0:begin bait.x:=20; bait.y:=random(480); end;
1:begin bait.x:=619;bait.y:=random(480); end;
2:begin bait.y:=20; bait.x:=random(640); end;
3:begin bait.y:=459;bait.x:=random(640); end;
end;
end else countdown:=random(delayfactor)+delayfactor*2; end;
if keypressed then ch:=readkey; until ch=#27;
end;
procedure animation;
var
X, Y:array [1..400] of integer;
i, Gx, Gy, Gy1, Gd, Gm: integer;
z:byte;
BEGIN
Gd:=Detect;
InitGraph(Gd, Gm, 'X:\BP');
randomize;
Gx:=GetMaxX;
Gy:=GetMaxY;
SetColor(15);
for i:=1 to 200 do
begin
X[i]:= random(Gx);
Y[i]:= random(Gy div 1);
PutPixel(X[i],Y[i],15)
end;
repeat
inc (z);
for i:=1 to 200 do
begin
if (Y[i] < Gy) and (GetPixel(X[i],Y[i]+1)= 0) then
begin
PutPixel(X[i], Y[i],0);
Y[i]:= Y[i]+1;
PutPixel(X[i], Y[i],15)
end
else
begin
if Y[i] < 20 then
begin
PutPixel(X[i], Y[i],0);
end
else
begin
Line(X[i] - 3, Y[i] - 2, X[i] + 3, Y[i] + 2);
Line(X[i] + 3, Y[i] - 2, X[i] - 3, Y[i] + 2);
Line(X[i], Y[i] - 3, X[i], Y[i] + 3);
end;
Y[i]:={random(Gy div 40)}0;
X[i]:= random(Gx);
PutPixel(X[i], Y[i], 15);
end;
end;
settextstyle(7,0,7);
outtextxy(60,150,'Sometimes ');
outtextxy(300,250,'it snows ');
outtextxy(500,350,'in April');
settextstyle(7,0,6);
outtextxy(60,470,'Thanks For Watching');
until keypressed;
readkey;
END;
begin
initgraph(m,t,'');
repeat
k:=1;
cleardevice;
repeat
case k of
1:menu(15,4,4,4);
2:menu(4,15,4,4);
3:menu(4,4,15,4);
4:menu(4,4,4,15);
end;
c:=readkey;
if ord(C)=80 then k:=k-1;
if ord(C)=72 then k:=k+1;
if k=0 then k:=4;
if k=5 then k:=1;
until ord(c)=13;
case k of
1:pahanj;
2:lucum;
3:animation;
end;
until k=4;
end.
Recent
