astronomia con pascal

rivoluzione annuale:anno solare, sidereo, precessione equinoziale

program sidereo2;
(* su disco 65 dispensa 49 \tu56\sidereo2.mar *)
(* variante di sidereo1.mar con precessione e moto apsidale*)
(* rivoluzione della terra attorno al sole *)

uses crt,graph;
type vet=array[1..800] of byte;
var disco:vet;
hg,k, anni,sostare,x1,y1:integer;

procedure simula;
begin
writeln('simulazione moto rivoluzione della terra ');
writeln('----------------------------------------');
writeln('si assume durata anno=360 giorni ');
writeln('si prescinde dal moto di precessione ');
writeln('si prescinde dal moto di spostamento apsidale ');
writeln('ANNO SIDEREO=ANNO TROPICO=ANNO ANOMALISTICO');
writeln('---------------------------------------------');
writeln('si considera anche il moto di precessione');
WrITELN('ANNO TROPICO < ANNO SIDEREO...20 minuti ');
writeln('--------------------------------------------');
writeln('si visualizza:');
writeln('sole,orbita terrestre,linea apsidale,equinoziale,solstiziale');
writeln('punti e date:equinozi,solstizi,perielio,afelio');
writeln('anno e giorno corrente');
writeln('inizio e fine anno tropico,sidereo,anomalistico');
writeln('movimento della terra attorno al sole');
writeln('---------------------------------------');
writeln('premere return per proseguire,prego ');
readln;
clrscr;
writeln('si deve indicare:');
writeln('numero anni di rivoluzione');
writeln('tempo per variare velocita di visualizzazione');
writeln('============================================');
writeln('SIMULAZIONE PROGRAMMATA PER PARAMETRI:');
WRITELN('RIVOLUZIONI=1....TEMPO SOSTA=1000....provarli...');
writeln('scrivi numero anni per rivoluzione..1.2.3..: 1');
readln(anni);
writeln('scrivi valore per sostare in punti speciali');
writeln('500..1000..5000.............................:1000 ');
readln(sostare);
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
ch:=readkey;
end;

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

procedure moto(g1,g2:integer); (* disegna orbita pianeta *)
var an,seno,coseno:integer;
rad:real;
begin
testo(10,420,'linea apsidale');
line(100,250,500,250); (* asse maggiore *)
(*line(350,400,350,100); asse minore *)
setfillstyle(1,3);
fillellipse(350,250,10,10); (* sole *)
for an:=g1 to g2 do
begin
setcolor(4);
rad:=an*3.14/180;
seno:=trunc(200*sin(rad));
coseno:=trunc(160*cos(rad));
putpixel(300+seno,250+coseno,2);
end;
end;

procedure moto1(g1,g2:integer;nome:vet);(* moto del pianeta*)
var an,seno,coseno,pa,giri,tg:integer;
rad:real;
grado,anno:string;
begin
pa:=g1;
for giri:=1 to anni do
begin
for an:=g1 to g2 do
begin
setcolor(4);
str(giri,anno); (* anno corrente *)
testo(10,70,'anno=');
testo(60,70,anno);
str(an-g1,grado); (* correzione per origine a 0 gradi *)
testo(80,60,grado); (* posizione orbitale espressa come giorni *)
testo(10,60,'giorno=');
tg:=an-g1; (* giorno in successione *)
if (tg=0) then testo(350,100,'equinozio 21 marzo');
if (tg=90) then testo(10,230,'solstizio 21 giugno ');
if (tg=205) then testo(350,400,'equinozio 23 settembre');
if (tg=285) then testo(460,280,'solstizio 21 dicembre');
rad:=an*3.14/180;
seno:=trunc(200*sin(rad));
coseno:=trunc(160*cos(rad));
putimage(300+seno,250+coseno,disco,1);
delay(50); (* persiste immagine *)
if (tg=0) or (tg=90) or (tg=205) or (tg=285)
or (an=360+pa) then delay(sostare);
putimage(300+seno,250+coseno,disco,1);
setcolor(3);
if (an=g1) then testo(250,80,'inizio anno tropico');
if (an=g1+hg) then testo(250,90,'fine anno tropico');
setcolor(4);
if an=90+hg then testo(370,230,'inizio anno anomalistico');
if an=90+hg then testo(370,220,'fine anno anomalistico');
setcolor(5);
if (k=1) and (an=160) then delay(1000) ;
if (k=1) and(an=160+hg) then delay(1000);
if an=160 then testo(250,40,'inizio anno sidereo');
if an=160+hg then testo(250,50,'fine anno sidereo');
setcolor(0); (*cancella grado *)
testo(80,60,grado);
end;
if k=1 then delay(5000); (* sosta prima della fine *)
delay(2000); (* segue cancellazione testi *)
setcolor(0);
testo(370,230,'inizio anno anomalistico');
testo(370,220,'fine anno anomalistico');
testo(250,80,'inizio anno tropico');
testo(250,90,'fine anno tropico');
testo(250,40,'inizio anno sidereo');
testo(250,50,'fine anno sidereo');
testo(80,70,anno);
testo(350,100,'equinozio 21 marzo');
testo(10,230,'solstizio 21 giugno ');
testo(350,400,'equinozio 23 settembre');
testo(460,280,'solstizio 21 dicembre');
end;
if k=1 then putimage(300+seno,250+coseno,disco,1);
end; (* ultima posizione pianeta *)

begin (* programma principale *)
clrscr;
simula;
grafica(1);
moto(0,360);
setcolor(2);
testo(150,420,'linea solstiziale');
line(110,210,495,275); (* linea solstiziale *)
testo(300,420,'linea equinoziale');
line(370,100,330,410); (* linea equinoziale *)
testo(375,30,'* stella fissa');
testo(10,40,'pianeta');
testo(340,260,'sole');
setfillstyle(1,2); (* disco pianeta *)
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco);
hg:=360;
moto1(160,160+hg,disco);
(* pausa; *)
setcolor(2);
hg:=350;
moto1(160,160+hg,disco);
setcolor(4);
setlinestyle(1,0,3);
k:=1;
line(410,100,280,420); (* linea equinoziale spostata *)
line(120,170,490,300); (* linea solstiziale spostate *)
testo(10,400,'spostamento equinoziale-solstiziale');
moto1(150,150+hg,disco);
(* pausa;*)
setcolor(2);
testo(10,410,'premi return per finire');
readln;
end.