[画像]
#!/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__
ｺﾒﾝﾄをする