# -*-Perl-*-

# phase of moon display, ripped off from xphoon
# instances allowed: multiple

package MGMmodule::phoon;
use POSIX;
use vars qw($xpm $PI);

$PI=3.14159265358979323846;  # assume not near black hole nor in Tennessee

# called once to initialize the module.  The xpath here is a Class.
sub module_init{
    my$this=shift;
    my$toplevel=$this->{"toplevel"};
    my$xclass=$this->{"xclass"};
    $toplevel->optionAdd("$xclass.order",               '.2',20);
    $this;
}

# called to build an instance.  The xpath here is a name path.
sub module_instance{
    my$this=shift;
    my$widget=$this->{"widget"};
    my$toplevel=$this->{"toplevel"};
    my$xpath=$this->{"xpath"};

    $toplevel->optionAdd("$xpath.relief", 'sunken' ,21);
    $toplevel->optionAdd("$xpath.ipad", 20 ,21);
    $toplevel->optionAdd("$xpath.borderwidth", 1 ,21);
    $toplevel->optionAdd("$xpath.scalewidadj", 150,21);
    $toplevel->optionAdd("$xpath.scalelenadj", 60,21);
    $toplevel->optionAdd("$xpath.scalejustify", 0,20);  #centered    

    $this->{"relief"}=$widget->optionGet("relief",'');
    my$border=$this->{"border"}=$widget->optionGet("borderwidth",'');
    $this->{"background"}=$widget->optionGet("background",'');
    $this->{"foreground"}=$widget->optionGet("foreground",'');

    # use our font and find the labelsize...
    my$testlabel=$this->{"widget"}->Label(-text=>"99 Mww",
					  -borderwidth=>0,
					  -padx=>1,-pady=>1);    
    my$textheight=$this->{"textheight"}=$testlabel->reqheight;
    my$textwidth=$this->{"textwidth"}=$testlabel->reqwidth;
    $testlabel->destroy;

    my$pad=$widget->optionGet("ipad","");
    my$minmoon=35+$pad/5;
    my$minx=(($textwidth<$minmoon?$minmoon:$textwidth)+$border*2);
    my$miny=$textheight+$minmoon+$border*2;

    $toplevel->optionAdd("$xpath.minx", $minx,21);      # safe
    $toplevel->optionAdd("$xpath.miny", $miny,21);      # safe

    $this;
}

sub module_run{
    my$this=shift;

    my$width=$this->{"width"};
    my$height=$this->{"height"};
    my$textwidth=$this->{"textwidth"};
    my$textheight=$this->{"textheight"};
    my$toplevel=$this->{"toplevel"};
    my$border=$this->{"border"};
    my$back=$this->{"background"};
    my$widget=$this->{"widget"}=$toplevel->Canvas(-class=>$this->{"name"},
						  Name=>$this->{"sequence"},
						  width=>$width-$border*2,
						  height=>$height-$border*2,
						  borderwidth=>$border,
						  highlightthickness=>0);
    my$pad=$widget->optionGet("ipad","");
    $height-=$textheight;
    my$square=$width;

    $square=$height if($square>$height);
    $square-=$border*2;
    $square*=(100-$pad)/100;
    $this->{"square"}=int($square);
    $this->{"time"}=-1;
    $this->{"day"}="un";

    # build the moon!
    $this->{"moonxpm"}=MGM::Xpm::data($xpm,'#000000');
    $this->{"moonxpm"}->scale($square,$square);
    my$darkdata=$this->{"moonxpm"}->write('#000','#888',16);
    $this->{"darkxpm"}=MGM::Xpm::data($darkdata);

    $this->module_update;
    $widget;
}


sub module_update{
    my$this=shift;
    my$t=time;
    my$widget=$this->{"widget"};
    my$square=$this->{"square"};
    if($t-$this->{"time"}>60*60){ # once an hour update
	my$jd = &jtime;

	my$angphase = &phase($jd);

	my$cap =cos($angphase);
	my$height=$this->{"moonxpm"}->height;
	my$localxpm=$this->{"moonxpm"}->copy;
	
	my$r=$square/2;
	for(my$i=0;$i<$square;$i++){
	    my$h=($i+.5)-$r;

	    my$x1 = -sqrt($r*$r-$h*$h);
	    my$x2 = -$x1;

	    if ( $angphase >= 0.0 && $angphase < $PI ){
		$x2 *= $cap;
	    }else{
		$x1 *= $cap;
	    }
	    $x1=floor($r+$x1);
	    $x2=ceil($r+$x2);
	    
	    $localxpm->merge($x1,$i,$this->{"darkxpm"},
			    $x1,$i,$x2-$x1+1,1);
	}

	# got an xpm.  Blow it into the widget.
	my$width=$this->{"width"};
	$height=$this->{"height"};
	my$textwidth=$this->{"textwidth"};
	my$textheight=$this->{"textheight"};
	
	my$localpm=$widget->
	    Pixmap($widget->PathName.".moon",-data=>$localxpm->
		   write($this->{"background"},$this->{"foreground"},16));
	
	$widget->delete("moon");
	$widget->createImage($width/2-1,($height-$textheight)/2-1,
			     -image=>$localpm,-anchor=>'center',
			     -tags=>['moon']);

	$this->{"time"}=$t;
    }
    # date
    if($this->{"day"} ne (localtime)[7]){	
	$widget->delete("date");
	my$date=localtime;
	$date=~s/\S+\s+(\S+)\s+(\d+)\s+\S+\s+(\d+)/$2 $1/;

	my$width=$this->{"width"};
	my$height=$this->{"height"};
	my$textwidth=$this->{"textwidth"};
	my$textheight=$this->{"textheight"};
	my$font=$widget->optionGet("font","");
	
	my$y=$height-($height-$textheight+$square)/2;
	my$x=int(($width-$textwidth)/2+.5);
	
	$widget->createText($width/2-1,$height-$y/2-1,-text=>"$date",
			    -fill=>$this->{"foreground"},-anchor=>'center',
			    -font=>$font,-tags=>['date']);
	
	$this->{"day"}=(localtime)[7];
	
    }
}

# from xphoon by Jef Poskanzer and Craig Leres.
# and pom.c (unknown)

# xphoon gets the julian date wrong.  If I'm in PDT, tz will
# negative because I lag GMT, and I want to *add* to my time to get
# UTC. Also, DST is already applied; correcting for it again is a
# screwup.  Avoid it all!  Use UTC.

# for the record: Julian day zero began at noon UTC BC 4713.  The
# Julian date measures days since then.  The day begins at noon UTC
# (thus the -.5 below).

# accurate to within about 20 minutes.

sub jtime{
    my@gmt=gmtime time;
    &jdate(@gmt)-0.5+ ($gmt[0] + 60 * ($gmt[1] + 60 * $gmt[2])) / 86400.0;
}

# jdate - convert internal GMT date and time to Julian day and fraction 

sub jdate{
    my(@t)=@_;
    my($c, $m, $y);
    
    $y = $t[5]+1900;
    $m = $t[4] + 1;
    if ($m > 2){
	$m -= 3;
    }else {
	$m += 9;
	$y--;
    }
    $c = int($y / 100);
    $y -= 100 * $c;
    $t[3]+int($c*146097/4) + int($y*1461/4) + int(($m*153+2)/5) + 1721119;
}

# Handy mathematical functions. 

sub fixangle{
    my$a=shift;
    $a - 360.0 * (floor($a / 360.0));
}

sub torad{
    my$d=shift;
    $d*$PI/180.0;
}

sub todeg{
    my$d=shift;
    $d*180.0/$PI;
}

# phase - calculate phase of moon as a fraction:
#
#      The argument is the time for which the phase is requested,
#      expressed as a Julian date and fraction.
sub phase{

    my$epoch=2446065.5;      # 1985 January 0.0 */
    my$EPSILONg=279.611371;  # solar ecliptic long at EPOCH 
    my$RHOg=282.680403;      # solar ecliptic long of perigee at EPOCH 
    my$ECCEN=0.01671542;     # solar orbit eccentricity 
    my$lzero=18.251907;      # lunar mean long at EPOCH 
    my$Pzero=192.917585;     # lunar mean long of perigee at EPOCH
    my$Nzero=55.204723;      # lunar mean long of node at EPOCH 

    my($pdate)=@_;

    # Calculation of the Sun's position. 
    
    my$Day = $pdate - $epoch;                    # date within epoch 
    my$N = &fixangle((360 / 365.2422) * $Day);   # mean anomaly of the Sun 
    my$M = &fixangle($N + $EPSILONg - $RHOg);    # convert from perigee
                                                 # co-ordinates to epoch 1980.0
    my$Ec=360.0/$PI*$ECCEN*sin(&torad($M));
    my$Lambdasun = &fixangle($N+ $Ec + $EPSILONg);  # Sun's geocentric ecliptic
                                                    # longitude 
    # Moon's mean longitude. 
    my$ml = &fixangle(13.1763966 * $Day + $lzero);

    # Moon's mean anomaly. 
    my$MM = &fixangle($ml - 0.1114041 * $Day - $Pzero);

    # Evection. 
    my$Ev = 1.2739 * sin(&torad(2 * ($ml - $Lambdasun) - $MM));
    
    # Annual equation. 
    my$Ae = 0.1858 * sin(&torad($M));

    # Correction term. 
    my$A3 = 0.37 * sin(&torad($M));
    
    # Corrected anomaly. 
    my$MmP = $MM + $Ev - $Ae - $A3;

    # Correction for the equation of the centre. 
    my$mEc = 6.2886 * sin(&torad($MmP));

    # Another correction term. 
    my$A4 = 0.214 * sin(&torad(2 * $MmP));

    # Corrected longitude. 
    my$lP = $ml + $Ev + $mEc - $Ae + $A4;

    # Variation. 
    my$V = 0.6583 * sin(&torad(2 * ($lP - $Lambdasun)));

    # True longitude. 
    my$lPP = $lP + $V;

    # Age of the Moon in degrees. 
    my$MoonAge = $lPP - $Lambdasun;

    &torad(&fixangle($MoonAge));
}

sub kepler{
    my($m, $ecc)=@_;
    my($e, $delta);

    $e = $m = &torad($m);
    do {
	$delta = $e - $ecc * sin($e) - $m;
	$e -= $delta / (1 - $ecc * cos($e));
    } while (abs($delta) > .000001);
    $e;
}

$xpm= <<'EOXPM';
/* XPM */
static char * moon_xpm[] = {
"71 71 16 1",
".	c #020204",
"+	c #8C8C8C",
"@	c #C9C9CA",
"#	c #464644",
"$	c #A6A6A5",
"%	c #E7E7E7",
"&	c #6D6D6C",
"*	c #1E1E1C",
"=	c #969697",
"-	c #DADADA",
";	c #B6B6B5",
">	c #F7F7F7",
",	c #5A5A5C",
"'	c #7D7D7C",
")	c #141414",
"!	c #2E2E2C",
".............................!#&'$$$==',#*)............................",
".........................!&=;@;$$$;@$;@;-%-$'#)........................",
"......................*,$$=='''=''''&&===$$$;@;+#......................",
"....................!,'&&'='==$==''&'&&&&'==$$@@@;,*...................",
"..................*,&&&&'=$$$=$===$$$=='&&'''=$$;@@@&..................",
".................#,,,&==$=''&='''&'='+==$&&++++$=;@@--,................",
"...............*,,,,,'''=&,&,,,&&&''''$;@=++=+''''+=@%%=*..............",
"..............#,,,,,''''&,,,,,,&&&&''''$;;$===$$+'''+;%%$!.............",
".............#,,,,,&'&&,,,,,,,&&&&&'&''=$;;$$=$$++'''+;---,............",
"...........*#,,#,,,,&,,,&,,,,&&&''&&''==$;;$;;;;;$==+=$$;@@,...........",
"..........*,#,,,,,,&,,&&&&&,,&&&''&''=$=$;;;@;@;;$++=;$$$$@-,..........",
".........*###,,&&&&&&&&&,,,&,&&&&&&''====$;@@$;;$$+$==;;;;;@@,.........",
"........*,###,&&&&&&&&&&&&&&&&&&'&&''=$==$@;;$;;$=+$;====@@=@-,........",
"........####,'=&&&&&&&,&'&&&'&&'&&''==$='=@$'&'$$===$$$==;@$=@@#.......",
".......!,##,&==&&&,,,&&&&&&&&&='''===$$$=$='''''=$===$++;;@;$$@;*......",
"......*,,##,&&&&&,&&&=&&'''&''='=$$$==$$==''&'''''''=='';;;;;;$@$......",
"......#####,,,&&,&&&''''&''''''''$$$='';;=''''''''''$;'=$;;;;@;;-&.....",
".....!#####,,,&'&&&&&''''+''''''''$$$=$;$'''''''''''$@$$$;-@;@@@@-!....",
"....*######,,,&'&,&'''+''''''''''&';;@;;$&&''''''''&'$;;@@@@;@@@;@+....",
"....#######,,&&'&&'+;$=++++++'='''$;@@;$=&'&'''''''&&=;@@@@-@@@-;;@#...",
"...*,####,,,,&'''&'+=+=====$$$$=;;;;;$$=''''''='''''&=@-@@@@-@@@;;@=...",
"...,,####,,,,&==','=;==$$$=;$$+=$$;;$=$===='''='''''&=;--@@;>@@@;$@@*..",
"..*',#,,,,,,&=$=''+===$-;===$$+===$='======='''''''''$;@@@@@@@@;@;@-&..",
"..#',#,,,,,&'$;$''''==;%-====++='&'==='';@$=;$'''''''$;;$@@$;;@;@@@-@*.",
"..&=,##,,,,,'=$''+++=========$'=''==''''+@++$@$$=''''$;$+@-;;;;@;;@@%!.",
".*'=,##,,,,,''=&''+====+=++=$+'=$;;;$''&+++$;$$''='''=$+++@-@@;$++;@-+.",
".!='###,,,,,'''''''+====+''++&'=;@;@;$+'++;;@+'&'&''''=+''$---$'+'$;-@.",
".#=&###,,,,,&&'&'=++$;=++++=+&'=;@;@@;;$=;-@;+'''''''''''';@>%$''''$@>!",
".,=&###,,,,,,&&&&'++$$;;+'++++++$;@;-%;;@@@-;+&'''==''&'&';;-%;'''&=@>,",
".&'',#,&,,,&,,&'''=++++;=++++==+$$;@---%%%--;+''''''''''&&$;@%$'&'&';-&",
".&,',#,,,,,,&&&''=''''+===++=;@;$+=@--@>>>-@;+++++''''''''&+;%@''&&&@-'",
"*&&=,##,,,,&&&'&=='''$$;$=$$$$;@==;-%%>>>>%;-=+++'''''''''$+$--+'&&$@@=",
"!'''&,,,,,,&&&'';$''=$;==+=%%;%;;@@-%%%-%%%@;$+'+++''''''+$$+--;'&'@@;=",
"!'''&,&,,,&&&&&=$=&'==;;=++@-@@@@--@%%------@==+++'+='==''+$+$@@;;;@@;'",
"!''=','&&&''&&&'$'&'''$@='+$@;@%%-@@%--------%;=++++=;=''++;;+;@;;;;;@=",
"!''++''&''+=&&&'''&'''=;='+=;@@@@@%--%-----%%>%%$=++;>;''+;++'+@@;$=$@=",
"!'''++&''+$$'&&&''''''=;;=+$;%-;@%%-%>>%%--%>>%%;++;>--@$$++''&;@;;'=@$",
"*&'+'+'''+$+''&&'$@==$=$;'+;@---@-@@->%%%%%>>>-$===@-@-@@='=''&'$;;=$-$",
"*&'++''+==$$&''&'$;''===='$$=-----@@%%-%%-%%>%@$$$$--@@@;'=='''&'$$$;-$",
"*'+++'++;'&&,&===$=''=====+;$----%%%---%%>>%>>@;;$$---@@@===''''==';$@'",
".&$==++++&,,,&$$=$=====+++'$@--%--%%--%%%>%%>%%%@$;-->>@$$=='''==$$$$;,",
".,+;====+&,&,&$===$;=+''+++---%%%%%%-%%-%>%-%>>>@@;@-%>-$===''===;;$;$!",
".#';===+=&&&,,'='==$+++'++=-%-%%->>-%>%%---%%>>%--@=$@>>@$'''====;;;;=*",
".!'+++$$+&&&&&'=='$+''+'++$;%%--@%%-@-----%%%>>>-;$==;->@;=''==;;$$;;=*",
".*&'++=$=+'&&'$=$'=+'''''+=$@-@--@-@@----%%-%>>>@$==;;--@$===$;--;$;;=.",
"..,'++=$$=+&'+;$=++$+'''++=;-@@-%-@---%%%%%-%%>%;$===@%-@@;$==;-@;;;;,.",
"..!&'++;@;+++$;'+;;@======$@-@->-@-%%%%>%---%%%%@$==+-%@@@@;=$$;;;@@;!.",
"..*&'''+==+$$$+'++$--;$=;@@%%%>>%-%>>>%%----%%%%-$$=+-@;@;@$=$;;;;;@$..",
"...,''++=='+$$$'$+=->@;;-%%>-->>>%%>>%%%-@-%>>>-@;@@;;@;@$$$$;$;;$;-,..",
"...*&'+++++'$$$;$;@@-%@--%%%>>%%>%%---%%%>%>>>-@@-%%$;-;@++;;$$;$;@@*..",
"....,''+++++$;;;;;@@;%--%%>>>>-%>%%-@@%%>>>%%%%>%%@;@@;@@+=--;$$$@@=...",
"....!'++'+$$$;;;$$-@;@--%>>>>%%>>%-%%%%>>%-%%%>>%@@@-@%@-$@-@$;;;--!...",
".....,'+&'++$;;;@@;@@--->%>>>%%%%->>>>>>%%>>%-%%@@@@@--%@;@-;;;;@-'....",
".....*&'''+++$;;;;@@@%-@--%>>>>%%%>>%-%%%>>>----%-@@@----;@-@;;;@;*....",
"......#''++++$$;;;;@@@-->--%>%>>>>%%-%%---------%-@@@-%%-@@-@;;;@#.....",
".......&''+='++$@;;@-%--%@-%%>>%>>%%%%%>--------%@@@@%>%-@@;@;;@'......",
".......*'''=='+$;;;$$;%%--->%%>>>%%%>>>>>>>>%--%@@@--%%%%@@-;;-$.......",
"........!&'=='+$$;=@@@@%>%%>>>>%%%-->-->--------;;;@--%>-@@;=@@*.......",
".........!&==+'$$$;;--;>>%%>>>%%%--@-----@@--%%-@@@---@;;;$@@@!........",
"..........#'=$$+$$=;@@@%%%%%-%>%%%%--@--->>---%%%@-@;@;;;$@@;!.........",
"...........#'=$$;$$;@;-%---%-%%%------@@->>--%%%-@;$$;$;;$@+!..........",
"............#=$;$$$;;@@%--%-------@------@--%>%-@;$$$$$$;==!...........",
".............!==$$;;;@;-%%-@-----@-----------@@;;;;;$;==='*............",
"..............!&=$;$$;@--%-@@@------@-@@----@@@@@-@;;=+$&..............",
"...............*,=;;$;;@---@--@-@@@@@@@@-@;@;;;@;;=$+$+#...............",
".................*,$$;;$@@-@@@@--@@@@@@@;@@@;;;$+++++&*................",
"...................!&$;;@@@@@@@-@@@@@@@@@@@@@@;;'=$&*..................",
".....................*#=;@;------@@@@@@--@@;;@;$$&*....................",
"........................!&=;@>>---@@@@@@@@@;$=,!.......................",
"...........................!,&=$;;;;;;$$$=&#*..........................",
".................................*!!#!*................................"};
EOXPM

bless {};