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

[Г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

[Lapp]

Гersh, я сделал тебе процедуру примерно как ты хотел, но работает все неправильно все равно (ниже скажу, почему).
Вот процедура:

procedure Border;
var
  dl,dl2,s1,s2:tReal;
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}

Неверен сам принцип "преломления" - его надо переделать. Дело в том, что эта процедура у тебя вызывается по проверке цвета точки на экране. Но ты не учел, что реальная толщина плюс наклон луча могут приводить к тому, что эта процедура при прохождении границы вызовется не один, а два или больше раз. Это приведет к двойному преломлению...

И вообще, идея такой эмуляции мне не очень нравится.. Было бы интереснее попробовать продемонстрировать принцип Гюйгенса..