in reply to Re^3: Using Inline::C in a package
in thread Using Inline::C in a package
use warnings; use strict; use Inline C => Config => BUILD_NOISY => 1; use Inline C => <<'EOC'; SV * get_handle() { return newSVuv(GetStdHandle(STD_OUTPUT_HANDLE)); } SV * get_attr(SV * h) { CONSOLE_SCREEN_BUFFER_INFO Info; if(!GetConsoleScreenBufferInfo((HANDLE)SvUV(h), &Info)) croak("Error obtaining current attributes"); return newSVuv(Info.wAttributes); } void set_attr(SV * h, SV * attr) { if(!SetConsoleTextAttribute((HANDLE)SvUV(h), (WORD)SvUV(attr))) croak("Error setting attributes"); } EOC use constant { FOREGROUND_BLUE => 1, FOREGROUND_GREEN => 2, FOREGROUND_RED => 4, FOREGROUND_INTENSITY => 8, BACKGROUND_BLUE => 16, BACKGROUND_GREEN => 32, BACKGROUND_RED => 64, BACKGROUND_INTENSITY => 128}; $| = 1; my $h = get_handle(); my $current = get_attr($h); my $current_background = $current & (BACKGROUND_RED | BACKGROUND_BLUE | BACKGROUND_GREEN | BACKGROUND_INTENSITY); # $current_foreground not needed in this script my $current_foreground = $current & (FOREGROUND_RED | FOREGROUND_BLUE | FOREGROUND_GREEN | FOREGROUND_INTENSITY); # Set $message to intense red on current background my $message = FOREGROUND_RED | FOREGROUND_INTENSITY | $current_background; set_attr($h, $message); print "ERROR_MSG = xyz"; # Restore original foreground/background colours. set_attr($h, $current); print "\n All Done\n";
And to pass that handle from perl back to C:SV * OpenDevice() { HANDLE handle; /* Do stuff that creates the handle */ return newSVuv(handle);
Alternatively, it can be passed around just as well as an unsigned long:void pass_handle(SV * handle) { HANDLE h = (HANDLE)SvUV(handle); /* Do stuff with the handle */ }
And to pass that handle from perl back to C:unsigned long OpenDevice() { HANDLE handle; /* Do stuff that creates the handle */ return (unsigned long)handle;
void pass_handle(unsigned long handle) { HANDLE h = (HANDLE)handle; /* Do stuff with the handle */ }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^5: Using Inline::C in a package
by BrowserUk (Patriarch) on Sep 05, 2013 at 12:30 UTC | |
by syphilis (Archbishop) on Sep 05, 2013 at 13:01 UTC | |
by BrowserUk (Patriarch) on Sep 05, 2013 at 13:07 UTC |