astronomia con pascal

esci turboastro.htm

rivoluzione annuale apparente del sole e costellazioni-segni, zodiacali

program anno2;
(* MOTO apparente annuale del sole attorno alla terra *)
(* su disco 65 dispensa 49 \TU55\anno2.mar *)

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');
var disco1:vet;
TEMPO,anni:INTEGER;


procedure simula;

begin
writeln('simulazione moto apparente annuale del sole ');
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 zodiacali');
writeln('rotazione diurna osservatore terrestre ');
writeln('evidenzia costellazioni visibili nel corso dei mesi');
writeln('movimento annuale diretto da ovest a est del sole');
writeln('mese entrata del sole nelle costellazioni zodiacali');
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:integer;
rad:real;

begin
a:=360;
x:=300;
y:=250;
r1:=180;
r2:=180;
setcolor(3);
setfillstyle(1,3);
fillellipse(300,250,45,45); (* terra *)
setcolor(14);
testo(50,10,'moto di rivoluzione apparente del sole da ovest a est');
testo(50,20,'dalla terra si vede il sole spostarsi ogni mese in una ');
testo(50,30,'diversa costellazione zodiacale ');
for ag:=1 to 12 do
begin
rad:=a*3.14/180;
s:=trunc(r1*sin(rad));
c:=trunc(r2*cos(rad));
setfillstyle(ag,ag+1);
fillellipse(x+s,y+c,30,30); (* cerchi zodiacali*)
a:=a+30;
end;
testo(290,390,'pesci');
testo(280,50,'vergine');
testo(100,250,'sagittario');
testo(420,250,'gemelli');
testo(240,370,'acquario');
testo(330,370,'ariete');
testo(120,330,'capricorno');
testo(400,330,'toro');
testo(400,200,'cancro');
testo(120,200,'scorpione');
testo(240,120,'bilancia');
testo(350,120,'leone');
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);
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;
end;

procedure moto(disco:vet);
var x1, n,x,y,ang,s2,c2,r1,r2,conta:integer;
rad1: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));
putimage(x+s2,y+c2,disco,1); (* sole *)
if (int(ang/30)=ang/30) 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 (int(ang/30)=ang/30) then testo(10,x1,zod[n]);
if (int(ang/30)=ang/30) then testo(500,x1,mesi[n]);
if (int(ang/30)=ang/30) then n:=n+1;
if (int(ang/30)=ang/30) then x1:=x1+10;
if (int(ang/30)=ang/30) then delay(tempo);
if (int(ang/30)=ang/30) then terra(ang);
delay(10); (* pausa per cambiare disco 10..100 *)
putimage(x+s2,y+c2,disco,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 *)
moto(disco1);
pausa;
end.