PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Phase de la Lune

http://forums.purebasic.com/french/viewtopic.php?t=12523

Page 1 sur 1

Phase de la Lune

Publié : dim. 22/janv./2012 1:37
par Le Soldat Inconnu
Salut,

J'ai retranscris un code permettant de calculer les phases de la Lune en PB.

La source original est dans le code de cette page web :
http://portail.imcce.fr/fr/grandpublic/ ... /index.php

Ne me demandez pas comment fonctionne le calcul, j'ai pas tout compris.

Après, j'ai juste codé les fonctions qui m'intéressent par rapport à mon logiciel "Calendrier"

Code : Tout sélectionner

Enumeration 0
	#MoonPhase_None = -1
	#MoonPhase_NewMoon
	#MoonPhase_FirstQuarter
	#MoonPhase_FullMoon
	#MoonPhase_LastQuarter
EndEnumeration
Structure MoonPhase_Structure
	Phase.b
	Date.l
	An.l
	Mois.b
	Jour.b
	Heure.b
	Minute.b
EndStructure
Global NewList MoonPhase.MoonPhase_Structure()

Procedure MoonPhase_Calculation(Year, Month)
	Static MoonPhase_Calculation_Year.l, MoonPhase_Calculation_Month.b
	Protected.l Date, i, ii, Heure, Minute, Mois, An, Jour, JJ
	Protected.d K, T, T2, T3, J, M, MP, F
	
	Debug #PB_Compiler_Procedure
	
	If Year <> MoonPhase_Calculation_Year Or Month <> MoonPhase_Calculation_Month
		MoonPhase_Calculation_Year = Year
		MoonPhase_Calculation_Month = Month
		
		ClearList(MoonPhase())
		
		Repeat
			GetSystemTime_(DateUTC.SYSTEMTIME)
			GetLocalTime_(DateLocale.SYSTEMTIME)
		Until DateUTC\wSecond = DateLocale\wSecond ; Garantit que la lecture de la date s'est effectuée sur la même seconde
		DateUTC_Seconde.q = Date(DateUTC\wYear, DateUTC\wMonth, DateUTC\wDay, DateUTC\wHour, DateUTC\wMinute, DateUTC\wSecond)
		DateLocale_Seconde.q = Date(DateLocale\wYear, DateLocale\wMonth, DateLocale\wDay, DateLocale\wHour, DateLocale\wMinute, DateLocale\wSecond)
		
		DecalageHoraire_Seconde.q = DateLocale_Seconde - DateUTC_Seconde
		
		CompilerIf #PB_Compiler_Debugger
			DecalageHoraire = DecalageHoraire_Seconde / 3600
			If DecalageHoraire > 0
				Debug "Votre fuseau horaire : GMT+" + Str(DecalageHoraire)
			Else
				Debug "Votre fuseau horaire : GMT" + Str(DecalageHoraire)
			EndIf
		CompilerEndIf
		
		Date = Date(Year, Month, 1, 0, 0, 0)
		Date = AddDate(Date, #PB_Date_Month, -1)
		K.d = Year(Date)
		Select Month(Date)
			Case 1
				K + 0.041
			Case 2
				K + 0.126
			Case 3
				K + 0.203
			Case 4
				K + 0.288
			Case 5
				K + 0.370
			Case 6
				K + 0.455
			Case 7
				K + 0.537
			Case 8
				K + 0.622
			Case 9
				K + 0.707
			Case 10
				K + 0.789
			Case 11
				K + 0.874
			Case 12
				K + 0.956
		EndSelect
		K = (K - 1900) * 12.3685
		K = Int(K) - 0.25
		If K < 0
			K - 1
		EndIf
		
		For ii = 0 To 11
			
			K + 0.25
			T.d = K / 1236.85
			T2.d = T * T
			T3.d = T * T2
			J.d = 2415020.75933 + 29.5305888531 * K + 0.0001337 * T2 - 0.000000150 * T3 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009 * T2) * #PI / 180)
			M.d = (359.2242 + 29.10535608 * K - 0.0000333 * T2 - 0.00000347 * T3) * #PI / 180
			M = M - Int(M / (2 * #PI)) * (2 * #PI)
			MP.d = (306.0253 + 385.81691806 * K + 0.0107306 * T2 + 0.00001236 * T3) * #PI / 180
			MP = MP - Int(MP / (2 * #PI)) * (2 * #PI)
			F.d = (21.2964 + 390.67050646 * K - 0.0016528 * T2 - 0.00000239 * T3) * #PI / 180
			F = F - Int(F / (2 * #PI)) * (2 * #PI)
			
			i = ii % 4
			If i = 0 Or i = 2
				J + (0.1734 - 0.000393 * T) * Sin(M)
				J + 0.0021 * Sin(2 * M) - 0.4068 * Sin(MP)
				J + 0.0161 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
				J + 0.0104 * Sin(2 * F) - 0.0051 * Sin(M + MP)
				J - 0.0074 * Sin(M - MP) + 0.0004 * Sin(2 * F + M)
				J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
				J + 0.001 * Sin(2 * F - MP) + 0.0005 * Sin(M + 2 * MP)
			Else
				J + (0.1721 - 0.0004 * T) * Sin(M)
				J + 0.0021 * Sin(2 * M) - 0.6280 * Sin(MP)
				J + 0.0089 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
				J + 0.0079 * Sin(2 * F) - 0.0119 * Sin(M + MP)
				J - 0.0047 * Sin(M - MP) + 0.0003 * Sin(2 * F + M)
				J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
				J + 0.0021 * Sin(2 * F - MP) + 0.0003 * Sin(M + 2 * MP)
				J + 0.0004 * Sin(M - 2 * MP) - 0.0003 * Sin(2 * M + MP)
				If i = 1
					J + 0.0028 - 0.0004 * Cos(M)
					J + 0.0003 * Cos(MP)
				Else
					J - 0.0028 + 0.0004 * Cos(M)
					J - 0.0003 * Cos(MP)
				EndIf
			EndIf
			
			J + 0.5
			JJ = Int(J)
			If JJ >= 2299160.5
				Alpha.d = Int((JJ - 1867216.25) / 36524.25)
				JJ = JJ + 1 + Alpha - Int(Alpha / 4)
			EndIf
			JJ + 1524
			Calcul_An = Int((JJ - 122.1) / 365.25)
			Calcul_Jour = Int(Calcul_An * 365.25)
			Calcul_Mois = Int((JJ - Calcul_Jour) / 30.6001)
			Jour = Int(JJ - Calcul_Jour - Int(Calcul_Mois * 30.6001))
			If Calcul_Mois < 13.5
				Mois = Int(Calcul_Mois - 1)
			Else
				Mois = Int(Calcul_Mois - 13)
			EndIf
			If Mois >= 3
				An = Int(Calcul_An - 4716)
			Else
				An = Int(Calcul_An - 4715)
			EndIf
			J - Int(J)
			Heure = Int(J * 24)
			Minute = Int((J - Heure / 24) * 1440)
			
			CompilerIf #PB_Compiler_Debugger
				Select i
					Case #MoonPhase_NewMoon
						Debug "Nouvelle lune"
					Case #MoonPhase_FirstQuarter
						Debug "Premier quartier"
					Case #MoonPhase_FullMoon
						Debug "Pleine lune"
					Case #MoonPhase_LastQuarter
						Debug "Dernier quartier"
				EndSelect
				Debug Str(Jour) + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An) + " à " + Str(Heure) + ":" + RSet(Str(Minute), 2, "0") + " (UTC)"
			CompilerEndIf
			
			AddElement(MoonPhase())
			MoonPhase()\Phase = i
			MoonPhase()\Date = Date(An, Mois, Jour, 0, 0, 0) + (Heure * 3600 + Minute * 60) + DecalageHoraire_Seconde
			MoonPhase()\An = Year(MoonPhase()\Date)
			MoonPhase()\Mois = Month(MoonPhase()\Date)
			MoonPhase()\Jour = Day(MoonPhase()\Date)
			MoonPhase()\Heure = Hour(MoonPhase()\Date)
			MoonPhase()\Minute = Minute(MoonPhase()\Date)
			
			Debug Str(MoonPhase()\Jour) + "/" + RSet(Str(MoonPhase()\Mois), 2, "0") + "/" + Str(MoonPhase()\An) + " à " + Str(MoonPhase()\Heure) + ":" + RSet(Str(MoonPhase()\Minute), 2, "0")
			
		Next
		
	EndIf
EndProcedure

Procedure NextMoonPhase(Year = 0, Month = 0, Day = 0) ; Get the next moon phase after the date in parameters or last result
	If Year And Month And Day
		MoonPhase_Calculation(Year, Month)
		Date = Date(Year, Month, Day, 0, 0, 0)
	ElseIf ListIndex(MoonPhase())
		Year = MoonPhase()\An
		Month = MoonPhase()\Mois
		Day = MoonPhase()\Jour
		MoonPhase_Calculation(Year, Month)
		Date = Date(Year, Month, Day, 0, 0, 0) + (24 * 60 * 60)
	EndIf
	If Date
		ForEach MoonPhase()
			If MoonPhase()\Date > Date
				Date = MoonPhase()\Date
				Break
			EndIf
		Next
	EndIf
	Debug #PB_Compiler_Procedure
	Debug Date
	ProcedureReturn Date
EndProcedure

Procedure GetMoonPhase(Year = 0, Month = 0, Day = 0) ; Get Moon phase of last result or of the date in parameters
	If Year And Month And Day
		MoonPhase_Calculation(Year, Month)
		Phase = #MoonPhase_None
		ForEach MoonPhase()
			If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
				Phase = MoonPhase()\Phase
				Break
			EndIf
		Next
	ElseIf ListIndex(MoonPhase())
			Phase = MoonPhase()\Phase
		EndIf
	CompilerIf #PB_Compiler_Debugger
		Debug #PB_Compiler_Procedure
		Select Phase
			Case #MoonPhase_None
				Debug "Ce jour n'est pas un état spécifique de la Lune"
			Case #MoonPhase_NewMoon
				Debug "Nouvelle lune"
			Case #MoonPhase_FirstQuarter
				Debug "Premier quartier"
			Case #MoonPhase_FullMoon
				Debug "Pleine lune"
			Case #MoonPhase_LastQuarter
				Debug "Dernier quartier"
		EndSelect
	CompilerEndIf
	ProcedureReturn Phase
EndProcedure

Procedure GetMoonPhaseYear() ; Get year of moon phase of last result
	An = #MoonPhase_None
	If ListIndex(MoonPhase())
		An = MoonPhase()\An
	EndIf
	Debug #PB_Compiler_Procedure
	Debug An
	ProcedureReturn An
EndProcedure

Procedure GetMoonPhaseMonth() ; Get month of moon phase of last result
	Mois = #MoonPhase_None
	If ListIndex(MoonPhase())
		Mois = MoonPhase()\Mois
	EndIf
	Debug #PB_Compiler_Procedure
	Debug Mois
	ProcedureReturn Mois
EndProcedure

Procedure GetMoonPhaseDay() ; Get day of moon phase of last result
	Jour = #MoonPhase_None
	If ListIndex(MoonPhase())
		Jour = MoonPhase()\Jour
	EndIf
	Debug #PB_Compiler_Procedure
	Debug Jour
	ProcedureReturn Jour
EndProcedure

Procedure GetMoonPhaseHour(Year = 0, Month = 0, Day = 0) ; Get hour of Moon phase of last result or of the date in parameters
	If Year And Month And Day
		MoonPhase_Calculation(Year, Month)
		Heure = #MoonPhase_None
		ForEach MoonPhase()
			If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
				Heure = MoonPhase()\Heure
				Break
			EndIf
		Next
	ElseIf ListIndex(MoonPhase())
			Heure = MoonPhase()\Heure
		EndIf
	Debug #PB_Compiler_Procedure
	Debug Heure
	ProcedureReturn Heure
EndProcedure

Procedure GetMoonPhaseMinute(Year = 0, Month = 0, Day = 0) ; Get minute of Moon phase of last result or of the date in parameters
	If Year And Month And Day
		MoonPhase_Calculation(Year, Month)
		Minute = #MoonPhase_None
		ForEach MoonPhase()
			If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
				Minute = MoonPhase()\Minute
				Break
			EndIf
		Next
	ElseIf ListIndex(MoonPhase())
			Minute = MoonPhase()\Minute
		EndIf
	Debug #PB_Compiler_Procedure
	Debug Minute
	ProcedureReturn Minute
EndProcedure



; Test du programme

Enumeration
	#ListeMois
	#ListeAn
	#An
	#Mois
EndEnumeration

Procedure RemplirListe(An, Mois)
	
	; Pour tous les jours du mois
	ClearGadgetItems(#ListeMois)
	Date = Date(An, Mois, 1, 0, 0, 0) ; Premier jour du mois
	While Month(Date) = Mois
		; Jour
		Jour = Day(Date)
		Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
		; Calcul de la phase de la Lune
		Phase = GetMoonPhase(An, Mois, Jour)
		Select Phase
			Case #MoonPhase_None
				Phase_Texte.s = ""
			Case #MoonPhase_NewMoon
				Phase_Texte.s = "Nouvelle lune"
			Case #MoonPhase_FirstQuarter
				Phase_Texte.s = "Premier quartier"
			Case #MoonPhase_FullMoon
				Phase_Texte.s = "Pleine lune"
			Case #MoonPhase_LastQuarter
				Phase_Texte.s = "Dernier quartier"
		EndSelect
		; Calcul de l'heure
		If Phase <> #MoonPhase_None
			Heure = GetMoonPhaseHour(An, Mois, Jour)
			Minute = GetMoonPhaseMinute(An, Mois, Jour)
			Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
		Else
			Heure_Texte.s = ""
		EndIf
		; Affiche dans la liste
		AddGadgetItem(#ListeMois, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
		; Ajoute un jour
		Date = AddDate(Date, #PB_Date_Day, 1)
	Wend
	
	
	; Pour l'année complète
	ClearGadgetItems(#ListeAn)
	Date = Date(An, 1, 1, 0, 0, 0) ; Premier jour de l'année
	Date = NextMoonPhase(An, Mois, 1)
	While Year(Date) = An
		; Jour
		Mois = GetMoonPhaseMonth()
		Jour = GetMoonPhaseDay()
		Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
		; Calcul de la phase de la Lune
		Phase = GetMoonPhase()
		Select Phase
			Case #MoonPhase_None
				Phase_Texte.s = ""
			Case #MoonPhase_NewMoon
				Phase_Texte.s = "Nouvelle lune"
			Case #MoonPhase_FirstQuarter
				Phase_Texte.s = "Premier quartier"
			Case #MoonPhase_FullMoon
				Phase_Texte.s = "Pleine lune"
			Case #MoonPhase_LastQuarter
				Phase_Texte.s = "Dernier quartier"
		EndSelect
		; Calcul de l'heure
		Heure = GetMoonPhaseHour()
		Minute = GetMoonPhaseMinute()
		Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
		; Affiche dans la liste
		AddGadgetItem(#ListeAn, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
		; Phase suivante
		Date = NextMoonPhase()
	Wend
	
EndProcedure

; Lecture de la date actuelle
Date = Date()
An = Year(Date)
Mois = Month(Date)

If OpenWindow(0, 0, 0, 600, 600, "Phase de la Lune", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered) = 0
	End
EndIf
ListIconGadget(#ListeMois, 0, 0, 300, 560, "Jour du mois", 100, #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListeMois, 1, "Heure", 50)
AddGadgetColumn(#ListeMois, 2, "Phase de la lune", 120)
ListIconGadget(#ListeAn, 300, 0, 300, 560, "Jour de l'année", 100, #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListeAn, 1, "Heure", 50)
	AddGadgetColumn(#ListeAn, 2, "Phase de la lune", 120)
TextGadget(#PB_Any, 0, 560, 300, 16, "Année", #PB_Text_Center)
TextGadget(#PB_Any, 200, 560, 300, 16, "Mois", #PB_Text_Center)
StringGadget(#An, 0, 576, 300, 24, Str(An), #PB_String_Numeric | #ES_CENTER)
StringGadget(#Mois, 300, 576, 300, 24, Str(Mois), #PB_String_Numeric | #ES_CENTER)

RemplirListe(An, Mois)

Repeat
	Event = WaitWindowEvent()
	
	Select Event
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #An, #Mois
					If EventType() = #PB_EventType_Change
						
						An = Val(GetGadgetText(#An))
						Mois = Val(GetGadgetText(#Mois))
						If An And Mois
							RemplirListe(An, Mois)
						EndIf
						
					EndIf
			EndSelect
	EndSelect
	
Until Event = #PB_Event_CloseWindow

Re: Phase de la Lune

Publié : dim. 22/janv./2012 2:47
par Huitbit
Hello,

Ca marche nickel.
Ne me demandez pas comment fonctionne le calcul, j'ai pas tout compris.
Ne t'inquiète pas, ce sont des formules empiriques(voir la référence donnée par l'imcce : le livre de Jean MEEUS).

J'ai ce livre, si d'autres calculs t'intéressent...


Hasta la vista !

Re: Phase de la Lune

Publié : dim. 22/janv./2012 10:47
par Kwai chang caine
C'est super ton truc... 8O
Tu fais vraiment des codes dans tous les domaines 8O
Moi qui me demande toujours si c'est la pleine lune quand je fais pipi dans mon terrain le nez en l'air :D
Parce que des fois on croit qu'elle est pleine, mais il manque une toute petite partie presque invisible a l'oeil :roll:
Grâce a toi je le saurais sans calendrier
Merci beaucoup du partage 8)

@HuitBit
ce sont des formules empiriques(voir la référence donnée par l'imcce : le livre de Jean MEEUS).
Je t'admire 8O
Comment tu fais pour comprendre l'incompréhensible...moi qui suis fier de savoir faire une multiplication :oops:
En école d’électronique, j'ai croisé pendant une année un prof de math qui était agrégé...je savais pas ce que cela voulais dire a l’époque
Maintenant je sais...c'est des gens, ils pense math, regarde math, respire math...
C'est tellement évident pour eux qu'ils en arrivent a oublier que certain ce sont arrêté au CP
J'ai jamais rien compris a ses cours, et le pauvre, plus y m'expliquait plus c’était pire :(
Tiens ça me rappelle certains membres du forum :roll: :oops:
J'ai ce livre, si d'autres calculs t'intéressent..
Toit aussi tu lis avant de te coucher....moi c'est télé star :mrgreen:

Re: Phase de la Lune

Publié : dim. 22/janv./2012 11:17
par Le Soldat Inconnu
@Huitbit :
il n'y a pas le calcul des premier croissant, dernier croissant et l'autre dont j'ai zappé le nom (lune au 3/4) ? Merci
un truc dans ce genre

Code : Tout sélectionner

J + (0.1734 - 0.000393 * T) * Sin(M) 
J + 0.0021 * Sin(2 * M) - 0.4068 * Sin(MP) 
J + 0.0161 * Sin(2 * MP) - 0.0004 * Sin(3 * MP) 
J + 0.0104 * Sin(2 * F) - 0.0051 * Sin(M + MP) 
J - 0.0074 * Sin(M - MP) + 0.0004 * Sin(2 * F + M) 
J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP) 
J + 0.001 * Sin(2 * F - MP) + 0.0005 * Sin(M + 2 * MP)
pour compléter les cas intermédiaire

Re: Phase de la Lune

Publié : dim. 22/janv./2012 13:48
par Huitbit
Hello,

Croissant, lune gibbeuse ?
Je ne pense pas qu'il y ait de formule car cela correspond à des phases intermédiares(donc périodes étalées sur plusieurs jours).


Je vais regarder, je te tiens au courant.
Hasta la vista !

Re: Phase de la Lune

Publié : dim. 22/janv./2012 15:46
par Backup
ben ..

et ce code alors ? il ne convient pas ?

corrigé pour tenir compte des premiers ")" et dernier quartier "(" de lune

Code : Tout sélectionner


Declare.d FNMoonPhase(Year,Month,Day)
Declare.s mois_string(mois)

annee=2012
mois=01
Debug "Les phases lunaire pour le mois de "+mois_string(mois) +" auront lieu les :"
Debug " "
For i=1 To 31
    CircleType.d=FNMoonPhase(annee,mois,i)
    If CircleType>0.97
        Debug Str(i)+" "+mois_string(mois)+"  Phase de la lune: Pleine lune   O"
        
        ElseIf CircleType<0.03
        Debug Str(i)+" "+mois_string(mois)+"  Phase de la lune: Pas de lune (Nouvelle lune)"
        
        
        ElseIf(CircleType>0.46) And (CircleType<0.53)
        if flag=0
            Debug Str(i)+" "+mois_string(mois)+"  Phase de la lune: premier quartier   ) "
            flag=1
            else
            Debug Str(i)+" "+mois_string(mois)+"  Phase de la lune: Dernier Quartier  ("
            flag=0
        endif
    EndIf
Next
; ******************************************************************************

Procedure.d FNMoonPhase(Year,Month,Day)
    If Month<=2
        Year=Year-1
        Month=Month+12
    EndIf
    
    Month=Month-3
    XYear=Year % 100
    Century=Int((Int(Year / 100)*146097) / 4)
    XYear=Int((XYear*1461) / 4)
    M.d=(Int(((((Month*153)+2)/ 5)+Day)+1721119+XYear+Century)+4.867)/29.53058
    ProcedureReturn Abs(2*(M-Int(M))-1)
EndProcedure

Procedure.s mois_string(num)
    ProcedureReturn StringField("Janvier,Fevrier,Mars,Avril,Mai,Juin,Juillet,Aout,Septembre,Octobre,Novembre,Decembre",num,",")
EndProcedure
ça corrobore le calendrier de la poste :)

Re: Phase de la Lune

Publié : dim. 22/janv./2012 20:18
par Le Soldat Inconnu
@Dobro : Je voulais quelque chose de précis. C'est vrai que le calcul semble barbare mais il est correct à quelques minutes près jusqu'en l'an 2500 :mrgreen: Bref, j'ai peut-être abusé sur la précision ....

J'ai mis à jour le code dans le premier sujet. J'ai terminé toutes les fonctions qui me semblent nécessaire pour mes programmes.

Re: Phase de la Lune

Publié : jeu. 26/janv./2012 22:26
par Noos88
Bonjour tous le monde, ton code est super mais une petite question me trote, pourquoi on ne peut pas allé au dela de janvier 2038??

(C'est la fin du monde :lol: :lol: ??)
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru