astronomia con pascal

esci turboastro.htm

moto diurno apparemte del sole e della luna

program lunare9;
(* MOTO DELLA LUNA E DEL SOLE DIURNO E MENSILE *)
(* su disco 65 dispensa 49 \TU56\lunare9.mar *)
(* variante di lunare8.mar *)

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

procedure simula;

begin
writeln('simulazione moto diurno e mensile della luna e del sole ');
writeln('relativamente ad un osservatore sulla terra immobile ');
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 del sole e 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:=1; (* 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(300,420,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(300,420,'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 orizzonte EST OVEST *)
begin
setcolor(5);
line(10,200,600,200);
line(300,200,300,10);
settextstyle(1,0,3);
testo(220,140,'meridiano osservatore');
testo(220,160,'orizzonte osservatore');
testo(10,170,'EST');
testo(500,170,'OVEST');
testo(400,40,'lunazione=');
testo(60,10,'sole');
testo(500,10,'luna');
setfillstyle(1,3);
fillellipse(300,200,20,20);
setcolor(3);
bar(1,200,630,410);
end;

procedure moto;
(* fase g3 ore sorgere culminare tramontare luna*)
var m,s1,c1,s2,c2,x,y,r1,r2,ora1,ora2,ora3,ora,giorni,g3,giorno:integer;
rad,rad1,s,c:real;
grado,h1,h2,h3:string;

begin
x:=300;
y:=200;
r1:=180;
r2:=180;
ora1:=5;
g3:=0;
for giorni:=0 to mese do
begin
giorno:=giorni;
str(giorno,grado);
setcolor(14);
outtextxy(540,40,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;
for m:=0 to 360 do
begin
rad:=m*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=-trunc(s);
c1:=trunc(c);
rad1:=(m+g3)*3.14/180;
s2:=-trunc(r1*sin(rad1));
c2:=trunc(r2*cos(rad1));
(* putpixel(x+s1,y+c1,4); *)
(* putpixel(x+s2,y+c2,2); *)
str(giorno,grado);
str(ora,h1);
str(ora2,h2);
str(ora3,h3);
setcolor(4);
putimage(x+s1,y+c1,disco2,1); (* luna *)
putimage(x+s2,y+c2,disco1,1); (* sole *)
setcolor(15);
if (m=95) then testo(10,220,'la luna sorge:ore='+h1);
if (m=175) then testo(230,230,'la luna culmina:ore='+h2);
if (m=265) then testo(330,220,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,360,'novilunio');
if ora1=12 then testo(200,360,'primo quarto');
if ora1=18 then testo(200,360,'plenilunio');
if ora1=24 then testo(200,360,'ultimo quarto');
if (m=5) or (m=95) or (m=175) or (m=265) or (m=355) then delay(TEMPO);
delay(20); (* pausa prima di cancellare gradi e disco 10..50..100*)
setcolor(3);
putimage(x+s1,y+c1,disco2,1);
putimage(x+s2,y+c2,disco1,1); (* modificare m per variare persistenza*)
if (m=120) then testo(10,220,'la luna sorge:ore='+h1);
if (m=200) then testo(230,230,'la luna culmina:ore='+h2);
if (m=290) then testo(330,220,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,360,'novilunio');
if ora1=12 then testo(200,360,'primo quarto');
if ora1=18 then testo(200,360,'plenilunio');
if ora1=24 then testo(200,360,'ultimo quarto');
end;
setcolor(1);
outtextxy(540,40,grado);
g3:=g3+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(400,20,10,10);
getimage(388,8,434,34,disco2); (* LUNA *)
moto;
pausa;
end.