esercitazioni di ottica

esci otticaturbo.htm

immagini rifrazione

 

(* rif1g.fis indice di rifrazione con grafica persistente *)

program rif1g;
uses crt,graph;
var i,r,n:real;
a,si,sr,ci,cr,tr:real;
scelta,pausa,contatore,passo,x,x1,x2,y,ai,ar:integer;

procedure grafica;
var sc,tp:integer;
stringa:string;
begin
sc:=0;
tp:=0;
stringa:='c:\tp\bgi';
initgraph(sc,tp,stringa);
end;

procedure assi;
begin
setcolor(5);
outtextxy(10,10,'mezzo meno rifrangente');
outtextxy(10,300,'mezzo piu rifrangente');
line(x1,y,x2,y); (* passaggio da meno a piu rifrangente *)
line(x,y-150,x,y+150); (* normale *)
end;

procedure disegna(si,ci,sr,cr:real);
var h:integer;
ai,ar:string;
begin
h:=100;
str(round(i),ai);
str(round(r),ar);
assi;
setcolor(4);
outtextxy(10,40,ai);outtextxy(50,40,'angolo di incidenza');
outtextxy(10,50,ar);outtextxy(50,50,'angolo di rifrazione');
outtextxy(50,60,'indice di rifrazione=1.55');
setcolor(4);
setlinestyle(0,1,3);
line(x,y,x-round(h*si),y-round(h*ci));(* incidente *)
setlinestyle(0,1,2);
line(x,y,x+round(h*sr),y+round(h*cr));(* rifratto *)
setlinestyle(0,1,2);
delay(pausa);
setcolor(7);
outtextxy(10,40,ai);outtextxy(10,50,ar);
end;

procedure fine;
begin
closegraph;
textmode(0);
writeln('fine prova:arrivederci:premi enter');
readln;
exit;
end;

procedure calcola;
begin
grafica;
clrscr;
i:=1;
n:=1.55;
passo:=1;
for contatore:=1 to 89 do
begin
si:=sin(i*3.14/180);
ci:=cos(i*3.14/180);
sr:=si/n;
cr:=sqrt(1-sqr(sr));
tr:=sr/cr;
r:=arctan(tr)*180/3.14;
disegna(si,ci,sr,cr);
i:=i+passo;
end;
setcolor(5);assi;
outtextxy(10,230,'premi enter');

outtextxy(10,340,'per rivedere premi 1..per finire premi 2');
readln(scelta);
if (scelta=1) then calcola else fine;
end;

begin
clrscr;
writeln('leggi della rifrazione:da aria a vetro ');
writeln('indica valore per pausa:100..1000...2000.3000..');
readln(pausa);
x1:=1;x2:=600;x:=300;y:=200;
calcola;
end.