astronomia con pascal

esci turboastro.htm

rivoluzione terra, luna , possibilità eclissi

program terra2;
(* rivoluzione terrestre e lunare con eclissi ogni mese *)
(* su disco 65 dispensa 49 \tu54\terra2.mar *)

uses crt,graph;
type vet=array[1..800] of byte;
const data:array[1..12] of integer=(18,50,85,120,153,187,221,255,288,322,
356,400);
fase:array[1..12] of integer=(0,35,68,100,135,169,204,237,273,305,
340,0);
var luna,terra,sole:vet;
mesi:integer;

procedure simula;
begin
writeln('simulazione moto di rivoluzione annuale della terra');
writeln('e moto di rivoluzione mensile della luna attorno alla terra');
writeln;
writeln('approssimazioni varie per semplificare i calcoli:');
writeln('1 rivoluzione terrestre = 12 rivoluzioni lunari ');
writeln('orbite descritte praticamente circolari,non ellittiche');
writeln('sole,terra,luna complanari:conseguenza:');
writeln('ogni plenilunio si verifica eclisse di luna');
writeln('ogni novilunio si verifica eclisse di sole');
writeln;
writeln('indicare numero mesi:2..3..12..');
readln(mesi);
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 pausa; (* premere return per proseguire *)
var ch:char;
begin
outtextxy(400,450,'premi return,prego');
ch:=readkey;
end;

procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;

procedure disco;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,luna);
testo(10,50,'luna');
setfillstyle(5,5);
fillellipse(420,20,15,15);
getimage(404,2,438,40,terra);
testo(420,50,'terra');
end;

procedure moto;
var giri,m1,x,y,r1,r2,m,s1,c1,s2,c2,g1,g2,q1,q2,date,k:integer;
rad,rad1,s,c:real;
stringa:string;

begin
g1:=0;
g2:=360;
r1:=150;
r2:=150;
x:=300;
y:=200;
q1:=50;
q2:=50;
m1:=0;
begin
line(10,200,600,200);
line(300,10,300,400);
testo(250,190,'sole');
putimage(290,190,sole,1);
testo(10,400,'piano della eclittica:');
testo(10,320,'giorni ');
TESTO(10,410,'RIVOLUZIONE DELLA TERRA ATTORNO AL SOLE:anno');
testo(10,420,'rivoluzione della LUNA attorno alla terra:mese');
testo(10,430,'convenzione:1 anno = 12 rivoluzioni lunari ');
testo(10,440,'ipotesi di complanarita di sole,luna,terra ');
testo(10,450,'conseguenza:eclisse di sole e luna ogni mese');
for giri:=1 to mesi do
begin
for m:=g1 to g2 do
begin
if (m/12=int(m/12)) then m1:=m1+1; (* 1080 gradi lunari per 90 terra*)
str(m1,stringa);
setcolor(14);
testo(20,300,stringa);
delay(10);
rad:=m1*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
putpixel(x+s1,y+c1,14);
putimage(x+s1,y+c1,terra,1);
rad1:=m*3.14/180;
s2:=trunc(q1*sin(rad1));
c2:=trunc(q2*cos(rad1));
putpixel(x+s1+s2,y+c1+c2,5);
putimage(x+s1+s2,y+c1+c2,luna,1);
for date:=1 to 12 do
begin
if (m1=data[date]) then k:=1
else if (m1=fase[date]) then k:=2
else k:=0;
if (k=1) then testo(10,350,'novilunio:eclisse di sole');
if (k=1) then putimage(290,190,luna,1); (* eclisse di sole *)
if (k=2) then testo(350,350,'plenilunio:eclisse di luna');
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
end;
delay(10);
putimage(x+s1+s2,y+c1+c2,luna,1);
setcolor(1);
testo(20,300,stringa);
testo(10,350,'novilunio:eclisse di sole');
testo(350,350,'plenilunio:eclisse di luna');
end;
putimage(x+s1,y+c1,terra,1);
end;
end;
end;

begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
disco;
moto;
pausa;
closegraph;
end.