listati per programmi in turbo pascal

ottica:: specchi, rifrazione

(* conca1.fis immagini specchi concavi *)

program concavi;
uses crt;
var dsorgente,dimmagine,altezzai,ingrandimento:real;
    altezzas,fuoco:integer;
    contatore:integer;
    b:string;
begin
 clrscr;
 writeln('legge punti coniugati per specchi concavi e lenti convesse');
 writeln('notare segmo + - per distanza,altezza immagine ');
 writeln;
 b:='------------------------------------------------------';
 fuoco:=40;
 dsorgente:=120;
 altezzas:=50;
 for contatore:=1 to 11 do
  begin
  if dsorgente=70 then writeln(b);
  if dsorgente=fuoco then
  begin
  dsorgente:=dsorgente-10;
  writeln('sorgente su fuoco=',fuoco,'..immagine a infinito');
  writeln(b);
  end;
  dimmagine:=fuoco*dsorgente/(dsorgente-fuoco);
  ingrandimento:=dimmagine/dsorgente;
  altezzai:= ingrandimento*altezzas;
  write('dsorgente=',dsorgente:3:0,'...dimmagine=',dimmagine:3:0);
  write('..ingrandimento=',ingrandimento:3:1);
  writeln('..altezzas=',altezzas,'..altezzai=',altezzai:3:0);
  dsorgente:=dsorgente-10;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* conca1.fis immagini specchi concavi *)

program concavi;
uses crt;
var dsorgente,dimmagine,altezzai:real;
    altezzas,fuoco:integer;
    contatore:integer;
begin
 clrscr;
 fuoco:=40;
 dsorgente:=120;
 altezzas:=50;
 for contatore:=1 to 11 do
  begin
  if dsorgente=fuoco then
  begin
  dsorgente:=dsorgente-10;
  writeln('sorgente su fuoco=immagine a infinito');
  end;
  dimmagine:=fuoco*dsorgente/(dsorgente-fuoco);
  altezzai:= dimmagine*altezzas/dsorgente;
  write('dsorgente=',dsorgente:3:0,'...dimmagine=',dimmagine:3:0);
  writeln('...altezzas=',altezzas,'...altezzai=',altezzai:3:0);
  dsorgente:=dsorgente-10;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* conca2.fis immagini specchi concavi e lenti convesse*)

program concavi;
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 specchi concavi o lenti convergenti');
 writeln('osservare variazione segno per q,g,i ');
 writeln('fuoco=40..posizione sorgente iniziale=120..sorgente=50 ');
 writeln;
 for contatore:=1 to 10 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.

(* conve1.fis immagini specchi convessi e lenti divergenti *)

program concavi;
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 specchi convessi o lenti divergenti');
 writeln('osservare variazione segno per q,g,i ');
 writeln('fuoco=-40..posizione sorgente iniziale=120..sorgente=50 ');
 writeln;
 for contatore:=1 to 10 do
  begin
  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.

(* dive1.fis immagini specchi convessi e lenti concave *)

program dive1;
uses crt;
var dsorgente,dimmagine,altezzai,ingrandimento:real;
    altezzas,fuoco:integer;
    contatore:integer;
    b:string;
begin
 clrscr;
 writeln('legge punti coniugati per specchi convessi e lenti concave');
 writeln('notare segmo + - per distanza,altezza immagine ');
 writeln;
 b:='------------------------------------------------------';
 fuoco:=-40;
 dsorgente:=120;
 altezzas:=50;
 for contatore:=1 to 11 do
  begin
  dimmagine:=fuoco*dsorgente/(dsorgente-fuoco);
  ingrandimento:=dimmagine/dsorgente;
  altezzai:= ingrandimento*altezzas;
  write('dsorgente=',dsorgente:3:0,'...dimmagine=',dimmagine:3:0);
  write('..ingrandimento=',ingrandimento:3:1);
  writeln('..altezzas=',altezzas,'..altezzai=',altezzai:3:0);
  dsorgente:=dsorgente-10;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* rifra1.fis indice di rifrazione *)

program rifra1;
uses crt;
var i,r,n:real;
    a,seni,senr,cosr,tanr:real;
    contatore,passo:integer;
    b:string;
begin
 clrscr;
 b:='----------------------------------------------------';
 i:=10;
 n:=1.55;
 (* oppure metti n:=1.33 *)
 passo:=10;
 writeln('legge della rifrazione:passaggio da aria ad acqua o vetro ');
 writeln('n acqua=1.33   n vetro=1.52 ');
 writeln;
 for contatore:=1 to 9 do
  begin
  seni:=sin(i*3.14/180);
  senr:=seni/n;
  cosr:=sqrt(1-sqr(senr));
  tanr:=senr/cosr;
  r:=arctan(tanr)*180/3.14;
  write('angolo i=',i:2:0,'....sin(i)=',seni:2:2);
  writeln('....sin(r)=',senr:3:2,'....r=',r:2:0,'...n=',seni/senr:2:2);
  i:=i+passo;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* rifra1a.fis indice di rifrazione *)

program rifra1a;
uses crt;
var i,r,n:real;
    a,seni,senr,cosr,tanr:real;
    contatore,passo,fine:integer;
    b:string;
begin
 clrscr;
 b:='----------------------------------------------------';
 i:=10;
 n:=1.55;
 (* oppure metti n:=1.33 *)
 passo:=10;
 fine:=9;
 writeln('legge della rifrazione:passaggio da aria ad acqua o vetro ');
 writeln('n acqua=1.33   n vetro=1.52 ');
 writeln;
 for contatore:=1 to fine do
  begin
  seni:=sin(i*3.14/180);
  senr:=seni/n;
  cosr:=sqrt(1-sqr(senr));
  tanr:=senr/cosr;
  r:=arctan(tanr)*180/3.14;
  write('angolo i=',i:2:0,'....sin(i)=',seni:2:2);
  writeln('....sin(r)=',senr:3:2,'....r=',r:2:2,'...n=',seni/senr:2:2);
  i:=i+passo;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* rifra2.fis indice di rifrazione e angolo limite *)

program rifra2;
uses crt;
var i,r,n:real;
    a,seni,senr,cosr,tanr:real;
    contatore,passo:integer;
    b:string;
begin
 clrscr;
 b:='----------------------------------------------------';
 i:=1;
 n:=1/1.55;
 (* oppure metti n:=1.33 *)
 passo:=1;
 writeln('legge della rifrazione:passaggio da acqua o vetro ad aria ');
 writeln('n acqua=1.33   n vetro=1.55 ');
 writeln;
 for contatore:=1 to 40  do
  begin
  if (contatore=10) or (contatore=20) or(contatore=30) then
  begin
  writeln('------premi enter--------');
  readln;
  end;
  seni:=sin(i*3.14/180);
  senr:=seni/n;
  cosr:=sqrt(1-sqr(senr));
  tanr:=senr/cosr;
  r:=arctan(tanr)*180/3.14;
  write('angolo i=',i:2:0,'....sin(i)=',seni:2:2);
  writeln('....sin(r)=',senr:3:2,'....r=',r:2:0,'...n=',seni/senr:2:2);
  i:=i+passo;
  end;
  writeln('premi enter per finire');
  readln;
end.

(* rifra3.fis indice di rifrazione e angolo limite *)

program rifra3;
uses crt;
var i,r,n:real;
    a,seni,senr,cosr,tanr:real;
    contatore,passo:integer;
    b:string;

procedure riflessione;
begin
 writeln('angolo incidenza=',i:2:2,'...angolo riflessione=',i:2:2);
end;

procedure rifrazione;
begin
 clrscr;
 b:='----------------------------------------------------';
 i:=5;
 n:=1/1.55;
 passo:=5;
 writeln('legge della rifrazione:passaggio da acqua o vetro ad aria ');
 writeln(' n vetro=1/1.55 ');
 writeln;
 for contatore:=1 to 17  do
  begin
  if i<=40 then
  begin
  seni:=sin(i*3.14/180);
  senr:=seni/n;
  cosr:=sqrt(1-sqr(senr));
  tanr:=senr/cosr;
  r:=arctan(tanr)*180/3.14;
  write('angolo i=',i:2:0,'....sin(i)=',seni:2:2);
  writeln('....sin(r)=',senr:3:2,'....r=',r:2:0,'...n=',seni/senr:2:2);
  i:=i+passo;
  end
  else
  begin
  i:=i+passo;
  riflessione;
  end;
  end;
  writeln('angolo limite tra 40 e 50:riflessione totale');
  writeln('premi enter per finire');
end;

begin
rifrazione;
readln;
end.