rivoluzione terrestre, moto apparente sole e luna
terra,terra1,2,3,5, tempo1, solare1, sole1
program terra2;
(* rivoluzione terrestre e lunare con eclissi ogni mese *)
(* su disco 65 dispensa 49 \tu54\terra2.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
const data:array[1..12] of integer=(18,50,85,120,153,187,221,255,288,322,
356,400);
fase:array[1..12] of integer=(0,35,68,100,135,169,204,237,273,305,
340,0);
var luna,terra,sole:vet;
mesi:integer;
procedure simula;
begin
writeln('simulazione moto di rivoluzione annuale della terra');
writeln('e moto di rivoluzione mensile della luna attorno alla terra');
writeln;
writeln('approssimazioni varie per semplificare i calcoli:');
writeln('1 rivoluzione terrestre = 12 rivoluzioni lunari ');
writeln('orbite descritte praticamente circolari,non ellittiche');
writeln('sole,terra,luna complanari:conseguenza:');
writeln('ogni plenilunio si verifica eclisse di luna');
writeln('ogni novilunio si verifica eclisse di sole');
writeln;
writeln('indicare numero mesi:2..3..12..');
readln(mesi);
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(400,450,'premi return,prego');
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure disco;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,luna);
testo(10,50,'luna');
setfillstyle(5,5);
fillellipse(420,20,15,15);
getimage(404,2,438,40,terra);
testo(420,50,'terra');
end;
procedure moto;
var giri,m1,x,y,r1,r2,m,s1,c1,s2,c2,g1,g2,q1,q2,date,k:integer;
rad,rad1,s,c:real;
stringa:string;
begin
g1:=0;
g2:=360;
r1:=150;
r2:=150;
x:=300;
y:=200;
q1:=50;
q2:=50;
m1:=0;
begin
line(10,200,600,200);
line(300,10,300,400);
testo(250,190,'sole');
putimage(290,190,sole,1);
testo(10,400,'piano della eclittica:');
testo(10,320,'giorni ');
TESTO(10,410,'RIVOLUZIONE DELLA TERRA ATTORNO AL SOLE:anno');
testo(10,420,'rivoluzione della LUNA attorno alla terra:mese');
testo(10,430,'convenzione:1 anno = 12 rivoluzioni lunari ');
testo(10,440,'ipotesi di complanarita di sole,luna,terra ');
testo(10,450,'conseguenza:eclisse di sole e luna ogni mese');
for giri:=1 to mesi do
begin
for m:=g1 to g2 do
begin
if (m/12=int(m/12)) then m1:=m1+1; (* 1080 gradi lunari per 90 terra*)
str(m1,stringa);
setcolor(14);
testo(20,300,stringa);
delay(10);
rad:=m1*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
putpixel(x+s1,y+c1,14);
putimage(x+s1,y+c1,terra,1);
rad1:=m*3.14/180;
s2:=trunc(q1*sin(rad1));
c2:=trunc(q2*cos(rad1));
putpixel(x+s1+s2,y+c1+c2,5);
putimage(x+s1+s2,y+c1+c2,luna,1);
for date:=1 to 12 do
begin
if (m1=data[date]) then k:=1
else if (m1=fase[date]) then k:=2
else k:=0;
if (k=1) then testo(10,350,'novilunio:eclisse di sole');
if (k=1) then putimage(290,190,luna,1); (* eclisse di sole *)
if (k=2) then testo(350,350,'plenilunio:eclisse di luna');
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
end;
delay(10);
putimage(x+s1+s2,y+c1+c2,luna,1);
setcolor(1);
testo(20,300,stringa);
testo(10,350,'novilunio:eclisse di sole');
testo(350,350,'plenilunio:eclisse di luna');
end;
putimage(x+s1,y+c1,terra,1);
end;
end;
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
disco;
moto;
pausa;
closegraph;
end.
program terra1;
(* MOTO annuale della terra attorno al sole *)
(* su disco 65 dispensa 49 \TU55\terra1.mar *)
(* variante di anno5.mar con precessiome e sfasamento segni e stelle *)
uses crt,graph;
type vet=array[1..800] of byte;
const
zod:array[1..12] of string=('pesci','ariete','toro','gemelli',
'cancro','leone','vergine','bilancia',
'scorpione','sagittario','capricorno','acquario');
mesi:array[1..12] of string=('marzo','aprile','maggio','giugno',
'luglio','agosto','settembre','ottobre',
'novembre','dicembre','gennaio','febbraio');
segno:array[1..12] of string=('ariete','toro','gemelli',
'cancro','leone','vergine','bilancia',
'scorpione','sagittario','capricorno','acquario',
'pesci');
var disco1,disco2:vet;
TEMPO,anni:INTEGER;
procedure simula;
begin
writeln('simulazione moto annuale della terra ');
writeln('con lo sfondo delle costellazioni zodiacali');
writeln('------------------------------------------------------- ');
writeln('ipotesi e convenzioni per semplificare calcoli :');
writeln('durata anno=360 giorni');
writeln('--------------------------------------------------------');
writeln('si visualizza:');
writeln('disco terrestre,costellazioni e segni zodiacali');
writeln('evidenzia costellazioni visibili nel corso dei mesi');
writeln('movimento annuale diretto da ovest a est della terra');
writeln('mese entrata del sole nelle costellazioni zodiacali');
writeln('sfasamento tra segni e costellazioni per precessione 2000 anni');
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 anni:1..2..3...');
readln(anni);
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
setcolor(14);
outtextxy(400,440,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(400,440,'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 asse sole terra *)
var a,x,y,c,s,r1,r2,ag,s1,c1:integer;
rad,rad1:real;
begin
a:=360;
x:=300;
y:=250;
r1:=180;
r2:=180;
setcolor(5);
setfillstyle(1,14);
fillellipse(300,250,15,15); (* sole *)
setcolor(14);
testo(50,10,'moto di rivoluzione della terra da ovest a est');
testo(50,20,'dalla terra si vede il sole spostarsi ogni mese in una ');
testo(50,30,'diversa costellazione zodiacale ');
testo(10,50,'costellazioni');
setcolor(11);
testo(560,20,'terra');
testo(530,50,'segni');
setcolor(2);
testo(10,470,'SFASAMENTO TRA COSTELLAZIONI E SEGNI,PER PRECESSIONE ');
for ag:=1 to 12 do
begin
SETCOLOR(14);
rad:=a*3.14/180;
rad1:=(a+10)*3.14/180;
s:=trunc(r1*sin(rad));
c:=trunc(r2*cos(rad));
s1:=trunc(150*sin(rad1));
c1:=trunc(140*cos(rad1));
setfillstyle(ag,ag+1);
fillellipse(x+s,y+c,30,30); (* cerchi zodiacali*)
testo(x+s,y+c,zod[ag]);
setcolor(10);
testo(x+s1,y+c1,segno[ag]);
a:=a+30;
end;
setcolor(5);
testo(10,440,'la terra ruota da ovest verso est');
end;
procedure terra(angolo:integer);
var x,y,r1,r2,s2,c2,s3,c3,ang:integer;
rad,rad2:real;
begin
x:=300;
y:=250;
for ang:=angolo to 360+ angolo do
begin
setcolor(14);
if (ang=angolo) then testo(450,400,'il sole tramonta');
if (ang=angolo+180) then testo(450,410,'il sole sorge');
if (ang=angolo+270) then testo(450,420,'il sole culmina');
rad:=ang*3.14/180;
rad2:=(90+ang)*3.14/180;
s3:=trunc(40*sin(rad2));
c3:=trunc(40*cos(rad2));
s2:=trunc(40*sin(rad));
c2:=trunc(40*cos(rad));
setlinestyle(0,0,3);
line(x,y,x+s3,y+c3); (* meridiano rotante *)
line(x+s2,y+c2,x-s2,y-c2); (* orizzonte rotante *)
testo(x+s2,y+c2,'W');
testo(x-s2,y-c2,'E');
delay(10);
setcolor(3);
line(x+s2,y+c2,x-s2,y-c2);
line(x,y,x+s3,y+c3);
testo(x+s2,y+c2,'W');
testo(x-s2,y-c2,'E');
end;
setcolor(1);
testo(450,400,'il sole tramonta');
testo(450,410,'il sole sorge');
testo(450,420,'il sole culmina');
end;
procedure moto(disco1,disco2:vet);
var x1, n,x,y,ang,s2,c2,r1,r2,conta,q:integer;
rad1,g1,g2:real;
begin
for conta:=1 to anni do
begin
n:=1;
x1:=100;
x:=300;
y:=250;
r1:=180;
r2:=180;
for ang:=0 to 360 do
begin
rad1:=ang*3.14/180;
s2:=trunc(r1*sin(rad1));
c2:=trunc(r2*cos(rad1));
g1:=int(ang/30);
g2:=(ang/30);
if (g1=g2) then q:=1;
putimage(x+s2,y+c2,disco1,1); (* sole *)
putimage(x-s2,y-c2,disco2,1); (* terra*)
if (q=1) then line(x,y,x+s2,y+c2);
setcolor(n+1);
if (n>12 ) then testo(10,400,'fine rivoluzione');
if (n>12) then setcolor(1);
if (q=1) then testo(10,x1,zod[n]);
if (q=1) then testo(530,x1,segno[n]);
if (q=1) then testo(10,150+x1,mesi[n]);
if (q=1) then n:=n+1;
if (q=1) then x1:=x1+10;
if (q=1) then delay(tempo);
(*if (q=1) then terra(ang);*)
q:=0;
delay(10); (* pausa per cambiare disco 10..100 *)
putimage(x+s2,y+c2,disco1,1);
putimage(x-s2,y-c2,disco2,1);
putpixel(x+s2,y+c2,2);
end;
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);(* disco sole *)
setfillstyle(2,2);
fillellipse(500,20,10,10); (* disco terra*)
getimage(488,8,514,34,disco2);
moto(disco1,disco2);
pausa;
closegraph;
end.
program terra2;
(* rivoluzione terrestre e lunare con eclissi ogni mese *)
(* su disco 65 dispensa 49 \tu54\terra2.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
const data:array[1..12] of integer=(18,50,85,120,153,187,221,255,288,322,
356,400);
fase:array[1..12] of integer=(0,35,68,100,135,169,204,237,273,305,
340,0);
var luna,terra,sole:vet;
mesi:integer;
procedure simula;
begin
writeln('simulazione moto di rivoluzione annuale della terra');
writeln('e moto di rivoluzione mensile della luna attorno alla terra');
writeln;
writeln('approssimazioni varie per semplificare i calcoli:');
writeln('1 rivoluzione terrestre = 12 rivoluzioni lunari ');
writeln('orbite descritte praticamente circolari,non ellittiche');
writeln('sole,terra,luna complanari:conseguenza:');
writeln('ogni plenilunio si verifica eclisse di luna');
writeln('ogni novilunio si verifica eclisse di sole');
writeln;
writeln('indicare numero mesi:2..3..12..');
readln(mesi);
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(400,450,'premi return,prego');
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure disco;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,luna);
testo(10,50,'luna');
setfillstyle(5,5);
fillellipse(420,20,15,15);
getimage(404,2,438,40,terra);
testo(420,50,'terra');
end;
procedure moto;
var giri,m1,x,y,r1,r2,m,s1,c1,s2,c2,g1,g2,q1,q2,date,k:integer;
rad,rad1,s,c:real;
stringa:string;
begin
g1:=0;
g2:=360;
r1:=150;
r2:=150;
x:=300;
y:=200;
q1:=50;
q2:=50;
m1:=0;
begin
line(10,200,600,200);
line(300,10,300,400);
testo(250,190,'sole');
putimage(290,190,sole,1);
testo(10,400,'piano della eclittica:');
testo(10,320,'giorni ');
TESTO(10,410,'RIVOLUZIONE DELLA TERRA ATTORNO AL SOLE:anno');
testo(10,420,'rivoluzione della LUNA attorno alla terra:mese');
testo(10,430,'convenzione:1 anno = 12 rivoluzioni lunari ');
testo(10,440,'ipotesi di complanarita di sole,luna,terra ');
testo(10,450,'conseguenza:eclisse di sole e luna ogni mese');
for giri:=1 to mesi do
begin
for m:=g1 to g2 do
begin
if (m/12=int(m/12)) then m1:=m1+1; (* 1080 gradi lunari per 90 terra*)
str(m1,stringa);
setcolor(14);
testo(20,300,stringa);
delay(10);
rad:=m1*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
putpixel(x+s1,y+c1,14);
putimage(x+s1,y+c1,terra,1);
rad1:=m*3.14/180;
s2:=trunc(q1*sin(rad1));
c2:=trunc(q2*cos(rad1));
putpixel(x+s1+s2,y+c1+c2,5);
putimage(x+s1+s2,y+c1+c2,luna,1);
for date:=1 to 12 do
begin
if (m1=data[date]) then k:=1
else if (m1=fase[date]) then k:=2
else k:=0;
if (k=1) then testo(10,350,'novilunio:eclisse di sole');
if (k=1) then putimage(290,190,luna,1); (* eclisse di sole *)
if (k=2) then testo(350,350,'plenilunio:eclisse di luna');
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
end;
delay(10);
putimage(x+s1+s2,y+c1+c2,luna,1);
setcolor(1);
testo(20,300,stringa);
testo(10,350,'novilunio:eclisse di sole');
testo(350,350,'plenilunio:eclisse di luna');
end;
putimage(x+s1,y+c1,terra,1);
end;
end;
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
disco;
moto;
pausa;
closegraph;
end.
program terra3;
(* rivoluzione terrestre e lunare con eclissi e retrocessione nodale *)
(* su disco 65 dispensa 49 \tu54\terra3.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
const data:array[1..12] of integer=(17,50,83,115,148,181,213,246,279,
311,344,378);
fase:array[1..12] of integer=(1,33,64,97,130,163,197,230,264,296,
329,363);
var luna,terra,sole:vet;
mesi:integer;
procedure simula;
begin
writeln('simulazione moto di rivoluzione annuale della terra');
writeln('e moto di rivoluzione mensile della luna attorno alla terra');
writeln;
writeln('approssimazioni varie per semplificare i calcoli:');
writeln('1 rivoluzione terrestre = 12 rivoluzioni lunari ');
writeln('orbite descritte praticamente circolari,non ellittiche');
writeln('sole,terra complanari:orbita lunare inclinata ');
writeln('eclisse di sole o di luna solo se novilunio o plenilunio');
writeln('con sole,terra,luna allineati su linea nodale:');
writeln('e complanari:sole,luna,terra su piano della eclittica');
writeln;
writeln('lo spostamemto retrogrado della linea nodale comporta');
writeln('la anticipazione delle ecclissi ogni anno rispetto alla');
writeln('data della eclisse dello anno precedente');
writeln;
writeln('indicare numero mesi:2..3..12..:prova completa=12 mesi');
readln(mesi);
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(400,450,'premi return,prego');
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure disco;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,luna);
testo(10,50,'luna');
setfillstyle(5,5);
fillellipse(420,20,15,15);
getimage(404,2,438,40,terra);
testo(420,50,'terra');
end;
procedure moto(n1,n6,p1,p6:integer);
var date,giri,m1,x,y,r1,r2,m,s1,c1,s2,c2,g1,g2,q1,q2,k,h:integer;
rad,rad1,s,c:real;
stringa:string;
begin
g1:=0;
g2:=mesi*360;
r1:=150;
r2:=150;
x:=300;
y:=200;
q1:=50;
q2:=50;
m1:=0;
begin
(*line(10,200,600,200);
line(300,10,300,400);*)
testo(250,190,'sole');
putimage(290,190,sole,1);
testo(10,400,'piano della eclittica:');
testo(10,320,'giorni ');
TESTO(10,410,'RIVOLUZIONE DELLA TERRA ATTORNO AL SOLE:anno');
testo(10,420,'rivoluzione della LUNA attorno alla terra:mese');
testo(10,430,'convenzione:1 anno = 12 rivoluzioni lunari ');
testo(10,440,'ipotesi :orbita lunare inclinata rispetto a eclittica ');
testo(10,450,'eclisse astri allineati su linea nodale o prossimi');
(*for giri:=1 to mesi do
begin *)
for m:=g1 to g2 do
begin
if (m/12=int(m/12)) then m1:=m1+1; (* 1080 gradi lunari per 90 terra*)
str(m1,stringa);
setcolor(14);
testo(20,300,stringa);
(*delay(10);*)
rad:=m1*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
(*putpixel(x+s1,y+c1,14);*)
putimage(x+s1,y+c1,terra,1);
rad1:=m*3.14/180;
s2:=trunc(q1*sin(rad1));
c2:=trunc(q2*cos(rad1));
(*putpixel(x+s1+s2,y+c1+c2,5);*)
putimage(x+s1+s2,y+c1+c2,luna,1);
for date:=1 to 12 do
begin
if (m1=data[date]) then h:=1
else if (m1=fase[date]) then h:=2
else h:=0;
if (h=1) then testo(10,330,'novilunio');
if (h=2) then testo(10,60,'plenilunio');
end;
if (m1=data[n1]) or (m1=data[n6] )then k:=1
else if (m1=fase[p1]) or (m1=fase[p6]) then k:=2
else k:=0;
if (k=2) then line (x,y,x+s1+s2,y+c1+c2);
if (k=1) then testo(10,350,'novilunio:eclisse di sole');
if (k=1) then putimage(290,190,luna,1); (* eclisse di sole *)
if (k=2) then testo(350,350,'plenilunio:eclisse di luna');
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
if (k=2) then putimage(x+s1+s2,y+c1+c2,sole,1);(* eclisse luna *)
delay(1);
putimage(x+s1+s2,y+c1+c2,luna,1);
setcolor(1);
testo(20,300,stringa);
testo(10,350,'novilunio:eclisse di sole');
testo(350,350,'plenilunio:eclisse di luna');
testo(10,330,'novilunio');
testo(10,60,'plenilunio');
putimage(x+s1,y+c1,terra,1);
end;
end;
putimage(290,190,sole,1);
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
disco;
moto(3,8,3,8);
setcolor(14);
moto(2,7,2,7);
setcolor(14);
moto(1,6,1,6);
setcolor(14);
pausa;
closegraph;
end.
program terra5;
(* rivoluzione terrestre e lunare con eclissi e retrocessione nodale *)
(* su disco 65 dispensa 49 \tu54\terra5.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
var luna,terra,sole:vet;
orbita,m,m1,sidereo:integer;
procedure simula;
begin
writeln('simulazione moto di rivoluzione annuale della terra');
writeln('e moto di rivoluzione mensile della luna attorno alla terra');
writeln;
writeln('approssimazioni varie per semplificare i calcoli:');
writeln('1 rivoluzione terrestre = 12 rivoluzioni lunari ');
writeln('orbite descritte praticamente circolari,non ellittiche');
writeln('sole,terra complanari:orbita lunare inclinata ');
writeln('eclisse di sole o di luna solo se novilunio o plenilunio');
writeln('con sole,terra,luna allineati su linea nodale o prossimi:');
writeln('e complanari:sole,luna,terra su piano della eclittica');
writeln;
writeln('lo spostamemto retrogrado della linea nodale comporta');
writeln('la anticipazione delle ecclissi ogni anno rispetto alla');
writeln('data della eclisse dello anno precedente');
writeln;
writeln('SI PROGRAMMA SIMULAZIONE PER TRE ANNI CON RETROCESSIONE ');
WRITELN;
writeln('indicare se si desidera persistenza orbite si=1..no=2 ');
readln(orbita);
WRITELN('indicare se si desidera visualizzare mese sidereo si=1..no=2');
readln(sidereo);
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(400,350,'premi return,prego');
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure disco;
begin
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,sole);
setfillstyle(1,2);
fillellipse(20,20,10,10);
getimage(8,8,34,34,luna);
testo(10,50,'luna');
setfillstyle(5,5);
fillellipse(420,20,15,15);
getimage(404,2,438,40,terra);
testo(420,50,'terra');
end;
procedure moto(n1,n2,n3,n4:integer);
var x,y,r1,s1,c1,s2,c2,q1:integer;
rad,rad1:real;
stringa:string;
begin
r1:=150;
x:=300;
y:=200;
q1:=50;
begin
testo(250,190,'sole');
putimage(290,190,sole,1);
testo(10,400,'piano della eclittica:');
testo(10,320,'giorni ');
TESTO(10,410,'RIVOLUZIONE DELLA TERRA ATTORNO AL SOLE:anno');
testo(10,420,'rivoluzione della LUNA attorno alla terra:mese');
testo(10,430,'convenzione:1 anno = 12 rivoluzioni lunari ');
testo(10,440,'ipotesi :orbita lunare inclinata rispetto a eclittica ');
testo(10,450,'eclisse astri allineati su linea nodale o prossimi');
while m1<361 do
begin
m1:=m1+1; (* giorni di rivoluzione terrestre *)
str(m1,stringa);
setcolor(14);
testo(20,300,stringa);
rad:=m1*3.14/180; (* terra rivoluzione 360 gradi/anno *)
s1:=trunc(r1*sin(rad));
c1:=trunc(r1*cos(rad));
if (orbita=1) then putpixel(x+s1,y+c1,14);
putimage(x+s1,y+c1,terra,1);
rad1:=m*3.14/180;
s2:=trunc(q1*sin(rad1));
c2:=trunc(q1*cos(rad1));
if (orbita=1) then putpixel(x+s1+s2,y+c1+c2,15);
putimage(x+s1+s2,y+c1+c2,luna,1);
setcolor(14);
if (m/360= int(m/360)) then testo(10,100,'inizio,fine,mese sidereo');
if (sidereo=1) and (m/360 = int(m/360)) then delay(1000);
m:=m+18; (* modulo rivoluzione lunare *)
if (m1=n1) or (m1=n2) then testo(10,150,'eclisse di sole');
if (m1=n1) or (m1=n2) then line(290,190,x+s1+s2,y+c1+c2);
if (m1=n1) or (m1=n2) then putimage(290,190,luna,1);
if (m1=n1) or (m1=n2) then delay(4000);
if (m1=n3) or (m1=n4) then testo(10,160,'eclisse di luna');
if (m1=n3) or (m1=n4) then putimage(x+s1+s2,y+c1+c2,sole,1);
if (m1=n3) or (m1=n4) then delay(4000);
delay(30); (* pausa per persistenza immagine *)
putimage(x+s1+s2,y+c1+c2,luna,0);
if (m1=360) then delay(3000); (*pausa dopo ogni 360 giorni *)
setcolor(1);
testo(20,300,stringa);
testo(10,100,'inizio,fine,mese sidereo');
testo(10,150,'eclisse di sole');
testo(10,160,'eclisse di luna');
putimage(x+s1,y+c1,terra,1);
putimage(x+s1+s2,y+c1+c2,luna,1);
putimage(290,190,sole,0);
end;
end;
putimage(290,190,sole,1);
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
disco;
setcolor(14);
m1:=0;
m:=0;
moto(54,223,63,235); (* regressione linea nodale *)
setcolor(14);
m:=0;
m1:=0;
moto(33,202,43,213);
m:=0;
m1:=0;
setcolor(14);
moto(2,181,12,191); (* regressione linea nodale *)
setcolor(14);
pausa;
closegraph;
end.
program tempo1;
(* MOTO della terra diurno e attorno al sole *)
(* su disco 65 dispensa 49 \TU55\tempo1.mar *)
(* girno solare giorno sidereo *)
uses crt,graph;
type vet=array[1..800] of byte;
var disco2,d1,d2,d3,d4,d5:vet;
TEMPO,anni:INTEGER;
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
setcolor(14);
outtextxy(400,440,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(400,440,'premi return,prego');
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure costante(disco2:vet); (* sole stella orbita fissa *)
var r,s,c,ang,x,y:integer;
rad:real;
begin
r:=150;
x:=300;
y:=200;
setlinestyle(0,0,1);
line(1,y,600,y);
line(1,y+70,160,y+70);
setcolor(10);
testo(10,y,'*') ;
testo(10,y+70,'*');
putimage(x-15,y-15,disco2,1); (* sole *)
setcolor(14);
for ang:=0 to 360 do
begin
rad:=ang*3.14/180;
s:=trunc(r*sin(rad));
c:=trunc(r*cos(rad));
putpixel(x+s,y+c,2);
end;
end;
procedure terra(d1,d2,d3,d4,d5:vet;fase:integer); (* moto terra *)
var r,s,c,ang,x,y,x1,y1:integer;
rad:real;
begin
r:=150;
x:=300;
y:=200;
x1:=x-r-15;
y1:=y-15;
s:=trunc(r*sin(fase*3.14/180));
c:=trunc(r*cos(fase*3.14/180));
x1:=x-15+s;
y1:=y-15+c;
testo(10,50,'inizio giorno sidereo e solare');
putimage(x1,y1,d1,1);
delay(1000);
putimage(x1,y1,d1,1);
putimage(x1,y1,d2,1);
delay(1000);
setcolor(1);
testo(10,50,'inizio giorno sidereo e solare');
putimage(x1,y1,d2,1);
putimage(x1,y1,d3,1);
delay(1000);
putimage(x1,y1,d3,1);
putimage(x1,y1,d4,1);
delay(1000);
putimage(x1,y1,d4,1);
putimage(x1,y1,d1,1);
setcolor(2);
if (fase=270) then testo(10,60,'fine giorno solare');
testo(10,50,'fine giorno sidereo');
pausa;
setcolor(1);
testo(10,50,'fine giorno sidereo');
if (fase=270) then testo(10,60,'fine giorno solare');
putimage(x1,y1,d1,1);
setcolor(14);
if (fase=300) then line (x,y,x1,y1+17);
if (fase=300) then putimage(x1,y1,d5,1);
if (fase=300) then testo(10,60,'fine giorno solare');
pausa;
setcolor(1);
testo(10,60,'fine giorno solare');
end;
begin (* programma principale *)
clrscr;
grafica(1); (* attiva pagina grafica *)
testo(10,40,'sole');
testo(500,40,'terra');
testo(500,50,'stella fissa *');
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco2);(* disco sole *)
setfillstyle(1,2);
fillellipse(500,20,10,10); (* disco terra 1*)
setlinestyle(0,0,3);
line(490,20,510,20);
line(500,10,500,20);
getimage(488,8,514,34,d1);
fillellipse(500,20,10,10); (* disco terra 2*)
setlinestyle(0,0,3);
line(490,20,500,20);
line(500,10,500,30);
getimage(488,8,514,34,d2);
fillellipse(500,20,10,10); (* disco terra 3 *)
setlinestyle(0,0,3);
line(490,20,510,20);
line(500,20,500,30);
getimage(488,8,514,34,d3);
fillellipse(500,20,10,10); (* disco terra 4 *)
setlinestyle(0,0,3);
line(500,10,500,30);
line(500,20,510,20);
getimage(488,8,514,34,d4);
fillellipse(500,20,10,10); (* disco terra 5 *)
setlinestyle(0,0,3);
line(490,25,510,15);
line(495,10,500,20);
getimage(488,8,514,34,d5);
costante(disco2);
testo(350,400,'giorno solare=giorno sidereo');
testo(350,410,'se la ruotasse senza rivoluzione');
terra(d1,d2,d3,d4,d5,270);
setcolor(1);
testo(350,400,'giorno solare=giorno sidereo');
testo(350,410,'se la ruotasse senza rivoluzione');
setcolor(2);
testo(10,370,'giorno solare > giorno sidereo:4 minuti');
testo(10,380,'per rivoluzione di 1 grado attorno al sole');
terra(d1,d2,d3,d4,d5,300);
setcolor(14);
testo(10,400,'il giorno solare varia durante il corso annuale');
testo(10,410,'infatti la terra descrive archi variabili per');
testo(10,420,'effetto della diversa velocita nella orbita ellittica');
pausa;
end.
program solare1;
(* su disco 65 dispensa 45 \tu56\solare1.mar *)
(* moto diurno del sole e della luna*)
(* novilunio,quadratura,plenilunio *)
uses crt,graph;
type vet=array[1..800] of byte;
var sole,luna:vet;
luogo1,luogo2,culmina:string;
t,orbite,sosta:integer;
procedure simula; (* introduzione a programma *)
begin
writeln('simulazione moto diurno del sole e della luna');
writeln('novilunio,quadratura,plenilunio ');
writeln('il sole e la luna si muovono da est verso ovest');
writeln('viene indicata la fase');
writeln('viene indicata ora del sorgere,culminazione,tramonto');
writeln('---------------------------------------------');
writeln('premere tasto PAUSE per fermare rotazione ');
writeln('premere tasto RETURN per riprendere rotazione');
writeln('---------------------------------------------');
writeln('indica velocita moto solare ');
writeln('numero 1 =moto rapido ');
writeln('numero 100 =moto lento ');
writeln('prova prima con 1 e poi altri valori...10..20..');
readln(t);
writeln('indicare numero rotazioni 1,2,3,4..');
readln(orbite);
orbite:=360*orbite;
writeln('scrivi valore pausa punti speciali');
writeln('1000...2000...5000....prova 1000 ');
readln(sosta);
clrscr;
end;
procedure fine; (* fine e ritorno a pascal *)
begin
exit;
end;
procedure grafica(x1,y1,x2,y2,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 *)
rectangle(x1,y1,x2,y2); (* cornice area 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(r1,r2,g3,p1,q1,q2,cu:integer;disco1,disco2:vet;luogo1,luogo2:string);
(* raggi r1,r2,q1,q2,gradi g3,figura...animazione figura*)
var m,s1,c1,s2,c2,sosta1:integer;
rad,rad1,s,c:real;
begin
for m:=0 to orbite do
begin
rad:=m*3.14/180;
rad1:=(m+g3)*3.14/180;
s:=r1*sin(rad); (* disco1 *)
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
s2:=trunc(q1*sin(rad1));(* disco2 *)
c2:=trunc(q2*cos(rad1));
setwritemode(0);
putimage(300+s1,200+c1,disco1,1); (* rotazione disco1 pieno singolo *)
putimage(300+s2,200+c2,disco2,1); (* rotazione disco2 *)
putimage(300+s1,200+c1,disco1,0);
putimage(300+s2,200+c2,disco2,0);
delay(t);
if m=90 then outtextxy(20,p1,luogo1);
if m=270 then outtextxy(480,p1,luogo2);
if m=180 then outtextxy(270,cu,culmina);
if (m=90) or(m=180) or(m=270) or (m=360) then sosta1:=sosta;
delay(sosta1);
sosta1:=0;
end;
delay(t);
putimage(300+s1,200+c1,disco1,1); (* cancella disco1 tramonto *)
putimage(300+s2,200+c2,disco2,1); (* cancella disco 2 *)
end;
procedure costante; (* disegno e testo fisso *)
begin
setfillstyle(1,4); (* tratto e colore terra *)
bar(290,250,310,200); (* terra *)
setfillstyle(1,2); (* orizzonte terra *)
fillellipse(300,250,40,40);
line(150,210,450,210);
testo(40,80,'sole');
testo(550,80,'luna');
setcolor(15);
testo(250,240,'orizzonte terra');
setcolor(4);
testo(270,220,'MERIDIANO');
setcolor(2);
testo(210,220,'EST');
testo(390,220,'OVEST');
setcolor(15);
testo(20,470,'attendere inizio simulazione,prego');
setfillstyle(1,14);
fillellipse(20,20,10,10); (* sole *)
getimage(5,5,35,35,sole); (* vettore sole *)
setfillstyle(3,5);
fillellipse(500,20,10,10); (* luna*)
getimage(485,5,515,35,luna); (* vettore luna *)
end;
procedure programma; (* contiene parte principale *)
procedure scelta; (* opzione fine o riprova *)
var ch:char;
begin
(* textmode(1); *)
restorecrtmode;
writeln('per rivedere,premi S,per finire premi N');
readln(ch);
if ch='S' then programma
else fine
end;
begin
clrscr;
simula; (* introduzione a programma *)
grafica(1,1,639,470,1); (* attiva pagina grafica *)
costante; (* disegno sfondo fisso *)
setcolor(5);
testo(290,450,'LA LUNA');
setcolor(15);
testo(270,290,'novilunio');
luogo1:='sorge alle 6';
luogo2:='tramonta alle 18';
culmina:='culmina alle 12';
moto(-280,190,0,400,-250,160,150,sole,luna,luogo1,luogo2); (* animazione *)
setcolor(4);
testo(270,300,'primo quarto');
luogo1:='sorge alle 12';
luogo2:='tramonta alle 24 ';
culmina:='culmina alle 18';
moto(-280,190,90,410,250,-160,160,sole,luna,luogo1,luogo2);
setcolor(5);
testo(270,310,'plenilunio');
luogo1:='sorge alle 18';
luogo2:='tramonta alle 6';
culmina:='culmina alle 24';
moto(-250,190,180,420,-250,160,170,luna,sole,luogo1,luogo2);
setcolor(2);
testo(270,320,'ultimo quarto');
luogo1:='sorge alle 24';
luogo2:='tramonta alle 12';
culmina:='culmina alle 6';
moto(-250,190,90,430,250,-160,180,luna,sole,luogo1,luogo2);
readln;
scelta; (* opzione fine o rivedere *)
end;
begin
programma; (* programma principale *)
pausa;
end.
program sole1;
(* su disco 65 dispensa 49 \tu56\sole1.mar *)
(* moto diurno del sole *)
(* equinozio,solstizio *)
uses crt,graph;
type vet=array[1..800] of byte;
var sole:vet;
luogo1,luogo2:string;
t:integer;
procedure simula; (* introduzione a programma *)
begin
writeln('simulazione moto diurno del sole');
writeln('agli equinozi e ai solstizi ');
writeln('il sole si sposta apparentemente da est a ovest');
writeln('descrivendo archi di diversa ampiezza');
writeln('spostando il punto del sorgere e tramontare');
writeln('e raggiungemdo altezze variabili con la stagione');
writeln('---------------------------------------------');
writeln('premere tasto PAUSE per fermare rotazione ');
writeln('premere tasto RETURN per riprendere rotazione');
writeln('---------------------------------------------');
writeln('indica velocita moto solare ');
writeln('numero 1 =moto rapido ');
writeln('numero 100 =moto lento ');
writeln('prova prima con 1 e poi altri valori...10..20..');
readln(t);
clrscr;
end;
procedure fine; (* fine e ritorno a pascal *)
begin
closegraph;
exit;
end;
procedure grafica(x1,y1,x2,y2,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 *)
rectangle(x1,y1,x2,y2); (* cornice area 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(r1,r2,g1,g2,p1:integer;disco1:vet;luogo1,luogo2:string);
(* raggi r1,r2,gradi g1,g2,figura...animazione figura*)
var m,s1,c1:integer;
rad,s,c:real;
begin
for m:=g1 to g2 do
begin
rad:=m*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
setwritemode(0);
putimage(300+s1,200+c1,disco1,1); (* rotazione disco pieno singolo *)
putimage(300+s1,200+c1,disco1,0);
delay(t);
if m=90 then outtextxy(20,p1,luogo1);
if m=270 then outtextxy(400,p1,luogo2);
if m=175 then outtextxy(240,300,'il sole culmina a sud');
if (m=175) or (m=90) or (m=270) then delay(2000);
end;
putimage(300+s1,200+c1,disco1,1); (* cancella sole tramonto *)
end;
procedure orbita(r1,r2:integer;co:word); (* disegna orbite vuote *)
var m,s2,c2:integer;
rad, s1,c1:real;
begin
for m:=90 to 270 do
begin
rad:=m*3.14/180;
s1:=r1*sin(rad);
c1:=r2*cos(rad);
s2:=trunc(s1);
c2:=trunc(c1);
putpixel(300+s2,250+c2,co);
end;
end;
procedure costante; (* disegno e testo fisso *)
begin
setfillstyle(1,4); (* tratto e colore terra *)
bar(290,250,310,200); (* terra *)
setfillstyle(1,2); (* orizzonte terra *)
bar(1,250,639,350);
testo(40,80,'sole');
testo(260,270,'orizzonte terra');
testo(280,290,'MERIDIANO');
testo(20,270,'EST');
testo(580,270,'OVEST');
testo(20,400,'equinozio');
testo(20,350,'premere return per proseguire');
setfillstyle(1,14);
fillellipse(20,20,10,10); (* sole *)
getimage(5,5,35,35,sole); (* vettore sole *)
end;
procedure programma; (* contiene parte principale *)
procedure scelta; (* opzione fine o riprova *)
var ch:char;
begin
(* textmode(1);*)
restorecrtmode;
writeln('per rivedere,premi S,per finire premi N');
readln(ch);
ch:=upcase(ch);
if ch='S' then programma
else fine
end;
begin
clrscr;
simula; (* introduzione a programma *)
grafica(1,1,639,470,1); (* attiva pagina grafica *)
costante; (* disegno sfondo fisso *)
luogo1:='il sole sorge a EST';
luogo2:='il sole tramonta a OVEST';
moto(-230,180,90,270,310,sole,luogo1,luogo2); (* animazione sole *)
pausa;
setcolor(4);
testo(20,420,'solstizio estivo');
luogo1:='il sole sorge a nord est';
luogo2:='il sole tramonta a nord ovest ';
moto(-280,190,90,270,320,sole,luogo1,luogo2);
pausa;
setcolor(5);
testo(20,440,'solstizio invernale');
luogo1:='il sole sorge a sud est';
luogo2:='il sole tramonta a sud ovest';
moto(-190,170,90,270,330,sole,luogo1,luogo2);
pausa;
setcolor(2);
testo(20,460,'orbite descritte agli equinozi e solstizi');
orbita(-230,170,5); (* disegna tre orbite vuote *)
orbita(-250,180,7);
orbita(-270,190,4);
pausa;
scelta; (* opzione fine o rivedere *)
end;
begin
programma; (* programma principale *)
end.