rivoluzione pianeti, configurazioni planetarie

pianeta1,2,3,4

program pianeta1;
(* rivoluzione di tre pianeti attorno al sole *)
(* con velocita decrescente da interno a esterno secondo Keplero 3 *)

uses crt,graph;
type vet=array[1..800] of byte;
     var pia1,pia2,pia3:vet;
        b,c,d, anni,p1,p2,p3:integer;

procedure simula;
begin
 writeln('simulazione rivoluzione planetaria');
 writeln('tre pianeti a diversa distanza dal sole ');
 writeln('si muovono con velocita decrescenti con la distanza');
 writeln('secondo la terza legge di Keplero');
 writeln;
 writeln('indica numero rivoluzioni pianeta interno :1..2..3....');
 readln(anni);
 writeln('indicare divisori:p1 > p2 > p3..divisori di 360 ');
 writeln('indicare divisore per pianeta1....es.10..20..30..PROVA 10 ');
 READLN(P1);
 WRITELN('indicare divisore per pianeta2....es.5..10.......prova 6 ');
 readln(p2);
 writeln('indicare divisore per pianeta3....es.10.15.......prova 3');
 readln(p3);
 writeln('premi return,prego');
 readln;
 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 testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
 outtextxy(x,y,nome);
end;

procedure pausa;                (* premere return per proseguire *)
var ch:char;
begin
testo(10,400,'premi return,prego');
 ch:=readkey;
end;

procedure disco;        (* disegna dischi pianeti *)
begin
 setfillstyle(1,2);
 fillellipse(20,20,10,10);
 getimage(8,8,34,34,pia1);
 setfillstyle(2,4);
 fillellipse(200,20,10,10);
 getimage(188,8,234,34,pia2);
  setfillstyle(3,5);
 fillellipse(100,20,10,10);
 getimage(88,8,134,34,pia3);
 testo(10,60,'pianeti');
 testo(290,170,'sole');
 line(300,50,300,400);
end;

procedure moto;
var ch,ax,x,y,r1,r2,r3,s1,c1,s2,c2,s3,c3:integer;
    rad1,rad2,rad3:real;

 begin
 x:=300;
 y:=200;
 r1:=100;
 r2:=130;
 r3:=160;
 setfillstyle(1,14);
 fillellipse(300,200,20,20);
 while c<=anni*360 do
 begin
  rad1:=c*3.14/180;
  rad2:=b*3.14/180;
  rad3:=d*3.14/180;
  s1:=trunc(r1*sin(rad1));
  c1:=trunc(r1*cos(rad1));
  s2:=trunc(r2*sin(rad2));
  c2:=trunc(r2*cos(rad2));
  s3:=trunc(r3*sin(rad3));
  c3:=trunc(r3*cos(rad3));
  putpixel(x+s1,y+c1,2);
  putimage(x+s1-10,y+c1,pia1,1);
  putpixel(x+s2-10,y+c2,14);
  putimage(x+s2-10,y+c2,pia2,1);
  putpixel(x+s3,y+c3,14);
  putimage(x+s3-10,y+c3,pia3,1);
  delay(50);
  if (c/360=int(c/360)) then testo(10,350,'inizio-fine anno pianeta1');
  if (b/360=int(b/360)) then testo(10,360,'inizio-fine anno pianeta2');
  if (d/360=int(d/360)) then testo(10,370,'inizio-fine anno pianeta3');
  if (c/360=int(c/360)) or (b/360=int(b/360)) or (d/360=int(d/360))
   then delay(1000);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y+c2,pia2,1);
  putimage(x+s3-10,y+c3,pia3,1);

 setcolor(1);
 testo(10,350,'inizio-fine anno pianeta1');
 testo(10,360,'inizio-fine anno pianeta2');
 testo(10,370,'inizio-fine anno pianeta3');

 setcolor(14);
  c:=c+p1;
  b:=b+p2;
  d:=d+p3;
 end;
 end;

 begin                    (* programma principale *)
 clrscr;
 simula;
 grafica(1);              (* attiva pagina grafica *)
 disco;
 c:=0;
 d:=0;
 b:=0;
 moto;
 pausa;
 closegraph;
 end.

program pianeta2;
(* spostamento pianeta e sua proiezione rispetto a stelle fisse*)

uses crt,graph;
type vet=array[1..800] of byte;
     var pia1:vet;
        c, anni:integer;

procedure simula;
begin
 writeln('simulazione rivoluzione planetaria');
 writeln('posizione pianeta interno rispetto a sole e terra ');
 writeln('rivoluzione e visione prospettica del moto planetario');
 writeln('rispetto alle stelle fisse:ipotesi di terra e sole fermi');
 writeln;
 writeln('indica numero rivoluzioni pianeta interno :1..2..3....');
 readln(anni);
 writeln('premi return,prego');
 readln;
 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 testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
 outtextxy(x,y,nome);
end;

procedure pausa;                (* premere return per proseguire *)
var ch:char;
begin
testo(10,400,'premi return,prego');
 ch:=readkey;
end;

procedure disco;        (* disegna dischi pianeti *)
begin
 setfillstyle(1,2);
 fillellipse(20,20,10,10);
 getimage(8,8,34,34,pia1);
 testo(10,60,'pianeti');
 testo(290,170,'sole');
 line(300,50,300,400);
 setfillstyle(2,4);
 fillellipse(300,400,15,15); (* terra *)
 testo(320,430,'terra');
 testo(10,200,'EST');
 testo(500,200,'OVEST');
 testo(10,420,'moto diretto   :da OVEST verso EST ');
 testo(10,430,'moto retrogrado:da EST   verso OVEST ');
 testo(150,30,'* * * * * * stelle fisse * * * * * * *');
end;

procedure moto;
var h,x,y,r1,r2,s1,c1,s2,c2,a,b,d:integer;
    rad1:real;
    stringa:string;

 begin
 x:=300;
 y:=200;
 r1:=100;
 r2:=135;
 setfillstyle(1,14);
 fillellipse(300,200,20,20);
 for h:=1 to anni do
 begin
 for c:=0 to 360 do
 begin
  str(c,stringa);
  testo(10,250,stringa);
  rad1:=c*3.14/180;
  s1:=trunc(r1*sin(rad1));
  c1:=trunc(r1*cos(rad1));
  s2:=trunc(r2*sin(rad1));
  c2:=trunc(r2*cos(rad1));
  putpixel(x+s1,y+c1,2);
  putpixel(x+s2,y-100,2);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y-120,pia1,1);
  line(x,y+200,x+s1,y+c1); (* terra pianeta*)
  line(x,y,x+s1,y+c1);     (* sole  pianeta *)
  if (c=70) then testo(350,300,'elongazione ovest:visibile al mattino');
  if (c=290) then testo(10,300,'elongazione est:visibile alla sera');
  if (c=0) then testo(200,300,'congiunzione inferiore:invisibile');
  if (c=180) then testo(200,50,'congiunzione superiore:invisibile');
  if (c>290) and (c<=360) then testo(50,10,'moto retrogrado');
  if (c>=0) and (c<70) then testo(50,10,'moto retrogrado');
  if (c>=70) and (c<=290) then testo(50,20,'moto diretto');
  if (c=70) or (c=290) or (c=180) then delay(3000);
  if (c/360=int(c/360)) then delay(3000);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y-120,pia1,1);
  setcolor(1);
  line(x,y+200,x+s1,y+c1);
  line(x,y,x+s1,y+c1);
  testo(350,300,'elongazione ovest:visibile al mattino');
  testo(10,300,'elongazione est:visibile alla sera');
  testo(200,300,'congiunzione inferiore:invisibile');
  testo(200,50,'congiunzione superiore:invisibile');
  testo(50,10,'moto retrogrado');
  testo(50,10,'moto retrogrado');
  testo(50,20,'moto diretto');
  testo(10,250,stringa);
  setcolor(14);
  fillellipse(300,200,20,20);
  line(300,50,300,430);
  putpixel(x+s1,y+c1,2);
 end;
 end;
 end;

 begin                    (* programma principale *)
 clrscr;
 simula;
 grafica(1);              (* attiva pagina grafica *)
 disco;
 c:=0;
 moto;
 pausa;
 closegraph;
 end.

program pianeta3;
(* spostamento pianeta interno e terra attorno al sole*)
(* configurazioni planetarie *)

uses crt,graph;
type vet=array[1..800] of byte;
     var pia1,pia2:vet;
        c,d, anni,sosta,p1,p2:integer;

procedure simula;
begin
 writeln('simulazione rivoluzione planetaria');
 writeln('posizione pianeta rispetto a sole e terra:configurazioni ');
 writeln('terra e pianeta entrambi in rivoluzione attorno al sole');
 writeln;
 writeln('si evidenzia,senza commento scritto:');
 writeln('congiunzione inferiore......sole......pianeta....terra');
 writeln('congiunzione superiore......pianeta...sole.......terra ');
 writeln('elongazione occidentale.....elongazione orientale');
 writeln;
 writeln('indica numero rivoluzioni 1..2..3......');
 readln(anni);
 anni:=anni*36; (* se c modulo pianeta=10 *)
 writeln('indica valore per velocita....10=veloce....1000..5000 lento');
 readln(sosta);
 writeln('indicare moduli per pianeta e terra: pianeta > terra..');
 write('modulo pianeta 5  10  15  =');readln(p1);
 repeat
 write('modulo terra  10  15  20  =');readln(p2);
 until p2<p1;
 writeln('premi return,prego');
 readln;
 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 testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
 outtextxy(x,y,nome);
end;

procedure pausa;                (* premere return per proseguire *)
var ch:char;
begin
testo(10,400,'premi return,prego');
 ch:=readkey;
end;

procedure disco;        (* disegna dischi pianeti *)
begin
 setfillstyle(1,2);
 fillellipse(20,20,10,10);
 getimage(8,8,34,34,pia1);
 testo(10,60,'pianeta');
 testo(290,170,'sole');
 setfillstyle(2,4);
 fillellipse(300,20,10,10); (* terra *)
 getimage(288,8,334,34,pia2);
 testo(10,420,'moto diretto   :da OVEST verso EST ');
 testo(10,430,'moto retrogrado:da EST   verso OVEST ');
 testo(350,10,'...... stelle fisse ......');
 testo(150,10,'terra');
end;

procedure moto;
var r,ss,cs,ang,h,x,y,r1,r2,s1,c1,s2,c2,a,b:integer;
    rad,rad1,rad2:real;
    stringa:string;

 begin
 x:=300;
 y:=200;
 r1:=100;
 r2:=150;
 r:=190;
 setfillstyle(1,14);
 fillellipse(300,200,20,20);
 for b:=0 to 72 do         (* stelle fisse *)
 begin
  rad:=ang*3.14/180;
  ss:=trunc(r*sin(rad));
  cs:=trunc(r*cos(rad));
  putpixel(x+ss,y+cs,15);
  ang:=ang+5;
 end;
 c:=0;
 d:=0;
 for h:=1 to anni do
    (* c:= c+10 modulo pianeta1 *)
    (* d:=d+5   modulo pianeta2 o terra *)
 begin
  str(c,stringa);
  testo(10,250,stringa);
  rad1:=c*3.14/180;
  rad2:=d*3.14/180;
  s1:=trunc(r1*sin(rad1));
  c1:=trunc(r1*cos(rad1));
  s2:=trunc(r2*sin(rad2));
  c2:=trunc(r2*cos(rad2));
  putpixel(x+s1,y+c1,2);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y+c2,pia2,1);
  line(x+s1,y+c1,x+s2,y+c2); (* terra pianeta*)
  line(x,y,x+s1,y+c1);     (* sole  pianeta *)
  line(x,y,x+s2,y+c2);
  if (h=anni) then delay(5000);
  delay(sosta);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y+c2,pia2,1);
  setcolor(1);
  line(x+s1,y+c1,x+s2,y+c2);
  line(x,y,x+s1,y+c1);
  line(x,y,x+s2,y+c2);
  testo(10,250,stringa);
  setcolor(14);
  fillellipse(300,200,20,20);
  putpixel(x+s1,y+c1,14);    (* orbita pianeta1 *)
  putpixel(x+s2-10,y+c2,14); (* orbita terra *)
  testo(290,170,'sole');
  c:=c+p1;
  d:=d+p2;
 end;
 end;

 begin                    (* programma principale *)
 clrscr;
 simula;
 grafica(1);              (* attiva pagina grafica *)
 disco;
 c:=0;
 d:=0;
 moto;
 pausa;
 closegraph;
 end.

program pianeta4;
(* spostamento pianeta esterno e terra attorno al sole*)
(* configurazioni planetarie *)

uses crt,graph;
type vet=array[1..800] of byte;
     var pia1,pia2:vet;
        c,d, anni,sosta,p1,p2:integer;

procedure simula;
begin
 writeln('simulazione rivoluzione planetaria:pianeta esterno');
 writeln('posizione pianeta rispetto a sole e terra:configurazioni ');
 writeln('terra e pianeta entrambi in rivoluzione attorno al sole');
 writeln;
 writeln('si evidenzia,senza commento scritto:');
 writeln('congiunzione inferiore......sole......terra....pianeta');
 writeln('congiunzione superiore......pianeta...sole.......terra ');
 writeln('elongazione occidentale.....elongazione orientale');
 writeln('quadratura  occidentale.....quadratura  orientale');
 writeln;
 writeln('indica numero rivoluzioni 1..2..3......');
 readln(anni);
 anni:=anni*36; (* se c modulo terra=10 *)
 writeln('indica valore per velocita....10=veloce....1000..5000 lento');
 readln(sosta);
 writeln('indicare moduli per pianeta e terra: terra > pianeta..');
 write('modulo terra 5  10  15  =');readln(p1);
 repeat
 write('modulo pianeta  10  15  20  =');readln(p2);
 until p2<p1;
 writeln('premi return,prego');
 readln;
 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 testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
 outtextxy(x,y,nome);
end;

procedure pausa;                (* premere return per proseguire *)
var ch:char;
begin
testo(10,400,'premi return,prego');
 ch:=readkey;
end;

procedure disco;        (* disegna dischi pianeti *)
begin
 setfillstyle(1,4);
 fillellipse(20,20,10,10);
 getimage(8,8,34,34,pia2);
 testo(10,60,'pianeta');
 testo(290,170,'sole');
 setfillstyle(2,2);
 fillellipse(300,20,10,10); (* terra *)
 getimage(288,8,334,34,pia1);
 testo(10,420,'moto diretto   :da OVEST verso EST ');
 testo(10,430,'moto retrogrado:da EST   verso OVEST ');
 testo(350,10,'...... stelle fisse ......');
 testo(150,10,'terra');
end;

procedure moto;
var r,ss,cs,ang,h,x,y,r1,r2,s1,c1,s2,c2,a,b:integer;
    rad,rad1,rad2:real;
    stringa:string;

 begin
 x:=300;
 y:=200;
 r1:=100;
 r2:=150;
 r:=190;
 setfillstyle(1,14);
 fillellipse(300,200,20,20);
 for b:=0 to 72 do         (* stelle fisse *)
 begin
  rad:=ang*3.14/180;
  ss:=trunc(r*sin(rad));
  cs:=trunc(r*cos(rad));
  putpixel(x+ss,y+cs,15);
  ang:=ang+5;
 end;
 c:=0;
 d:=0;
 for h:=1 to anni do
    (* c:= c+10 modulo pianeta1 *)
    (* d:=d+5   modulo pianeta2 o terra *)
 begin
  str(c,stringa);
  testo(10,250,stringa);
  rad1:=c*3.14/180;
  rad2:=d*3.14/180;
  s1:=trunc(r1*sin(rad1));
  c1:=trunc(r1*cos(rad1));
  s2:=trunc(r2*sin(rad2));
  c2:=trunc(r2*cos(rad2));
  putpixel(x+s1,y+c1,2);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y+c2,pia2,1);
  line(x+s1,y+c1,x+s2,y+c2); (* terra pianeta*)
  line(x,y,x+s1,y+c1);     (* sole  pianeta *)
  line(x,y,x+s2,y+c2);
  if (h=anni) then delay(5000);
  delay(sosta);
  putimage(x+s1-10,y+c1,pia1,1);
  putimage(x+s2-10,y+c2,pia2,1);
  setcolor(1);
  line(x+s1,y+c1,x+s2,y+c2);
  line(x,y,x+s1,y+c1);
  line(x,y,x+s2,y+c2);
  testo(10,250,stringa);
  setcolor(14);
  fillellipse(300,200,20,20);
  putpixel(x+s1,y+c1,14);    (* orbita pianeta1 *)
  putpixel(x+s2-10,y+c2,14); (* orbita terra *)
  testo(290,170,'sole');
  c:=c+p1;
  d:=d+p2;
 end;
 end;

 begin                    (* programma principale *)
 clrscr;
 simula;
 grafica(1);              (* attiva pagina grafica *)
 disco;
 c:=0;
 d:=0;
 moto;
 pausa;
 closegraph;
 end.