precessione asse terrestre, stagioni, sistema terra luna
precex2,stagione, sistema1
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.
program stagione;
(* spostamento linea equinoziale e durata stagioni *)
(* su disco 65 dispensa 49 \tu55\stagione.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
var sole,pianeta1:vet;
tempo,anni,pre:integer;
procedure simula;
begin
textcolor(2);
textbackground(4);
writeln('rappresentazione diversa durata delle stagioni............ ');
writeln;
writeln('si visualizza:.............................................');
writeln('sole,linea apsidale,afelio,perielio........................');
writeln('linea equinoziale e sua precessione........................');
writeln('terra in rivoluzione attorno al sole.....................');
writeln('varia durata stagioni per spostamento linea equinoziale....');
writeln('-----------------------------------------------------------');
writeln('indicare velocita per rivoluzione.1.5.10 prova 1...........');
readln(tempo);
writeln('indicare numero anni....1..12............prova 12..........');
readln(anni);
writeln('indicare valore precessione 15..30..45...prova 30..........');
readln(pre);
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 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(14);
testo(10,450,'premi return,prego');
ch:=readkey;
setcolor(1);
testo(10,450,'premi return,prego');
end;
procedure dischi;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,5);
fillellipse(20,20,10,10);
getimage(8,8,34,34,pianeta1);
testo(10,40,'terra');
setcolor(14);
settextstyle(1,0,3);
testo(10,190,'afelio');
testo(550,190,'perielio');
testo(300,190,'sole');
settextstyle(0,0,1);
end;
procedure moto(sole,pianeta1:vet);
var x,y,rx,ry,s,c,a,GIRI,k,s1,c1,b,co,a1:integer;
rad,rad2:real;
begin
x:=300;
y:=200;
rx:=200;
ry:=150;
co:=2;
a1:=0;
setcolor(2);
line(x+50,y-150,x+50,y+150);
line(x-250,y,x+250,y);
putimage(x+40,y-10,sole,1);
FOR GIRI:=1 TO anni DO
BEGIN
setcolor(14);
for a:=a1 to 360+a1 do
begin
rad:=a*3.14/180;
rad2:=(360+a)*3.14/180;
s:=trunc(rx*sin(rad));
c:=trunc(ry*cos(rad));
s1:=-trunc(rx*sin(rad2));
c1:=trunc(ry*cos(rad2));
putpixel(x+50-s1,y+c1,14);
delay(tempo); (* variazione velocita *)
delay(1);
if (a>=a1) and (a<=180+a1) then k:=1
else k:=0;
if (k=1) then line(x+50,y,x+50-s,y+c);
setcolor(co);
end;
begin
setcolor(14);
testo(10,350,'equinozio di primavera');
testo(10,360,'precessione linea equinoziale');
for b:=180-a1 to 540-a1 do
begin
rad2:=(360+b)*3.14/180;
s1:=-trunc(rx*sin(rad2));
c1:=trunc(ry*cos(rad2));
putimage(x+50-s1,y+c1,pianeta1,1);
delay(tempo); (* variazione velocita *)
delay(1);
putimage(x+50-s1,y+c1,pianeta1,1); (* cancella pianeti *)
if (b=540-a1) then putimage(x+50-s1,y+c1,pianeta1,1);
setcolor(co);
a1:=a1+pre;
co:=co+1;
if (co=15) then co:=2;
end;
setcolor(1);
testo(10,350,'equinozio di primavera');
testo(10,360,'precessione linea equinoziale');
end;
END;
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
dischi;
setcolor(2);
testo(10,380,'la linea apsidale congiunge afelio e perielio');
testo(10,390,'la linea equinoziale si sposta in senso orario');
testo(10,400,'avvicinandosi agli apsidi:20 minuti ogni anno ');
setcolor(2);
SETTEXTSTYLE(1,0,3);
testo(300,10,'variazione durata stagioni');
testo(10,410,'semestre estivo : zona con tratteggio');
settextstyle(0,0,1);
testo(400,440,'tra equinozi 21/3 e 22/9 ');
moto(sole,pianeta1);
pausa;
end.
program sistema1;
(* spostamento sistema terra luna attorno al sole *)
uses crt,graph;
type vet=array[1..800] of byte;
const novi:array[1..11] of integer=(8,25,41,58,74,90,107,123,139,156,172);
pleni:array[1..11] of integer=(16,32,49,65,81,98,115,132,148,165,180);
var luna,terra:vet;
tempo,sosta:integer;
procedure simula;
begin
writeln('simulazione rivoluzione annuale terra-luna attorno al sole');
writeln('e rivoluzione sistema terra-luna attorno a baricentro comune');
writeln;
writeln('indicare valore per velocita...:veloce=10...lento=5000..');
writeln('prova 1000.....');
readln(tempo);
writeln('indicare se si desidera visualizzare avviso per ogni');
writeln('plenilunio e novilunio: si=1...no=2...');
writeln('con NO si rende piu visibile rotazione sistema,senza scritte');
writeln('prova entrambi i modi...');
readln(sosta);
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 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
testo(10,400,'premi return,prego');
ch:=readkey;
end;
procedure disco;
begin
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,luna);
putimage(500,20,luna,1);
testo(500,50,'luna');
setfillstyle(1,14);
fillellipse(20,20,15,15);
getimage(2,2,40,40,terra);
testo(20,50,'terra');
end;
procedure moto;
var x,y,st,ct,sl,cl,s,c,a,b,r,rt,rl,giri,date,px:integer;
rad1,rad:real;
stringa:string;
begin
setfillstyle(2,14);
x:=300;
y:=200;
r:=150;
if (sosta=1) then rt:=5
else rt:=10;
rl:=50;
giri:=0;
a:=0;
b:=0;
fillellipse(x,y,30,30); (* sole *)
testo(300,200,'sole');
for giri:=1 to 180 do
begin
str(giri,stringa);
testo(10,400,stringa);
rad:=b*3.14/180;
a:=a+24;
rad1:=a*3.14/180;
s:=trunc(r*sin(rad));
c:=trunc(r*cos(rad));
st:=trunc(rt*sin(rad1));
ct:=trunc(rt*cos(rad1));
sl:=-trunc(rl*sin(rad1));
cl:=-trunc(rl*cos(rad1));
for date:=1 to 11 do
begin
if (giri=pleni[date]) and (sosta=1) then testo(10,300,'novilunio')
else
if (giri=novi[date]) and (sosta=1) then testo(10,330,'plenilunio');
if (giri=pleni[date]) or (giri=novi[date]) then px:=1;
end;
putpixel(x+s,y+c,4);
setlinestyle(3,1,3);
putpixel(x+s+st,y+c+ct,14);
putpixel(x+s+sl,y+c+cl,15);
putimage(x+s+st,y+c+ct,terra,1);
putimage(x+s+sl,y+c+cl,luna,1);
b:=b+2;
delay(tempo);
if (px=1) and(sosta=1) then delay(1000);
putimage(x+s+st,y+c+ct,terra,1);
putimage(x+s+sl,y+c+cl,luna,1);
setcolor(1);
testo(10,300,'novilunio');
testo(10,330,'plenilunio');
testo(10,400,stringa);
setcolor(14);
px:=0;
end;
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
disco;
moto;
pausa;
closegraph;
end.