ForNext

2.5. 文書情報の復元

VBScript

JScript

Perl

use strict;
#******************************************************************************
#   文書情報の復元
#******************************************************************************
my  $c              =   "";
my  $code           =   "";
my  $EOF            =   "\0\0";
my  $NEWLINE        =   "\n";

my  $lastc          =   "";
my  $nrep           =   0;
my  $RCODE          =   "\0";

while (($code = get_char()) ne $EOF)
{
    if ($code eq $RCODE)
    {
        # 反復記号なら 繰り返される文字
        last if (($c = get_char()) eq $EOF);
        $lastc = $c;

        # 繰り返す回数
        $nrep = "";
    }
    else
    {
        # 反復記号でなければ、文字数
        $nrep = $code;
    }

    # 反復記号なら 繰り返す回数、反復記号でなければ 文字数
    while (1)
    {
        $c = get_char();
        last if ($c eq $EOF);
        last if ($c eq $RCODE);
        $nrep .= $c;
    }
    last if ($c eq $EOF);

    if ($code eq $RCODE)
    {
        # 反復記号なら 文字を繰り返す
        for ( ; $nrep > 0; $nrep--)
        {
            put_char($lastc);
        }
    }
    else
    {
        # 反復記号でなければ 繰り返しではない文字を出力
        for ( ; $nrep > 0; $nrep--)
        {
            $c = get_char();
            last if ($c eq $EOF);
            put_char($c);
        }
    }
}

#==============================================================================
#   １文字 取得
#==============================================================================
my  $current_line   =   "";
my  $pos            =   -1;

sub get_char
{
    my  $char;

    # まだ読んでなかったら
    if ($current_line eq "")
    {
        # １行読む
        $current_line = <STDIN>;

        # ファイルの終わりなら 終了
        return  $EOF    if  (!$current_line);

        # 改行コードを取り除く
        chomp($current_line);

        # 現在位置 クリア
        $pos    =   0;
    }

    # 行の終わりに達したら
    if ($pos >= length($current_line))
    {
        # 現在行 クリア
        $current_line = "";

        # 行の終わりを 知らせる
        return $NEWLINE;
    }

    # 半角 / 全角
    if  (substr($current_line, $pos, 1) =~ /^[\x80-\xff]/)
    {
        # ２バイト取得
        $char   =   substr($current_line, $pos, 2);
        $pos    +=  2;
    }
    else
    {
        # １バイト取得
        $char   =   substr($current_line, $pos, 1);
        $pos++;
    }

    return $char;
}

#==============================================================================
#   １文字 出力
#==============================================================================
my  $buffer         =   "";

sub put_char
{
    ($_)    =   @_;

    if  ($_ eq  $NEWLINE)
    {
        # 行の終わりなら 出力
        print   $buffer, "\n";
        $buffer =   "";
    }
    else
    {
        # 行の終わりでなければ、バッファにためる
        $buffer .=  $_;
    }
}

PHP

Python

Ruby

PowerShell

Scala

F#

C

C++

C++Builder

VC++

C#

Java

Objective-C

D

VB

VB.NET

Delphi

Ada

PL/SQL

T-SQL