Hi Todd,
I refactored your code a bit to make it a bit more readable IMHO. Thinking
on publish it on modules.raku.org if you are not interested to do so.
#`{
Reference:
https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-messagebox
https://stackoverflow.com/questions/59105696/how-can-i-create-pop-up-windows-for-perl6-in-windows
}
use NativeCall;
enum Icons (
MB_ICONEXCLAMATION => 0x00000030,
MB_ICONWARNING => 0x00000030,
MB_ICONINFORMATION => 0x00000040,
MB_ICONASTERISK => 0x00000040,
MB_ICONQUESTION => 0x00000020,
MB_ICONSTOP => 0x00000010,
MB_ICONERROR => 0x00000010,
MB_ICONHAND => 0x00000010
);
enum Buttons (
MB_ABORTRETRYIGNORE => 0x00000002,
MB_CANCELTRYCONTINUE => 0x00000006,
MB_HELP => 0x00004000,
MB_OK => 0x00000000,
MB_OKCANCEL => 0x00000001,
MB_RETRYCANCEL => 0x00000005,
MB_YESNO => 0x00000004,
MB_YESNOCANCEL => 0x00000003
);
enum MessageBoxReturn (
DABORT => 3,
IDCANCEL => 2,
IDCONTINUE => 11,
IDIGNORE => 5,
IDNO => 7,
IDOK => 1,
IDRETRY => 4,
IDTRYAGAIN => 10,
IDYES => 6
);
constant WCHAR = uint16;
constant INT = int32;
constant UINT = uint32;
constant HANDLE = Pointer[void];
constant LPWCTSTR = CArray[WCHAR];
sub MessageBoxW( HANDLE, LPWCTSTR, LPWCTSTR, UINT ) is
native('user32') returns INT { * };
sub to-c-str( Str $str ) returns CArray[WCHAR] {
my @str := CArray[WCHAR].new;
for ( $str.comb ).kv -> $i, $char { @str[$i] = $char.ord; }
@str[ $str.chars ] = 0;
@str;
}
sub MessageBox(Str $title, Str $message, Icons $icon =
Icons::MB_ICONINFORMATION, Buttons $button = Buttons::MB_OK) returns
MessageBoxReturn is export
{
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" { say "Sorry, $SubName only work in Windows.";
exit; }
MessageBoxReturn(MessageBoxW( my $handle, to-c-str( $message ),
to-c-str( $title ), $icon +| $button ));
}
On Sat, 7 Dec 2019 at 13:36, Tom Browder <tom.brow...@gmail.com> wrote:
> On Sat, Dec 7, 2019 at 05:41 ToddAndMargo via perl6-users <
> perl6-users@perl.org> wrote:
>
>> Hi All,
>>
>> I wrote and extensive module for pop up in Windows.
>
>
> Todd, you need to publish your module to the Raku module ecosystem. Many
> people, including myself, want to see an easily-installable module with at
> least some basic tests to give strangers confidence that it will not blow
> up. Instructions are in the docs, and there are helper modules to get you
> started.
>
> I'll send you specific doc references later when I get a chance, but it's
> probably better for you to dig around the doc site a bit more on your own.
> Hint: in the search box, enter 'module'.
>
> -Tom
>
>
>>
>> It does not contain a time out option. Maybe some day I
>> will work on the timer function.
>>
>> Thank you all for helping me with various parts of this!
>>
>> There are basically two subs to import
>> WinMsg and WinPopUp
>>
>> Here are some one liners to test it with:
>>
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
>> Duper Title', 'What? You were expecting something witty?',
>> 'Information', 'Ok' );"
>>
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
>> Duper Title', 'What? You were expecting something witty?', 'Question',
>> 'YesNoCancel' );
>>
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg; WinMsg( 'Super
>> Duper Title', 'What? You were expecting something witty?' );"
>>
>> Let me know if you find any booboo's.
>>
>> -T
>>
>>
>> <WinPopUps.pm6>
>> # unit module WinPopUps;
>> # WinMsg.pm6
>>
>> #`{
>> Reference:
>>
>>
>> https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-messagebox
>>
>>
>> https://stackoverflow.com/questions/59105696/how-can-i-create-pop-up-windows-for-perl6-in-windows
>> }
>>
>> use NativeCall;
>>
>> sub WinPopUp( Str $TitleStr,
>> Str $MessageStr,
>> Str $Icons where * ~~ "Exclamation" |
>> "Warning" |
>> "Information" |
>> "Asterisk" |
>> "Question" |
>> "Stop" |
>> "Error" |
>> "Hand",
>> Str $Buttons where * ~~ "AbortRetryIgnore" |
>> "CancelTryAgainContinue" |
>> "Help" |
>> "Ok" |
>> "OkCancel" |
>> "RetryCancel" |
>> "YesNo" |
>> "YesNoCancel" )
>> is export( :WinPopUp ) {
>>
>> #`{
>>
>> Pop up a message box to the user. Windows only.
>> Return what button was pressed
>>
>> Note: you are constrainedthe the Icon and Button values shown in
>> the sub declaration.
>>
>> Test one liners:
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp(
>> 'Super Duper Title', 'What? You were expecting something witty?',
>> 'Information', 'Ok' );"
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp(
>> 'Super Duper Title', 'What? You were expecting something witty?',
>> 'Question', 'YesNoCancel' );
>>
>> }
>>
>> my Str $SubName = &?ROUTINE.name;
>> my Str $OS = $*KERNEL.name;
>>
>> if not $OS eq "win32" { say "Sorry, $SubName only work in Windows.";
>> exit; }
>> my int32 $RtnInt = 0;
>> my Str $RtnStr = "";
>> my int32 $IconInt;
>> my int32 $ButtonInt;
>> my int32 $UINT;
>>
>> # Note: these constants are 32 bit
>> constant WCHAR = uint16;
>> constant INT = int32;
>> constant UINT = uint32;
>> constant HANDLE = Pointer[void];
>> constant LPWCTSTR = CArray[WCHAR];
>>
>>
>> constant MB_ICONEXCLAMATION = 0x00000030;
>> constant MB_ICONWARNING = 0x00000030;
>> constant MB_ICONINFORMATION = 0x00000040;
>> constant MB_ICONASTERISK = 0x00000040;
>> constant MB_ICONQUESTION = 0x00000020;
>> constant MB_ICONSTOP = 0x00000010;
>> constant MB_ICONERROR = 0x00000010;
>> constant MB_ICONHAND = 0x00000010;
>>
>>
>> constant MB_ABORTRETRYIGNORE = 0x00000002;
>> constant MB_CANCELTRYCONTINUE = 0x00000006;
>> constant MB_HELP = 0x00004000;
>> constant MB_OK = 0x00000000;
>> constant MB_OKCANCEL = 0x00000001;
>> constant MB_RETRYCANCEL = 0x00000005;
>> constant MB_YESNO = 0x00000004;
>> constant MB_YESNOCANCEL = 0x00000003;
>>
>> constant DABORT = 3;
>> constant IDCANCEL = 2;
>> constant IDCONTINUE = 11;
>> constant IDIGNORE = 5;
>> constant IDNO = 7;
>> constant IDOK = 1;
>> constant IDRETRY = 4;
>> constant IDTRYAGAIN = 10;
>> constant IDYES = 6;
>>
>>
>> # Note: the following two subs have to be embedded
>>
>> sub MessageBoxW( HANDLE, LPWCTSTR, LPWCTSTR, UINT ) is
>> native('user32') returns INT { * };
>>
>> sub to-c-str( Str $str ) returns CArray[WCHAR] {
>> my @str := CArray[WCHAR].new;
>> for ( $str.comb ).kv -> $i, $char { @str[$i] = $char.ord; }
>> @str[ $str.chars ] = 0;
>> @str;
>> }
>>
>>
>> if $Icons eq "Exclamation" { $IconInt = MB_ICONEXCLAMATION; }
>> elsif $Icons eq "Warning" { $IconInt = MB_ICONWARNING; }
>> elsif $Icons eq "Information" { $IconInt = MB_ICONINFORMATION; }
>> elsif $Icons eq "Asterisk" { $IconInt = MB_ICONASTERISK; }
>> elsif $Icons eq "Question" { $IconInt = MB_ICONQUESTION; }
>> elsif $Icons eq "Stop" { $IconInt = MB_ICONSTOP; }
>> elsif $Icons eq "Error" { $IconInt = MB_ICONERROR; }
>> elsif $Icons eq "Hand" { $IconInt = MB_ICONHAND; }
>>
>> if $Buttons eq "AbortRetryIgnore" { $ButtonInt =
>> MB_ABORTRETRYIGNORE; }
>> elsif $Buttons eq "CancelTryAgainContinue" { $ButtonInt =
>> MB_CANCELTRYCONTINUE; }
>> elsif $Buttons eq "Help" { $ButtonInt = MB_HELP; }
>> elsif $Buttons eq "Ok" { $ButtonInt = MB_OK; }
>> elsif $Buttons eq "OkCancel" { $ButtonInt =
>> MB_OKCANCEL; }
>> elsif $Buttons eq "RetryCancel" { $ButtonInt =
>> MB_RETRYCANCEL; }
>> elsif $Buttons eq "YesNo" { $ButtonInt = MB_YESNO; }
>> elsif $Buttons eq "YesNoCancel" { $ButtonInt =
>> MB_YESNOCANCEL; }
>>
>> $UINT = $IconInt +| $ButtonInt; # Bitwise OR them together
>>
>> $RtnInt = MessageBoxW( my $handle, to-c-str( $MessageStr ),
>> to-c-str( $TitleStr ), $UINT );
>>
>> # say $RtnInt;
>> if $RtnInt == DABORT { $RtnStr = "Abort"; }
>> elsif $RtnInt == IDCANCEL { $RtnStr = "Cancel"; }
>> elsif $RtnInt == IDCONTINUE { $RtnStr = "Continue"; }
>> elsif $RtnInt == IDIGNORE { $RtnStr = "Ignore"; }
>> elsif $RtnInt == IDNO { $RtnStr = "No"; }
>> elsif $RtnInt == IDOK { $RtnStr = "Ok"; }
>> elsif $RtnInt == IDRETRY { $RtnStr = "Retry"; }
>> elsif $RtnInt == IDTRYAGAIN { $RtnStr = "Try Again"; }
>> elsif $RtnInt == IDYES { $RtnStr = "Yes"; }
>>
>> return $RtnStr;
>> }
>>
>>
>> sub WinMsg( Str $TitleStr, Str $MessageStr ) is export( :WinMsg ) {
>>
>> #`{
>> Simple "Ok" pop up with no return value
>>
>> Test one liner:
>> perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg;
>> WinMsg( 'Super Duper Title', 'What? You were expecting something witty?'
>> );"
>>
>> }
>>
>> WinPopUp( $TitleStr, $MessageStr, "Information", "Ok" );
>>
>> }
>> </WinpopUps.pm6>
>>
>
