国民宿舎はらぺこ 大浴場

概要

PC のキーボードを MIDI キーボードにしてしまうという、激しくありがちなプログラムです。MIDI マッパーが正しく設定されていればふつーに音が鳴ります。

操作方法

画面の表示に合わせてキーを押すと音が鳴り、放せば止まります。

また、カーソルキーの上下でオクターブを移動することができます。

動作環境

• 本プログラムは cygwin 上の Perl にて動作確認していますが、Win32API::MIDI をビルドして動かすことができるようであれば、ActivePerl 上でも動かせるかもしれません。
• Windows 以外の OS では動作しません。
• Win32API::MIDI モジュールを追加インストールする必要があります。
• Win32::Console のバージョンが古いと、定義済み変数であるはずの変数が定義されていない為に例外が発生するかもしれません。その場合は、最新のモジュールに差し替えてください。

制限事項

音色の差し替えやベロシティの変更など、その他のいろんなことは一切できません。

また、キーリピートが発生するぐらい押しっぱなしにしていると、何故か和音が 3 つぐらいまでしか鳴らせなくなっちゃったりします。

免責事項

Artistic License (参考: 日本語訳) に準じます。ご自由にどうぞ。また、一切の保証はありません。ご利用は自己責任で。

ソースコード

#!/usr/bin/perl

package Keybord;

use strict;

use Win32::Console;

# 鍵盤のキー割り当て
use constant    KEYBORD_MAP_WHITE_LOW       => [qw(z x c v b n m , . / \\)];
use constant    KEYBORD_MAP_BLACK_LOW       => [qw(s d), '', qw(g h j), '', qw(l ;)];
use constant    KEYBORD_MAP_WHITE_HIGH      => [qw(q w e r t y u i o p @ [)];
use constant    KEYBORD_MAP_BLACK_HIGH      => [qw(2 3 4), '', qw(6 7), '', qw(9 0 -)];

# 鍵盤の垂直表示位置
use constant    KEYBORD_POS_Y_WHITE_LOW     => [ 12, 20 ];
use constant    KEYBORD_POS_Y_BLACK_LOW     => [ 12, 16 ];
use constant    KEYBORD_POS_Y_WHITE_HIGH    => [  2, 10 ];
use constant    KEYBORD_POS_Y_BLACK_HIGH    => [  2,  6 ];

# 鍵盤の水平表示位置
use constant    KEYBORD_POS_X_LOW           => 10;
use constant    KEYBORD_POS_X_HIGH          => 8;

# 鍵盤の幅
use constant    KEY_WIDTH_WHITE             => 4;
use constant    KEY_WIDTH_BLACK             => 2;

# 鍵盤の色
use constant    KEY_COLOR_WHITE             => $FG_BLACK | $BG_LIGHTGRAY;
use constant    KEY_COLOR_BLACK             => $FG_LIGHTGRAY | $BG_BLACK;
use constant    KEY_COLOR_HIGHLIGHT         => $FG_BLACK | $BG_YELLOW;

# 鍵盤の最初のキーに割り当てられるノート値 (デフォルト値)
use constant    FIRST_NOTE_LOW              => 48;
use constant    FIRST_NOTE_HIGH             => 65;

# オクターブシフトで変化するノート値
use constant    OCTAVE                      => 12;

# オクターブシフトの閾値
use constant    NOTE_UNDER_LIMIT            => 0;
use constant    NOTE_UPPER_LIMIT            => 127 - scalar(@{&KEYBORD_MAP_WHITE_HIGH}) * 2;

# 鍵盤のキーに対する各種情報 (ノート値差分、インデクス、白鍵 or 黒鍵、押下中か否か)
my %keybord_info_low;
my %keybord_info_high;
{
    my $setNoteDiff = sub {
        my ($note_diff, $white, $black) = @_;
        for (my $i = 0, my $note = 0; $i < @$white; $i++){
            $note_diff->{$white->[$i]} = {
                'note' => $note++,
                'index' => $i,
                'type' => 'white',
                'is down' => 0,
            };
            $note_diff->{$black->[$i]} = {
                'note' => $note++,
                'index' => $i,
                'type' => 'black',
                'is down' => 0
            }                               if $black->[$i] ne '';
        }
    };
    $setNoteDiff->(\%keybord_info_low, KEYBORD_MAP_WHITE_LOW, KEYBORD_MAP_BLACK_LOW);
    $setNoteDiff->(\%keybord_info_high, KEYBORD_MAP_WHITE_HIGH, KEYBORD_MAP_BLACK_HIGH);
}

# コンソール出力オブジェクト
our $console_out = new Win32::Console(STD_OUTPUT_HANDLE);

# パッケージローカル関数
my ($displayKeybord);

# オブジェクト生成 - 画面作り
sub new {
    my $invocant = shift;
    my $class = ref $invocant || $invocant;
    
    $console_out->Cls($FG_BLACK | $BG_BLUE);
    $displayKeybord->(KEYBORD_MAP_WHITE_LOW, KEYBORD_POS_X_LOW, 'white', KEYBORD_POS_Y_WHITE_LOW);
    $displayKeybord->(KEYBORD_MAP_WHITE_HIGH, KEYBORD_POS_X_HIGH, 'white', KEYBORD_POS_Y_WHITE_HIGH);
    $displayKeybord->(KEYBORD_MAP_BLACK_LOW, KEYBORD_POS_X_LOW, 'black', KEYBORD_POS_Y_BLACK_LOW);
    $displayKeybord->(KEYBORD_MAP_BLACK_HIGH, KEYBORD_POS_X_HIGH, 'black', KEYBORD_POS_Y_BLACK_HIGH);
    
    my $self = {
        'first note low'    => FIRST_NOTE_LOW,      # 下鍵盤の最初のキーのノート値
        'first note high'   => FIRST_NOTE_HIGH,     # 上鍵盤の (以下略)
    };
    
    bless $self, $class
}

# デストラクタ - 画面消去
sub DESTROY {
    $console_out->Cls($ATTR_NORMAL);
}

# キー on/off 切り替え - 対応するノート値を返す
sub keyTurn {
    my ($self, $key, $is_down) = @_;
    my $high_or_low =     $keybord_info_low{$key}   ? 'low'
                        : $keybord_info_high{$key}  ? 'high'
                        :                             undef;
    return  unless $high_or_low;
    
    my $keybord = $high_or_low eq 'low' ? \%keybord_info_low : \%keybord_info_high;
    # リピート防止の為、押し続けている間はノート値を返さない
    return  if $keybord->{$key}{'is down'} && $is_down;
    
    $keybord->{$key}{'is down'} = $is_down;
    my ($note, $index, $type) = @{$keybord->{$key}}{qw(note index type)};
    my $y = $high_or_low eq 'low'   ? ($type eq 'white' ? KEYBORD_POS_Y_WHITE_LOW->[1]
                                                        : KEYBORD_POS_Y_BLACK_LOW->[1])
                                    : ($type eq 'white' ? KEYBORD_POS_Y_WHITE_HIGH->[1]
                                                        : KEYBORD_POS_Y_BLACK_HIGH->[1]);
    # ハイライトの切り替え
    $console_out->FillAttr(
        $is_down    ? KEY_COLOR_HIGHLIGHT
                    : $type eq 'white' ? KEY_COLOR_WHITE : KEY_COLOR_BLACK,
        $type eq 'white' ? KEY_WIDTH_WHITE : KEY_WIDTH_BLACK,
        ($high_or_low eq 'low' ? KEYBORD_POS_X_LOW : KEYBORD_POS_X_HIGH) +
            ($type eq 'white' ? 0 : KEY_WIDTH_WHITE - int(KEY_WIDTH_BLACK / 2)) +
            KEY_WIDTH_WHITE * $index,
        $y);
    
    $note + $self->{"first note $high_or_low"}
}

# オクターブを上げる / 下げる
sub moveOctave {
    my ($self, $updown) = @_;
    return  if $updown eq 'down' && $self->{'first note low'} - OCTAVE < NOTE_UNDER_LIMIT;
    return  if $updown eq 'up' && $self->{'first note high'} + OCTAVE > NOTE_UPPER_LIMIT;
    
    $self->{'first note low'} += $updown eq 'up' ? OCTAVE : - OCTAVE;
    $self->{'first note high'} += $updown eq 'up' ? OCTAVE : - OCTAVE;
}

# 画面作り - キーボード描画
$displayKeybord = sub {
    my ($keymap, $x, $type) = (shift, shift, shift);
    my ($y1, $y2) = @{shift()};
    $x += $type eq 'white' ? 0 : KEY_WIDTH_WHITE - int(KEY_WIDTH_BLACK / 2);
    local $_;
    for my $key (@$keymap){
        next    if $key eq '';
        $console_out->FillAttr(
            $type eq 'white'    ? (KEY_COLOR_WHITE, KEY_WIDTH_WHITE, $x, $_)
                                : (KEY_COLOR_BLACK, KEY_WIDTH_BLACK, $x, $_)
            )   for ($y1 .. $y2);
        $console_out->WriteChar($key, $x, $y2);
    }
    continue {
        $x += KEY_WIDTH_WHITE;
    }
};

package main;

use strict;

use Win32::Console;
use Win32API::MIDI;

# 仮想キー
use constant    VKEY_END                => 27;  # 終了キー : [ESC]
use constant    VKEY_OCTAVE_UP          => 38;  # オクターブを上げる : カーソルキー [↑]
use constant    VKEY_OCTAVE_DOWN        => 40;  # オクターブを下げる : カーソルキー [↓]


# MIDI イベント
use constant    MIDI_STATUS_NOTE_ON     => 0x90;    # ステータスコード: note on
use constant    MIDI_VELOCITY           => 100;     # ベロシティ

my $console_in = new Win32::Console(STD_INPUT_HANDLE);

my $midi = new Win32API::MIDI;
my $midi_out = new Win32API::MIDI::Out      or die $midi->OutGetErrorText;

my $keybord = new Keybord;

while (1){
    my ($type, $is_down, undef, $vkey, undef, $char) = $console_in->Input;
    next    if $type != 1;          # キー入力以外のイベントの場合
    last    if $vkey == VKEY_END;   # 終了キーが押された場合
    
    # オクターブ移動
    $keybord->moveOctave('up'), next    if $vkey == VKEY_OCTAVE_UP && $is_down;
    $keybord->moveOctave('down'), next  if $vkey == VKEY_OCTAVE_DOWN && $is_down;
    
    my $key = $keybord->keyTurn(chr $char, $is_down);
    next    unless defined $key;
    $midi_out->ShortMsg(
        (($is_down ? 100 : 0) << 16) |
        ($key << 8) |
        MIDI_STATUS_NOTE_ON)
            or die $midi_out->GetErrorText;
}

$midi_out->Close;

__END__