rivoluzione annuale
sidereo1,2,3,4,5
program sidereo1;
(* su disco 65 dispensa 49 \tu56\sidereo1.mar *)
(* rivoluzione della terra attorno al sole *)
uses crt,graph;
type vet=array[1..800] of byte;
var disco:vet;
anni,sostare: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('---------------------------------------------');
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('si deve indicare:');
writeln('numero anni di rivoluzione');
writeln('tempo per variare velocita di visualizzazione');
writeln('============================================');
writeln('scrivi numero anni per rivoluzione..1.2.3..');
readln(anni);
writeln('scrivi valore per sostare in punti speciali');
writeln('500..1000..5000........prova 3000 ');
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: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=');
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 (an=pa) or (an=90+pa) or (an=365) or (an=445)
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+360 then testo(250,90,'fine anno tropico');
setcolor(4);
if an=90+360 then testo(370,230,'inizio anno anomalistico');
if an=90+360 then testo(370,220,'fine anno anomalistico');
setcolor(5);
if an=g1 then testo(250,40,'inizio anno sidereo');
if an=g1+360 then testo(250,50,'fine anno sidereo');
setcolor(0); (*cancella grado *)
testo(80,60,grado);
end;
delay(sostare); (* 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);
end;
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1);
moto(0,360);
testo(350,100,'equinozio 21 marzo');
testo(350,400,'equinozio 23 settembre');
testo(10,230,'solstizio 21 giugno');
testo(460,280,'solstizio 21 dicembre');
setcolor(2);
testo(460,260,'perielio 3 gennaio ');
testo(10,260,'afelio 4 luglio ');
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);
moto1(160,160+360,disco);
setcolor(2);
testo(10,410,'premi return per finire');
readln;
end.
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.
program sidereo3;
(* su disco 65 dispensa 49 \tu56\sidereo3.mar *)
(* variante di sidereo2.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);
setlinestyle(1,0,3); (* nuova linea apsidale *)
line(100,270,500,230);
testo(10,380,'spostamento apsidale');
moto1(160,160+hg,disco);
setcolor(2);
testo(10,410,'premi return per finire');
readln;
end.
program sidereo4;
(* su disco 65 dispensa 49 \tu56\sidereo4.mar *)
(* variante di sidereo3.mar con precessione equinoziale *)
(* rivoluzione della terra attorno al sole *)
uses crt,graph;
type vet=array[1..800] of byte;
var disco1,disco2: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('SIMULAZIONE PROGRAMMATA PER PARAMETRI:');
WRITELN('RIVOLUZIONI=1....TEMPO SOSTA=1......');
writeln('PREMI RETURN,PREGO');
ANNI:=1;
SOSTARE:=1;
READLN;
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
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');
testo(10,260,'afelio 4 luglio');
testo(460,260,'perielio 3 gennaio');
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,r1,r2,q1,q2,dg,gt,gf:integer;d1,d2:vet);(* pianeti*)
var an2,an,s1,c1,s2,c2,pa,giri,tg:integer;
rad2,rad1: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');
an2:=an+dg;
rad1:=an*3.14/180;
rad2:=an2*3.14/180;
s1:=trunc(r1*sin(rad1)); (* pianeta n1*)
c1:=trunc(r2*cos(rad1));
s2:=trunc(q1*sin(rad2)); (* pianeta n2 *)
c2:=trunc(q2*cos(rad2));
putimage(300+s1,250+c1,disco1,1);
putimage(300+s2,250+c2,disco1,1);
delay(50); (* persiste immagine *)
if (tg=0) or (tg=90) or (tg=205) or (tg=285)
or (an=360+pa) then delay(sostare);
if (k=1) and (an=160+hg) then delay(4000);
putimage(300+s1,250+c1,disco1,1); (* cancella dischi pianeti *)
putimage(300+s2,250+c2,disco1,1);
setcolor(3);
if (an=gt) then testo(250,80,'inizio anno tropico');
if (an=gf) then testo(250,90,'fine anno tropico');
if (an=gf) and (k=1) then testo(250,90,'fine anno tropico');
if (an=gf) and (k=1) then delay(1000);
if (k=1) and(an=gt) then testo(250,90,'inizio 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(1000); (* 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);
end;
if k=1 then putimage(300+s1,250+c1,disco1,1);
if k=1 then putimage(300+s2,250+c2,disco1,1);
end; (* ultima posizione pianeta *)
begin (* programma principale *)
clrscr;
simula;
grafica(1);
moto(0,360);
setcolor(3);
testo(60,10,'PIANO DELLA ECLITTICA:SOLE E TERRA COMPLANARI');
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 pianeta1 *)
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco1);
hg:=360;
testo(10,150,'anno sidereo=anno tropico:assente precessione');
moto1(160,160+hg,200,160,230,190,0,160,160+hg,disco1,disco1);
setcolor(2);
hg:=360;
testo(250,40,'inizio anno sidereo');
testo(250,80,'inizio anno tropico');
moto1(160,160+hg,200,160,230,190,0,160,160+hg,disco1,disco1);
setcolor(1);
testo(10,150,'anno sidereo=anno tropico:assente precessione');
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');
testo(10,150,'anno tropico<anno sidereo per precessione');
testo(250,80,'inizio anno tropico');
moto1(160,160+hg,200,160,230,190,0,150,145+hg,disco1,disco1);
setcolor(2);
testo(10,410,'premi return per finire');
readln;
end.
program sidereo5;
(* su disco 65 dispensa 49 \tu56\sidereo5.mar *)
(* variante di sidereo3.mar con precessione equinoziale *)
(* rivoluzione della terra attorno al sole *)
uses crt,graph;
type vet=array[1..800] of byte;
var disco1:vet;
iat,ias,fat,fas:string;
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('SIMULAZIONE PROGRAMMATA PER PARAMETRI:');
WRITELN('RIVOLUZIONI=1....TEMPO SOSTA=1......');
writeln('tre disegni sulla stessa area grafica ');
writeln('PREMI RETURN,PREGO');
READLN;
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
outtextxy(300,400,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(300,400,'premi return,prego');
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure moto(x1,y1:integer); (* disegna orbita pianeta *)
var an,seno,coseno,r1,r2:integer;
rad:real;
begin
r1:=100;
r2:=80;
setfillstyle(1,3);
fillellipse(x1,y1,10,10); (* sole *)
settextstyle(1,0,1);
testo(120,30,'stella *');
testo(270,30,'stella *');
testo(420,30,'stella *');
for an:=0 to 360 do
begin
setcolor(4);
rad:=an*3.14/180;
seno:=trunc(r1*sin(rad));
coseno:=trunc(r2*cos(rad));
putpixel(x1+seno,y1+coseno,2);
end;
setcolor(2);
testo(20,400,'linea equinoziale iniziale');
line(150,40,150,240);
line(450,40,450,240);
line(300,220,300,390);
end;
procedure moto1(x1,y1,g1,g2,k:integer;d1:vet);(* pianeti*)
var an,s1,c1,r1,r2:integer;
rad1:real;
begin
for an:=g1 to g2 do
begin
r1:=100;
r2:=80;
setcolor(3);
rad1:=an*3.14/180;
s1:=trunc(r1*sin(rad1)); (* pianeta n1*)
c1:=trunc(r2*cos(rad1));
putimage(x1+s1,y1+c1,disco1,1);
delay(50); (* persiste immagine *)
if (k=1) and (an=360) then testo(10,210,fat);
if (k=1) and (an=360) then testo(10,220,fas);
if (k=2) and (an=330) then testo(300,210,fat);
if (k=2) and (an=330) then delay(2000);
if (k=2) and (an=360) then testo(300,220,fas);
if (k=3) and (an=450) then testo(370,320,fat);
if (k=3) and (an=450) then delay(2000);
if (k<3) and (an=360) then pausa;
if (k=3) and(an=480) then testo(370,330,'fine anno anomalistico');
if (k=3) and (an=480) then delay(2000);
putimage(x1+s1,y1+c1,disco1,1); (* cancella dischi pianeti *)
setcolor(3);
end;
end; (* ultima posizione pianeta *)
begin (* programma principale *)
clrscr;
simula;
grafica(1);
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco1);
moto(150,150);
moto(300,300);
moto(450,150);
setcolor(3);
testo(60,10,'PIANO DELLA ECLITTICA:SOLE E TERRA COMPLANARI');
settextstyle(0,0,1);
setcolor(3);
iat:='inizio anno tropico';
ias:='inizio anno sidereo';
fat:='fine anno tropico';
fas:='fine anno sidereo';
testo(10,100,'assente precessione:tropico=sidereo');
testo(10,180,iat);
testo(10,190,ias);
moto1(150,150,0,360,1,disco1);
testo(10,210,fat);
testo(10,220,fas);
setcolor(2);
testo(320,100,'presente precessione:tropico<sidereo');
testo(300,180,iat);
testo(300,190,ias);
line(400,250,495,50);
moto1(450,150,0,360,2,disco1);
testo(300,220,fas);
setcolor(3);
testo(20,350,'presente spostamento linea apsidale');
line(200,300,400,300); (* originale *)
setcolor(4);
line(200,320,400,280); (* nuova apsidale *)
testo(370,300,iat);
testo(370,310,'inizio anno anomalistico');
moto1(300,300,90,480,3,disco1);
setcolor(2);
pausa;
testo(10,430,'premi return per finire');
readln;
end.