listati per turbo pascal

ottica, lenti e rifrazione

(* lentec2g.fis immagini lenti convergenti *)
(* immagine grafica *)

program lente1;
uses crt,graph;
var g:real;
    p,q,s,i,f:integer;
    scelta,contatore,passo:integer;
    x1,x2,xv,xf,y,xc,pausa:integer;

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

procedure assi;
begin
setcolor(6);
outtextxy(x1,y+20,'asse principale ');
line(x1,y,x2,y);          (* asse principale*)
outtextxy(xv,y+170,'lente convergente');
line(xv,y-190,xv,y+190);  (* lente *)
outtextxy(xf,y+10,'fuoco');
line(xf,y+2,xf,y-2);      (* fuoco *)
line(xv-f,y+2,xv-f,y-2);      (* fuoco *)
outtextxy(xc,y-10,'centro curvatura');
line(xc,y+2,xc,y-2);      (* centro curvatura *)
line(xv-2*f,y+2,xv-2*f,y-2);
end;

procedure disegna(p,q,s,i:integer);
var ps,qs,hs,hi:string;
begin
assi;
str(p,ps);
str(q,qs);
str(s,hs);
str(i,hi);
outtextxy(10,10,ps);outtextxy(50,10,'posizione sorgente');
outtextxy(10,20,qs);outtextxy(50,20,'posizione immagine');
outtextxy(10,30,hs);outtextxy(50,30,'altezza sorgente ');
outtextxy(10,40,hi);outtextxy(50,40,'altezza immagine ');
outtextxy(400,10,'distanza focale=40');
setcolor(3);
line(xv+p,y,xv+p,y-s); (* sorgente *)
setcolor(4);
line(xv-q,y,xv-q,y+i); (* immagine *)
setcolor(5);
line(xv,y-s,xv+p,y-s); (* raggio incidente parallelo asse  *)
line(xv+p,y-s,xv-q,y+i); (* raggio incidente passa per centro ottico *)
if p>f then
line(xv,y-s,xv-q,y+i) (* raggio rifratto passa per fuoco   *)
else
line(xv-f,y,xv-q,y+i);(* prolunga raggio passa per fuoco   *)
line(xv,y,xv-q,y+i);   (* prolunga raggio passa per centro ottico*)
delay(pausa);
setcolor(0);
outtextxy(10,10,ps);
outtextxy(10,20,qs);
outtextxy(10,30,hs);
outtextxy(10,40,hi);

line(xv+p,y,xv+p,y-s); (* sorgente *)
line(xv-q,y,xv-q,y+i); (* immagine *)
line(xv,y-s,xv+p,y-s); (* raggio incidente parallelo asse  *)
line(xv+p,y-s,xv-q,y+i); (* raggio incidente passa per centro ottico *)
if p>f then
line(xv,y-s,xv-q,y+i) (* raggio rifratto passa per fuoco   *)
else
line(xv-f,y,xv-q,y+i);(* prolunga raggio passa per fuoco   *)
line(xv,y,xv-q,y+i);   (* prolunga raggio passa per centro ottico*)
end;



procedure calcola;
begin
 clrscr;
 grafica;
 f:=40;
 p:=120;
 s:=40;
 passo:=10;
 x1:=1;x2:=600;xv:=300;
 xf:=xv+f;xc:=xv+2*f;
 y:=200;
 for contatore:=1 to 9 do
  begin
  if p=f then
  begin
  p:=p-passo;
  end;
  q:=round(f*p/(p-f));
  g:=q/p;
  i:=round(s*g);
  disegna(p,q,s,i);
  p:=p-10;
  end;
  setcolor(5);
  outtextxy(10,320,'premi 1 per rivedere o 2 per finire');
  readln(scelta);
  if (scelta=1) then calcola else exit;
  end;

begin
clrscr;
writeln('creazione immagini con lente convergente');
writeln('si sposta la sorgente verso la lente');
writeln('si calcolano e si visualizzano :');
writeln('posizione sorgente,posizione immagine');
writeln('altezza sorgente costante e altezza immagine');
writeln;
writeln('indica valore per velocita:1000..2000..3000 ');
readln(pausa);
calcola;
end.

(* lentec2g.fis immagini lenti convergenti *)
(* immagine grafica *)

program lente1;
uses crt,graph;
var g:real;
    p,q,s,i,f:integer;
    scelta,contatore,passo:integer;
    x1,x2,xv,xf,y,xc,pausa: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(6);
outtextxy(x1,y+20,'asse principale ');
line(x1,y,x2,y);          (* asse principale*)
outtextxy(xv,y+170,'lente convergente');
line(xv,y-190,xv,y+190);  (* lente *)
outtextxy(xf,y+10,'fuoco');
line(xf,y+2,xf,y-2);      (* fuoco *)
line(xv-f,y+2,xv-f,y-2);      (* fuoco *)
outtextxy(xc,y-10,'centro curvatura');
line(xc,y+2,xc,y-2);      (* centro curvatura *)
line(xv-2*f,y+2,xv-2*f,y-2);
end;

procedure disegna(p,q,s,i:integer);
var ps,qs,hs,hi:string;
begin
assi;
str(p,ps);
str(q,qs);
str(s,hs);
str(i,hi);
outtextxy(10,10,ps);outtextxy(50,10,'posizione sorgente');
outtextxy(10,20,qs);outtextxy(50,20,'posizione immagine');
outtextxy(10,30,hs);outtextxy(50,30,'altezza sorgente ');
outtextxy(10,40,hi);outtextxy(50,40,'altezza immagine ');
outtextxy(400,10,'distanza focale=40');
setcolor(3);
line(xv+p,y,xv+p,y-s); (* sorgente *)
setcolor(4);
line(xv-q,y,xv-q,y+i); (* immagine *)
setcolor(5);
line(xv,y-s,xv+p,y-s); (* raggio incidente parallelo asse  *)
line(xv+p,y-s,xv-q,y+i); (* raggio incidente passa per centro ottico *)
if p>f then
line(xv,y-s,xv-q,y+i) (* raggio rifratto passa per fuoco   *)
else
line(xv-f,y,xv-q,y+i);(* prolunga raggio passa per fuoco   *)
line(xv,y,xv-q,y+i);   (* prolunga raggio passa per centro ottico*)
delay(pausa);
setcolor(0);
outtextxy(10,10,ps);
outtextxy(10,20,qs);
outtextxy(10,30,hs);
outtextxy(10,40,hi);

line(xv+p,y,xv+p,y-s); (* sorgente *)
line(xv-q,y,xv-q,y+i); (* immagine *)
line(xv,y-s,xv+p,y-s); (* raggio incidente parallelo asse  *)
line(xv+p,y-s,xv-q,y+i); (* raggio incidente passa per centro ottico *)
if p>f then
line(xv,y-s,xv-q,y+i) (* raggio rifratto passa per fuoco   *)
else
line(xv-f,y,xv-q,y+i);(* prolunga raggio passa per fuoco   *)
line(xv,y,xv-q,y+i);   (* prolunga raggio passa per centro ottico*)
end;



procedure calcola;
begin
 clrscr;
 grafica;
 f:=40;
 p:=120;
 s:=40;
 passo:=10;
 x1:=1;x2:=600;xv:=300;
 xf:=xv+f;xc:=xv+2*f;
 y:=200;
 for contatore:=1 to 9 do
  begin
  if p=f then
  begin
  p:=p-passo;
  end;
  q:=round(f*p/(p-f));
  g:=q/p;
  i:=round(s*g);
  disegna(p,q,s,i);
  p:=p-10;
  end;
  setcolor(5);
  outtextxy(10,350,'premi 1 per rivedere o 2 per finire');
  readln(scelta);
  if (scelta=1) then calcola else exit;
  end;

begin
clrscr;
writeln('creazione immagini con lente convergente');
writeln('si sposta la sorgente verso la lente');
writeln('si calcolano e si visualizzano :');
writeln('posizione sorgente,posizione immagine');
writeln('altezza sorgente costante e altezza immagine');
writeln;
writeln('indica valore per velocita:1000..2000..3000 ');
readln(pausa);
calcola;
end.

(* lentec.fis immagini lenti convergenti *)

program lentec;
uses crt;
var p,q,i,g:real;
    s,f:integer;
    contatore,passo:integer;
    b:string;
begin
 clrscr;
 b:='----------------------------------------------------';
 f:=40;
 p:=120;
 s:=50;
 passo:=10;
 writeln('legge punti coniugati per lente convergente');
 writeln('osservare segno di q,g,i positivo o negativo');
 writeln;
 for contatore:=1 to 11 do
  begin
  if p=2*f -passo then writeln(b);
  if p=f then
  begin
  writeln('sorgente su fuoco=immagine a infinito');
  p:=p-passo;
  end;
  q:=f*p/(p-f);
  g:=q/p;
  i:= s*g;
  write('dsorgente=',p:3:0,'...dimmagine=',q:3:0);
  writeln('...g=',g:3:2,'...altezzas=',s,'...altezzai=',i:3:0);
  p:=p-10;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* lented2g.fis immagini lenti divergenti *)
(* immagine grafica *)

program lente1;
uses crt,graph;
var g:real;
    p,q,s,i,f:integer;
    scelta,contatore,passo:integer;
    x1,x2,xv,xf,y,xc,pausa: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(6);
outtextxy(x1,y+20,'asse principale ');
line(x1,y,x2,y);          (* asse principale*)
outtextxy(xv,y+170,'lente divergente');
line(xv,y-190,xv,y+190);  (* lente *)
outtextxy(xf,y+10,'fuoco');
line(xf,y+2,xf,y-2);      (* fuoco *)
line(xv-f,y+2,xv-f,y-2);      (* fuoco *)
outtextxy(xv+5*f,y-10,'centro curvatura');
line(xc,y+2,xc,y-2);      (* centro curvatura *)
line(xv-2*f,y+2,xv-2*f,y-2);
end;

procedure disegna(p,q,s,i:integer);
var ps,qs,hs,hi:string;
begin
assi;
str(p,ps);
str(q,qs);
str(s,hs);
str(i,hi);

outtextxy(10,10,ps);outtextxy(50,10,'posizione sorgente');
outtextxy(10,20,qs);outtextxy(50,20,'posizione immagine');
outtextxy(10,30,hs);outtextxy(50,30,'altezza sorgente ');
outtextxy(10,40,hi);outtextxy(50,40,'altezza immagine ');
outtextxy(400,10,'distanza focale=-40');
setcolor(3);
line(xv+p,y,xv+p,y-s); (* sorgente *)
setcolor(4);
line(xv-q,y,xv-q,y+i); (* immagine *)
setcolor(5);
line(xv,y-s,xv+p,y-s); (* raggio incidente parallelo asse  *)
line(xv+p,y-s,xv-p,y+s); (* raggio incidente passa per centro ottico *)
line(xv,y-s,xv-f,y); (* raggio rifratto passa per fuoco   *)
line(xv,y-s,xv+f,y-2*s);
delay(pausa);
setcolor(0);
outtextxy(10,10,ps);
outtextxy(10,20,qs);
outtextxy(10,30,hs);
outtextxy(10,40,hi);
line(xv,y-s,xv+f,y-2*s);
line(xv+p,y,xv+p,y-s);
line(xv-q,y,xv-q,y+i);
line(xv,y-s,xv+p,y-s);
line(xv+p,y-s,xv-p,y+s);
line(xv,y-s,xv-f,y);
end;

procedure calcola;
begin
 clrscr;
 grafica;
 f:=-40;
 p:=120;
 s:=40;
 passo:=10;
 x1:=1;x2:=600;xv:=300;
 xf:=xv+f;xc:=xv+2*f;
 y:=200;
 for contatore:=1 to 9 do
  begin
  if p=f then
  begin
  p:=p-passo;
  end;
  q:=round(f*p/(p-f));
  g:=q/p;
  i:=round(s*g);
  disegna(p,q,s,i);
  p:=p-10;
  end;
  setcolor(5);
  outtextxy(10,320,'premi 1 per rivedere o 2 per finire');
  readln(scelta);
  if (scelta=1) then calcola else exit;
  end;

begin
clrscr;
writeln('creazione immagini con lente divergente');
writeln('si sposta la sorgente verso la lente');
writeln('si calcolano e si visualizzano :');
writeln('posizione sorgente,posizione immagine');
writeln('altezza sorgente costante e altezza immagine');
writeln;
writeln('indica valore per velocita:1000..2000..3000 ');
readln(pausa);
calcola;
end.

(* 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.

(* 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.

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

program rifra2g;
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 piu rifrangente a meno *)
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 / 1.55');
setcolor(4);
line(x,y,x-round(h*sr),y-round(h*cr));(* rifratto *)
line(x,y,x+round(h*si),y+round(h*ci));(* incidente  *)
if (contatore>=40) then
begin
outtextxy(300,300,'angolo incidente quasi angolo LIMITE ');
outtextxy(300,320,'prendi nota del valore angolo incidente ');
delay(5000);
end;
delay(pausa);
setcolor(0);
outtextxy(10,40,ai);
outtextxy(10,50,ar);
setcolor(7);
line(x,y,x+round(h*si),y+round(h*ci));(* rifratto  *)
line(x,y,x-round(h*sr),y-round(h*cr));(* incidente *)
end;

procedure fine;
begin
outtextxy(10,340,'fine:arrivederci:premi enter');
readln;
closegraph;textmode(0);
exit;
end;

procedure calcola;
begin
 clrscr;
 grafica;
 i:=1;
 n:=1/1.55;
 passo:=1;
 for contatore:=1 to 40 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,220,'premi enter');
readln;
outtextxy(10,240,'premi 1 per rivedere o 2 per finire');
readln(scelta);
if (scelta=1) then calcola else fine;
end;

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

(* rif3g.fis rifrazione con grafica persistente e angolo limite*)

program rif3g;
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,340,'mezzo piu rifrangente');
line(x1,y,x2,y);       (* passaggio da meno a piu rifrangente *)
line(x,y-150,x,y+150); (* normale *)
end;

procedure fine;
begin
outtextxy(10,350,'fine:arrivederci:premi enter');
readln;
closegraph;textmode(0);
end;

procedure disegna(si,ci,sr,cr:real);
var h:integer;
    ai,ar,ax:string;
begin
h:=100;
str(round(i),ai);
str(round(r),ar);
assi;
setcolor(4);
if (i<40) then
begin
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 / 1.55');
setcolor(4);
line(x,y,x-round(h*sr),y-round(h*cr));(* rifratto *)
line(x,y,x+round(h*si),y+round(h*ci)); (* incidente  *)
delay(pausa);
if (i=39) then
begin
outtextxy(300,300,'incidente quasi angolo limite');
delay(3000);
end;
setcolor(0);
outtextxy(10,40,ai);
outtextxy(10,50,ar);
outtextxy(300,300,'incidente quasi angolo limite');
setcolor(7);
line(x,y,x+round(h*si),y+round(h*ci));(* rifratto  *)
line(x,y,x-round(h*sr),y-round(h*cr));(* incidente *)
end;

if (i>40) then
begin
str(round(i),ax);
outtextxy(300,150,'riflessione totale');
outtextxy(10,300,ax);outtextxy(400,300,'angolo incidente');
outtextxy(10,310,ax);outtextxy(400,310,'angolo riflessione');
line(x,y,x+round(h*si),y+round(h*ci));
line(x,y,x-round(h*si),y+round(h*ci));
delay(pausa);
if(i=70) then delay(5000);
setcolor(4);
line(x,y,x+round(h*si),y+round(h*ci));
line(x,y,x-round(h*si),y+round(h*ci));
setcolor(0);
outtextxy(10,300,ax);
outtextxy(10,310,ax);
end;
end;

procedure calcola;
begin
 clrscr;
 grafica;
 n:=1/1.55;
 passo:=1;
 i:=1;
 for contatore:=1 to 70 do
  begin
  if i<=40 then
  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
  else
  begin;
  r:=i;
  si:=sin(i*3.14/180);
  ci:=cos(i*3.14/180);
  disegna(si,ci,0,0);
  i:=i+passo;
  end;
  end;
setcolor(5);assi;
outtextxy(10,230,'premi enter');
outtextxy(10,250,'premi 1 per rivedere o 2 per finire');
readln(scelta);
if (scelta=1) then calcola else fine;
end;

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

(* rifra1g.fis indice di rifrazione con grafica*)

program rifra1;
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);
if (contatore>=9) then delay(5000);
setcolor(7);
outtextxy(10,40,ai);
outtextxy(10,50,ar);
setlinestyle(0,1,2);
line(x,y,x+round(h*sr),y+round(h*cr));(* rifratto  *)
setlinestyle(0,1,3);
line(x,y,x-round(h*si),y-round(h*ci));(* incidente *)
end;

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

procedure calcola;
begin
 grafica;
 clrscr;
 i:=10;
 n:=1.55;
 passo:=10;
 for contatore:=1 to 9 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:1000...2000.3000..');
readln(pausa);
x1:=1;x2:=600;x:=300;y:=200;
calcola;
end.

(* rifra2g.fis indice di rifrazione con grafica e angolo limite *)

program rifra2g;
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 / 1.55');
setcolor(4);
line(x,y,x-round(h*sr),y-round(h*cr));(* rifratto *)
line(x,y,x+round(h*si),y+round(h*ci));(* incidente  *)
if (contatore>=40) then
begin
outtextxy(300,300,'angolo incidente quasi angolo LIMITE ');
outtextxy(300,320,'prendi nota del valore angolo incidente ');
delay(5000);
end;
delay(pausa);
setcolor(0);
outtextxy(10,40,ai);
outtextxy(10,50,ar);
line(x,y,x+round(h*si),y+round(h*ci));(* rifratto  *)
line(x,y,x-round(h*sr),y-round(h*cr));(* incidente *)
end;

procedure fine;
begin
outtextxy(10,340,'fine:arrivederci:premi enter');
readln;
closegraph;textmode(0);
exit;
end;

procedure calcola;
begin
 clrscr;
 grafica;
 i:=1;
 n:=1/1.55;
 passo:=1;
 for contatore:=1 to 40 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,220,'premi enter');
readln;
outtextxy(10,240,'premi 1 per rivedere o 2 per finire');
readln(scelta);
if (scelta=1) then calcola else fine;
end;

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

(* rifra3g.fis indice di rifrazione con grafica e angolo limite*)

program rifra3g;
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,340,'mezzo piu rifrangente');
line(x1,y,x2,y);       (* passaggio da meno a piu rifrangente *)
line(x,y-150,x,y+150); (* normale *)
end;

procedure fine;
begin
outtextxy(10,350,'fine:arrivederci:premi enter');
readln;
closegraph;textmode(0);
end;

procedure disegna(si,ci,sr,cr:real);
var h:integer;
    ai,ar,ax:string;
begin
h:=100;
str(round(i),ai);
str(round(r),ar);
assi;
setcolor(4);
if (i<40) then
begin
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 / 1.55');
setcolor(4);
line(x,y,x-round(h*sr),y-round(h*cr));(* rifratto *)
line(x,y,x+round(h*si),y+round(h*ci)); (* incidente  *)
delay(pausa);
if (i=39) then
begin
outtextxy(300,300,'incidente quasi angolo limite');
delay(3000);
end;
setcolor(0);
outtextxy(10,40,ai);
outtextxy(10,50,ar);
outtextxy(300,300,'incidente quasi angolo limite');
line(x,y,x+round(h*si),y+round(h*ci));(* rifratto  *)
line(x,y,x-round(h*sr),y-round(h*cr));(* incidente *)
end;

if (i>40) then
begin
str(round(i),ax);
outtextxy(300,150,'riflessione totale');
outtextxy(10,300,ax);outtextxy(400,300,'angolo incidente');
outtextxy(10,310,ax);outtextxy(400,310,'angolo riflessione');
line(x,y,x+round(h*si),y+round(h*ci));
line(x,y,x-round(h*si),y+round(h*ci));
delay(pausa);
if(i=70) then delay(5000);
setcolor(0);
line(x,y,x+round(h*si),y+round(h*ci));
line(x,y,x-round(h*si),y+round(h*ci));
outtextxy(10,300,ax);
outtextxy(10,310,ax);
end;
end;

procedure calcola;
begin
 clrscr;
 grafica;
 n:=1/1.55;
 passo:=1;
 i:=1;
 for contatore:=1 to 70 do
  begin
  if i<=40 then
  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
  else
  begin;
  r:=i;
  si:=sin(i*3.14/180);
  ci:=cos(i*3.14/180);
  disegna(si,ci,0,0);
  i:=i+passo;
  end;
  end;
setcolor(5);assi;
outtextxy(10,230,'premi enter');
outtextxy(10,250,'premi 1 per rivedere o 2 per finire');
readln(scelta);
if (scelta=1) then calcola else fine;
end;

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