Преломление и полное внутренне отражение Опции

[Гersh]

Текст задачи:
"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 - 9.05.2006 14:08

[Гersh]

Ура!
Теперь более или менее что-то работает. Один глюк только! Почему-то иногда, когда луч идет снизу вверх (из воды в воздух), иногда вылетает Ошибка 207: Invalid floating point operation. Видимо тут где-то получается минус под корнем (в процедуре Border) Откуда он там берется? Или тут не в том дело??
При этом так получается не всегда! Иногда все, нормально иногда через какое-то время такая ошибка вылетает, а иногда при первом же пломлении. Странно (
Вот, например, при начальных параметрах x0=100; y0=300; a=10; или a=30; при первом же сталкивании с границей ошибка вылетает. А при a=190 (при тех же x и y) - при четвертом.
Вот последняя версия программы:

program zadacha197; {Гершенович Игорь}
Uses Crt, Graph, Gersh;
const
	 n1 = 1;			 {показатель преломления воздуха}
	 n2 = 1.33;		  {показатель преломления воды}
	 X0 : Integer = 100; {начальная координата X}
	 Y0 : Integer = 300; {начальная координата Y}
	 a : Real = 10;	  {начальный угол}
	 pause : Integer = 1000;
var
   x, y, yb : 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, yb, GetMaxX, yb);
	 Randomize;
	 for i:=1 to 100 do PutPixel (Random(GetMaxX),Random(yb),7);
	 SetColor (3);
	 for i:=1 to 50 do begin
		 x:=Random(GetMaxX);
		 y:=Random(yb)+yb;
		 Line (x,y,x+5,y);
	 end;
end; {Env}

procedure Border;
var
   dl, dl2, s1, s2: Real;
begin
	 dl2:=dx*dx+dy*dy;
	 dl:=Sqrt(dl2);
	 s1:=dx/dl;
	 if dy>0 then s2:=s1*n1/n2 else s2:=s1*n2/n1;
	 if s2>=1.0 then dy:=-dy else begin
	   dx:=dl*s2;
	   dy:=Sqrt(dl2-dx*dx)*dy/Abs(dy)
	 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('');
	 yb:=GetMaxY div 2;
	 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 (y>=yb) and (y0<yb) or (y<=yb) and (y0>yb) then Border;
		   if GetPixel(x,y)=15 then adge;
		   if KeyPressed then control;
		   Y0:=y;
	 until KeyPressed;
END.

А чисто физически теперь ведь все нормально?

2lapp:
Кстати, а ты не объяснишь как твоя процедура действует? Как оно вообще просчитывается физчески и геометрически и как именно реализуется в алгоритме.

Сообщение отредактировано: volvo - 3.11.2006 22:27