astronomia con pascal

esci turboastro.htm

mese lunare , sideraole e sinodico

program mensile2;
(* MOTO della luna mensile attorno alla terra *)
(* su disco 65 dispensa 49 \TU55\mensile2.mar *)
(* mese sinodico e mese sidero *)

uses crt,graph;
type vet=array[1..800] of byte;
var disco1,disco2,d1,d2,d3,d4,d5:vet;
p,contagiri:INTEGER;
t1,t2:string;

procedure simula;
begin
writeln(' simulazione moto mensile della luna attorno alla terra');
writeln;
writeln(' indica valore per velocita....1..5...10 ...');
readln(p);
writeln(' indica numero di anni per rivoluzione..1..2..3..');
readln(contagiri);
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(disco2:vet); (* sole stella terra orbita fissa *)
var r,s,c,ang,x,y:integer;
rad:real;

begin
r:=150;
x:=300;
y:=200;
testo(300,450,'*');
testo(290,210,'sole');
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(disco1,d1:vet); (* moto terra e luna *)
var r,s,c,ang,x,y,c2,s2,giri,fase,ruota:integer;
rad:real;

begin
r:=50;
x:=300;
y:=200;
fase:=0;
for ruota:=1 to contagiri*12 do
begin
s2:=trunc(150*sin(fase*3.14/180));
c2:=trunc(150*cos(fase*3.14/180));
putimage(x+s2,y-18+c2,disco1,1); (* disco terra*)
for ang:=0 to 360 do
begin
setcolor(14);
s:=trunc(r*sin(ang*3.14/180));
c:=trunc(r*cos(ang*3.14/180));
putimage(x+s2+s,y-18+c2+c,d1,1);
setcolor(1);
putimage(x+s2+s,y-18+c2+c,d1,1);
end;
putimage(x+s2,y-18+c2,disco1,1);
fase:=fase+30;
end;
end;

begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
testo(10,40,'terra');
testo(500,40,'luna');
testo(500,50,'stella fissa *');
setfillstyle(1,14);
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco2);(* disco sole *)
setfillstyle(1,5);
fillellipse(20,20,10,10);
getimage(8,8,34,34,disco1);(* disco terra *)
setfillstyle(1,2);
fillellipse(500,20,10,10); (* disco luna 1*)
line(490,20,510,20);
getimage(488,8,514,34,d1);
costante(disco2);
terra(disco1,d1);
pausa;
end.