sistema copernicano

ritorna

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:\';                (* 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.

ritorna