[kansaipm] Re: 猫集会のお願い

[mishima at momo.so-net.ne.jp]

三嶋です。

From: Nagayoshi_Michio <cudjo at venus.dti.ne.jp>
Subject: [kansaipm] 猫集会のお願い
Date: Sun, 16 Jul 2000 11:35:21 +0900

> ＣＵＤＪＯ＠京都です。
> 
> 昨日は早々に退散してしまい、申し訳ありませんでした m(_ _)m。
> 漏れ聞くところによると、例のカレンダーの曜日が狂うのは
> デバッグできたとのことですが、できれば完成版(?)を公開して
> くださいね。

昨日は（おっと、もうおとといか）お疲れ様でした。
たった１時間で、Perl/Tk の Hello, World! から年間カレンダーの
表示まで、無理なくステップアップしていく構成がすばらしかった
です。

曜日が狂うバグは、sub juldate の中でループを回して sub maxDay を
呼び出すところにありました。

    for ( my $i = 1; $i < $month; $i++ ){
	$ans += maxDay($year,$i);	# ← $i が $month になってたの
    }

直しましたので、完成版を添付しておきます。

> ＃「自作の別ソース内関数の呼び出し」は、おまじないが多すぎて
> ＃理解できていない (;_;)。

実は私も、わかっていたつもりでわかってないことがありました。
package 宣言がなければ、名前空間はメインと同じものが使われます。
そのため、MyDate 内で package 宣言をなくせば、パッケージ内の名前を
外に見せる(export)ためのおまじないも不要になります。

#package MyDate;	# 変数名や関数名を、新しい名前空間に保持する。
#require Exporter;	# 名前空間の外に変数名や関数名を見せるためのおまじない
#@ISA = qw(Exporter);	# （同上）
#@EXPORT = qw(from_1_1_1 juldate leapYear weekday maxDay); # （同上）

↑ここらへんのおまじないは、まとめてコメントアウトしました。

> ともあれ、第2回猫集会も期待しています。よろしく。
-------------- next part --------------
#!/usr/local/bin/perl -w

use Tk;
use strict;
use FindBin;
use lib $FindBin::Bin;
use MyDate;

my $mw = new MainWindow;
my($y) = (localtime)[5];	# デフォルトは今月
$y += 1900;		# localtime が返す年は「西暦−１９００」なので注意
if( @ARGV == 1 ){	# 引数があれば、年をとる
    ($y) = @ARGV;
}
my $c = 0;
my $r = 0;
for my $m (1..12){
    my $fr = $mw->Frame;
    $fr->grid(-row=>$r, -column=>$c,
	      -sticky=>'n',
	      -padx=>10, -pady=>10);
    if( ++$c >= 3 ){
	$r ++;
	$c = 0;
    }
    dispMonth($fr,$y,$m);
}
MainLoop;

##
## 月の表示
##
sub dispMonth {
    my( $parent, $y, $m ) = @_;
    my( $maxD ) = maxDay($y,$m);
    my $r = 0;				# 最初は０行目
    my $c = weekday( $y, $m, 1 );	# 月曜が０列目として、１日の列から
    my $color;
    for ( my $d = 1; $d <= $maxD; $d++, $c++ ) {
	if ( $c >= 7 ) {		# 最後の列を超えるようなら
	    $r++;			# 次の行へ行って
	    $c = 0;			# 最初の列に戻る
	}
	if( $c == 0 ){
	    $color = 'red';
	}elsif( $c == 6 ){
	    $color = 'blue';
	}else{
	    $color = 'black';
	}
	my $label = $parent->Label(-text=>$d,
				   -foreground=>$color);
	$label->grid(-row => $r, -column => $c);
    }
}

-------------- next part --------------
#package MyDate;
#require Exporter;
#@ISA = qw(Exporter);
#@EXPORT = qw(from_1_1_1 juldate leapYear weekday maxDay);
use strict;
use integer;

##
## 指定された年月日に対して、西暦１年１月１日から数えた日数を返す
##
sub from_1_1_1 {
    my( $year, $month, $day ) = @_;
    my $lastyear = $year - 1;
    my $ans = 365 * $lastyear
        + $lastyear / 4
	- $lastyear / 100
	+ $lastyear / 400		# ここまでが昨年末までの日数
	+ juldate($year, $month, $day);	# 今年に入ってから今日までの日数

    return $ans;
}

##
## 指定された年月日に対して、１月１日から数えた日数を返す
##
sub juldate {
    my( $year, $month, $day ) = @_;
    # 今月初めから今日までの日数
    my $ans = $day;
    # 先月末までの日数を加算
    for ( my $i = 1; $i < $month; $i++ ){
	$ans += maxDay($year,$i);
    }
    return $ans;
}

##
## 指定された年が閏年なら True を返す
##
sub leapYear {
    my($year) = @_;
    return( $year % 400 == 0 or
	    $year % 4   == 0 && $year % 100 != 0 );
}

##
## 指定された年月日の曜日を返す（日＝０〜土＝６）
##
sub weekday {
    my( $y, $m, $d ) = @_;
    my $jd = from_1_1_1( $y, $m, $d );

    return ( $jd % 7 );	# ７で割った余りを返す
}

##
## 指定された年月の日数を返す
##
sub maxDay {
    my($y,$m) = @_;
    my @maxTbl = (0,
		  31, 28, 31, 30, 31, 30,
		  31, 31, 30, 31, 30, 31);
    my $ans = $maxTbl[$m];
    if( $m == 2 and leapYear($y) ){
	$ans ++;
    }
    return $ans;
}

1;