astronomia con pascal
esci turboastro.htm
program solare1; (* su disco 65 dispensa 45 \tu56\solare1.mar *) (* moto diurno del sole e della luna*) (* novilunio,quadratura,plenilunio *) uses crt,graph; type vet=array[1..800] of byte; var sole,luna:vet; luogo1,luogo2,culmina:string; t,orbite,sosta:integer; procedure simula; (* introduzione a programma *) begin writeln('simulazione moto diurno del sole e della luna'); writeln('novilunio,quadratura,plenilunio '); writeln('il sole e la luna si muovono da est verso ovest'); writeln('viene indicata la fase'); writeln('viene indicata ora del sorgere,culminazione,tramonto'); 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,4..'); readln(orbite); orbite:=360*orbite; writeln('scrivi valore pausa punti speciali'); writeln('1000...2000...5000....prova 1000 '); readln(sosta); 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,sosta1: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); if (m=90) or(m=180) or(m=270) or (m=360) then sosta1:=sosta; delay(sosta1); sosta1:=0; end; delay(t); 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(150,210,450,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,'attendere inizio simulazione,prego'); setfillstyle(1,14); fillellipse(20,20,10,10); (* sole *) getimage(5,5,35,35,sole); (* vettore sole *) setfillstyle(3,5); fillellipse(500,20,10,10); (* luna*) getimage(485,5,515,35,luna); (* vettore luna *) 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); 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,luna,luogo1,luogo2); (* animazione *) 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,luna,luogo1,luogo2); 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,luna,sole,luogo1,luogo2); 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,luna,sole,luogo1,luogo2); readln; scelta; (* opzione fine o rivedere *) end; begin programma; (* programma principale *) pausa; end.