###RUN_PERL: #!/usr/bin/perl

# /bsta/2words
# 2words is generated from 2words.1.pl.
#
# The wordgame interface
#
# Copyright (C) 2016, 2017, 2023, 2024  Balthasar Szczepański
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use utf8;
# use Encode::Locale ('decode_argv');
use Encode ('encode', 'decode');

###PERL_LIB: use lib /botm/lib/bsta
use botm_common (
	'HTTP_STATUS',
	'fail_method', 'fail_content_type',
	'http_header_status', 'http_header_allow',
	'merge_url',
	'read_header_env',
	'html_entity_encode_dec',
	'url_query_decode', 'url_query_encode',
	'open_encoded'
);
use bsta_lib (
	'STATE', 'INTF_STATE',
	'get_id',
	'print_html_start', 'print_html_end',
	'print_html_head_start', 'print_html_head_end',
	'print_html_body_start', 'print_html_body_end',
	'write_index',
	'get_remote_addr', 'get_password',
	'merge_settings',
	'ong',
	'read_story', 'write_story',
	'read_settings', 'read_state'
);

###PERL_CGI_PATH:           CGI_PATH           = /bsta/
###PERL_CGI_2WORDS_PATH:    CGI_2WORDS_PATH    = /bsta/2words

###PERL_DATA_STORY_PATH:    DATA_STORY_PATH    = /botm/data/bsta/story

###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon

###PERL_STORY_LENGTH:       STORY_LENGTH       = 16
###PERL_PAGE_LENGTH:        PAGE_LENGTH        = 16
###PERL_FIRSTPAGE_LENGTH:   FIRSTPAGE_LENGTH   = 4

binmode STDIN,  ':encoding(UTF-8)';
binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';
# decode_argv();

my %http;
my %cgi;
my %story;
my %new_story;
my %settings;
my %state;

my $time = time();
srand ($time-$$);

my $method;
my $IP;
my $words;
my $color2;
my $last_IP;
my $story_id;
my $turn;
my $status;
my $allow;
my $message;
my $first_letter;
my $second_letter;
my $last_letter;
my $intf_state;
my $intf_pass;
my $intf_pause;
my $intf_mode;
my $fh;
my $story_lock;
my @story_lines;
my $ong_state;
my $page;
my $password;
my $password_ok;


delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;

if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
	$method = $1;
}
else {
	exit fail_method($ENV{'REQUEST_METHOD'}, ['GET','POST', 'HEAD']);
}

%http = read_header_env(\%ENV);
%cgi = url_query_decode($ENV{'QUERY_STRING'});

if ($method eq 'POST') {
	if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
		my %cgi_post = url_query_decode( <STDIN> );
		%cgi = merge_settings(\%cgi, \%cgi_post);
	}
	# multipart not supported
	else{
		exit fail_content_type($method, $http{'content-type'});
	}
}

$IP = get_remote_addr();
$page = get_id(\%cgi);
$password = get_password(\%cgi);
if ($cgi{'words'} ne '') {
	$words = $cgi{'words'};
}

%settings = read_settings();
%state    = read_state();
$ong_state = int($state{'state'});

$password_ok = ($password eq $settings{'password'});
if ($password_ok) {
	$IP .= ' OK';
}

$story_lock=0;
if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) {
	$story_lock=1;
	if (flock($fh,2)) {
		$story_lock=2;
	}
	%story = read_story($fh);
	
	if ($story{'lastip'} =~ /^.+$/) {
		$last_IP=$&;
	}
	else {
		$last_IP='0.0.0.0';
	}
	
	$last_letter = lc($story{'letter'});
	$story_id   = int($story{'id'});
	$intf_pass  = int($story{'pass'});
	$intf_state = int($story{'state'});
	$intf_mode  = $intf_state & INTF_STATE->{'mode'};
	$intf_pause = $intf_state & INTF_STATE->{'||'};
	
	if ($IP ne $last_IP) {
		$turn = 1;
	}
	else {
		$turn = 0;
	}
	
	if (
		($intf_state < 0) || (
			($method eq 'POST') && (
				($cgi{'clear'} ne '') || 
				($cgi{'clear_all'} ne '')
			)
		)
	) {
		if (
			($cgi{'clear_all'} ne '') ||
			($intf_state < -1)
		) {
			$story{'id'} = 0;
		}
		$story{'content'} = '';
		$story{'lastip' } = '0.0.0.0';
		$story{'letter' } = '';
		$story{'pass'   } = 0;
		$story{'state'  } = INTF_STATE->{'X'};
		$turn = 0;
		if ($ong_state == STATE->{'inactive'}) {
			write_index(
				\%state,
				\%settings,
				$story{'pass'},
				$story{'state'},
				0 # pause
			);
		}
		write_story($fh, \%story);
	}
	
	if (($words ne '') && ($method eq 'POST')) {
		if (
			(!$turn) &&
			(!$password_ok)
		) {
			$status = HTTP_STATUS->{'forbidden'};
			$message = "It's not your turn.";
		}
		# TODO: consider allowing non-ASCII letters in words.
		# (not very important in English language)
		elsif (
			($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) ||
			($password_ok && ($words ne ''))
		) {
			# we have 2 words
			$first_letter  = lc(substr($2, 0, 1));
			$second_letter = lc(substr($4, 0, 1));
			if (
				($first_letter ne $last_letter) &&
				($last_letter ne '') && 
				(!$password_ok)
			) {
				$status = HTTP_STATUS->{'bad_request'};
				$message = 'The first word must start with '.uc($last_letter).'.';
			}
			elsif (
				($first_letter eq $second_letter) &&
				(!$password_ok)
			) {
				$status = HTTP_STATUS->{'bad_request'};
				$message = 'The second word can\'t also start with '.uc($first_letter).'.';
			}
			else {
				# words are valid
				# update state
				$story{'content'} = $story{'content'} . $words."\n";
				$turn = 0;
				$story{'lastip'} = $IP;
				$story{'letter'} = $second_letter;
				
				if ($cgi{'next'} ne '') {
					# start next game
					if (
						$password_ok ||
						(split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1))
					) {
						# store finished game
						write_story($story_id, \%story);
						# init new game
						$new_story{'id'     } = $story_id + 1;
						$new_story{'letter' } = '';
						$new_story{'lastip' } = $IP;
						$new_story{'content'} = '';
						$new_story{'pass'   } = 0;
						$new_story{'state'  } = INTF_STATE->{'X'};
						# reset hidden interface
						$intf_state = INTF_STATE->{'X'};
						$intf_pass = 0;
						$intf_mode = INTF_STATE->{'X'};
						$intf_pause= 0;
						if($ong_state == STATE->{'inactive'}) {
							# ONG not activated yet; reset index
							write_index(
								\%state,
								\%settings,
								$intf_pass,
								$intf_mode,
								$intf_pause
							);
						}
						# save new game
						write_story($fh, \%new_story);
					}
					else {
						$message = 'To early to finish this wordgame.';
						write_story($fh, \%story);
					}
				}
				else {
					# continue the game
					if ($intf_pass == 1) {
						# hidden interface was already active; deactivate
						$intf_pass = 2;
						$story{'pass'} = 2;
						if($ong_state == STATE->{'inactive'}) {
							write_index(
								\%state,
								\%settings,
								$intf_pass,
								$intf_mode,
								$intf_pause
							);
						}
					}
					elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) {
						# correct password for the hidden interface!
						if ($intf_pass != 0) {
							$message = 'The password has already been used in this story.';
						}
						elsif ($ong_state != STATE->{'inactive'}) {
							# ONG already active, nothing to do here
							$message = "???";
						}
						else {
							# ready to activate?
							my $r;
							
							# ONG tape interface
							$r = ong(
								'i',   # ID: tape interface
								$time, # ONG time;    not relevant
								0,     # timer;       not relevant
								0,     # update;      not relevant
								0,     # print
								\%settings,         # not relevant
								'',    # %default;    not relevant
								'',    # %frame_data; not relevant
								''     # $goto_list;  not relevant
							);
							if ($r) {
								# ONG CFRT
								$r = ong(
									'c',   # ID: CFRT
									$time, # ONG time;   not relevant
									0,     # timer;      not relevant
									0,     # update;     not relevant
									0,     # print
									\%settings,
									'',    # %default
									'',    # %frame_data
									''     # $goto_list; not relevant
								);
							}
							if ($r) {
								# ONG frame 0!
								$r = ong(
									0,     # frame ID
									$time, # ONG time; might get overwritten later
									0,     # timer
									0,     # update
									0,     # print
									\%settings,
									'',    # %default
									'',    # %frame_data
									''     # $goto_list
								);
							}
							if($r) {
								# new state of hidden interface
								$intf_pass = 1;
								$intf_state = INTF_STATE->{'X'};
								$intf_mode  = INTF_STATE->{'X'};
								$intf_pause = 0;
								$story{'pass'} = 1;
								$story{'state'} = INTF_STATE->{'X'};
								write_index(
									\%state,
									\%settings,
									$intf_pass,
									$intf_mode,
									$intf_pause
								);
							}
						}
					}
					write_story($fh, \%story);
				}
			}
		}
		else {
			$status = HTTP_STATUS->{'bad_request'};
			$message = 'Please, two words, not more, not less (some punctuation is allowed).';
		}
	}
	elsif (
		($cgi{'s'} ne '') &&
		($intf_pass == 1) &&
		($ong_state == STATE->{'inactive'})
	) {
		$intf_state = int($cgi{'s'}) & INTF_STATE->{'mask'};
		$intf_mode  = $intf_state & INTF_STATE->{'mode'};
		$intf_pause = $intf_state & INTF_STATE->{'||'};
		$story{'state'} = $intf_state;
		write_index(
			\%state,
			\%settings,
			$intf_pass,
			$intf_mode,
			$intf_pause
		);
		write_story($fh, \%story);
	}
	@story_lines = split(/\r?\n/, $story{'content'});
	if(@story_lines & 1) {
		$turn = !$turn;
	}
	
	close($fh);
}

if ($status ne '') {
	print http_header_status($status);
}
if ($allow ne '') {
	print http_header_allow($allow);
}
print "Content-type: text/html; charset=UTF-8\n\n";

if($method eq 'HEAD') {
	exit;
}

my $max_page = int(($story_id + PAGE_LENGTH - FIRSTPAGE_LENGTH - 1) / PAGE_LENGTH);
my $newer_available = ($page > 0);
my $older_available = ($page < $max_page);
my $show_intf = ($intf_pass == 1) && ($ong_state == STATE->{'inactive'});
my $id_start = 
	$story_id-1 -(
		($page == 0)	? 0 : (
			(($page-1) * PAGE_LENGTH ) + FIRSTPAGE_LENGTH
		)
	);
my $id_stop = $story_id-1 - (($page*PAGE_LENGTH) + FIRSTPAGE_LENGTH);
if ($id_stop < 0) {
	$id_stop = -1;
}

my $bsta_url = CGI_PATH;
my $twowords_url = CGI_2WORDS_PATH;
my $newer_url;
my $older_url;
my $oldest_url;
my $newest_url = merge_url(
	{'path' => $twowords_url},
	{'path' => 0}
);
if ($newer_available) {
	$newer_url = merge_url(
		{'path' => $twowords_url},
		{'path' => $page-1}
	);
}
if ($older_available) {
	$older_url = merge_url(
		{'path' => $twowords_url},
		{'path' => $page+1}
	);
	$oldest_url = merge_url(
		{'path' => $twowords_url},
		{'path' => $max_page}
	);
}
my $button_4_url = merge_url(
	{'path' => $twowords_url},
	{'query' => {'s' => (INTF_STATE->{'>'} | $intf_pause)}}
);
my $button_3_url = merge_url(
	{'path' => $twowords_url},
	{'query' => {'s' => (INTF_STATE->{'<<'} | $intf_pause)}}
);
my $button_2_url = merge_url(
	{'path' => $twowords_url},
	{'query' => {'s' => (INTF_STATE->{'>>'} | $intf_pause)}}
);
my $button_1_url = merge_url(
	{'path' => $twowords_url},
	{'query' => {'s' => INTF_STATE->{'X'}}}
);
my $button_0_url = merge_url(
	{'path' => $twowords_url},
	{'query' => {'s' => ($intf_pause ? $intf_mode : ($intf_mode | INTF_STATE->{'||'}))}}
);
my $button_5_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-20.gif'}
);
my $button_4_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-10'.(($intf_mode == INTF_STATE->{'>'}) ? '_' : '').'.gif'}
);
my $button_3_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-08'.(($intf_mode == INTF_STATE->{'<<'}) ? '_' : '').'.gif'}
);
my $button_2_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-04'.(($intf_mode == INTF_STATE->{'>>'}) ? '_' : '').'.gif'}
);
my $button_1_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-02.gif'}
);
my $button_0_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-01'.($intf_pause ? '_' : '').'.gif'}
);
my $intf_img_id = '';
if ($intf_state == INTF_STATE->{'>'}) {
	$intf_img_id = '_10'
}
elsif ($intf_mode == INTF_STATE->{'<<'}) {
	$intf_img_id = '_08'
}
elsif ($intf_mode == INTF_STATE->{'>>'}) {
	$intf_img_id = '_04'
}
my $intf_img = merge_url(
	{'path' => CGI_PATH()},
	{'path' => 'intf-00'.$intf_img_id.'.gif'}
);

if ($password_ok) {
	my $password_query = url_query_encode({'p', $settings{'password'}});
	$twowords_url = merge_url($twowords_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$newest_url   = merge_url($newest_url   , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$newer_url    = merge_url($newer_url    , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$older_url    = merge_url($older_url    , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$button_4_url = merge_url($button_4_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$button_3_url = merge_url($button_3_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$button_2_url = merge_url($button_2_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$button_1_url = merge_url($button_1_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	$button_0_url = merge_url($button_0_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
}

my $_password = $password_ok ? html_entity_encode_dec($settings{'password'}, 1): '';
my $_bsta_url     = html_entity_encode_dec($bsta_url     , 1);
my $_twowords_url = html_entity_encode_dec($twowords_url , 1);
my $_newest_url   = html_entity_encode_dec($newest_url   , 1);
my $_newer_url    = html_entity_encode_dec($newer_url    , 1);
my $_older_url    = html_entity_encode_dec($older_url    , 1);
my $_oldest_url   = html_entity_encode_dec($oldest_url   , 1);
my $_button_4_url = html_entity_encode_dec($button_4_url , 1);
my $_button_3_url = html_entity_encode_dec($button_3_url , 1);
my $_button_2_url = html_entity_encode_dec($button_2_url , 1);
my $_button_1_url = html_entity_encode_dec($button_1_url , 1);
my $_button_0_url = html_entity_encode_dec($button_0_url , 1);
my $_button_5_img = html_entity_encode_dec($button_5_img , 1);
my $_button_4_img = html_entity_encode_dec($button_4_img , 1);
my $_button_3_img = html_entity_encode_dec($button_3_img , 1);
my $_button_2_img = html_entity_encode_dec($button_2_img , 1);
my $_button_1_img = html_entity_encode_dec($button_1_img , 1);
my $_button_0_img = html_entity_encode_dec($button_0_img , 1);
my $_intf_img     = html_entity_encode_dec($intf_img     , 1);
my $_message      = html_entity_encode_dec($message      , 1);
my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);

print_html_start(\*STDOUT);
print_html_head_start(\*STDOUT);


print '  <title>Two words &bull; '.$_website_name.'</title>'."\n";
print '  <link rel="start" href="'.$_oldest_url.'">'."\n";
if ($older_available) {
	print '  <link rel="prev" href="'.$_older_url.'">'."\n";
}
if ($newer_available) {
	print '  <link rel="next" href="'.$_newer_url.'">'."\n";
}

print_html_head_end(\*STDOUT);
print_html_body_start(\*STDOUT);

print '   <div id="inst" class="ins">'."\n";

print '    <div id="title">'."\n";
print '     <h1 id="titletext">Two words</h1>'."\n";
print '    </div>'."\n";

if ($page == 0) {
	print '    <div id="storypuzzle">'."\n";
	for (my $i = 0; $i < @story_lines; ++$i) {
		print '     <span class="'.($turn ? 'ni':'br').'">'.html_entity_encode_dec($story_lines[$i], 1).'</span>'."\n";
		$turn = !$turn;
	}
	print '    </div>'."\n";

	print '    <div id="command">'."\n";
	if ($message ne '') {
		print '     <span class="br">'.$_message.'</span>'."\n";
	}
	
	if ($turn || $password_ok) {
		print '     <form method="post" action="'.$_twowords_url.'">'."\n";
		if ($message eq '') {
			if ($story{"content"} eq '') {
				print '      Two words, please:<br>'."\n";
			}
			else {
				print '      Please continue, two words:<br>'."\n";
			}
		}
		print '      <input class="intx" type="text" name="words">'."\n";
		print '      <input class="inbt" type="submit" value="enter">'."\n";
		if ((@story_lines >= (STORY_LENGTH-1)) || $password_ok ) {
			print '      <input class="inbt" type="submit" name="next" value="enter and then start a new one">'."\n";
		}
		if ($password_ok) {
			print '      <input class="inbt" type="submit" name="clear" value="clear">'."\n";
			print '      <input class="inbt" type="submit" name="clear_all" value="clear all">'."\n";
			print '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
		}
		print '     </form>'."\n";
	}
	else {
		if ($message eq '') {
			print '     Wait for it.'."\n";
		}
	}
	print '    </div>'."\n";
}
elsif ($message ne '') {
	print '    <div id="command">'."\n";
	print '     <span class="br">'.$_message.'</span>'."\n";
	print '    </div>'."\n";
}
print '   </div>'."\n";

if ($show_intf) {
	print '   <div id="framespace">'."\n";
	print '    <table id="intftable" cellspacing="0" cellpadding="0">'."\n";
	print '     <tr class="intf">'."\n";
	print '      <td colspan="6" class="intf"><img src="'.$_intf_img.'" alt="" class="intf"></td>'."\n";
	print '     </tr>'."\n";
	
	print '     <tr class="intf">'."\n";
	print '      <td class="intf"><img src="'.$_button_5_img.'" alt="o" class="intf"></td>'."\n";
	print '      <td class="intf"><a href="'.$_button_4_url.'"><img src="'.$_button_4_img.'" class="intf" alt="&gt;"></a></td>'."\n";
	print '      <td class="intf"><a href="'.$_button_3_url.'"><img src="'.$_button_3_img.'" class="intf" alt="&lt;&lt;"></a></td>'."\n";
	print '      <td class="intf"><a href="'.$_button_2_url.'"><img src="'.$_button_2_img.'" class="intf" alt="&gt;&gt;"></a></td>'."\n";
	print '      <td class="intf"><a href="'.$_button_1_url.'"><img src="'.$_button_1_img.'" class="intf" alt="^"></a></td>'."\n";
	print '      <td class="intf"><a href="'.$_button_0_url.'"><img src="'.$_button_0_img.'" class="intf" alt="||"></a></td>'."\n";
	print '     </tr>'."\n";
	print '    </table>'."\n";
	print '   </div>'."\n";
}

print '   <div id="insb" class="ins">'."\n";

print '    <div id="undertext">'."\n";
for (my $i = $id_start; $i > $id_stop; --$i) {
	%new_story = read_story($i);
	print '     <p class="'.(($i&1)?'br':'ni').'" id="s'.$i.'">'.html_entity_encode_dec($new_story{'content'}).'</p>'."\n";
}
print '    </div>'."\n";

print '    <div id="underlinks">'."\n";
print '     <a href="'.$_bsta_url.'">BSTA</a> |'."\n";
print '     <a href="'.$_twowords_url.'">Once again</a>';
if ($older_available) {
	print ' |'."\n";
	print '     <a href="'.$_older_url.'">Before</a>';
}
if ($newer_available) {
	print ' |'."\n";
	print '     <a href="'.$newer_url.'">Unbefore</a>';
}
if ($older_available) {
	print ' |'."\n";
	print '<a href="'.$_oldest_url.'">Initially</a>';
}
if($turn) {
	print ' |'."\n";
	print '     (Entering words here is irreversible. Your actions might be remembered forever. So please be reasonable.)';
}
print "\n";
print '    </div>'."\n";

print '   </div>'."\n";

print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'});
print_html_end(\*STDOUT);
