用Perl来玩填字游戏

继续写个Perl玩,填字游戏。

游戏规则很简单,简要说一下:一个十字形的图案,上下左右已经有文字了,中间需要填上一个字,使得它和上下左右都能组成词语。

为了避免中文传参乱码,用了utf8::all

其中,uniq.txt是双字词语的数据库,每行一个词语。

使用方法:

  • 做题

 perl fill.pl -a 上 左 右 下

  • 生成题

 perl fill.pl -c 中

代码如下:

Code

#!/usr/bin/env perl

use strict;

use warnings;
use utf8;
use utf8::all;
use 5.010;
use Getopt::Long;
 
sub center
{
    my $word = shift or return;
    return if ! (length $word eq 1);
    open my $data, '<', 'uniq.txt';
    binmode $data,':utf8';
    my (@last, @first);
    while (<$data>) {
        push @last, $_ if ($_ =~ /$word$/);
        push @first, $_ if ($_ =~ /^$word/);
    }
    for (my$last_vertical = 0; $last_vertical < scalar@last; $last_vertical++) {
        for (my$last_horizontal = 1; $last_horizontal < scalar @last; $last_horizontal++) {
            for (my$first_horizontal = 0; $first_horizontal < scalar@first; $first_horizontal++) {
                for (my $first_vertical = 1; $first_vertical < scalar @first; $first_vertical++) {
                    my $first_line = substr $last[$last_vertical],0,1;
                    chomp(my $second_line_part_1 = $last[$last_horizontal]);
                    my $second_line_part_2 = substr $first[$first_horizontal],1,1;
                    my $third_line = substr $first[$first_vertical],1,1;
                    print "  ",$first_line,"n",$second_line_part_1,$second_line_part_2,"n","  ",$third_line,"nn";
                }
            }
        }
    }
}
 
sub around
{
    my $up_letter = shift or return;
    my $left_letter = shift or return;
    my $right_letter = shift or return;
    my $under_letter = shift or return;
    return if !((length $up_letter eq 1) and (length $left_letter eq 1) and (length $right_letter eq 1) and (length $under_letter eq 1));
    open my $data, '<', 'uniq.txt';
    binmode $data,':utf8';
    my (@up,@left,@right,@under);
    while (<$data>) {
        push @up, $_ if ($_ =~ /^$up_letter/);
        push @left, $_ if ($_ =~ /^$left_letter/);
        push @right, $_ if ($_ =~ /$right_letter$/);
        push @under, $_ if ($_ =~ /$under_letter$/);
    }

    for (my $last_vertical = 0; $last_vertical < scalar@up; $last_vertical++) {
        chomp (my ($center_1) = substr $up[$last_vertical],1,1);
        for (my $last_horizontal = 0; $last_horizontal < scalar@left; $last_horizontal++) {
            chomp (my ($center_2) = substr $left[$last_horizontal],1,1);
next if ! $center_1 eq $center_2;
            for (my $first_horizontal = 0; $first_horizontal < scalar@right; $first_horizontal++) {
                chomp (my ($center_3) = substr $right[$first_horizontal],0,1);
next if ! $center_2 eq $center_3;
                for (my $first_vertical = 0; $first_vertical < scalar@under; $first_vertical++) {
                    chomp (my ($center_4) = substr $under[$first_vertical],0,1);
                    next if ! $center_3 eq $center_4;
                    if (($center_1 eq $center_2) and ($center_2 eq $center_3) and ($center_3 eq $center_4)) {
                        my $center_word = $center_1;
                        chomp ($center_1 = substr  $up[$last_vertical],0,1);
                        chomp ($center_2 = substr  $left[$last_horizontal],0,1);
                        chomp ($center_3 = substr  $right[$first_horizontal],1,1);
                        chomp ($center_4 = substr  $under[$first_vertical],1,1);
                        print "  ",$center_1,"n",$center_2,$center_word,$center_3,"n","  ",$center_4,"n";
                    }
                }
            }
        }
    }
}

my@center_type = ();
my@around_type = ();

GetOptions(
    'center|c=s{,}' => @center_type,
    'around|a=s{4,}' => @around_type
);

foreach my $center (@center_type) {
    center $center if length $center eq 1;
}

exit if scalar @around_type lt 4;

for (my $index = 0; $index < scalar @around_type;  $index+=4) {
    exit if scalar @around_type lt $index + 3;
    around $around_type[$index], $around_type[$index+1], $around_type[$index+2], $around_type[$index+3];
}

声明: 本文为0xBBC原创, 转载注明出处喵~

发表评论

电子邮件地址不会被公开。 必填项已用*标注