astronomia con pascal

moto della luna e fasi lunari

program lunix2;
(* MOTO DELLA LUNA attorno alla terra in rotazione;sole fisso *)
(* su disco 65 dispensa 49 \TU56\lunix2.mar *)
(* mese lunare e successione fasi lunari nel mese *)
(* variante di lunix1.mar*)

uses crt,graph;
type vet=array[1..800] of byte;
var disco1,disco2:vet;
TEMPO,mese:INTEGER;

procedure simula;

begin
writeln('simulazione moto mensile della luna ');
writeln('con spostamento giornaliero attorno alla terra');
writeln('osservatore terrestre in rotazione diurna e fasi lunari ');
writeln('------------------------------------------------------- ');
writeln('ipotesi e convenzioni per semplificare calcoli :');
writeln('durata del mese lunare=24 giorni');
writeln('spostamento angolare diurno della luna=15 gradi');
writeln('ore del sorgere,culminare,tramontare,multipli di 60 minuti');
writeln('--------------------------------------------------------');
writeln('si visualizza:');
writeln('disco terrestre,orizzonte,meridiano,est,ovest');
writeln('movimento disco della luna');
writeln('ora del sorgere,culminare,tramontare della luna');
writeln('successione dei giorni lunari da 0 a 24 o meno ');
writeln('novilunio,primo quarto,plenilunio,ultimo quarto');
writeln('========================================================');
writeln('si deve indicare il tempo per regolare velocita movimento');
writeln('scrivere un numero come 10..100..1000.....');
writeln('PROVARE CON TEMPI LUNGHI,1000,PER VEDERE BENE LE SCRITTE');
WRITELN('PROVARE CON TEMPI CORTI,1,PER VEDERE RAPIDAMENTE ');
WRITELN('TEMPO=');READLN(TEMPO);
writeln('indicare numero giorni:24 per mese completo:vari minuti...');
writeln('numero minore di 24 per vedere solo alcune fasi...........');
readln(mese);
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
setcolor(14);
outtextxy(100,440,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(100,440,'premi return,prego');
end;

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

procedure costante; (* disegna terra e asse sole terra *)
begin
setfillstyle(1,5); (* settore notturno *)
bar(300,10,600,400);
setcolor(3);
line(10,200,600,200);
setfillstyle(1,14);
fillellipse(50,200,40,40); (* sole *)
testo(420,440,'lunazione=');
testo(60,10,'sole');
testo(150,10,'luna');
setcolor(15);
testo(300,30,'per effetto dello spostamento della luna');
testo(300,50,'attorno alla terra nel corso del mese');
testo(300,70,'di 15 gradi al giorno( sarebbero 13)');
testo(300,90,'la luna sorge ogni giorno 1 ora in ritardo');
testo(300,110,'rispetto al giorno precedente:conseguenza:');
testo(300,130,'alternanza delle FASI LUNARI ');
setcolor(14);
testo(300,250,'la terra ruota da OVEST verso EST');
testo(300,270,'in 24 ore:1 ora ogni 15 gradi ');
testo(300,290,'persiste luna in vecchia posizione');
testo(300,310,'con LUNA PULSANTE corrente ');
testo(350,190,'linea meridiana');
setcolor(3);
setfillstyle(1,3);
fillellipse(300,200,45,45); (* terra *)
end;

procedure moto;
var m,s1,c1,s2,c2,x,y,r1,r2,ora1,ora2,ora3,ora,giorni,giorno:integer;
rad,rad1,rad2,s,c:real;
grado,h1,h2,h3:string;
m1,m2,ang,c3,s3,giri,y1:integer;
begin
x:=300;
y:=200;
y1:=185;
r1:=180;
r2:=180;
ora1:=5;
m1:=270;
m2:=0;
giorni:=1;
for giri:=0 to mese do
begin
giorno:=giorni;
str(giorno,grado);
setcolor(14);
outtextxy(540,440,grado);
ora1:=ora1+1;
if (ora1<24) then ora:=ora1
else ora:=ora1-24;
if (ora1<19) then ora2:=ora1+6
else ora2:=ora1-18;
if (ora1<13) then ora3:=ora1+12
else ora3:=ora1-12;
rad:=m1*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
str(giorno,grado);
str(ora,h1);
str(ora2,h2);
str(ora3,h3);
setcolor(4);
for ang:=0 to 360 do (* rotazione terra *)
begin
setcolor(14);
rad1:=ang*3.14/180; (* meridiano rotante*)
rad2:=(90+ang)*3.14/180; (* orizzonte rotante*)
s2:=trunc(40*sin(rad1));
c2:=trunc(40*cos(rad1));
s3:=trunc(40*sin(rad2));
c3:=trunc(40*cos(rad2));
line(x,y,x+s3,y+c3); (* meridiano osservatore*)
testo(x+s2,y+c2,'W');
testo(x-s2,y-c2,'E');
line(x+s2,y+c2,x-s2,y-c2 ); (* orizzonte osservatore*)
delay(100); (* pausa per cambiare disco 10..100 *)
m:=ang;
if (m=90+m2) then testo(10,410,'la luna sorge:ore='+h1);
if (m=180+m2) then testo(230,420,'la luna culmina:ore='+h2);
if (m=270+m2) then testo(400,410,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,430,'novilunio');
if ora1=12 then testo(200,430,'primo quarto');
if ora1=18 then testo(200,430,'plenilunio');
if ora1=24 then testo(200,430,'ultimo quarto');
setcolor(3);
line(x,y,x+s3,y+c3);
testo(x+s2,y+c2,'W');
testo(x-s2,y-c2,'E');
line(x+s2,y+c2,x-s2,y-c2);
putimage(x+s1,y1+c1,disco1,0);
if(m=90+m2) or (m=180+m2) or (m=270+m2) then delay(tempo);
delay(20); (* pausa prima di cancellare gradi e disco 10..50..100*)
putimage(x+s1,y1+c1,disco2,1);
end;
setcolor(1);
putimage(x+s1,y1+c1,disco1,1);
testo(10,410,'la luna sorge:ore='+h1);
testo(230,420,'la luna culmina:ore='+h2);
testo(400,410,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,430,'novilunio');
if ora1=12 then testo(200,430,'primo quarto');
if ora1=18 then testo(200,430,'plenilunio');
if ora1=24 then testo(200,430,'ultimo quarto');
outtextxy(540,440,grado);
giorni:=giorni+1;
m2:=m2+15; (* determina stampa ora lunare *)
m1:=m1+15; (* aumento di 15 gradi al giorno sfasamento sole luna *)
end;
end;

begin (* programma principale *)
clrscr;
SIMULA;
grafica(1); (* attiva pagina grafica *)
costante; (* disegno fisso terra *)
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco1);(* SOLE *)
setfillstyle(2,2);
fillellipse(250,20,10,10);
getimage(238,8,284,34,disco2); (* LUNA *)
moto;
pausa;
end.