astronomia con pascal

rivoluzione della terra e costellazioni zodiacali

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.