astronomia con pascal

precessione asse rotazione terrestre

program precex2;
(* precessione asse terrestre *)
(* su disco 65\tu53\ dispensa 49 con turbo pascal v.5 *)

uses crt,graph;

var sosta,fissa,gradi:integer;

procedure presenta;
var stringa:string[30];
begin;
stringa:='premi return,prego';
writeln('simulazione precessione asse terrestre');
writeln;
writeln('moto di precessione asse di rotazione terrestre');
writeln('attorno ad asse della eclittica in circa 26000 anni');
writeln('in senso contrario a quello di rotazione terrestre');
writeln;
writeln('cause principali:');
writeln('1..asse rotazione inclinato rispetto piano eclittica..66 gradi');
writeln('2..terra in rotazione attorno ad asse nord-sud');
writeln('3..rigonfiamento equatoriale globo terrestre');
writeln('4..attrazione luni-solare variabile nel tempo');
WRITELN(stringa);READLN; clrscr;
WRITELN('CONSEGUENZA :');
writeln('il rigonfiamento equatoriale viene attratto in modo diverso');
writeln('dal sole e dalla luna nel corso del tempo:');
writeln('periodo annuale:influenza del sole');
writeln('periodo mensile:influenza della luna');
writeln('EFFETTO LUNARE:NUTAZIONE ,ondulazione moto precessione');
writeln('come effetto si dovrebbe verificare il raddrizzamento assiale');
writeln('riportando il piano equatoriale sul piano della eclittica');
writeln('e asse rotazione parallelo ad asse eclittica');
writeln;
writeln('si verifica invece un moto di rotazione assiale attorno');
writeln('ad asse della eclittica,in circa 26000 anni');
writeln('ridotto a circa 21000 anni per spostamento linea apsidale');
writeln(stringa);readln;clrscr;
writeln('CONSEGUENZE MOTO DI PRECESSIONE:');
writeln('1..anticipazione degli equinozi :20 minuti ogni anno');
writeln('2..anno tropico minore di anno sidereo');
writeln('3..variazione durata delle stagioni');
writeln('4..sfasamento tra segni zodiacali e costellazioni zodiacali');
writeln('5..variazione polo celeste..polare..vega..');
writeln('6..variazione coordinate stellari...');
writeln(stringa);readln;clrscr;
writeln('indica tempo per velocita:100 rapido...1000 lento');readln(sosta);
writeln('indica modulo angolare:2..5..10...prova 2...');readln(gradi);
writeln(stringa);
readln;
end;

procedure grafica(f,sc,tp:integer); (* attiva pagina grafica*)
var stringa:string;
begin
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(2);
testo(10,400,'premi return,prego');
ch:=readkey;
setcolor(1);
testo(10,400,'premi return,prego');
end;

procedure terra;
var x:integer;
begin
x:=200;
circle(x,200,20);
circle(500,200,20); (* sole*)
line(x,10,x,400); (* asse eclittica*)
line(10,200,500,200);(* piano eclittica*)
testo(100,10,'asse eclittica');
testo(10,190,'piano eclittica');
testo(210,30,' * polare ');
testo(40,30,'vega * ');
testo(500,300,'sole');
testo(100,380,'asse terrestre inclinato 23 gradi rispetto asse eclittica ');
end;

procedure sistema; (* indica forze attrazione sole-luna-terra *)
var x,a1,b1,ang:integer;
sx,sy:real;
begin
x:=200;
ang:=25;
circle(x,200,100); (* terra *)
circle(500,200,30);(* sole *)
line(x,10,x,400); (* asse eclittica*)
line(10,200,500,200);(* piano eclittica*)
testo(100,10,'asse eclittica');
testo(10,190,'piano eclittica');
for ang:=25 downto 0 do
begin
sx:=sin(ang*3.14/180);
sy:=cos(ang*3.14/180);
a1:=trunc(100*sx);
b1:=trunc(100*sy);
setcolor(2);
testo(100,380,'asse terrestre inclinato 23 gradi rispetto asse eclittica ');
line(x+a1,200+b1,x-a1,200-b1);
testo(100,100,'nord');
testo(250,300,'sud');
setcolor(4);
line(x+b1,200-a1,x-b1,200+a1);
testo(100,250,'equatore');
testo(100,390,'equatore inclinato 23 gradi rispetto piano eclittica');
setcolor(14);
testo(200,20,'centro terra e sole su piano eclittica');
line(500,200,x+b1,200-a1);
line(500,200,x+-b1,200+a1);
testo(300,150,'A ');
testo(100,270,'B ');
testo(200,30,'attrazione del sole su rigonfiamento equatoriale');
testo(200,40,'massima in A ,minima in B');
testo(200,50,'tendenza al raddrizzamento asse rotazione');
delay(sosta);
setcolor(1);
if (ang=0) then setcolor(2);
line(x+a1,200+b1,x-a1,200-b1);
testo(100,100,'nord');
testo(250,300,'sud');
if (ang=0) then setcolor(14);
line(500,200,x+b1,200-a1);
line(500,200,x-b1,200+a1);
if (ang=0) then setcolor(4);
line(x+b1,200-a1,x-b1,200+a1);
if (ang=0) then setcolor(1);
testo(300,150,'A ');
testo(100,270,'B ');
end;
end;

procedure cerchi;
begin
circle(200,100,40);
circle(200,300,40);
end;

procedure moto(x,y,x1,y1,fissa:integer);
var s,c,a,r,n,s1,c1,girate:integer;
rad,rad1:real;
begin
r:=40;
n:=0;
cerchi;
girate:=trunc(360/gradi);
for a:=0 to girate do
begin
setcolor(14);
circle(x,200,20);
line(x,10,x,400); (* asse eclittica*)
line(10,200,500,200);(* piano eclittica*)
rad:=n*3.14/180;
rad1:=(180+n)*3.14/180;
c:=-trunc(r*cos(rad));
s:=trunc(r*sin(rad));
c1:=-trunc(r*cos(rad1));
s1:=trunc(r*sin(rad1));
if (n>=90) then setcolor(2);
line(x+s,y+c,x+s1,y1+c1);
if (fissa=2) then testo(x+s,y+c-20,'N');
if (fissa=2) then testo(x+s1,y1+c1+20,'S');
cerchi;
if (n=90) then testo(300,50,'anno 1990:asse rivolto verso la polare');
if (n=270) then testo(300,50,'anno 13000:asse rivolto verso vega ');
if (n>=270) then setcolor(4);
if (n=90) or (n=270) then pausa;
delay(sosta);
setcolor(1);
if (fissa=2) then line(x+s,y+c,x+s1,y1+c1);
if (fissa=2) then testo(x+s,y+c-20,'N');
if (fissa=2) then testo(x+s1,y1+c1+20,'S');
if (n=90) then testo(300,50,'anno 1990:asse rivolto verso la polare');
if (n=270) then testo(300,50,'anno 13000:asse rivolto verso vega ');
n:=n+gradi;
end;
end;

begin (* programma principale *)
clrscr;
presenta;
grafica(1,0,0); (* attiva pagina grafica f,sc,tp *)
sistema; (* sistema terra sole e attrazione *)
pausa;
grafica(1,0,0);
terra;
moto(200,100,200,300,1); (* x y x1 y1 *)
pausa;
grafica(1,0,0);
terra;
moto(200,100,200,300,2);
setcolor(14);
terra;
cerchi;
pausa;
end.