Правила форума
Прочтите прежде чем задавать вопрос!
"197. Экран разделен горизонтальной линей, изображающей границу раздела воды и воздуха. Изобразите траекторию светового луча, выходящего из произвольной точки и распространяющего по законам геометрической оптики. Считайте, что от границ луч отражается зеркально, учтите также возможность полного внутреннего отражения. (Это должна быть анимация – луч должен лететь из произвольной (заданной) точки под произвольным (заданным) углом. – Авт.)"
А Вот, собственно программа... Только в ней нехватет основной процедуры Border:
Код
program zadacha197; {Гершенович Игорь}
Uses Crt, Graph, Gersh;
const
n1 = 1;
n2 = 1.33;
X0 : Integer = 100;
Y0 : Integer = 100;
a : Real = 45;
pause : Integer = 1000;
var
x, y : Integer;
x1, y1, dx, dy : Real;
procedure Env;
var i, x, y : Integer;
begin
SetColor (15);
Rectangle (0,0,GetMaxX,GetMaxY);
SetColor (11);
Line (0,GetMaxY div 2, GetMaxX, GetMaxY div 2);
Randomize;
for i:=1 to 100 do PutPixel (Random(GetMaxX),Random(GetMaxY div 2),7);
SetColor (3);
for i:=1 to 50 do begin
x:=Random(GetMaxX);
y:=Random(GetMaxY div 2)+GetMaxY div 2;
Line (x,y,x+5,y);
end;
end; {Env}
procedure Border;
begin
if dy=n1/n2 then if dx>0 then a:=3*Pi/2 else a:=Pi/2 else
begin
{????????????????????????????????
а сдесь должон быть расчет угла после преломления
(если я, конечно правильно сделал критический угол)
??????????????????????????????? }
end;
end; {Border}
procedure adge;
begin
if (x=GetMaxX) or (x=0) then dx:=-dx;
if (y=GetMaxY) or (y=0) then dy:=-dy;
end; {adge}
procedure control;
var ch : char;
begin
repeat Ch:= Readkey until Ch<>#0;
case Ord (Ch) of
43 : if pause>1 then dec(pause,100);
45 : inc(pause,100);
27 : halt;
end;
end; {control}
BEGIN
GraphBegin('');
Env;
x1:=X0; y1:=Y0;
a:=a*Pi/180;
dx:=cos(a);
dy:=sin(a);
repeat
PutPixel (x,y,14);
Delay (pause);
PutPixel (x,y,15);
x1:=x1+dx;
y1:=y1+dy;
x:=Round(x1);
y:=Round(y1);
MoveTo (x,y);
if GetPixel(x,y)=11 then Border;
if GetPixel(x,y)=15 then adge;
if KeyPressed then control;
until KeyPressed;
END.
Помоите эту процедуру написать!
(В программе используется мой модуль - Gersh (процедура GraphBegin('')))
Сообщение отредактировано: Гersh -
Жаль...
