console.pm

ARM上的如果你对底层感兴趣

package Win32::Console;
#######################################################################
#
# Win32::Console - Perl Module for Windows Clipboard Interaction
# ^^^^^^^^^^^^^^
# Version: 0.03 (07 Apr 1997)
#
#######################################################################

require Exporter;       # to export the constants to the main:: space
require DynaLoader;     # to dynuhlode the module.

@ISA= qw( Exporter DynaLoader );
@EXPORT = qw(
    BACKGROUND_BLUE
    BACKGROUND_GREEN
    BACKGROUND_INTENSITY
    BACKGROUND_RED
    CAPSLOCK_ON
    CONSOLE_TEXTMODE_BUFFER
    CTRL_BREAK_EVENT    
    CTRL_C_EVENT
    ENABLE_ECHO_INPUT
    ENABLE_LINE_INPUT
    ENABLE_MOUSE_INPUT
    ENABLE_PROCESSED_INPUT
    ENABLE_PROCESSED_OUTPUT
    ENABLE_WINDOW_INPUT
    ENABLE_WRAP_AT_EOL_OUTPUT
    ENHANCED_KEY
    FILE_SHARE_READ
    FILE_SHARE_WRITE
    FOREGROUND_BLUE
    FOREGROUND_GREEN
    FOREGROUND_INTENSITY
    FOREGROUND_RED
    LEFT_ALT_PRESSED
    LEFT_CTRL_PRESSED
    NUMLOCK_ON
    GENERIC_READ
    GENERIC_WRITE
    RIGHT_ALT_PRESSED
    RIGHT_CTRL_PRESSED
    SCROLLLOCK_ON
    SHIFT_PRESSED
    STD_INPUT_HANDLE
    STD_OUTPUT_HANDLE
    STD_ERROR_HANDLE
);


#######################################################################
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function.  If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
#

sub AUTOLOAD {
    my($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    #reset $! to zero to reset any current errors.
    $!=0;
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
#    if ($! =~ /Invalid/) {
#        $AutoLoader::AUTOLOAD = $AUTOLOAD;
#        goto &AutoLoader::AUTOLOAD;
#    } else {
        ($pack, $file, $line) = caller; undef $pack;
        die "Symbol Win32::Console::$constname not defined, used at $file line $line.";
#    }
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}


#######################################################################
# STATIC OBJECT PROPERTIES
#
$VERSION = "0.03";

# %HandlerRoutineStack = ();
# $HandlerRoutineRegistered = 0;

#######################################################################
# PUBLIC METHODS
#

#======== (MAIN CONSTRUCTOR)
sub new {
#========
    my($class, $param1, $param2) = @_;

    my $self = {};

    if(defined($param1) 
    and ($param1 == constant("STD_INPUT_HANDLE",  0)
    or   $param1 == constant("STD_OUTPUT_HANDLE", 0)
    or   $param1 == constant("STD_ERROR_HANDLE",  0))) {

        $self->{'handle'} = _GetStdHandle($param1);

    } else {

        $param1 = constant("GENERIC_READ", 0)    | constant("GENERIC_WRITE", 0) unless $param1;
        $param2 = constant("FILE_SHARE_READ", 0) | constant("FILE_SHARE_WRITE", 0) unless $param2;
        $self->{'handle'} = _CreateConsoleScreenBuffer($param1, $param2, 
                                                       constant("CONSOLE_TEXTMODE_BUFFER", 0));
    }
    bless $self, $class;
    return $self;
}


#============
sub Display {
#============
    my($self)=@_;
    return undef unless ref($self);

    return _SetConsoleActiveScreenBuffer($self->{'handle'});
}

#===========
sub Select {
#===========
    ($self, $type) = @_;
    return undef unless ref($self);

    return _SetStdHandle($type, $self->{'handle'});
}


#==========
sub Title {
#==========
    my($self, $title) = @_;

    $title = $self unless ref($self);

    if(defined($title)) {
      return _SetConsoleTitle($title);
    } else {
      return _GetConsoleTitle();
    }
}

#==============
sub WriteChar {
#==============
    my($self, $text, $col, $row) = @_;
    return undef unless ref($self);

    return _WriteConsoleOutputCharacter($self->{'handle'},$text,$col,$row);
}

#=============
sub ReadChar {
#=============
    my($self, $size, $col, $row) = @_;
    return undef unless ref($self);
  
    my $buffer = (" " x $size);  
    if(_ReadConsoleOutputCharacter($self->{'handle'}, $buffer, $size, $col, $row)) {
        return $buffer;
    } else {
        return undef;
    }
}



#==============
sub WriteAttr {
#==============
    my($self, $attr, $col, $row) = @_;
    return undef unless ref($self);
    return _WriteConsoleOutputAttribute($self->{'handle'}, $attr, $col, $row);
}

#=============
sub ReadAttr {
#=============
    my($self, $size, $col, $row) = @_;
    return undef unless ref($self);
  
    return _ReadConsoleOutputAttribute($self->{'handle'}, $size, $col, $row);
}


#==========
sub Write {
#==========
    my($self,$string) = @_;
    return undef unless ref($self);
    return _WriteConsole($self->{'handle'}, $string);
}


#=============
sub ReadRect {
#=============
    my($self, $left, $top, $right, $bottom) = @_;
    return undef unless ref($self);
    
    my $col = $right  - $left + 1;
    my $row = $bottom - $top  + 1;

    my $buffer = (" " x ($col*$row*4));
    if(_ReadConsoleOutput($self->{'handle'},   $buffer,
                          $col,  $row, 0,      0,
                          $left, $top, $right, $bottom)) {
        return $buffer;
    } else {
        return undef;
    }
}


#==============
sub WriteRect {
#==============
    my($self, $buffer, $left, $top, $right, $bottom) = @_;
    return undef unless ref($self);

    my $col = $right  - $left + 1;
    my $row = $bottom - $top  + 1;

    return _WriteConsoleOutput($self->{'handle'},   $buffer,
                               $col,  $row, 0,  0,
                               $left, $top, $right, $bottom);
}



#===========
sub Scroll {
#===========
    my($self, $left1, $top1, $right1, $bottom1,
              $col,   $row,  $char,   $attr,
              $left2, $top2, $right2, $bottom2) = @_;
    return undef unless ref($self);
  
    return _ScrollConsoleScreenBuffer($self->{'handle'},
                                      $left1, $top1, $right1, $bottom1,
                                      $col,   $row,  $char,   $attr,
                                      $left2, $top2, $right2, $bottom2);
}


#==============
sub MaxWindow {
#==============
    my($self, $flag) = @_;
    return undef unless ref($self);
  
    if(not defined($flag)) {
        my @info = _GetConsoleScreenBufferInfo($self->{'handle'});
        return $info[9], $info[10];
    } else {
        return _GetLargestConsoleWindowSize($self->{'handle'});
    }
}

#=========
sub Info {
#=========
    my($self) = @_;
    return undef unless ref($self);
  
    return _GetConsoleScreenBufferInfo($self->{'handle'});
}


#===========
sub Window {
#===========
    my($self, $flag, $left, $top, $right, $bottom) = @_;
    return undef unless ref($self);
  
    if(not defined($flag)) {
        my @info = _GetConsoleScreenBufferInfo($self->{'handle'});
        return $info[5], $info[6], $info[7], $info[8];
    } else {
        return _SetConsoleWindowInfo($self->{'handle'}, $flag, $left, $top, $right, $bottom);
    }
}

#==============
sub GetEvents {
#==============
    my $self="";
    ($self)=@_;
    return undef unless ref($self);
  
    return _GetNumberOfConsoleInputEvents($self->{'handle'});
}


#==========
sub Flush {
#==========
    my($self) = @_;
    return undef unless ref($self);

    return _FlushConsoleInputBuffer($self->{'handle'});
}

#==============
sub InputChar {
#==============
    my($self, $number) = @_;
    return undef unless ref($self);
    
    $number = 1 unless defined($number);
  
    my $buffer = (" " x $number);
    if(_ReadConsole($self->{'handle'}, $buffer, $number) == $number) {
        return $buffer;
    } else {
        return undef;
    }
}

#==========
sub Input {
#==========
    my($self) = @_;
    return undef unless ref($self);
  
    return _ReadConsoleInput($self->{'handle'});
}

#==============
sub PeekInput {
#==============
    my($self) = @_;
    return undef unless ref($self);
  
    return _PeekConsoleInput($self->{'handle'});
}