program calendario; uses crt; var rit, maxNum : char; cosaFare : byte; errore : integer; function controllo: char; var car: char; carDig: char; doveX, doveY : integer; procedure avvisa; begin sound (440); delay (10); sound (220); delay (20); nosound; end; { avvisa } procedure mostra; begin gotoxy (doveX, doveY); write (carDig); end; { mostra } begin doveX:= wherex; doveY:= wherey; carDig:=' '; mostra; repeat car:=readkey; case car of #13 : begin controllo:=carDig; if (carDig<>' ') then exit else avvisa; end; #27 : begin controllo:='0'; exit; end; else begin if car in ['1'..maxNum] then carDig:= car else avvisa; end; end; { case } mostra; until 1=0; end; function filtro:string; var cifra:char; cifraDig:string[40]; doveX, doveY:integer; procedure avvisa; begin sound (440); delay (20); sound (220); delay (40); nosound; end; { avvisa } procedure mostra; begin gotoxy (doveX, doveY); write (cifraDig); end; { mostra } begin doveX:=whereX; doveY:=whereY; cifraDig:=' '; mostra; repeat cifra:=readkey; case cifra of #13 : begin filtro:=cifraDig; if (cifraDig<>' ') then exit else avvisa; end; #8 : begin gotoxy (wherex-1,wherey); write (' '); cifraDig:=copy(cifraDig,1,Length(cifraDig)-1); mostra; end; else begin if (cifra in ['0'..'9']) or (cifra='.') then cifraDig:=cifraDig+cifra else avvisa; end; end; { case } mostra; until 1=0; end; procedure inizia; begin textbackground (0); clrscr; gotoxy (32,7); textcolor (12); write ('C A L E N D A R I O'); gotoxy (15,10); textcolor (9); write ('1'); gotoxy (18,10); textcolor (14); write ('IL GIORNO NEL CALENDARIO'); gotoxy (15,11); textcolor (9); write ('2'); gotoxy (18,11); textcolor (14); write ('GIORNO DELLA PASQUA CRISTIANA'); gotoxy (15,12); textcolor (9); write ('3'); gotoxy (18,12); textcolor (14); write ('EQUINOZI E SOLSTIZI'); gotoxy (15,13); textcolor (9); write ('4'); gotoxy (18,13); textcolor (14); write ('DISTANZA TRA DUE DATE'); gotoxy (15,14); textcolor (9); write ('5'); gotoxy (18,14); textcolor (14); write ('note sul programma'); gotoxy (18,17); textcolor (9); write ('Digita il numero dell''argomento che ti interessa'); gotoxy (18,18); write ('('); textcolor (12); gotoxy (19,18); write ('ESC'); textcolor (9); gotoxy (23,18); write ('per uscire)'); gotoxy (18,19); maxNum:='5'; val (controllo, cosaFare, errore); end; procedure giorno; var giorno, mese, anno, bisestile, giornoSettimana : integer; numeroOro, annoSecolare, epatta, a, b, c, d, e : integer; regolare, eta, aa, mm : integer; ag, bg, gg : LongInt; gs : string[10]; begin textbackground (0); clrscr; gotoxy (3,3); textcolor (12); write ('IL GIORNO NEL CALENDARIO'); gotoxy (3,7); textcolor (14); write ('Inserisci il giorno della data'); gotoxy (65,7); val (filtro,giorno,errore); gotoxy (3,9); write ('Inserisci il numero del mese'); gotoxy (65,9); val (filtro,mese,errore); gotoxy (3,11); write ('Inserisci l''anno'); gotoxy (65,11); val (filtro,anno,errore); mm := mese; aa := anno; if anno < 1583 then begin gotoxy (3, 13); textcolor(10); write ('Darei una indicazione priva di senso.'); gotoxy (3, 14); write ('Il calendario gregoriano, su cui mi baso, e'' stato adottato nel 1583.'); end else begin bisestile := 0; if ((anno mod 4 = 0) and (anno mod 100 <> 0)) or (anno mod 400 = 0) then bisestile := 1; if ((mese = 1) and (giorno > 31)) or ((mese = 2) and (bisestile = 1) and (giorno > 29)) or ((mese = 2) and (bisestile <> 1) and (giorno > 28)) or ((mese = 3) and (giorno > 31)) or ((mese = 4) and (giorno > 30)) or ((mese = 5) and (giorno > 31)) or ((mese = 6) and (giorno > 30)) or ((mese = 7) and (giorno > 31)) or ((mese = 8) and (giorno > 31)) or ((mese = 9) and (giorno > 30)) or ((mese = 10) and (giorno > 31)) or ((mese = 11) and (giorno > 30)) or ((mese = 12) and (giorno > 31)) or (mese < 1) or (mese > 12) then begin gotoxy (3, 13); textcolor(10); write ('Il giorno indicato non esiste.'); end else begin if mese < 3 then begin mese := mese + 12; anno := anno - 1; end; ag := anno div 100; bg := 2 - ag + ag div 4; gg := trunc(365.25 * (anno + 4716)) + trunc(30.6 * (mese + 1)) + giorno + bg - 1524; gotoxy(3,14); textcolor(10); write('giorno giuliano alle ore 12: ', gg); giornoSettimana := gg mod 7; case giornoSettimana of 0 : gs := 'LUNEDI'; 1 : gs := 'MARTEDI'; 2 : gs := 'MERCOLEDI'; 3 : gs := 'GIOVEDI'; 4 : gs := 'VENERDI'; 5 : gs := 'SABATO'; 6 : gs := 'DOMENICA'; end; gotoxy(3,15); write('giorno nella settimana: ', gs); numeroOro := (aa + 1) mod 19; if numeroOro = 0 then numeroOro := 19; annoSecolare := aa div 100; a := (numeroOro * 11 - 10) mod 30; b := annoSecolare - 15; c := (b - (b div 25)) div 3; d := b * 3 div 4; e := (d - c) mod 30; if a > e then epatta := a - e else epatta := 30 - (e - a); if bisestile = 0 then begin case mm of 1 : regolare := 0; 2 : regolare := 1; 3 : regolare := 0; 4 : regolare := 1; 5 : regolare := 2; 6 : regolare := 3; 7 : regolare := 4; 8 : regolare := 5; 9 : regolare := 7; 10 : regolare := 7; 11 : regolare := 9; 12 : regolare := 9; end; { case } end else begin case mm of 1 : regolare := 0; 2 : regolare := 1; 3 : regolare := 1; 4 : regolare := 2; 5 : regolare := 3; 6 : regolare := 4; 7 : regolare := 5; 8 : regolare := 6; 9 : regolare := 8; 10 : regolare := 8; 11 : regolare := 10; 12 : regolare := 10; end; { case } end; eta := epatta + regolare + giorno; if eta > 30 then eta := eta - 30; if eta > 30 then eta := eta - 30; gotoxy(3,16); if (eta >= 28) and (eta <= 30) then write('la fase lunare in corso e'' di Luna Nuova'); if (eta >= 1) and (eta <= 5) then write('la luna e'' in fase crescente tra Luna Nuova e Primo Quarto'); if (eta >= 6) and (eta <= 8) then write('la luna e'' in fase crescente al Primo Quarto'); if (eta >= 9) and (eta <= 12) then write('la luna e'' in fase crescente tra Primo Quarto e Luna Piena'); if (eta >= 13) and (eta <= 15) then write('la fase lunare in corso e'' di Luna Piena'); if (eta >= 16) and (eta <= 19) then write('la luna e'' in fase calante tra Luna Piena e Ultimo Quarto'); if (eta >= 20) and (eta <= 22) then write('la luna e'' in fase calante all''Ultimo Quarto'); if (eta >= 23) and (eta <= 27) then write('la luna e'' in fase calante tra Ultimo Quarto e Luna Nuova'); gotoxy(3,17); if (eta >= 1) and (eta <= 10) then write('nel ciclo siderale la luna e'' in fase discendente'); if (eta >= 11) and (eta <= 24) then write('nel ciclo siderale la luna e'' in fase ascendente'); if (eta >= 25) and (eta <= 30) then write ('nel ciclo siderale la luna e'' in fase discendente'); end end; end; procedure giornoPasqua; var anno, a, b, c, d, e, g, h, j, k, m, r, n, p : integer; mese : string[12]; begin textbackground (0); clrscr; gotoxy (3,3); textcolor (12); write ('GIORNO DELLA PASQUA CRISTIANA'); gotoxy (3,7); textcolor (14); write ('Inserisci l''anno'); gotoxy (65,7); val (filtro,anno,errore); if anno < 1583 then begin gotoxy (3, 10); textcolor(10); write ('Darei una indicazione priva di senso.'); gotoxy (3, 11); write ('Il calendario gregoriano, su cui mi baso, e'' stato adottato nel 1583.'); end else begin a := anno mod 19; b := trunc(anno/100); c := anno mod 100; d := trunc(b/4); e := b mod 4; g := trunc((8*b+13)/25); h := (19*a+b-d-g+15) mod 30; j := trunc(c/4); k := c mod 4; m := trunc((a+11*h)/319); r := (2*e+2*j-k-h+m+32) mod 7; n := trunc((h-m+r+90)/25); p := (h-m+r+n+19) mod 32; if n = 3 then mese := ' marzo' else mese := ' aprile'; gotoxy(3,10); textcolor(10); write (p, mese); end; end; procedure distanzaDate; var g, gg, m, mm, a, aa, p, q, differenza, bisestile, bisestileb : integer; n, nn : LongInt; begin textbackground (0); clrscr; gotoxy (3,3); textcolor (12); write ('DISTANZA TRA DUE DATE'); gotoxy (3,7); textcolor (14); write ('Inserisci il giorno della prima data'); gotoxy (65,7); val (filtro,g,errore); gotoxy (3,8); write ('Inserisci il numero del mese della prima data'); gotoxy (65,8); val (filtro,m,errore); gotoxy (3,9); write ('Inserisci l''anno della prima data'); gotoxy (65,9); val (filtro,a,errore); gotoxy (3,11); write ('Inserisci il giorno dell''altra data'); gotoxy (65,11); val (filtro,gg,errore); gotoxy (3,12); write ('Inserisci il numero del mese dell''altra data'); gotoxy (65,12); val (filtro,mm,errore); gotoxy (3,13); write ('Inserisci l''anno dell''altra data'); gotoxy (65,13); val (filtro,aa,errore); if (a < 1583) or (aa < 1583) then begin gotoxy (3, 15); textcolor(10); write ('Darei una indicazione priva di senso.'); gotoxy (3, 16); write ('Il calendario gregoriano, su cui mi baso, e'' stato adottato nel 1583.'); end else begin bisestile := 0; bisestileb := 0; if ((a mod 4 = 0) and (a mod 100 <> 0)) or (a mod 400 = 0) then bisestile := 1; if ((aa mod 4 = 0) and (aa mod 100 <> 0)) or (aa mod 400 = 0) then bisestileb :=1; if ((m = 1) and (g > 31)) or ((m = 2) and (bisestile = 1) and (g > 29)) or ((m = 2) and (bisestile <> 1) and (g > 28)) or ((m = 3) and (g > 31)) or ((m = 4) and (g > 30)) or ((m = 5) and (g > 31)) or ((m = 6) and (g > 30)) or ((m = 7) and (g > 31)) or ((m = 8) and (g > 31)) or ((m = 9) and (g > 30)) or ((m = 10) and (g > 31)) or ((m = 11) and (g > 30)) or ((m = 12) and (g > 31)) or (m < 1) or (m > 12) or ((mm = 1) and (gg > 31)) or ((mm = 2) and (bisestileb = 1) and (gg > 29)) or ((mm = 2) and (bisestileb <> 1) and (gg > 28)) or ((mm = 3) and (gg > 31)) or ((mm = 4) and (gg > 30)) or ((mm = 5) and (gg > 31)) or ((mm = 6) and (gg > 30)) or ((mm = 7) and (gg > 31)) or ((mm = 8) and (gg > 31)) or ((mm = 9) and (gg > 30)) or ((mm = 10) and (gg > 31)) or ((mm = 11) and (gg > 30)) or ((mm = 12) and (gg > 31)) or (mm < 1) or (mm > 12) then begin gotoxy (3, 17); textcolor(10); write ('Uno dei giorni indicati non esiste.'); end else begin if m < 3 then begin a := a - 1; m := m + 12; end; p := trunc(a / 100); q := 2 - p + trunc(p / 4); n := trunc(365.25 * (a + 4716)) + trunc(30.6001 * (m + 1)) + g + q - 1524; if mm < 3 then begin aa := aa - 1; mm := mm + 12; end; p := trunc(aa / 100); q := 2 - p + trunc(p / 4); nn := trunc(365.25 * (aa + 4716)) + trunc(30.6001 * (mm + 1)) + gg + q - 1524; if n > nn then differenza := n - nn else differenza := nn - n; gotoxy(3,16); textcolor(10); write('tra le due date corrono ', differenza, ' giorni'); end; end; end; { distanzaDate } procedure note; begin textbackground(0); clrscr; textcolor(14); gotoxy(3,3); write('Ciao da Vittorio Albertoni, autore di questo software.'); gotoxy(3,5); write('L''inserimento di ciascun dato va confermato con il tasto INVIO.'); gotoxy(3,6); write('Se non compare il dato inserito vuol dire che non e'' un dato valido'); gotoxy(3,7); write('(ad esempio si e'' battuta una lettera dell''alfabeto invece di un numero).'); gotoxy(3,8); write('Se la data inserita non esiste esce avviso e occorre ricominciare da capo.'); gotoxy(3,10); write('Le indicazioni relative alla luna sono descrittive e non hanno un valore'); gotoxy(3,11); write('puntuale (quando si dice che si e'' in fase di Luna Piena, per esempio, non'); gotoxy(3,12); write('necessariamente siamo nel giorno del plenilunio ma siamo in quel periodo di'); gotoxy(3,13); write('2 o 3 giorni attorno al plenilunio, quando la luna e'' bella tonda).'); gotoxy(3,15); write('Buon divertimento.'); end; { note } procedure equisol; var anno, yy : integer; y, diff : real; ttm, JDIm, Tm, Lm, Mm, Mrm, Cm, LVm, Om, Orm, LAm, angm, anrm, ccm, JDNm, Zm, Fm, alm, Am, Bm, CCCm, Dm, Em, giom, giornom, orrm, oram, minm : real; ttg, JDIg, Tg, Lg, Mg, Mrg, Cg, LVg, Og, Org, LAg, angg, anrg, ccg, JDNg, Zg, Fg, alg, Ag, Bg, CCCg, Dg, Eg, giog, giornog, orrg, orag, ming : real; tts, JDIs, Ts, Ls, Ms, Mrs, Cs, LVs, Os, Ors, LAs, angs, anrs, ccs, JDNs, Zs, Fs, als, Ass, Bs, CCCs, Ds, Es, gios, giornos, orrs, oras, mins : real; ttd, JDId, Td, Ld, Md, Mrd, Cd, LVd, Od, Ordd,LAd, angd, anrd, ccd, JDNd, Zd, Fd, ald, Ad, Bd, CCCd, Dd, Ed, giod, giornod, orrdd, orad, mind : real; const pi = 3.1415926535; begin textbackground (0); clrscr; gotoxy (3,3); textcolor (12); write ('EQUINOZI E SOLSTIZI'); gotoxy (3,5); textcolor (14); write ('Inserisci l''anno'); gotoxy (65,5); val (filtro,anno,errore); if anno < 1583 then begin gotoxy (3, 10); textcolor(10); write ('Darei una indicazione priva di senso.'); gotoxy (3, 11); write ('Il calendario gregoriano, su cui mi baso, e'' stato adottato nel 1583.'); end else begin yy := anno; y := yy/1000; ttm := 0.1; repeat JDIm := 1721139.2855+365.2421376*yy+0.0679190*y*y-0.0027879*y*y*y; Tm := (JDIm-2415020.0)/36525; Lm := 279.69668+36000.76892*Tm+0.0003025*Tm*Tm; Mm := 358.47583+35999.04975*Tm-0.000150*Tm*Tm-0.0000033*Tm*Tm*Tm; Mrm := Mm*2*pi/360; Cm := (1.919460-0.004789*Tm-0.000014*Tm*Tm)*sin(Mrm)+(0.020094-0.000100*Tm)*sin(2*Mrm)+0.000293*sin(3*Mrm); LVm := Lm+Cm; Om := 259.18-1934.142*Tm; Orm := Om*2*pi/360; LAm := LVm-0.00569-0.00479*sin(Orm); angm := 0*90-LAm; anrm := angm*2*pi/360; ccm := 58*sin(anrm); JDNm := JDIm+ccm; JDIm := JDNm; diff := JDIm-JDNm; ttm := abs(diff); until (ttm = 0); ttg := 0.1; repeat JDIg := 1721233.2486+365.2417284*yy-0.0530180*y*y+0.0093320*y*y*y; Tg := (JDIg-2415020.0)/36525; Lg := 279.69668+36000.76892*Tg+0.0003025*Tg*Tg; Mg := 358.47583+35999.04975*Tg-0.000150*Tg*Tg-0.0000033*Tg*Tg*Tg; Mrg := Mg*2*pi/360; Cg := (1.919460-0.004789*Tg-0.000014*Tg*Tg)*sin(Mrg)+(0.020094-0.000100*Tg)*sin(2*Mrg)+0.000293*sin(3*Mrg); LVg := Lg+Cg; Og := 259.18-1934.142*Tg; Org := Og*2*pi/360; LAg := LVg-0.00569-0.00479*sin(Org); angg := 1*90-LAg; anrg := angg*2*pi/360; ccg := 58*sin(anrg); JDNg := JDIg+ccg; JDIg := JDNg; diff := JDIg - JDNg; ttg := abs(diff); until (ttg = 0); tts := 0.1; repeat JDIs := 1721325.6978+365.2425055*yy-0.1266890*y*y+0.0019401*y*y*y; Ts := (JDIs-2415020.0)/36525; Ls := 279.69668+36000.76892*Ts+0.0003025*Ts*Ts; Ms := 358.47583+35999.04975*Ts-0.000150*Ts*Ts-0.0000033*Ts*Ts*Ts; Mrs := Ms*2*pi/360; Cs := (1.919460-0.004789*Ts-0.000014*Ts*Ts)*sin(Mrs)+(0.020094-0.000100*Ts)*sin(2*Mrs)+0.000293*sin(3*Mrs); LVs := Ls+Cs; Os := 259.18-1934.142*Ts; Ors := Os*2*pi/360; LAs := LVs-0.00569-0.00479*sin(Ors); angs := 2*90-LAs; anrs := angs*2*pi/360; ccs := 58*sin(anrs); JDNs := JDIs+ccs; JDIs := JDNs; diff := JDIs -JDNs; tts := abs(diff); until (tts = 0); ttd := 0.1; repeat JDId := 1721414.3920+365.2428898*yy-0.0109650*y*y+0.0084885*y*y*y; Td := (JDId-2415020.0)/36525; Ld := 279.69668+36000.76892*Td+0.0003025*Td*Td; Md := 358.47583+35999.04975*Td-0.000150*Td*Td-0.0000033*Td*Td*Td; Mrd := Md*2*pi/360; Cd := (1.919460-0.004789*Td-0.000014*Td*Td)*sin(Mrd)+(0.020094-0.000100*Td)*sin(2*Mrd)+0.000293*sin(3*Mrd); LVd := Ld+Cd; Od := 259.18-1934.142*Td; Ordd := Od*2*pi/360; LAd := LVd-0.00569-0.00479*sin(Ordd); angd := 3*90-LAd; anrd := angd*2*pi/360; ccd := 58*sin(anrd); JDNd := JDId+ccd; JDId := JDNd; diff := JDId-JDNd; ttd := abs(diff); until (ttd = 0); Zm := int(JDNm+0.5); Fm := JDNm-Zm; if Zm < 2299161 then Am := Zm else begin alm := int((Zm-1867216.25)/36524.25); Am := Zm+1+alm-int(alm/4); end; Bm := Am+1524; CCCm := int((Bm-122.1)/365.25); Dm := int(365.25*CCCm); Em := int((Bm-Dm)/30.6001); giom := Bm-Dm-int(30.6001*Em)+Fm; giornom := int(giom); orrm := 1440.0*((giom-giornom)*1000)/1000; oram := int(orrm/60)+12; minm := int(orrm-60*(oram-12)); if oram >= 24 then begin oram := oram-24; giornom := giornom+1; end; gotoxy(3,7); textcolor(10); writeln ('equinozio di primavera:'); writeln (' ', giornom:2:0, ' marzo, ore ', oram:2:0, ':', minm:2:0); Zg := int(JDNg+0.5); Fg := JDNg-Zg; if Zg < 2299161 then Ag := Zg else begin alg := int((Zg-1867216.25)/36524.25); Ag := Zg+1+alg-int(alg/4); end; Bg := Ag+1524; CCCg := int((Bg-122.1)/365.25); Dg := int(365.25*CCCg); Eg := int((Bg-Dg)/30.6001); giog := Bg-Dg-int(30.6001*Eg)+Fg; giornog := int(giog); orrg := 1440.0*((giog-giornog)*1000)/1000; orag := int(orrg/60)+12; ming := int(orrg-60*(orag-12)); if orag >= 24 then begin orag := orag-24; giornog := giornog+1; end; gotoxy(3,9); textcolor(10); writeln ('solstizio d''estate:'); writeln (' ', giornog:2:0, ' giugno, ore ', orag:2:0, ':', ming:2:0); Zs := int(JDNs+0.5); Fs := JDNs-Zs; if Zs < 2299161 then Ass := Zs else begin als := int((Zs-1867216.25)/36524.25); Ass := Zs+1+alg-int(als/4); end; Bs := Ass+1524; CCCs := int((Bs-122.1)/365.25); Ds := int(365.25*CCCs); Es := int((Bs-Ds)/30.6001); gios := Bs-Ds-int(30.6001*Es)+Fs; giornos := int(gios); orrs := 1440.0*((gios-giornos)*1000)/1000; oras := int(orrs/60)+12; mins := int(orrs-60*(oras-12)); if oras >= 24 then begin oras := oras-24; giornos := giornos+1; end; gotoxy(3,11); textcolor(10); writeln ('equinozio d''autunno:'); writeln (' ', giornos:2:0, ' settembre, ore ', oras:2:0, ':', mins:2:0); Zd := int(JDNd+0.5); Fd := JDNd-Zd; if Zd < 2299161 then Ad := Zd else begin ald := int((Zd-1867216.25)/36524.25); Ad := Zd+1+ald-int(ald/4); end; Bd := Ad+1524; CCCd := int((Bd-122.1)/365.25); Dd := int(365.25*CCCd); Ed := int((Bd-Dd)/30.6001); giod := Bd-Dd-int(30.6001*Ed)+Fd; giornod := int(giod); orrdd := 1440.0*((giod-giornod)*1000)/1000; orad := int(orrdd/60)+12; mind := int(orrdd-60*(orad-12)); if orad >= 24 then begin orad := orad-24; giornod := giornod+1; end; gotoxy(3,13); textcolor(10); writeln ('solstizio d''inverno:'); writeln (' ', giornod:2:0, ' dicembre, ore ', orad:2:0, ':', mind:2:0); writeln (); writeln (' (ore efemeridi del meridiano di Greenwich)'); end; end; {equisol} begin repeat inizia; case cosaFare of 0 : halt; 1 : giorno; 2 : giornoPasqua; 3 : equisol; 4 : distanzaDate; 5 : note; end; { case } gotoxy (13,21); textcolor (9); write ('Premi un tasto qualsiasi per tornare al menu principale'); rit:=readkey; until keypressed; end.