moto della luna
lunare2,3,4,5,6,7,8,9
program lunare2;
(* su disco 65,dispensa 49 \tu56\lunare2.mar *)
(* variante di lunare1...zona sotto orizzonte *)
(* provare a cambiare sc,tp=0,1,2,3 per scambio colore e scala *)
(* fasi lunari con sole e luna mobili *)
(* indicazione rotazione in gradi *)
uses crt,graph;
type vet=array[1..800] of byte;
var sole,lunan,lunap,pquarto,uquarto:vet;
tempo,orbita:integer;
ore:string;
procedure simula;
begin
writeln('simulazione alternanza fasi lunari');
writeln('moto apparente del sole e della luna :est---> ovest');
writeln('----------------------------------------------');
writeln('si visualizzano i disegni :');
writeln('terra con orizzonte ,EST,OVEST,al centro ');
writeln('luna nuova,primo quarto,luna piena,ultimo quarto,sole');
writeln('------------------------------------------------');
writeln('si indica per ogni fase:');
writeln('ora del sorgere,culminazione,tramonto');
writeln;
writeln('scrivi valore per velocita rotazione ');
writeln('1=molto veloce....500=molto lento....prova 1');
readln(tempo);
writeln('scrivi numero rotazioni per orizzonte terrestre');
writeln('1..2..3.:prova 1...');
readln(orbita);
orbita:=orbita*360; (* rotazioni in gradi *)
end;
procedure grafica(f:integer); (* attiva pagina grafica*)
(* coordinate finestra,colore sfondo e disegno *)
var sc,tp:integer;
stringa:string;
begin
sc:=2; (* 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
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure moto(rx,ry,dg:integer;lunad,soled:vet;ora:string);(* orbite *)
var a,s,c,s1,c1:integer;
rad,rad1:real;
stringa:string;
begin
for a:=0 to orbita do
begin
str(a,stringa); (* stampa valore in gradi *)
setwritemode(1);
setcolor(2);
outtextxy(20,170,stringa);
setcolor(1);
if a=90 then testo(2,10,'fase.......sorge..culmina..tramonta');
if a=90 then setcolor(3);
if a=90 then testo(2,20,ora);
if a=180 then setcolor(2);
if a=180 then testo(2,20,ora);
if a=270 then setcolor(3);
if a=270 then testo(2,20,ora);
if a=360 then setcolor(2);
if a=360 then testo(2,20,ora);
rad:=a*3.14/180;
rad1:=(a+dg)*3.14/180;
s:=trunc(-rx*sin(rad));
c:=trunc(ry*cos(rad));
s1:=trunc(-rx*sin(rad1));
c1:=trunc(ry*cos(rad1));
setcolor(2);
setwritemode(1);
setlinestyle(0,0,3);
putimage(150+s,100+c,lunad,1);
putimage(150+s1,100+c1,soled,1);
delay(tempo); (* pausa rotazione *)
setcolor(0); (* cancella valore in gradi *)
outtextxy(20,170,stringa);
putimage(150+s,100+c,lunad,1); (* cancella disco *)
putimage(150+s1,100+c1,soled,1);
end;
outtextxy(2,20,ora);
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
setfillstyle(2,14);
fillellipse(300,20,12,10);
getimage(288,8,314,34,sole);
setfillstyle(1,1);
fillellipse(20,20,12,10);
getimage(8,8,34,34,lunap);
getimage(20,8,34,34,pquarto);
getimage(8,8,20,34,uquarto);
setfillstyle(1,0);
fillellipse(20,160,12,10);
getimage(8,148,34,194,lunan);
setfillstyle(1,2);
setcolor(2);
fillellipse(150,112,16,14); (* terra *)
setcolor(3);
setfillstyle(1,0); (* cancella modello *)
setcolor(0);
sector(20,20,0,360,15,15);
sector(20,160,0,360,15,15);
sector(300,20,0,360,15,15);
setcolor(2);
setfillstyle(1,1); (* zona sotto orizzonte *)
bar(1,110,319,199);
testo(10,90,'est');
testo(270,90,'ovest');
testo(120,130,'meridiano');
line(1,110,319,110); (* orizzonte terra fisso *)
line(150,100,150,70); (* meridiano *)
ore:='novilunio.....6........12.......18';
moto(100,100,0,lunan,sole,ore); (* raggi,fase,dischi *)
(* pausa;attivabile *) (* novilunio *)
ore:='p quarto.....12........18.......24';
moto(100,100,90,pquarto,sole,ore); (* primo quarto *)
(* pausa; *)
ore:='plenilunio...18........24........6';
moto(100,100,180,sole,lunap,ore); (* plenilunio *)
(* pausa; *)
ore:='u quarto.....24.........6.......12';
moto(100,100,270,uquarto,sole,ore); (* ultimo quarto*)
pausa;
end.
program lunare3;
(* su disco 65 dispensa 49 \tu56\lunare3.mar *)
(* fasi lunari immobili con terra rotante *)
(* indicazione rotazione in gradi *)
(* indicazione ora solare *)
uses crt,graph;
type vet=array[1..800] of byte;
var lunan,lunap,pquarto,uquarto:vet;
sosta,tempo,orbita:integer;
ore:string;
procedure simula;
begin
writeln('simulazione alternanza fasi lunari');
writeln('rotazione orizzonte della terra e osservatore ');
writeln('----------------------------------------------');
writeln('si visualizzano i disegni :');
writeln('raggi solari sulla destra');
writeln('terra con orizzonte rotante,al centro ');
writeln('luna nuova,primo quarto,luna piena,ultimo quarto');
writeln('------------------------------------------------');
writeln('si indica per ogni fase:');
writeln('ora del sorgere,culminazione,tramonto');
writeln;
writeln('scrivi valore per velocita rotazione ');
writeln('1=molto veloce....500=molto lento....prova 200');
readln(tempo);
writeln('scrivi numero rotazioni per orizzonte terrestre');
writeln('1..2..3..............................prova 1 ');
readln(orbita);
writeln('scrivi numero per sosta punti speciali ');
writeln('1000...2000....5000..................prova 2000');
readln(sosta);
orbita:=90+orbita*360; (* rotazioni in gradi *)
end;
procedure grafica(f:integer); (* attiva pagina grafica*)
(* coordinate finestra,colore sfondo e disegno *)
var sc,tp:integer;
stringa:string;
begin
sc:=2; (* 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 *)
rectangle(1,1,319,199);
setbkcolor(f); (* colore sfondo *)
end;
procedure pausa; (* premere return per proseguire *)
var ch:char;
begin
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure sole; (* raggi solari paralleli *)
var a,b:integer;
begin
b:=1;
setcolor(3);
for a:=1 to 40 do
begin
line(300,b,319,b);
b:=b+5;
end;
settextstyle(1,1,1);
setcolor(2);
outtextxy(300,40,'raggi solari');
end;
procedure moto(x,y:integer;m:word;disco:vet;ora:string);
var a,s,c,s1,c1,p2:integer; (* rotazione orizzonte terrestre *)
rad,rad1:real;
stringa,t1:string;
begin
putimage(x,y,disco,m);
for a:=90 to orbita do
begin
str(a-90,stringa); (* stampa valore in gradi *)
setwritemode(1);
setcolor(2);
outtextxy(20,170,stringa);
if (a=90) then t1:='6'; (* orario solare *)
if (a=180) then t1:='12';
if (a=270) then t1:='18';
if (a=360) then t1:='24';
if (a=450) then t1:='6';
outtextxy(260,170,t1);
outtextxy(240,160,'ora solare');
if (a=90) or (a=180) or (a=270) or (a=360) or (a=450) then p2:=sosta;
setcolor(1);
if a=90 then testo(2,10,'fase.......sorge..culmina...tramonta');
if a=90 then setcolor(3);
if a=90 then testo(2,20,ora);
if a=180 then setcolor(2);
if a=180 then testo(2,20,ora);
if a=270 then setcolor(3);
if a=270 then testo(2,20,ora);
if a=360 then setcolor(2);
if a=360 then testo(2,20,ora);
rad:=a*3.14/180;
rad1:=(a+90)*3.14/180;
s:=trunc(30*sin(rad));
c:=trunc(30*cos(rad));
s1:=trunc(25*sin(rad1));
c1:=trunc(25*cos(rad1));
setcolor(2);
setwritemode(1);
setlinestyle(0,0,3);
line(150-s,112-c,150+s,112+c); (* orizzonte *)
line(150,112,150-s1,112-c1); (* osservatore *)
delay(tempo); (* pausa rotazione terra *)
delay(p2); (* pausa punti speciali *)
line(150-s,112-c,150+s,112+c);
line(150,112,150-s1,112-c1);
setcolor(0); (* cancella valore in gradi *)
outtextxy(20,170,stringa);
outtextxy(260,170,t1);
p2:=0;
end;
outtextxy(2,20,ora); (* cancella scritta *)
putimage(x,y,disco,1); (* cancella disco*)
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
setfillstyle(1,1);
fillellipse(20,20,12,10);
getimage(8,8,34,34,lunap);
getimage(20,8,34,34,pquarto);
setfillstyle(1,0);
fillellipse(20,160,12,10);
getimage(8,148,34,194,lunan);
setfillstyle(1,2);
setcolor(2);
fillellipse(150,112,16,14); (* terra *)
testo(2,180,'la terra ruota da ovest verso est');
setcolor(3);
sole;
setfillstyle(1,0); (* cancella modello *)
setcolor(0);
sector(20,20,0,360,15,15);
sector(20,160,0,360,15,15);
pausa;
setcolor(2);
settextstyle(0,0,1);
setcolor(3);
ore:='novilunio......6......12......18';
moto(250,100,1,lunan,ore);
ore:='p quarto......12......18......24';
moto(150,50,0,pquarto,ore);
ore:='plenilunio....18......24.......6';
moto(50,100,0,lunap,ore);
ore:='u quarto......24.......6......12';
moto(150,150,0,pquarto,ore);
pausa;
end.
program lunare4;
(* su disco 65 dispensa 49 \tu56\lunare4.mar *)
(* moto diurno del sole e della luna*)
(* novilunio,quadratura,plenilunio *)
uses crt,graph;
type vet=array[1..800] of byte;
var sole,lunan,lunap,pquarto,uquarto:vet;
luogo1,luogo2,culmina:string;
t,orbite:integer;
procedure simula; (* introduzione a programma *)
begin
writeln('simulazione moto diurno del sole e della luna');
writeln('novilunio,quadratura,plenilunio ');
writeln('---------------------------------------------');
writeln('premere tasto PAUSE per fermare rotazione ');
writeln('premere tasto RETURN per riprendere rotazione');
writeln('---------------------------------------------');
writeln('indica velocita moto solare ');
writeln('numero 1 =moto rapido ');
writeln('numero 100 =moto lento ');
writeln('prova prima con 1 e poi altri valori...10..20..');
readln(t);
writeln('indicare numero rotazioni :1,2,3.....prova 1 ');
readln(orbite);
orbite:=orbite*360;
clrscr;
end;
procedure fine; (* fine e ritorno a pascal *)
begin
closegraph;
exit;
end;
procedure grafica(x1,y1,x2,y2,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 *)
rectangle(x1,y1,x2,y2); (* cornice area grafica *)
setbkcolor(f); (* colore sfondo *)
end;
procedure pausa; (* premere return per proseguire *)
var ch:char;
begin
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure moto(r1,r2,g3,p1,q1,q2,cu:integer;disco1,disco2:vet;luogo1,luogo2:string);
(* raggi r1,r2,q1,q2,gradi g3,figura...animazione figura*)
var m,s1,c1,s2,c2:integer;
rad,rad1,s,c:real;
begin
for m:=0 to orbite do
begin
rad:=m*3.14/180;
rad1:=(m+g3)*3.14/180;
s:=r1*sin(rad); (* disco1 *)
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
s2:=trunc(q1*sin(rad1));(* disco2 *)
c2:=trunc(q2*cos(rad1));
setwritemode(0);
putimage(300+s1,200+c1,disco1,1); (* rotazione disco1 pieno singolo *)
putimage(300+s2,200+c2,disco2,1); (* rotazione disco2 *)
putimage(300+s1,200+c1,disco1,0);
putimage(300+s2,200+c2,disco2,0);
delay(t);
if m=90 then outtextxy(20,p1,luogo1);
if m=270 then outtextxy(480,p1,luogo2);
if m=180 then outtextxy(270,cu,culmina);
end;
delay(500);
putimage(300+s1,200+c1,disco1,1); (* cancella disco1 tramonto *)
putimage(300+s2,200+c2,disco2,1); (* cancella disco 2 *)
end;
procedure costante; (* disegno e testo fisso *)
begin
setfillstyle(1,4); (* tratto e colore terra *)
bar(290,250,310,200); (* terra *)
setfillstyle(1,2); (* orizzonte terra *)
fillellipse(300,250,40,40);
line(1,210,650,210);
testo(40,80,'sole');
testo(550,80,'luna');
setcolor(15);
testo(250,240,'orizzonte terra');
setcolor(4);
testo(270,220,'MERIDIANO');
setcolor(2);
testo(210,220,'EST');
testo(390,220,'OVEST');
setcolor(15);
testo(20,470,'premere return per proseguire');
setfillstyle(1,14);
fillellipse(20,20,10,10); (* sole *)
getimage(5,5,35,35,sole); (* vettore sole *)
setfillstyle(1,15); (* luna piena*)
fillellipse(500,20,10,10);
getimage(485,5,515,35,lunap);
setfillstyle(1,1); (* luna nuova *)
fillellipse(450,20,10,10);
getimage(435,5,465,35,lunan);
setlinestyle(4,0,1); (* per falce luna *)
setfillstyle(1,2); (* primo quarto *)
sector(600,20,0,360,10,10);
setfillstyle(1,1);
sector(600,20,270,90,10,10);
getimage(585,5,615,35,pquarto);
setfillstyle(1,1); (* ultimo quarto *)
sector(560,20,0,360,10,10);
setfillstyle(1,2);
sector(560,20,270,90,10,10);
getimage(545,5,585,35,uquarto);
end;
procedure programma; (* contiene parte principale *)
procedure scelta; (* opzione fine o riprova *)
var ch:char;
begin
(* textmode(1);*)
restorecrtmode;
writeln('per rivedere,premi S,per finire premi N');
readln(ch);
ch:=upcase(ch);
if ch='S' then programma
else fine
end;
begin
clrscr;
simula; (* introduzione a programma *)
grafica(1,1,639,470,1); (* attiva pagina grafica *)
costante; (* disegno sfondo fisso *)
setcolor(5);
testo(290,450,'LA LUNA');
setcolor(15);
testo(270,290,'novilunio');
luogo1:='sorge alle 6';
luogo2:='tramonta alle 18';
culmina:='culmina alle 12';
moto(-280,190,0,400,-250,160,150,sole,lunan,luogo1,luogo2); (* animazione *)
pausa;
setcolor(4);
testo(270,300,'primo quarto');
luogo1:='sorge alle 12';
luogo2:='tramonta alle 24 ';
culmina:='culmina alle 18';
moto(-280,190,90,410,250,-160,160,sole,pquarto,luogo1,luogo2);
pausa;
setcolor(5);
testo(270,310,'plenilunio');
luogo1:='sorge alle 18';
luogo2:='tramonta alle 6';
culmina:='culmina alle 24';
moto(-250,190,180,420,-250,160,170,lunap,sole,luogo1,luogo2);
pausa;
setcolor(2);
testo(270,320,'ultimo quarto');
luogo1:='sorge alle 24';
luogo2:='tramonta alle 12';
culmina:='culmina alle 6';
moto(-250,190,90,430,250,-160,180,uquarto,sole,luogo1,luogo2);
pausa;
scelta; (* opzione fine o rivedere *)
end;
begin
programma; (* programma principale *)
end.
program lunare5;
(* su disco 65 dispensa 49 \tu56\lunare5.mar *)
(* moto diurno del sole e della luna*)
(* novilunio,quadratura,plenilunio *)
(* variante di lunare4 con stile diverso testo *)
uses crt,graph;
type vet=array[1..800] of byte;
var sole,lunan,lunap,pquarto,uquarto:vet;
luogo1,luogo2,culmina:string;
t,orbite,k:integer;
procedure simula; (* introduzione a programma *)
begin
writeln('simulazione moto diurno del sole e della luna');
writeln('novilunio,quadratura,plenilunio ');
writeln('---------------------------------------------');
writeln('premere tasto PAUSE per fermare rotazione ');
writeln('premere tasto RETURN per riprendere rotazione');
writeln('---------------------------------------------');
writeln('indica velocita moto solare ');
writeln('numero 1 =moto rapido ');
writeln('numero 100 =moto lento ');
writeln('prova prima con 1 e poi altri valori...10..20..');
readln(t);
writeln('indicare numero rotazioni in gradi:360,720,1080..');
readln(orbite);
clrscr;
end;
procedure fine; (* fine e ritorno a pascal *)
begin
exit;
end;
procedure grafica(x1,y1,x2,y2,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 *)
rectangle(x1,y1,x2,y2); (* cornice area grafica *)
setbkcolor(f); (* colore sfondo *)
end;
procedure pausa; (* premere return per proseguire *)
var ch:char;
begin
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure moto(r1,r2,g3,p1,q1,q2,cu:integer;disco1,disco2:vet;luogo1,luogo2:string);
(* raggi r1,r2,q1,q2,gradi g3,figura...animazione figura*)
var m,s1,c1,s2,c2:integer;
rad,rad1,s,c:real;
stringa:string;
begin
for m:=0 to orbite do
begin
rad:=m*3.14/180;
rad1:=(m+g3)*3.14/180;
s:=r1*sin(rad); (* disco1 *)
c:=r2*cos(rad);
s1:=trunc(s);
c1:=trunc(c);
s2:=trunc(q1*sin(rad1));(* disco2 *)
c2:=trunc(q2*cos(rad1));
settextstyle(1,0,2);
setwritemode(0);
putimage(300+s1,200+c1,disco1,1); (* rotazione disco1 pieno singolo *)
putimage(300+s2,200+c2,disco2,1); (* rotazione disco2 *)
putimage(300+s1,200+c1,disco1,0);
putimage(300+s2,200+c2,disco2,0);
delay(t);
if m=90 then outtextxy(20,p1,luogo1);
if m=270 then outtextxy(470,p1,luogo2);
if m=180 then outtextxy(270,cu,culmina);
end;
delay(500);
putimage(300+s1,200+c1,disco1,1); (* cancella disco1 tramonto *)
putimage(300+s2,200+c2,disco2,1); (* cancella disco 2 *)
end;
procedure costante; (* disegno e testo fisso *)
begin
setfillstyle(1,4); (* tratto e colore terra *)
bar(290,250,310,200); (* terra *)
setfillstyle(1,2); (* orizzonte terra *)
fillellipse(300,250,40,40);
line(1,210,650,210);
testo(40,80,'sole');
testo(550,80,'luna');
setcolor(15);
testo(250,240,'orizzonte terra');
setcolor(4);
testo(270,220,'MERIDIANO');
setcolor(2);
testo(210,220,'EST');
testo(390,220,'OVEST');
setcolor(15);
testo(20,470,'premere return per proseguire');
setfillstyle(1,14);
fillellipse(20,20,10,10); (* sole *)
getimage(5,5,35,35,sole); (* vettore sole *)
setfillstyle(1,15); (* luna piena*)
fillellipse(500,20,10,10);
getimage(485,5,515,35,lunap);
setfillstyle(1,1); (* luna nuova *)
fillellipse(450,20,10,10);
getimage(435,5,465,35,lunan);
setlinestyle(4,0,1); (* per falce luna *)
setfillstyle(1,2); (* primo quarto *)
sector(600,20,0,360,10,10);
setfillstyle(1,1);
sector(600,20,270,90,10,10);
getimage(585,5,615,35,pquarto);
setfillstyle(1,1); (* ultimo quarto *)
sector(560,20,0,360,10,10);
setfillstyle(1,2);
sector(560,20,270,90,10,10);
getimage(545,5,585,35,uquarto);
end;
procedure programma; (* contiene parte principale *)
procedure scelta; (* opzione fine o riprova *)
var ch:char;
begin
restorecrtmode;
writeln('per rivedere,premi S,per finire premi N');
readln(ch);
ch:=upcase(ch);
if ch='S' then programma
else fine
end;
begin
clrscr;
simula; (* introduzione a programma *)
grafica(1,1,639,470,1); (* attiva pagina grafica *)
costante; (* disegno sfondo fisso *)
setcolor(5);
testo(290,450,'LA LUNA');
setcolor(15);
testo(270,270,'novilunio');
luogo1:='sorge alle 6';
luogo2:='tramonta alle 18';
culmina:='culmina alle 12';
moto(-280,190,0,405,-250,160,130,sole,lunan,luogo1,luogo2); (* animazione *)
pausa;
setcolor(4);
testo(270,285,'primo quarto');
luogo1:='sorge alle 12';
luogo2:='tramonta alle 24 ';
culmina:='culmina alle 18';
moto(-280,190,90,420,-250,160,145,pquarto,sole,luogo1,luogo2);
pausa;
setcolor(5);
testo(270,305,'plenilunio');
luogo1:='sorge alle 18';
luogo2:='tramonta alle 6';
culmina:='culmina alle 24';
moto(-250,190,180,435,-250,160,160,lunap,sole,luogo1,luogo2);
pausa;
setcolor(2);
testo(270,320,'ultimo quarto');
luogo1:='sorge alle 24';
luogo2:='tramonta alle 12';
culmina:='culmina alle 6';
moto(-250,190,90,450,250,-160,175,uquarto,sole,luogo1,luogo2);
pausa;
scelta; (* opzione fine o rivedere *)
end;
begin
programma; (* programma principale *)
end.
program lunare6;
(* su disco 65 dispensa 49 \tu56\lunare6.mar *)
(* fasi lunari immobili con terra rotante *)
(* indicazione rotazione in gradi *)
uses crt,graph;
type vet=array[1..800] of byte;
var lunan,lunap,pquarto,uquarto:vet;
tempo,orbita:integer;
procedure simula;
begin
writeln('simulazione alternanza fasi lunari');
writeln('rotazione orizzonte della terra e osservatore ');
writeln('----------------------------------------------');
writeln('si visualizzano i disegni :');
writeln('raggi solari sulla destra');
writeln('terra con orizzonte rotante,al centro ');
writeln('luna nuova,primo quarto,luna piena,ultimo quarto');
writeln('------------------------------------------------');
writeln('si indica per ogni fase:');
writeln('ora del sorgere,culminazione,tramonto');
writeln;
writeln('scrivi valore per velocita rotazione ');
writeln('1=molto veloce....500=molto lento....prova 200');
readln(tempo);
writeln('scrivi numero rotazioni per orizzonte terrestre');
writeln('1..2..3.');
readln(orbita);
orbita:=90+orbita*360; (* rotazioni in gradi *)
end;
procedure grafica(f:integer); (* attiva pagina grafica*)
(* coordinate finestra,colore sfondo e disegno *)
var sc,tp:integer;
stringa:string;
begin
sc:=1; (* valore risoluzione 0,1,2,3,4,5,8,9 *)
tp:=0; (* valore valido 1 - 0 palette *)
stringa:='c:\scheda'; (*ica ove cercare GRAPH *)
initgraph(sc,tp,stringa); (* attiva scheda grafica *)
rectangle(1,1,319,199);
setbkcolor(f); (* colore sfondo *)
end;
procedure pausa; (* premere return per proseguire *)
var ch:char;
begin
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
procedure sole; (* raggi solari paralleli *)
var a,b:integer;
begin
b:=1;
setcolor(3);
for a:=1 to 40 do
begin
line(300,b,319,b);
b:=b+5;
end;
settextstyle(1,1,1);
setcolor(2);
outtextxy(300,40,'raggi solari');
end;
procedure moto; (* rotazione orizzonte terrestre *)
var a,s,c,s1,c1:integer;
rad,rad1:real;
stringa:string;
begin
for a:=90 to orbita do
begin
str(a-90,stringa); (* stampa valore in gradi *)
setwritemode(1);
setcolor(2);
outtextxy(20,170,stringa);
setcolor(1);
if a=90 then testo(2,10,'fase.......sorge..culmina..tramonta');
if a=90 then setcolor(3);
if a=90 then testo(2,20,'novilunio: 6 12 18');
if a=180 then setcolor(2);
if a=180 then testo(2,30,'1 quarto: 12 18 24');
if a=270 then setcolor(3);
if a=270 then testo(2,40,'plenilunio: 18 24 6');
if a=360 then setcolor(2);
if a=360 then testo(2,50,'2 quarto: 24 6 12');
rad:=a*3.14/180;
rad1:=(a+90)*3.14/180;
s:=trunc(30*sin(rad));
c:=trunc(30*cos(rad));
s1:=trunc(25*sin(rad1));
c1:=trunc(25*cos(rad1));
setcolor(2);
setwritemode(1);
setlinestyle(0,0,3);
line(150-s,112-c,150+s,112+c); (* orizzonte *)
line(150,112,150-s1,112-c1); (* osservatore *)
delay(tempo); (* pausa rotazione terra *)
line(150-s,112-c,150+s,112+c);
line(150,112,150-s1,112-c1);
setcolor(0); (* cancella valore in gradi *)
outtextxy(20,170,stringa);
end;
end;
begin (* programma principale *)
clrscr;
simula;
grafica(1); (* attiva pagina grafica *)
setfillstyle(1,1);
fillellipse(20,20,12,10);
getimage(8,8,34,34,lunap);
putimage(50,100,lunap,0); (* lunapiena *)
getimage(20,8,34,34,pquarto);
putimage(150,50,pquarto,0); (* primoquarto *)
putimage(150,150,pquarto,0); (* ultimoquarto *)
setfillstyle(1,0);
fillellipse(20,160,12,10);
getimage(8,148,34,194,lunan);
putimage(250,100,lunan,1); (* lunanuova *)
setfillstyle(1,2);
setcolor(2);
fillellipse(150,112,16,14); (* terra *)
setcolor(3);
sole;
setfillstyle(1,0); (* cancella modello *)
setcolor(0);
sector(20,20,0,360,15,15);
sector(20,160,0,360,15,15);
pausa;
setcolor(2);
settextstyle(0,0,1);
testo(130,70,'primo quarto');
testo(130,180,'ultimo quarto');
setcolor(3);
testo(10,130,'plenilunio');
testo(230,130,'novilunio');
pausa;
moto;
pausa;
end.
program lunare7;
(* su disco 65 dispensa 49 \tu56\lunare7.mar *)
(* fasi lunari fisse e posizione terra luna sole *)
uses crt,graph;
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
ch:=readkey;
end;
procedure testo(x,y:integer;nome:string); (* stampa legenda testo *)
begin
outtextxy(x,y,nome);
end;
begin (* programma principale *)
clrscr;
grafica(1); (* attiva pagina grafica *)
setfillstyle(2,14); (* disegna sole *)
fillellipse(600,200,30,30);
setfillstyle(1,2); (* disegna terra verde *)
fillellipse(300,200,30,30);
fillellipse(400,200,20,20); (* luna nuova *)
fillellipse(300,300,20,20); (* ultimoquarto *)
fillellipse(300,100,20,20); (* lunapiena *)
fillellipse(200,200,20,20); (* primo quarto *)
setfillstyle(1,1);
sector(400,200,90,270,20,20); (* luna nuova *)
sector(300,300,90,270,20,20);
sector(300,100,90,270,20,20);
sector(200,200,90,270,20,20);
pausa;
setfillstyle(1,2);
fillellipse(450,200,20,20); (* luna nuova *)
fillellipse(300,350,20,20); (* ultimoquarto *)
fillellipse(150,200,20,20); (* lunapiena *)
fillellipse(300,50,20,20); (* primo quarto *)
sector(150,200,0,360,20,20);
setcolor(1);
setfillstyle(1,1);
sector(450,200,0,360,20,20); (* luna nuova *)
sector(300,350,90,270,20,20);
sector(300,50,90,270,20,20);
setcolor(2);
sector(450,200,0,360,20,20);
testo(10,50,'primo quarto:12...18...24');
testo(400,150,'novilunio:6....12...18');
testo(10,250,'plenilunio:18....24...6');
testo(400,300,'ultimo quarto:24...6...12');
testo(550,250,'sole');
testo(10,370,'viene indicata la fase,ora sorgere,culminazione,tramontare');
pausa; end.
program lunare8;
(* MOTO DELLA LUNA E DEL SOLE DIURNO E MENSILE *)
(* su disco 65 dispensa 49 \TU56\lunare8.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
var disco1,disco2:vet;
TEMPO,mese:INTEGER;
procedure simula;
begin
writeln('simulazione moto diurno e mensile della luna e del sole ');
writeln('relativamente ad un osservatore sulla terra immobile ');
writeln('------------------------------------------------------- ');
writeln('ipotesi e convenzioni per semplificare calcoli :');
writeln('durata del mese lunare=24 giorni');
writeln('spostamento angolare diurno della luna=15 gradi');
writeln('ore del sorgere,culminare,tramontare,multipli di 60 minuti');
writeln('--------------------------------------------------------');
writeln('si visualizza:');
writeln('disco terrestre,orizzonte,meridiano,est,ovest');
writeln('movimento disco del sole e della luna');
writeln('ora del sorgere,culminare,tramontare della luna');
writeln('successione dei giorni lunari da 0 a 24 o meno ');
writeln('novilunio,primo quarto,plenilunio,ultimo quarto');
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:24 per mese completo:vari minuti...');
writeln('numero minore di 24 per vedere solo alcune fasi...........');
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:=1; (* 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(300,400,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(300,400,'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 orizzonte EST OVEST *)
begin
setcolor(3);
line(10,200,600,200);
line(300,200,300,10);
testo(250,170,'meridiano osservatore');
testo(250,220,'orizzonte terrestre');
testo(10,180,'EST');
testo(500,180,'OVEST');
testo(400,40,'lunazione=');
testo(60,10,'sole');
testo(500,10,'luna');
setfillstyle(1,3);
fillellipse(300,200,20,20);
end;
procedure moto;
var m,s1,c1,s2,c2,x,y,r1,r2,ora1,ora2,ora3,ora,giorni,g3,giorno:integer;
rad,rad1,s,c:real;
grado,h1,h2,h3:string;
begin
x:=300;
y:=200;
r1:=180;
r2:=180;
ora1:=5;
g3:=0;
for giorni:=0 to mese do
begin
giorno:=giorni;
str(giorno,grado);
setcolor(14);
outtextxy(540,40,grado);
ora1:=ora1+1;
if (ora1<24) then ora:=ora1
else ora:=ora1-24;
if (ora1<19) then ora2:=ora1+6
else ora2:=ora1-18;
if (ora1<13) then ora3:=ora1+12
else ora3:=ora1-12;
for m:=0 to 360 do
begin
rad:=m*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=-trunc(s);
c1:=trunc(c);
rad1:=(m+g3)*3.14/180;
s2:=-trunc(r1*sin(rad1));
c2:=trunc(r2*cos(rad1));
(* putpixel(x+s1,y+c1,4); *)
(* putpixel(x+s2,y+c2,2); *)
str(giorno,grado);
str(ora,h1);
str(ora2,h2);
str(ora3,h3);
setcolor(4);
putimage(x+s1,y+c1,disco2,1); (* luna *)
putimage(x+s2,y+c2,disco1,1); (* sole *)
setcolor(15);
if (m=95) then testo(10,220,'la luna sorge:ore='+h1);
if (m=175) then testo(230,230,'la luna culmina:ore='+h2);
if (m=265) then testo(400,220,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,400,'novilunio');
if ora1=12 then testo(200,400,'primo quarto');
if ora1=18 then testo(200,400,'plenilunio');
if ora1=24 then testo(200,400,'ultimo quarto');
if (m=5) or (m=95) or (m=175) or (m=265) or (m=355) then delay(TEMPO);
delay(20); (* pausa prima di cancellare gradi e disco 10..50..100*)
setcolor(1);
putimage(x+s1,y+c1,disco2,1);
putimage(x+s2,y+c2,disco1,1); (* modificare m per variare persistenza*)
if (m=120) then testo(10,220,'la luna sorge:ore='+h1);
if (m=200) then testo(230,230,'la luna culmina:ore='+h2);
if (m=290) then testo(400,220,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,400,'novilunio');
if ora1=12 then testo(200,400,'primo quarto');
if ora1=18 then testo(200,400,'plenilunio');
if ora1=24 then testo(200,400,'ultimo quarto');
end;
outtextxy(540,40,grado);
g3:=g3+15; (* aumento di 15 gradi al giorno sfasamento sole luna *)
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);(* SOLE *)
setfillstyle(2,2);
fillellipse(400,20,10,10);
getimage(388,8,434,34,disco2); (* LUNA *)
moto;
pausa;
end.
program lunare9;
(* MOTO DELLA LUNA E DEL SOLE DIURNO E MENSILE *)
(* su disco 65 dispensa 49 \TU56\lunare9.mar *)
(* variante di lunare8.mar *)
uses crt,graph;
type vet=array[1..800] of byte;
var disco1,disco2:vet;
TEMPO,mese:INTEGER;
procedure simula;
begin
writeln('simulazione moto diurno e mensile della luna e del sole ');
writeln('relativamente ad un osservatore sulla terra immobile ');
writeln('------------------------------------------------------- ');
writeln('ipotesi e convenzioni per semplificare calcoli :');
writeln('durata del mese lunare=24 giorni');
writeln('spostamento angolare diurno della luna=15 gradi');
writeln('ore del sorgere,culminare,tramontare,multipli di 60 minuti');
writeln('--------------------------------------------------------');
writeln('si visualizza:');
writeln('disco terrestre,orizzonte,meridiano,est,ovest');
writeln('movimento disco del sole e della luna');
writeln('ora del sorgere,culminare,tramontare della luna');
writeln('successione dei giorni lunari da 0 a 24 o meno ');
writeln('novilunio,primo quarto,plenilunio,ultimo quarto');
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:24 per mese completo:vari minuti...');
writeln('numero minore di 24 per vedere solo alcune fasi...........');
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:=1; (* 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(300,420,'premi return,prego');
ch:=readkey;
setcolor(1);
outtextxy(300,420,'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 orizzonte EST OVEST *)
begin
setcolor(5);
line(10,200,600,200);
line(300,200,300,10);
settextstyle(1,0,3);
testo(220,140,'meridiano osservatore');
testo(220,160,'orizzonte osservatore');
testo(10,170,'EST');
testo(500,170,'OVEST');
testo(400,40,'lunazione=');
testo(60,10,'sole');
testo(500,10,'luna');
setfillstyle(1,3);
fillellipse(300,200,20,20);
setcolor(3);
bar(1,200,630,410);
end;
procedure moto;
(* fase g3 ore sorgere culminare tramontare luna*)
var m,s1,c1,s2,c2,x,y,r1,r2,ora1,ora2,ora3,ora,giorni,g3,giorno:integer;
rad,rad1,s,c:real;
grado,h1,h2,h3:string;
begin
x:=300;
y:=200;
r1:=180;
r2:=180;
ora1:=5;
g3:=0;
for giorni:=0 to mese do
begin
giorno:=giorni;
str(giorno,grado);
setcolor(14);
outtextxy(540,40,grado);
ora1:=ora1+1;
if (ora1<24) then ora:=ora1
else ora:=ora1-24;
if (ora1<19) then ora2:=ora1+6
else ora2:=ora1-18;
if (ora1<13) then ora3:=ora1+12
else ora3:=ora1-12;
for m:=0 to 360 do
begin
rad:=m*3.14/180;
s:=r1*sin(rad);
c:=r2*cos(rad);
s1:=-trunc(s);
c1:=trunc(c);
rad1:=(m+g3)*3.14/180;
s2:=-trunc(r1*sin(rad1));
c2:=trunc(r2*cos(rad1));
(* putpixel(x+s1,y+c1,4); *)
(* putpixel(x+s2,y+c2,2); *)
str(giorno,grado);
str(ora,h1);
str(ora2,h2);
str(ora3,h3);
setcolor(4);
putimage(x+s1,y+c1,disco2,1); (* luna *)
putimage(x+s2,y+c2,disco1,1); (* sole *)
setcolor(15);
if (m=95) then testo(10,220,'la luna sorge:ore='+h1);
if (m=175) then testo(230,230,'la luna culmina:ore='+h2);
if (m=265) then testo(330,220,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,360,'novilunio');
if ora1=12 then testo(200,360,'primo quarto');
if ora1=18 then testo(200,360,'plenilunio');
if ora1=24 then testo(200,360,'ultimo quarto');
if (m=5) or (m=95) or (m=175) or (m=265) or (m=355) then delay(TEMPO);
delay(20); (* pausa prima di cancellare gradi e disco 10..50..100*)
setcolor(3);
putimage(x+s1,y+c1,disco2,1);
putimage(x+s2,y+c2,disco1,1); (* modificare m per variare persistenza*)
if (m=120) then testo(10,220,'la luna sorge:ore='+h1);
if (m=200) then testo(230,230,'la luna culmina:ore='+h2);
if (m=290) then testo(330,220,'la luna tramonta:ore='+h3);
if ora1=6 then testo(200,360,'novilunio');
if ora1=12 then testo(200,360,'primo quarto');
if ora1=18 then testo(200,360,'plenilunio');
if ora1=24 then testo(200,360,'ultimo quarto');
end;
setcolor(1);
outtextxy(540,40,grado);
g3:=g3+15; (* aumento di 15 gradi al giorno sfasamento sole luna *)
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);(* SOLE *)
setfillstyle(2,2);
fillellipse(400,20,10,10);
getimage(388,8,434,34,disco2); (* LUNA *)
moto;
pausa;
end.