From c4aa3698f3a26637ccb1b6bcf4dd8d2693dc63dc Mon Sep 17 00:00:00 2001 From: Andrew Egeler Date: Sat, 4 Apr 2015 10:06:24 -0400 Subject: [PATCH 1/3] Find and use bundled SDL2.dll --- lib/SDL2/Raw.pm | 128 ++++++++++++++++++++++++++++-------------------- 1 file changed, 75 insertions(+), 53 deletions(-) diff --git a/lib/SDL2/Raw.pm b/lib/SDL2/Raw.pm index 040cd36..01f861e 100644 --- a/lib/SDL2/Raw.pm +++ b/lib/SDL2/Raw.pm @@ -1,12 +1,34 @@ use NativeCall; -my Str $lib; -BEGIN { - if $*VM.config ~~ /dll/ { - $lib = 'SDL2'; - } else { - $lib = 'libSDL2'; +sub find-bundled($lib is copy) { + # if we can't find one, assume there's a system install + my $base = "lib/SDL2/$lib"; + for @*INC { + if my @files = ($_.files($base) || $_.files("blib/$base")) { + my $files = @files[0]; + my $tmp = $files{$base} || $files{"blib/$base"}; + + # copy to a temp dir + $tmp.IO.copy($*SPEC.tmpdir ~ '\\' ~ $lib); + $lib = $*SPEC.tmpdir ~ '\\' ~ $lib; + + last; + } + } + + $lib; +} + +sub sdl-lib { + state $lib; + unless $lib { + if $*VM.config ~~ /dll/ { + $lib = find-bundled('SDL2.dll'); + } else { + $lib = 'libSDL2'; + } } + $lib; } class SDL_Point is repr('CStruct') { @@ -39,8 +61,8 @@ enum SDL_INIT ( :NOPARACHUTE(0x100000) ); -sub SDL_Init(int32 $flags) is native($lib) is export {*} -sub SDL_Quit() is native($lib) is export {*} +sub SDL_Init(int32 $flags) is native(&sdl-lib) is export {*} +sub SDL_Quit() is native(&sdl-lib) is export {*} class SDL_Window is repr('CPointer') { } @@ -124,13 +146,13 @@ class SDL_Texture is repr('CPointer') { } sub SDL_GetNumRenderDrivers() returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_GetRenderDriverInfo(int $index, SDL_RendererInfo $info) returns int - is native($lib) + is native(&sdl-lib) is export {*} @@ -138,108 +160,108 @@ sub SDL_CreateWindowAndRenderer(int $width, int $height, int32 $flags, CArray[SDL_Window] $win, CArray[SDL_Renderer] $renderer) returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_CreateRenderer(SDL_Window $win, int $index, int32 $flags) returns SDL_Renderer - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_CreateTexture(SDL_Renderer $renderer, int32 $format, int $access, int $w, int $h) returns SDL_Texture - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_SetRenderTarget(SDL_Renderer $renderer, SDL_Texture $texture) returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_UpdateTexture(SDL_Texture $tex, SDL_Rect $rect, OpaquePointer $data, int32 $pitch) returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_SetTextureBlendMode(SDL_Texture $tex, int $blendmode) returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_GetTextureBlendMode(SDL_Texture $tex, CArray[int] $blendmode) returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_RenderSetLogicalSize(SDL_Renderer $renderer, int $w, int $h) returns int - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_RenderGetLogicalSize(SDL_Renderer $renderer, CArray[int] $w, CArray[int] $h) - is native($lib) + is native(&sdl-lib) is export {*} sub SDL_SetRenderDrawColor(SDL_Renderer $renderer, int8 $r, int8 $g, int8 $b, int8 $a) returns int - is native($lib) + is native(&sdl-lib) is export {*} -sub SDL_SetTextureColorMod(SDL_Texture $texture, int8 $r, int8 $g, int8 $b) returns int32 is native($lib) is export {*} +sub SDL_SetTextureColorMod(SDL_Texture $texture, int8 $r, int8 $g, int8 $b) returns int32 is native(&sdl-lib) is export {*} -sub SDL_GetRenderDrawColor(SDL_Renderer $renderer, CArray[uint8] $r, CArray[uint8] $g, CArray[uint8] $b, CArray[uint8] $a) returns int is native($lib) is export {*} +sub SDL_GetRenderDrawColor(SDL_Renderer $renderer, CArray[uint8] $r, CArray[uint8] $g, CArray[uint8] $b, CArray[uint8] $a) returns int is native(&sdl-lib) is export {*} sub SDL_SetRenderDrawBlendMode(SDL_Renderer $renderer, int $blendmode) - is native($lib) + is native(&sdl-lib) is export {*} -sub SDL_RenderCopy(SDL_Renderer $renderer, SDL_Texture $src, SDL_Rect $srcrect, SDL_Rect $destrect) returns int is native($lib) is export {*} -sub SDL_RenderCopyEx(SDL_Renderer $renderer, SDL_Texture $src, SDL_Rect $srcrect, SDL_Rect $destrect, num $angle, SDL_Point $center, int $flip) returns int is native($lib) is export {*} +sub SDL_RenderCopy(SDL_Renderer $renderer, SDL_Texture $src, SDL_Rect $srcrect, SDL_Rect $destrect) returns int is native(&sdl-lib) is export {*} +sub SDL_RenderCopyEx(SDL_Renderer $renderer, SDL_Texture $src, SDL_Rect $srcrect, SDL_Rect $destrect, num $angle, SDL_Point $center, int $flip) returns int is native(&sdl-lib) is export {*} -sub SDL_RenderClear(SDL_Renderer $renderer) returns int is native($lib) is export {*} -sub SDL_RenderPresent(SDL_Renderer $renderer) is native($lib) is export {*} +sub SDL_RenderClear(SDL_Renderer $renderer) returns int is native(&sdl-lib) is export {*} +sub SDL_RenderPresent(SDL_Renderer $renderer) is native(&sdl-lib) is export {*} -sub SDL_RenderDrawPoint(SDL_Renderer $renderer, int $x, int $y) returns int is native($lib) is export {*} -sub SDL_RenderDrawLine(SDL_Renderer $renderer, int $x, int $y, int $x2, int $y2) returns int is native($lib) is export {*} +sub SDL_RenderDrawPoint(SDL_Renderer $renderer, int $x, int $y) returns int is native(&sdl-lib) is export {*} +sub SDL_RenderDrawLine(SDL_Renderer $renderer, int $x, int $y, int $x2, int $y2) returns int is native(&sdl-lib) is export {*} -sub SDL_RenderDrawRect(SDL_Renderer $renderer, SDL_Rect $rect) returns int is native($lib) is export {*} -sub SDL_RenderFillRect(SDL_Renderer $renderer, SDL_Rect $rect) returns int is native($lib) is export {*} +sub SDL_RenderDrawRect(SDL_Renderer $renderer, SDL_Rect $rect) returns int is native(&sdl-lib) is export {*} +sub SDL_RenderFillRect(SDL_Renderer $renderer, SDL_Rect $rect) returns int is native(&sdl-lib) is export {*} -sub SDL_DestroyTexture(SDL_Texture $texture) is native($lib) is export {*} -sub SDL_DestroyRenderer(SDL_Renderer $renderer) is native($lib) is export {*} +sub SDL_DestroyTexture(SDL_Texture $texture) is native(&sdl-lib) is export {*} +sub SDL_DestroyRenderer(SDL_Renderer $renderer) is native(&sdl-lib) is export {*} -sub SDL_GL_BindTexture(SDL_Texture $texture, CArray[num] $texw, CArray[num] $texh) returns int is native($lib) is export {*} -sub SDL_GL_UnBindTexture(SDL_Texture $texture) returns int is native($lib) is export {*} +sub SDL_GL_BindTexture(SDL_Texture $texture, CArray[num] $texw, CArray[num] $texh) returns int is native(&sdl-lib) is export {*} +sub SDL_GL_UnBindTexture(SDL_Texture $texture) returns int is native(&sdl-lib) is export {*} -sub SDL_VideoInit(Str $drivername) returns int is native($lib) is export {*} -sub SDL_VideoQuit() is native($lib) is export {*} +sub SDL_VideoInit(Str $drivername) returns int is native(&sdl-lib) is export {*} +sub SDL_VideoQuit() is native(&sdl-lib) is export {*} -sub SDL_GetNumVideoDrivers() returns int is native($lib) is export {*} -sub SDL_GetVideoDriver(int $index) returns Str is native($lib) is export {*} -sub SDL_GetCurrentVideoDriver() returns Str is native($lib) is export {*} +sub SDL_GetNumVideoDrivers() returns int is native(&sdl-lib) is export {*} +sub SDL_GetVideoDriver(int $index) returns Str is native(&sdl-lib) is export {*} +sub SDL_GetCurrentVideoDriver() returns Str is native(&sdl-lib) is export {*} -sub SDL_GetNumVideoDisplays() returns int is native($lib) is export {*} -sub SDL_GetDisplayName(int $index) returns Str is native($lib) is export {*} -sub SDL_GetDisplayBounds(int $index, SDL_Rect $rect) returns int is native($lib) is export {*} +sub SDL_GetNumVideoDisplays() returns int is native(&sdl-lib) is export {*} +sub SDL_GetDisplayName(int $index) returns Str is native(&sdl-lib) is export {*} +sub SDL_GetDisplayBounds(int $index, SDL_Rect $rect) returns int is native(&sdl-lib) is export {*} -sub SDL_CreateWindow(Str $title, int $x, int $y, int $w, int $h, int32 $flags) returns SDL_Window is native($lib) is export {*} -sub SDL_SetWindowTitle(SDL_Window $window, Str $title) returns Str is native($lib) is export {*} -sub SDL_GetWindowTitle(SDL_Window $window) returns Str is native($lib) is export {*} +sub SDL_CreateWindow(Str $title, int $x, int $y, int $w, int $h, int32 $flags) returns SDL_Window is native(&sdl-lib) is export {*} +sub SDL_SetWindowTitle(SDL_Window $window, Str $title) returns Str is native(&sdl-lib) is export {*} +sub SDL_GetWindowTitle(SDL_Window $window) returns Str is native(&sdl-lib) is export {*} -sub SDL_UpdateWindowSurface(SDL_Window $window) returns int is native($lib) is export {*} +sub SDL_UpdateWindowSurface(SDL_Window $window) returns int is native(&sdl-lib) is export {*} -sub SDL_SetWindowGrab(SDL_Window $window, int $grabbed) is native($lib) is export {*} -sub SDL_GetWindowGrab(SDL_Window $window) returns int is native($lib) is export {*} +sub SDL_SetWindowGrab(SDL_Window $window, int $grabbed) is native(&sdl-lib) is export {*} +sub SDL_GetWindowGrab(SDL_Window $window) returns int is native(&sdl-lib) is export {*} enum SDL_EventType ( @@ -370,9 +392,9 @@ class SDL_MouseWheelEvent is repr('CStruct') { has int32 $.y; } -sub SDL_PollEvent(SDL_Event $event) returns int32 is native($lib) is export {*} -sub SDL_WaitEvent(SDL_Event $event) returns int32 is native($lib) is export {*} -sub SDL_WaitEventTimeout(SDL_Event $event, int32 $timeout) returns int32 is native($lib) is export {*} +sub SDL_PollEvent(SDL_Event $event) returns int32 is native(&sdl-lib) is export {*} +sub SDL_WaitEvent(SDL_Event $event) returns int32 is native(&sdl-lib) is export {*} +sub SDL_WaitEventTimeout(SDL_Event $event, int32 $timeout) returns int32 is native(&sdl-lib) is export {*} sub SDL_CastEvent(SDL_Event $event) is export { given $event.type { @@ -402,7 +424,7 @@ our constant SDL_IGNORE = 0; our constant SDL_DISABLE = 0; our constant SDL_ENABLE = 1; -sub SDL_EventState(int32 $type, int32 $state) returns uint8 is native($lib) is export {*} +sub SDL_EventState(int32 $type, int32 $state) returns uint8 is native(&sdl-lib) is export {*} my sub _pxfmt($type, $order, $layout, $bits, $bytes) { (1 +< 28) +| ($type +< 24) +| ($order +< 20) +| ($layout +< 16) +| ($bits +< 8) +| $bytes From df21957044ecb6ec81e29170075db9d7f2e0193a Mon Sep 17 00:00:00 2001 From: Andrew Egeler Date: Sat, 4 Apr 2015 10:12:37 -0400 Subject: [PATCH 2/3] Download SDL2.dll if needed --- Build.pm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 Build.pm diff --git a/Build.pm b/Build.pm new file mode 100644 index 0000000..42adef4 --- /dev/null +++ b/Build.pm @@ -0,0 +1,54 @@ +use Panda::Builder; + +use Shell::Command; +use LWP::Simple; +use NativeCall; + +# test sub for system library +sub test() is native('SDL2.dll') { * } + +class Build is Panda::Builder { + method build($workdir) { + my $need-copy = False; + + # we only have .dll files bundled. Non-windows is assumed to have openssl already + if $*DISTRO.is-win { + test(); + CATCH { + default { + $need-copy = True if $_.payload ~~ m:s/Cannot locate/; + } + } + } + + if $need-copy { + # to avoid a dependency (and because Digest::SHA is too slow), we do a hacked up powershell hash + # this should work all the way back to powershell v1 + my &ps-hash = -> $path { + my $fn = 'function get-sha256 { param($file);[system.bitconverter]::tostring([System.Security.Cryptography.sha256]::create().computehash([system.io.file]::openread((resolve-path $file)))) -replace \"-\",\"\" } '; + my $out = qqx/powershell -noprofile -Command "$fn get-sha256 $path"/; + $out.lines.grep({$_.chars})[*-1]; + } + say 'No system SDL library detected. Installing bundled version.'; + mkdir($workdir ~ '\blib\lib\SDL2'); + my @files = ("SDL2.dll"); + my @hashes = ("20EB366E76D04CEF2CF38FF4D4D7A7DCBFB75C6B50281960A49861F847561E54"); + for @files Z @hashes -> $f, $h { + say "Fetching " ~ $f; + my $blob = LWP::Simple.get('http://URI/for/download/' ~ $f); + say "Writing " ~ $f; + spurt($workdir ~ '\blib\lib\SDL2\\' ~ $f, $blob); + + say "Verifying " ~ $f; + my $hash = ps-hash($workdir ~ '\blib\lib\SDL2\\' ~ $f); + if ($hash ne $h) { + die "Bad download of $f (got: $hash; expected: $h)"; + } + say ""; + } + } + else { + say 'Found system SDL library.'; + } + } +} From df641de5e67c6f08ab608db0ec2d1c7a9872e16e Mon Sep 17 00:00:00 2001 From: Andrew Egeler Date: Sat, 4 Apr 2015 10:16:02 -0400 Subject: [PATCH 3/3] Include LWP::Simple for dll fetch --- META.info | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/META.info b/META.info index 15b97b3..eb7a9c2 100644 --- a/META.info +++ b/META.info @@ -2,7 +2,7 @@ "name" : "SDL2::Raw", "version" : "0.1", "description" : "Sugar-free NativeCall binding for libSDL2", - "depends" : [ ], + "depends" : [ "LWP::Simple" ], "source-url" : "git://github.com/timo/SDL2_Raw-p6.git", "author" : "Timo Paulssen", "provides": {