QB64.org Forum

Active Forums => Programs => Topic started by: Qwerkey on February 23, 2019, 05:05:07 am

Title: Phases of the Moon
Post by: Qwerkey on February 23, 2019, 05:05:07 am

This is a simple little program demonstrating how the phases of the Moon develop depending upon the positions of the Moon and the Sun in the sky.

The view is for an observer in the northern hemisphere looking south - you Southern-hemispherical people would see things upside-down (but then we're not sure what is preventing you from falling off the Earth anyway! - cue for Pete to give his "gravity of the situation" pun).

The dark green foreshortened half-circle at the bottom represents the viewer's horizon: the Sun and Moon rise in the East (left-hand side) and sink in the West.

Of course, the sizes of the Sun and Moon are way, way larger than in the actual sky, but it is the phase of the moon that is the only important factor.  Apart from the phase, all other factors are quite unrealistic.

The program will start with your current time and date and will then proceed minute-by-minute.  The position of the Sun will be correct, but the Moon starts arbitrarily opposite the Sun (full Moon).  The Sun will gradually catch up the Moon, and there will be a total eclipse every complete Moon cycle (27.3 days in this model).

I could have made the program more complex with more realistic factors, but have left it in this state.  It is rather a simple piece of code and I therefore feel slightly embarrassed to foist it upon you.  You will need the moon image.

Code: QB64: [Select]

1. 'Moon Phases by QWERKEY 02/03/19
2.  
3. CONST Radius% = 98, HalfScreenX% = 550, HalfScreenY% = 300, Pi! = 4 * ATN(1)
4. CONST G! = 0.75, H! = 0.7, Twelve% = 720, MinsStep%% = 2, Delta! = 0.15, Eclipse! = 0.004
5. _TITLE "Moon Phases"
6.  
7. Moon1& = _LOADIMAGE("moon1.png", 32)
8. TempImg& = _NEWIMAGE(2 * Radius% + 1, 2 * Radius% + 1, 32)
9. _DEST TempImg&
10. _PUTIMAGE (0, 0)-(2 * Radius%, 2 * Radius%), Moon1&
11. Moon& = MakeHardware&(TempImg&)
12. _FREEIMAGE Moon1&
13. TempImg& = _NEWIMAGE(2 * Radius% + 1, 2 * Radius% + 1, 32)
14. _DEST TempImg&
15. CIRCLE (Radius%, Radius%), Radius%, _RGB32(255, 255, 0)
16. PAINT (Radius%, Radius%), _RGB32(255, 255, 0)
17. Sun& = MakeHardware&(TempImg&)
18. TempImg& = _NEWIMAGE(2 * HalfScreenX% + 1, 2 * HalfScreenX% + 1, 32)
19. _DEST TempImg&
20. CIRCLE (HalfScreenX%, HalfScreenX%), HalfScreenX%, _RGB32(0, 50, 0)
21. PAINT (HalfScreenX%, HalfScreenX%), _RGB32(0, 50, 0)
22. Ground& = MakeHardware&(TempImg&)
23.  
24. DIM Months$(12, 1), Days%(1)
25. DATA Jan,31,Feb,28,Mar,31,Apr,30,May,31,Jun,30,Jul,31,Aug,31,Sep,30,Oct,31,Nov,30,Dec,31
26. FOR N% = 1 TO 12
27.     FOR M% = 0 TO 1
28.         READ Months$(N%, M%)
29.     NEXT M%
30. NEXT N%
31. Days%(0) = VAL(LEFT$(DATE$, 2))
32. Days%(1) = VAL(MID$(DATE$, 4, 2))
33. IF Days%(0) = 2 AND Days%(1) = 29 THEN Days%(1) = 28
34. NoMins% = INT(TIMER) \ 60
35. Beta1! = (Twelve% - NoMins%) * Pi! / Twelve%
36. Beta2! = Beta1! - Pi!
37.  
38. SCREEN _NEWIMAGE(2 * HalfScreenX% + 1, 2 * HalfScreenY% + 1, 32)
39. _SCREENMOVE 50, 20
40. _DEST 0
41. _DISPLAYORDER _SOFTWARE , _HARDWARE
42.  
43. WHILE INKEY$ = ""
44.  
45.     _LIMIT 60
46.  
47.     Theta! = Beta1! - Beta2! - 3 * Pi! / 2
48.     IF Theta! < -3 * Pi! / 2 THEN
49.         Theta! = Theta! + 2 * Pi!
50.     ELSEIF Theta! > Pi! / 2 THEN
51.         Theta! = Theta! - 2 * Pi!
52.     END IF
53.  
54.     IF Beta1! > -Pi! / 2 AND Beta1! < Pi! / 2 THEN
55.         IF (Theta! < -3 * Pi! / 2 + Eclipse! AND Theta! > -3 * Pi! / 2) OR (Theta! < Pi! / 2 AND Theta! > Pi! / 2 - Eclipse!) THEN
56.             COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 10)
57.         ELSE
58.             COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 250 * (COS(Beta1!)) ^ 0.3)
59.         END IF
60.         CLS
61.     END IF
62.     IF Beta1! > -Pi! / 2 - Delta! AND Beta1! < Pi! / 2 + Delta! THEN
63.         X1% = CINT(HalfScreenX% * SIN(-Beta1!))
64.         Y1% = CINT(2 * HalfScreenY% * G! * COS(-Beta1!))
65.         _PUTIMAGE (HalfScreenX% + X1% - Radius%, 2 * HalfScreenY% + 1 - Y1% - Radius%), Sun&
66.     END IF
67.     IF Beta2! > -Pi! / 2 - Delta! AND Beta2! < Pi! / 2 + Delta! THEN
68.         TempImg& = _NEWIMAGE(2 * Radius% + 1, 2 * Radius% + 1, 32)
69.         _DEST TempImg&
70.         IF Theta! >= -Pi! / 2 THEN
71.             FOR N% = 0 TO 500
72.                 Phi! = N% * Pi! / 500
73.                 PSET (CINT(Radius% * SIN(Phi!) * SIN(-Pi! / 2)) + Radius%, CINT(Radius% * COS(Phi!)) + Radius%), _RGB32(40, 40, 20)
74.             NEXT N%
75.             FOR N% = 0 TO 500
76.                 Phi! = N% * Pi! / 500
77.                 PSET (CINT(Radius% * SIN(Phi!) * SIN(Theta!)) + Radius%, CINT(Radius% * COS(Phi!)) + Radius%), _RGB32(40, 40, 20)
78.             NEXT N%
79.             IF CINT(Radius% * SIN(Pi! / 2) * SIN(Theta!)) > -(Radius% - 1) THEN PAINT (1, Radius%), _RGB32(40, 40, 20)
80.             _SETALPHA 230, _RGB32(40, 40, 20)
81.         ELSE
82.             FOR N% = 0 TO 500
83.                 Phi! = N% * Pi! / 500
84.                 PSET (CINT(Radius% * SIN(Phi!) * SIN(Pi! / 2)) + Radius%, CINT(Radius% * COS(Phi!)) + Radius%), _RGB32(40, 40, 20)
85.             NEXT N%
86.             Theta2! = Theta! + Pi!
87.             FOR N% = 0 TO 500
88.                 Phi! = N% * Pi! / 500
89.                 PSET (CINT(Radius% * SIN(Phi!) * SIN(Theta2!)) + Radius%, CINT(Radius% * COS(Phi!)) + Radius%), _RGB32(40, 40, 20)
90.             NEXT N%
91.             IF CINT(Radius% * SIN(Pi! / 2) * SIN(Theta2!)) < (Radius% - 1) THEN PAINT (2 * Radius% - 1, Radius%), _RGB32(40, 40, 20)
92.             _SETALPHA 230, _RGB32(40, 40, 20)
93.         END IF
94.         Shadow& = MakeHardware&(TempImg&)
95.         _DEST 0
96.         X2% = CINT(HalfScreenX% * SIN(-Beta2!))
97.         Y2% = CINT(2 * HalfScreenY% * G! * COS(-Beta2!))
98.         _PUTIMAGE (HalfScreenX% + X2% - Radius%, 2 * HalfScreenY% + 1 - Y2% - Radius%), Moon&
99.         _PUTIMAGE (HalfScreenX% + X2% - Radius%, 2 * HalfScreenY% + 1 - Y2% - Radius%), Shadow&
100.         _FREEIMAGE Shadow&
101.     END IF
102.     _PUTIMAGE (0, (2 * HalfScreenY% + 1) * H!)-(2 * HalfScreenX% + 1, 2 * HalfScreenY% + 1), Ground&, , (0, 0)-(2 * HalfScreenX% + 1, HalfScreenX%)
103.     LOCATE 1, 1
104.     IF NoMins% \ 60 <= 9 THEN
105.         PRINT " 0" + RIGHT$(STR$(NoMins% \ 60), 1) + " "; NoMins% MOD 60;
106.     ELSE
107.         PRINT NoMins% \ 60; NoMins% MOD 60;
108.     END IF
109.     LOCATE 1, 130: PRINT Months$(Days%(0), 0) + " "; Days%(1);
110.  
111.     _DISPLAY
112.  
113.     NoMins% = NoMins% + MinsStep%%
114.     IF NoMins% >= 1440 THEN
115.         NoMins% = NoMins% - 1440
116.         Days%(1) = Days%(1) + 1
117.         IF Days%(1) > VAL(Months$(Days%(0), 1)) THEN
118.             Days%(1) = 1
119.             Days%(0) = Days%(0) + 1
120.             IF Days%(0) > 12 THEN Days%(0) = 1
121.         END IF
122.     END IF
123.     Beta1! = (Twelve% - NoMins%) * Pi! / Twelve% ' Sun
124.     IF Beta1! < -Pi! THEN Beta1! = Beta1! + 2 * Pi!
125.     Beta2! = Beta2! - (MinsStep%% * Pi! / Twelve%) + (2 * 0.0001593) 'Moon 27.39days - factor of 2???
126.     IF Beta2! < -Pi! THEN Beta2! = Beta2! + 2 * Pi!
127.  
128. WEND
129.  
130. SYSTEM
131.  
132. FUNCTION MakeHardware& (Img&)
133.     MakeHardware& = _COPYIMAGE(Img&, 33)
134.     _FREEIMAGE Img&
135. END FUNCTION
136.  

Title: Re: Phases of the Moon
Post by: johnno56 on February 25, 2019, 08:01:12 am

Very cool... Love the animations...

I can remember working out the moon's position on a calculator... 40 minutes of buttons and scribbling... just for one location... Then a further few minutes to calculate the phase... This is SO much quicker... Thank you.

Title: Re: Phases of the Moon
Post by: FellippeHeitor on February 25, 2019, 08:48:08 am

Fun to watch, Notley!

Title: Re: Phases of the Moon
Post by: Qwerkey on February 25, 2019, 10:51:33 am

Not half as much fun as it was to code, Heitor!

Title: Re: Phases of the Moon
Post by: Ashish on March 04, 2019, 09:41:22 am

It seems a very precise simulation. Impressive work, Qwerkey!

Text Only | Text with Attachments