leggi di keplero
program keplero;
(* leggi di keplero *)
(* su disco 65 dispensa 49 \tu55\keplero.mar *)
uses crt,dos,graph;
type vet=array[1..800] of byte;
var sole,pianeta1,pianeta2:vet;
tempo,anni:integer;
procedure simula;
begin
textcolor(2);
textbackground(4);
writeln('rappresentazione delle tre leggi di KEPLERO............... ');
writeln;
writeln('si visualizza:.............................................');
writeln('sole,linea apsidale,afelio,perielio........................');
writeln('prima,seconda,terza legge con testo esplicativo............');
writeln('e pianeta o pianeti in rivoluzione attorno al sole.........');
writeln('-----------------------------------------------------------');
writeln('indicare velocita per rivoluzione.1.5.10 prova 1...........');
readln(tempo);
writeln('indicare numero volte per rivedere ogni legge 1.2.3.prova 1');
readln(anni);
clrscr;
end;
procedure grafica(f:integer); (* attiva pagina grafica*)
(* coordinate finestra,colore sfondo e disegno *)
var sc,tp:integer;
stringa:string;
begin
sc:=0; (* valore risoluzione 0,1,2,3,4,5,8,9 *)
tp:=0; (* valore valido 1 - 0 palette *)
stringa:='c:\scheda'; (* indica ove cercare GRAPH *)
initgraph(sc,tp,stringa); (* attiva scheda grafica *)
setbkcolor(f); (* colore sfondo *)
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure pausa; (* premere return per proseguire *)
var ch:char;
begin
setcolor(14);
testo(10,450,'premi return,prego');
ch:=readkey;
setcolor(1);
testo(10,450,'premi return,prego');
end;
procedure dischi;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,5);
fillellipse(20,20,10,10);
getimage(8,8,34,34,pianeta1);
testo(10,40,'pianeta');
setfillstyle(2,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,pianeta2);
setcolor(14);
settextstyle(1,0,3);
testo(10,190,'afelio');
testo(550,190,'perielio');
testo(300,190,'sole');
settextstyle(0,0,1);
end;
procedure moto(sole,pianeta1:vet;k:integer);
var x,y,rx,ry,s,c,a,GIRI,ritardo,nota:integer;
rad:real;
begin
x:=300;
y:=200;
rx:=200;
ry:=150;
ritardo:=100;
nota:=100;
setcolor(2);
line(x-250,y,x+250,y);
putimage(x+40,y-10,sole,1);
FOR GIRI:=1 TO anni DO
BEGIN
setcolor(14);
for a:=0 to 360 do
begin
rad:=a*3.14/180;
s:=trunc(rx*sin(rad));
c:=trunc(ry*cos(rad));
putpixel(x+s,y+c,14);
putimage(x-10+s,y-10+c,pianeta1,1);
putpixel(x+s,y+c,14);
delay(tempo); (* variazione velocita *)
delay(ritardo);
if (a>=0) and (a<=180) then nota:=nota+1
else nota:=nota-1;
sound(nota);
if (a>=0 ) and (a<=90) then ritardo:=ritardo-1;
if (a>90 ) and (a<=270) then ritardo:=ritardo+1;
if (a>270) and (a<360) then ritardo:=ritardo-1;
putimage(x-10+s,y-10+c,pianeta1,1); (* cancella pianeti *)
if (k=2) and (a>=60) and (a<=120) then line(x+40,y,x+5+s,y+c);
if (k=2) and (a>=250) and(a<=290) then line(x+40,y,x-5+s,y+c);
end;
end;
END;
procedure moto1(pianeta1:vet;k:integer);
var x,y,rx,ry,s,c,a,GIRI,s1,c1,ritardo,nota:integer;
rad,rad2:real;
min,sec:string;
ora,minuti,secondi,decimi:word;
begin
x:=300;
y:=200;
rx:=200;
ry:=150;
ritardo:=100;
nota:=100;
setcolor(2);
testo(500,380,'minuti-secondi');
FOR GIRI:=1 TO anni DO
BEGIN
setcolor(14);
for a:=0 to 360 do
begin
rad:=a*3.14/180;
rad2:=(a)*3.14/180;
s:=trunc(rx*sin(rad));
c:=trunc(ry*cos(rad));
s1:=trunc((rx+20)*sin(rad2));
c1:=trunc((ry+20)*cos(rad2));
if (k=3) then putpixel(x+s,y+c,14);
if (k=3) then putimage(x-10+s,y-10+c,pianeta1,1);
putpixel(x+s,y+c,14);
if (k=4) then putpixel(x+s1,y+c1,2);
if (k=4) then putimage(x-10+s1,y-10+c1,pianeta2,1);
delay(tempo); (* variazione velocita *)
delay(ritardo);
gettime(ora,minuti,secondi,decimi);
str(secondi,sec);
str(minuti,min);
if (k=3) then testo(500,400,min+' '+sec);
if (k=4) then testo(500,420,min+' '+sec);
if (a>=0) and (a<=180) then nota:=nota+1
else nota:=nota-1;
sound(nota);
if (k=4) then delay(100);
if (a>=0 ) and (a<=90) then ritardo:=ritardo-1;
if (a>90 ) and (a<=270) then ritardo:=ritardo+1;
if (a>270) and (a<360) then ritardo:=ritardo-1;
if (k=3) then putimage(x-10+s,y-10+c,pianeta1,1); (* cancella pianeti *)
if (k=4) then putimage(x-10+s1,y-10+c1,pianeta2,1);
setcolor(1);
if (k=3) then testo(500,400,min+' '+sec);
if (k=4) then testo(500,420,min+' '+sec);
setcolor(14);
end;
if (k=3) then testo(500,400,min+' '+sec);
if (k=4) then testo(500,420,min+' '+sec);
end;
END;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
dischi;
setcolor(2);
testo(10,360,'ogni pianeta descrive orbite ellittiche attorno al sole');
testo(10,370,'il sole si trova su un fuoco della ellisse');
testo(10,380,'la linea apsidale congiunge afelio e perielio');
setcolor(2);
SETTEXTSTYLE(1,0,3);
testo(300,10,'PRIMA LEGGE DI KEPLERO');
moto(sole,pianeta1,1);
TESTO(300,30,'SECONDA LEGGE DI KEPLERO');
settextstyle(0,0,1);
TESTO(10,390,'raggio congiungente pianeta con sole descrive ');
testo(10,400,'aree equivalenti in tempi uguali:ne consegue ');
testo(10,410,'che la velocita varia nel corso della orbita ');
testo(10,420,'massima in perielio e minima in afelio ');
moto(sole,pianeta1,2);
setcolor(5);
settextstyle(1,0,3);
testo(300,50,'terza legge di keplero');
settextstyle(0,0,1);
testo(10,430,'i quadrati dei tempi di rivoluzione dei pianeti');
testo(10,440,'sono proporzionali ai cubi delle distanze dal sole');
settime(00,00,00,00);
moto1(pianeta2,3);
settime(00,00,00,00);
moto1(pianeta2,4);
nosound;
pausa;
end.