package sspd;
#------------------------------------
# 人工無脳『精霊石』試作D型 ver 2.23
#

#--------------------------- ユーザ定義 -----------------------------

$Name        = 'muno';				# 人工無脳の名前
$DictFile[0] = 'muno1.dic';			# プライマリ辞書のパス
$DictFile[1] = 'muno2.dic';			# セカンダリ辞書のパス
$UListFile   = 'users.txt';			# ユーザ情報ファイルのパス
$VCondInterv = 10;					# 仮想体調変動周期 /日
$VClimInterv = 2;					# 仮想天候変動周期 /日
$Birthtime   = 976107537;			# 誕生日(シリアル値)
$MaxUsers    = 128;					# ユーザ最大登録数
$FeelLong    = 20000;				#「久しぶり」の閾値
$FeelSoon    = 3600;				#「すぐ」の閾値
$NotFoundLog = 'notfound.txt';		# notfoundログのパス
$UName       = "anonym";			# 現在の話し相手

#--------------------------------------------------------------------


$Queue[0] ="";
$Queue[1] ="";
$PrevInput="";
$PrevKey  ="";
@Dict[0]  =();
@Dict[1]  =();
$Message  =	"";

sub _load()
{
	return if(@Dict[0]);
	for $i (0..1) {
		open(DICT,$DictFile[$i]) or die ("$DictFile[$i] not found");

		while(<DICT>) {
			/^([^ ]+) ([^\n]+)/ && do{ $Dict[$i]{($1)}=($2); };
		}
		
		close DICT;
	}
}


sub reply($)
{
	my $input=shift;
	@LocalTime=localtime(time);
	
	&_load;
	return &_expand('$DONT_REPEAT$') if $PrevInput eq $input;
	$PrevInput=$input;
	for $Priority (0..1) {
		if($Queue[$Priority]) {
			my $q=$Queue[$Priority];
			$Queue[$Priority]="";
			return  &_expand($q);
		}
	
		foreach $key (keys %{$Dict[$Priority]}) {
			if($input =~ /$key/) {
				$PrevKey=$key;
				return &_expand($key);
			}
		}
	}
	
	return "" unless($input);
	open(NFL,">> $NotFoundLog") or die("$NotFoundLog not found");
	print (NFL "$input\n");
	close NFL;
	$Priority=1;
	return &_expand ('$NOT_FOUND$');
}

sub logout($)
{
	my $name=shift;
	open(USERS, "+<$UListFile") or die "cannot open users info";
	my @users=<USERS>;
	for($i=0 ; $i<$#users ; $i++)
	{
		if(index($users[$i],$name)==0) {
			@userinfo=split(/,/,substr($users[$i],length $name));
			splice(@users,$i,1);
			last;
		}
	}
	my $t=time;
	my $c=$userinfo[1]+1;
	unshift(@users,"$name $t,$c\n");
	splice(@users,$MaxUsers);
	seek(USERS,0,0);
	print USERS @users;
	truncate(USERS,tell(USERS));
	close USERS;
}

sub _expand($)
{
	my $key=shift;
	my $s=$Dict[0]{$key};
	if($s eq ""){ $s=$Dict[1]{$key}}
	my @value=split(/,/, $s);
	my $str=$value[rand(@value)];

	$str =~ s/\%uname\%/$UName/g;
	$str =~ s/\%name\%/$Name/g;
	$str =~ s/\%sec\%/$LocalTime[0]/g;
	$str =~ s/\%min\%/$LocalTime[1]/g;
	$str =~ s/\%hour\%/$LocalTime[2]/g;
	$str =~ s/\%date\%/$LocalTime[3]/g;
	$str =~ s/\%month\%/$LocalTime[4]/g;
	$str =~ s/\%year\%/$LocalTime[5]/g;
	$str =~ s/\%day\%/$LocalTime[6]/g;
	$str =~ s/\%prevkey\%/$PrevKey/g;
	
	$str =~ s/\%season\%/   &get_season  /eg;
	$str =~ s/\%zone\%/     &get_zone     /eg;
	$str =~ s/\%vcond\%/    &get_vcond    /eg;
	$str =~ s/\%vclim\%/    &get_vclim    /eg;
	$str =~ s/\%birthday\%/ &get_birthday /eg;
	$str =~ s/\%age\%/      &get_age      /eg;
	$str =~ s/\%freq\%/     &get_freq     /eg;
	
	$str =~ s/\%queue ([^\n]+)\%/  &_queue($1) /ge;
	$str =~ s/\%dequeue\%/         &_dequeue  /ge;
	$str =~ s/\%post ([^\n\% ]+)\%/ &_post($1) /ge;
	$str =~ s/\%pushw ([^\n\% ]+)\%/ &_pushw($1) /ge;
	$str =~ s/\%peekw\%/ &_peekw /ge;
	$str =~ s/\%popw\% / &popw /ge;
	$str =~ s/(\$[^ \$]+\$)/ &_expand($1) /ge;

	return $str;
}

sub get_season { 
	my $m=$LocalTime[4];
	($m>=3)+($m>=6)+($m>=9)-3*($m==12);
}

sub get_zone {
	my $h=$LocalTime[2];
	($h>=7)+($h>=10)+($h>=11)+($h>=14)+($h>=19)-5*($h>=22);
}

sub get_vcond { int(2*sin(2*3.14159*time/($VCondInterv*60*60*24))+3.5); }

sub get_vclim { int(2*sin(2*3.14159*time/($VWeather*60*60*24))+3.5); }

sub get_birthday {
	my @bd=localtime $Birthtime;
	"$bd[4]/$bd[2]";
}

sub get_age { sprintf("%3.2f",(time-$Birthtime)/(365.25*24*60*60))	}

sub get_freq {
	open(USERS, $UListFile) or die "cannot open $UListFile info";
	while(<USERS>){
		/^$UName ([^\n]+)/ && do{
			close USERS;
			@Users=split(/,/,($1));
			#simplified fussy ↓
			my $fsoon =$FeelSoon+rand($FeelSoon*.1)-$FeelSoon*.05;
			return 3 if $Users[0]<$fsoon;
			my $flong =$FeelLong+rand($FeelLong*.1)-$FeelLong*.05;
			return 1 if $Users[0]>$flong;
			return 2;
		}
	}
	close USERS;
	return 0;
}


sub _queue($)
{
	$Queue[$Priority]=shift;
	return "";
}

sub _dequeue()
{
	$Queue[0]="";
	$Queue[1]="";
	return "";
}

sub _post($)
{
	$Message=shift;
	return "";
}

sub _pushw($)
{
	my $word=shift;
	push @Wordstack,$word;
	return $word;
}

sub _peekw() { $Workstack[$#Wordstack]; }

sub _popw() { pop @Wordstack; }

1;
__END__;

=head 1 NAME

sspd - Spiritstone Prototype D

=head 2 関数

reply


=head 2 展開される環境変数

%year%,%month%,%date%,%day%
%season%
%hour%,%min%,%sec%
%zone%
%vweather%
%vcond%
%birthday%
%age%
%prevkey%
%freq%	0:新顔 1:久々 2:普通 3:頻繁

=head2 ディレクティブ

%queue <string>% 
%dequeue%
%post <message>%

=head 2 辞書の予約語

$NOT_FOUND$	辞書にヒットしなかったときに使用
$HELLO$ 挨拶

=head 2 ユーザ情報

@userinfo=(
	$lastaccess,  # 最後にログアウトした日
);

=cut