use strict; use warnings; use JSON; use File::Find qw(finddepth); use Encode qw(decode); #### START OF GLOBAL VARS my $fh; # Output file handle my $imgDirectory = 'C:/Users/Owner/My Website/img/covers'; my @thingers = (); # [ { "type":"altars", "count":35, "super":"furniture" },... ] #### END OF GLOBAL VARS #### START OF MAIN PROGRAM #### my $idxJsonData = loadJson("json/index.json.txt"); foreach my $r (@{$idxJsonData->{"things"}}) { makeThingerPage($r); } makeIndexPage(); #### END OF MAIN PROGRAM #### sub loadJson { my $inname = $_[0]; my $jsondata = ''; open(my $jinfh, "<", $inname) || die("can't open $inname: $!"); print "*** reading $inname ... "; while ( <$jinfh> ) { $jsondata .= $_; } close $jinfh; print "DONE!\n"; print "*** parsing $inname ... "; print STDERR "*** parsing $inname ...\n"; $jsondata =~ s/^\x{ef}\x{bb}\x{bf}//; # decode_json doesn't like these leading bytes, the "Byte Order Mark" aka BOM. my $hashref = decode_json $jsondata; print "DONE!\n"; print STDERR "*** $inname parsed!\n"; return $hashref; } sub type2super { my $type = $_[0]; my $super = 'zzz'; foreach my $r (@{$idxJsonData->{'things'}}) { if ($r->{'type'} eq $type) { if (exists($r->{'super'})) { return $r->{'super'}; } else { return $super; } } } return $super; } sub makeIndexPage { open($fh, ">:encoding(UTF-8)", "index.html"); print $fh "\n\n\n"; print $fh "\n"; print $fh "\n"; print $fh "IF Things\n"; print $fh "\n\n"; print $fh "\n

\"\" IF Things

\n\n"; print $fh "

Let's examine things in works of interactive fiction! What sorts of things do you want to look at?

\n"; print $fh "

Things by Category

\n"; # First we need to assemble a list of top supercategories. my %supers = (); foreach my $r (@{$idxJsonData->{'things'}}) { my $super = 'zzz'; if (exists($r->{'super'})) { $super = $r->{'super'}; } $supers{$super} = { 'thingers' => [] } unless exists($supers{$super}); } # Now load those supercategories from @thingers. foreach my $r (@thingers) { my $super = type2super( $r->{'type'} ); push @{$supers{$super}->{'thingers'}}, $r; } # Report 'em! print $fh "\n\n"; print $fh "

Things in Alphabetical Order

\n"; print $fh "\n\n"; print $fh "

About this Thinger project

\n"; print $fh "

I don't expect to stay around forever, so I'm also publishing the raw data and program that I used to create these pages."; print $fh " If you wish to continue (update, modify, expand) this project or make a similar project and not want to start from scratch, please feel free to use my materials."; print $fh " Crediting me would be nice, please and thank you."; print $fh " In the meantime, I retain the right to maintain my own version of this project as long as I'm willing and able to do it.

\n"; print $fh "\n"; print $fh "

All my JSON files use UTF-8 encoding. This project was begun in September 2018. HUGE thank you to all you authors of interactive fiction. You are all amazing. Thank you.

\n"; print $fh "

— David Welbourn

\n"; doFooter('index'); print $fh "\n\n"; close $fh; } sub makeThingerPage { my $idxRecord = $_[0]; my $thType = $idxRecord->{'type'}; my $inFilename = "json/" . $thType . ".json.txt"; my $outFilename = $thType . ".html"; my $thJsonData = loadJson($inFilename); my $thCount = 0; open($fh, ">:encoding(UTF-8)", $outFilename); print $fh "\n\n\n"; print $fh "\n"; print $fh "\n"; print $fh "" . ucfirst($thType) . " in Interactive Fiction\n"; print $fh "\n"; insertJS(); print $fh "\n\n"; print $fh "\n

\"\"" . ucfirst($thType) . ' in Interactive Fiction'; print $fh ""; print $fh "\"[top]\""; print $fh " \"[menu]\""; print $fh "

\n\n"; print $fh "
\n\n"; print_vmenu(); # The vertical menu with the sort menuitems. # Intro if (exists($idxRecord->{'about'})) { my $s = $idxRecord->{'about'}; print $fh "

" if (substr($s,0,1) ne '<'); print $fh $s; print $fh "

" if (substr($s,0,1) ne '<'); print $fh "\n
\n"; } # Main: Gather info my @rawInfo = (); foreach my $k (keys %{$thJsonData}) { my $v = $thJsonData->{$k}; # First, determine if this game is one that we're interested in. # Fatally incomplete entries will be skipped over. my $ok = 1; if (!exists($v->{'title'})) { $ok = 0; } elsif ($v->{'title'} eq '') { $ok = 0; } if (!exists($v->{'things'})) { $ok = 0; } elsif (scalar @{$v->{'things'}} == 0) { $ok = 0; } else { foreach my $th (@{$v->{'things'}}) { if (!exists($th->{'name'})) { $ok = 0; } elsif ($th->{'name'} eq '') { $ok = 0; } if (!exists($th->{'desc'})) { $ok = 0; } elsif ($th->{'desc'} eq '') { $ok = 0; } elsif ($th->{'desc'} =~ /\[TODO\]/) { $ok = 0; } } } if ($ok) { # Add a record to @rawInfo. my $resp = $v->{'things'}[0]{'desc'}; my $relyear = calcReleaseYear($k, $v); my $revyear = 9999 - $relyear; my $r = { 'id' => $k, 'title' => $v->{'title'}, 'things' => $v->{'things'}, 's1' => title2sort($v->{'title'}), 's2' => resp2sort($resp), 's3' => $relyear . ' ' . title2sort($v->{'title'}), 's4' => $revyear . ' ' . title2sort($v->{'title'}), 'resp' => $resp }; if (exists($v->{'sfx'})) { $r->{'sfx'} = $v->{'sfx'}; } if (exists($v->{'x'})) { $r->{'x'} = $v->{'x'}; } $r->{'year'} = $relyear; push @rawInfo, $r; $thCount += scalar @{$v->{'things'}}; } } # Sorting my @sortedInfo = sort { $a->{'s2'} cmp $b->{'s2'} } @rawInfo; my $counter = 1000; foreach my $r (@sortedInfo) { $r->{'s2'} = $counter++; # Replace s2 field with a 4-digit number to sort by. } @sortedInfo = sort { $a->{'s3'} cmp $b->{'s3'} } @sortedInfo; $counter = 1000; foreach my $r (@sortedInfo) { $r->{'s3'} = $counter++; # Replace s3 field with a 4-digit number to sort by. } @sortedInfo = sort { $a->{'s4'} cmp $b->{'s4'} } @sortedInfo; $counter = 1000; foreach my $r (@sortedInfo) { $r->{'s4'} = $counter++; # Replace s4 field with a 4-digit number to sort by. } @sortedInfo = sort { $a->{'s1'} cmp $b->{'s1'} } @sortedInfo; $counter = 1000; foreach my $r (@sortedInfo) { $r->{'s1'} = $counter++; # Replace s1 field with a 4-digit number to sort by. } # Main: Output print $fh "\n\n"; # End of respList. # Remember the number of things. push @thingers, { "type" => $thType, "count" => $thCount }; # Outro # print $fh "
\n"; # if (exists($v->{'outro'})) { # my $s = $v->{'outro'}; # print $fh "

" if (substr($s,0,1) ne '<'); # print $fh $s; # print $fh "

" if (substr($s,0,1) ne '<'); # print $fh "\n"; # } # print $fh "

Do you want to see the "; # my @otherCommands = (); # foreach my $command (sort keys %{$idxJsonData->{"commands"}}) { # push @otherCommands, $command if $command ne $commandKey; # } # my $n = 1; my $nCommands = scalar(@otherCommands); # foreach my $command (@otherCommands) { # print $fh "or " if $n == $nCommands; # print $fh "". uc($command) . ""; # print $fh "," if $n != $nCommands; # print $fh " "; # $n++; # } # print $fh " page next?

"; doFooter($thType); print $fh "\n\n"; close $fh; } sub doFooter { my $pageName = $_[0]; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); my $dd = substr('0' . $mday,-2); my $mmm = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon]; my $yyyy = 1900 + $year; print $fh "\n"; } sub print_vmenu { my $code = <<'END_VMENU'; END_VMENU print $fh $code; } sub title2sort { my $s = $_[0]; $s = lc($s); if ($s =~ /^(.*)\|(.*)$/) { $s = $2 . ' (' . $1 .')'; } # TODO: replace accented characters with unaccented ones. return $s; } sub title2html { my $s = $_[0]; $s =~ s/\|//g; $s =~ s/&/&/g; $s =~ s//>/g; $s =~ s/\[or\]/|/g; return $s; } sub s2id { my $s = $_[0]; $s = lc($s); $s =~ s/ /_/g; $s =~ s/\//_/g; return $s; } sub calcReleaseYear { my ($k, $v) = @_; if (exists($v->{'year'})) { return $v->{'year'}; } else { my $yy = substr($k, 5, 2); # scrape the 2-digit year from the id. if ($yy eq 'xx' || $yy eq '') { return '0000'; } elsif ($yy ge '70') { return '19' . $yy; } else { return '20' . $yy; } } } sub insertJS { my $jsCode = <<'END_JSCODE'; END_JSCODE print $fh $jsCode; } # Convert a response string into something I can sort by. sub resp2sort { my $s = $_[0]; $s = lc($s); $s =~ s/\n/ /gs; # $s =~ s/\[.*?\]<\/i>//g; # remove my embedded comments. (old markup!) $s =~ s/.*?<\/ins>//g; # remove my embedded comments. (new markup!) $s =~ s/<.*?>//g; # remove all HTML tags. $s =~ s/&[a-z]+;/ /g; # remove   etc. # TODO: remove accents on characters. $s =~ s/\s+/ /g; # replace whitespace sequences with single space. $s =~ s/^[^a-z0-9]+//; # remove leading non-alphanumerics. if (length($s) > 50) { # chop down to 50 characters if longer. $s = substr($s,0,50); } return $s; }