astronomia con pascal

esci turboastro.htm

apparente spostamento del sorgere e tramontare de sole durante l'anno

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

uses crt,graph;
type vet=array[1..800] of byte;
var disco1:vet;
TEMPO,mese:INTEGER;

procedure simula;

begin
writeln('simulazione moto apparente diurno del sole ');
writeln('con alternanza del giorno e della notte');
writeln('------------------------------------------------------- ');
writeln('ipotesi e convenzioni per semplificare calcoli :');
writeln('durata del giorno=24 ore');
writeln('ore del sorgere,culminare,tramontare,multipli di 60 minuti');
writeln('--------------------------------------------------------');
writeln('si visualizza:');
writeln('disco terrestre,orizzonte,meridiano,est,ovest');
writeln('movimento diurno da est verso ovest del sole');
writeln('ora del sorgere,culminare,tramontare del sole');
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 giorni:1..2..3...');
readln(mese);
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(100,440,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(100,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 *)
begin
setfillstyle(1,5); (* settore notturno *)
bar(1,200,600,400);
setcolor(3);
line(10,200,600,200);
setcolor(15);
testo(400,20,'situazione: ');
testo(300,250,'il SOLE ruota da EST verso OVEST');
testo(300,270,'in 24 ore:1 ora ogni 15 gradi ');
testo(270,350,'linea meridiana');
line(300,200,300,10);
setcolor(3);
testo(10,190,'EST');
testo(550,190,'OVEST');
setfillstyle(1,3);
fillellipse(300,200,45,45); (* terra *)
testo(400,30,'settore diurno');
testo(400,410,'settore notturno');
setcolor(5);
testo(280,200,'lat=45 N');
end;

procedure moto(r1:integer;disco:vet;stagione:string); (* sole *)

var ora,m,s2,c2,ang,x,y,r2,giorni:integer;
rad1:real;
hora,data:string;

begin
x:=300;
y:=200;
r2:=r1;
ora:=0;
for giorni:=1 to mese do
begin
setcolor(14);
str(giorni,data);
testo(20,40,'giorno='+data);
testo(400,40,stagione);
for ang:=0 to 360 do (* rotazione sole *)
begin
setlinestyle(1,0,3);
setcolor(6);
if (r1=160) and (ang=120) then line(x,y,x-s2,y+c2);
if (r1=160) and (ang=120) then line(x,y,x+s2,y+c2);
if (r1=160) and (ang=120) then testo(200,100,'sud-est');
if (r1=160) and (ang=120) then testo(350,100,'sud-ovest');
setcolor(2);
if (r1=180) and (ang=60) then testo(200,300,'nord-est');
if (r1=180) and (ang=60) then testo(350,300,'nord-ovest');
setlinestyle(0,0,3);
if (r1=180) and (ang=60) then line(x,y,x-s2,y+c2);
if (r1=180) and (ang=60) then line(x,y,x+s2,y+c2);
if (int(ang/15)=ang/15) then ora:=ora+1;
str(ora,hora);
testo(20,70,'ora ='+hora);
setcolor(14);
if (ang=360) or (ang=0) then testo(20,320,'mezzanotte');
if (ang=90) and (r1=170) then testo(20,240,'il sole sorge:ore 6');
if (ang=180) then testo(20,250,'il sole culmina:ore 12');
if (ang=270)and (r1=170) then testo(20,260,'il sole tramonta:ore 18');
if (ang=90) and (r1=180) then testo(20,240,'il sole sorge:ore 4');
if (ang=270)and (r1=180) then testo(20,260,'il sole tramonta:ore 20');
if (ang=90) and (r1=160) then testo(20,240,'il sole sorge:ore 8');
if (ang=270)and (r1=160) then testo(20,260,'il sole tramonta:ore 16');
rad1:=ang*3.14/180;
s2:=trunc(r1*sin(rad1));
c2:=trunc(r2*cos(rad1));
putimage(x-s2,y+c2,disco,1);
delay(10); (* pausa per cambiare disco 10..100 *)
putimage(x-s2,y+c2,disco,1);
putpixel(x-s2,y+c2,2);
m:=ang;
setcolor(3);
if(m=90) or (m=180) or (m=270) then delay(tempo);
setcolor(1);
testo(20,70,'ora ='+hora);
setcolor(14);
delay(10); (* pausa prima di cancellare gradi e disco 10..50..100*)

end;
setcolor(1);
ora:=0;
testo(400,40,stagione);
testo(20,40,'giorno='+data);
setcolor(5);
testo(20,320,'mezzanotte');
testo(20,240,'il sole sorge:ore 6');
testo(20,250,'il sole culmina:ore 12');
testo(20,260,'il sole tramonta:ore 18');
testo(20,240,'il sole sorge:ore 4');
testo(20,260,'il sole tramonta:ore 20');
testo(20,240,'il sole sorge:ore 8');
testo(20,260,'il sole tramonta:ore 16');
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(170,disco1,'equinozio');
moto(160,disco1,'solstizio dicembre');
moto(180,disco1,'solstizio giugno');
pausa;
end.