Version 6 of moon phase
Updated 2005-03-21 17:00:56 by lwvRichard Suchenwirth 2004-09-13 - http://www.faqs.org/faqs/astronomy/faq/part3/ (item C.11) describes John Horton Conway's approximation for the moon phase of a given date. Here it is in Tcl:
proc moonphase date {
set y [clock format $date -format %Y]
set delta [expr {$y/100==19? 4: 8.3}]
scan [clock format $date -format %m] %d m
set m [expr {$m==1? 3: $m==2? 4: $m}]
scan [clock format $date -format %d] %d d
set t [expr ($y%100)%19]
if {$t>9} {incr t -19}
expr {(round(($t*11)%30+$m+$d-$delta)%30)}
}Testing:
% moonphase [clock scan "June 6, 1944"] 14
which matches the FAQ's example and stands for (almost) full moon.
Fred Limouzin - 2005-03-21: Here's a little week-end project related to the above. It's still a draft, but it's getting there! It simply displays the moon phase in a canvas, based on a percentage value representing the progression within a full moon cycle. 0% is a new Moon, 50% a full Moon, 100% is the next new Moon (in fact 100% is clamped back to 0, etc.).
I was going to create a new page, but after a quick search on wiki, I found out about this page, so I'm gonna append to it! It's probably easy enough to merge both posts, although I intend to eventually add the big equation needed to calculate the appropriate precentage value in function of the location (latitude/longitude coordinates), and the date/day/time.
Here's a screeshot:
You'll also need the background image (in fact the most important part! ;-)):
The code and images can also be found at http://dire.straits.free.fr/vertigo ([L1 ]).
#!/bin/sh
# Frederic Limouzin ; Copyrights (c)2005 - all rights reserved \
exec tclsh "$0" ${1+"$@"}
package require Tk
set ::OFFSET 99
set ::RADIUS 100
set ::STEPY 2
####################################################
# ellipse-shaped Mask
# x^2/a^2 + y^2/b^2 = 1
####################################################
proc ElipseMask {rx1 rx2 ry clr} {
if {$ry == 0} { return 0 }
set lst [list]
foreach rx [list $rx1 $rx2] rysign {1.0 -1.0} {
if {$rx < 0} {
set rxsign -1.0
set rx [expr {abs($rx)}]
} else {
set rxsign 1.0
}
for {set y -$ry} {$y <= $ry} {incr y $::STEPY} {
set t [expr {1.0 - ((1.0 * $y * $y) / (1.0 * $ry * $ry))}]
set x [expr {round(1.0 * $rx * sqrt($t))}]
lappend lst [expr {round(($rxsign * $x) + $::OFFSET)}]
lappend lst [expr {round(($rysign * $y) + $::OFFSET)}]
}
}
return [.c create polygon $lst -fill $clr -outline $clr]
}
####################################################
# p in percent of a full cycle within [0.0;100.0]
# 0% and 100% : new moon; 50% full moon; etc.
####################################################
proc ElipsePhase {p} {
while {$p >= 100.0} {
set p [expr {1.0 * ($p - 100.0)}]
}
set phasesLst { {New Moon} {Waxing Crescent} {First Quarter} \
{Waxing Gibbous} {Full Moon} {Waning Gibbous} \
{Last Quarter} {Waning Crescent} }
set phase [lindex $phasesLst [expr {int(8.0 * $p / 100.0)}]]
set quadrant [expr {int(1.0 * $p / 25.0)}]
set mod [expr {(1.0 * $p) - (25.0 * $quadrant)}]
if {$quadrant == 3} {
set rx1 [expr {-1.0 * (4.0 * $mod)}]
} elseif {$quadrant == 2} {
set rx1 [expr {100.0 - (4.0 * $mod)}]
} else {
set rx1 -$::RADIUS
}
if {$quadrant == 0} {
set rx2 [expr {100.0 - (4.0 * $mod)}]
} elseif {$quadrant == 1} {
set rx2 [expr {-1.0 * (4.0 * $mod)}]
} else {
set rx2 $::RADIUS
}
return [list $rx1 $rx2 $phase]
}
####################################################
set phaselbl {}
canvas .c -width [expr {2 * $::RADIUS}] \
-height [expr {2 * $::RADIUS}] -background black
label .l -textvariable phaselbl
pack .c -side top
pack .l -side bottom
# Full moon image as the 'background'
set fname [file join [file dirname [info script]] moon.gif]
set img [image create photo -file $fname]
.c create image 0 0 -image $img -anchor nw
set ry $::RADIUS
set co #111111
####################################################
#Example1
# 1 full cycle from new to next new moon
for {set pc 0} {$pc <= 100} {incr pc} {
foreach {rx1 rx2 phaselbl} [ElipsePhase $pc] {break;#} ;#assign
set obj [ElipseMask $rx1 $rx2 $ry $co]
update
after 100
.c delete $obj
}
#Example2
after 1000
set pc 64.0
foreach {rx1 rx2 phaselbl} [ElipsePhase $pc] {break;#} ;#assign
set obj [ElipseMask $rx1 $rx2 $ry $co]
update
;#.c delete $obj ;# must remove the mask if you need another example
#### TODO
# Calculate the 'pc' phase in function of the date/day ([clock])
# the latitude/longitude, etc...Of couse the best part remains to be added (i.e. the actual equation based on date/time and location), which will be done when I get some time!
Cheers,
--Fred