Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

The Monastery Gates

( #131=superdoc: print w/ replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Error in HTTPS connection with error: No connection could be made because the target machine actively refused it. at C:/Perl/lib/LWP/Protocol/http.pm line 47
2 direct replies — Read more / Contribute
by jliu5
on Jul 26, 2016 at 11:36

    Hi Monks,

    I am trying to create a REST client to do a simple GET service at a https server, but got this error.

    Here is my sample code, please advice.:

    #! /usr/bin/env perl use REST::Client; use MIME::Base64; my $username = 'me'; my $password = 'me!!'; my $headers = {Accept => 'application/xml', Authorization => 'Basic ' +. encode_base64($username . ':' . $password)}; my $client = REST::Client->new(); $client->getUseragent->ssl_opts(verify_hostname => 0); $client->getUseragent->ssl_opts(SSL_verify_mode => SSL_VERIFY_NONE); $client->getUseragent->no_proxy('server_ip_string', 'server_ip_string' +); $client->GET("https://server_ip_string:port/upm-server/nbi/organizatio +n", $headers ); my $response = $client->responseContent(); print $response;
IO::Compress::Gzip file close issues
2 direct replies — Read more / Contribute
by Paul.Unix
on Jul 26, 2016 at 07:08
    I encountered an issue with IO::Compress::Gzip. After a successful gzip I want to unlink the original file but sometimes the unlink fails with a "permission denied" I made a pragmatic work around by adding a delay and try the unlink again. But a good solution would be preferred. The same issue happens with moving the new .gz to another directory. The files are not in use by another process. Running Strawberry Perl 5.22.0 on Windows 2008 and 2012
    use warnings; use strict; use POSIX; use Cwd; use Cwd 'abs_path'; use Time::Local 'timelocal_nocheck'; # used for SCHEDULE option in +the MQX.ini use Net::Domain qw(hostname hostfqdn hostdomain domainname); use File::Basename; use File::Copy; use IO::Compress::Gzip qw(gzip $GzipError) ; use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; # module used in the state messages use Digest::MD5; # modules used in put mode use threads; use threads::shared; use Thread::Queue; if ( gzip $archfile => "$archfile.gz", AutoClose => 1, BinModeI +n => 1 ) { my $delete_try_counter = mqx_get_setting('ARCHIVEMOVETRY'); while ( -f $archfile and not unlink $archfile and $dele +te_try_counter != 0 ) { $global_EVENTLOG_IN_LQ->enqueue("WARNING, $arch_ha +shref->{'EVENTLOG'},Can not delete $archfile. Error: $! try: $delete_ +try_counter"); $delete_try_counter -= 1; sleep(mqx_get_setting('ARCHIVEMOVEWAIT')); # wait x sec +onds before retrying } $archfile .= ".gz"; # add .gz to the file name } else { # if the gzip failed try to arc +hive the original file $global_EVENTLOG_IN_LQ->enqueue("ERROR, $arch_hashref->{' +EVENTLOG'}, gzip failed on $archfile\n$GzipError"); }
@INC not set for perlbrew
3 direct replies — Read more / Contribute
by Alessandro
on Jul 25, 2016 at 14:07

    Hi monks,

    I am on os x El capitan and have perlbrew installed. However, when I install a perl module I can't get it working, because it seems perl is not looking at the right place.

    Can't locate WWW/Mechanize.pm in @INC (you may need to install the WWW::Mechanize module) (@INC contains: /Library/Perl/5.18/darwin-thread-multi-2level /Library/Perl/5.18 /Network/Library/Perl/5.18/darwin-thread-multi-2level /Network/Library/Perl/5.18 /Library/Perl/Updates/5.18.2/darwin-thread-multi-2level /Library/Perl/Updates/5.18.2 /System/Library/Perl/5.18/darwin-thread-multi-2level /System/Library/Perl/5.18 /System/Library/Perl/Extras/5.18/darwin-thread-multi-2level /System/Library/Perl/Extras/5.18 .)

    also

     which perl returns  /opt/local/bin/perl5

    my understanding is that it should return the path to perlbrew install and not the system perl.

    and  perl -v returns  This is perl 5, version 22, subversion 2 (v5.22.2) built for darwin-thread-multi-2level and I indeed used perlbrew to install and switch to perl 5.22.2 but it seems somehow, the "switch" was only partial. What am I missing here?

    Thanks

Recommendations on a module for web crawling
1 direct reply — Read more / Contribute
by edimusrex
on Jul 25, 2016 at 13:59

    I am trying to crawl a web page where the data I am seeking is generated by javascript. I haven't had to deal with this before but I can imagine I am not the only one who has come across this. Is there a specific module that is preferred in this instance? I've tried using Mechanize::Firefox but the page complains about unsupported browser. I'd prefer to do this in perl but will use other languages if need be.

    Thanks for your recommendations

Apache Kafka prior use
No replies — Read more | Post response
by Wiggins
on Jul 23, 2016 at 14:52
    I am looking for advice from someone who has sailed a possibly mythical sea named 'Apache Kafka' in a Perl boat.

    Due to a thinness of published guidance for the Perl interface, I would like to know if a different Producer is needed for each 'different topic'? I have the producer and consumer each on separate threads. But now have to publish to 3 different topics. I know consumers a 1:1 with topics. Are publishers the same?

    Update

    I have ventured a small distance from shore and returned where I had hoped. I find that a single Producer can handle multiple ( =2 which is greater than 1) topics.

    It is always better to have seen your target for yourself, rather than depend upon someone else's description.

Regex on a variable with special characters
3 direct replies — Read more / Contribute
by jaydee
on Jul 22, 2016 at 04:40
    I have 2 variables one is simple like below.
    $x = "SERVER-NAME";
    and I am trying to see if $y starts with $x, but $y sometimes contains regex special characters like ()[], also ** which can give me errors.

    How can I safely check if $x at the start of $y?

    $y =~ /^$x/;
    is the current regex I am using.
XS generation error, function returning list
1 direct reply — Read more / Contribute
by Cacadril
on Jul 21, 2016 at 15:46

    Following the perlxstut, in example 5 I get the following error:

    Mytest.c:251:2: error: too few arguments to function 'statfs'

    The example creates a module function statfs that is tested like this in t/Mytest.t:

    my @a; @a = &Mytest::my_statfs("/blech"); # Test non-existent file/directory ok( scalar(@a) == 1 && $a[0] == 2 ); @a = &Mytest::my_statfs("/"); # Test existing file/directory is ( scalar(@a), 7 );

    In other words, the function returns a list.

    In Mytest.xs:

    #include <sys/vfs.h> ... void statfs(path) char * path INIT: int i; struct statfs buf; PCODE: i = statfs(path, &buf); if (i == 0) { XPUSHs(sv_2mortal(newSVnv(buf.f_bavail))); XPUSHs(sv_2mortal(newSVnv(buf.f_bfree))); XPUSHs(sv_2mortal(newSVnv(buf.f_blocks))); XPUSHs(sv_2mortal(newSVnv(buf.f_bsize))); XPUSHs(sv_2mortal(newSVnv(buf.f_ffree))); XPUSHs(sv_2mortal(newSVnv(buf.f_files))); XPUSHs(sv_2mortal(newSVnv(buf.f_type))); } else { XPUSHs(sv_2mortal(newSVnv(errno))); }

    The Makefile.PL generates the following C code:

    XS_EUPXS(XS_Mytest_statfs) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "path"); { char * path = (char *)SvPV_nolen(ST(0)) ; #line 43 "Mytest.xs" int i; struct statfs buf; PCODE: i = statfs(path, &buf); if (i == 0) { XPUSHs(sv_2mortal(newSVnv(buf.f_bavail))); XPUSHs(sv_2mortal(newSVnv(buf.f_bfree))); XPUSHs(sv_2mortal(newSVnv(buf.f_blocks))); XPUSHs(sv_2mortal(newSVnv(buf.f_bsize))); XPUSHs(sv_2mortal(newSVnv(buf.f_ffree))); XPUSHs(sv_2mortal(newSVnv(buf.f_files))); XPUSHs(sv_2mortal(newSVnv(buf.f_type))); } else { XPUSHs(sv_2mortal(newSVnv(errno))); } #line 250 "Mytest.c" statfs(path); } XSRETURN_EMPTY; }

    Look near the end of this function. Why is this call to statfs being generated? I have tried to call the module function "my_statfs" instead of "statfs", Then the call near the end of the function becomes my_statfs(buf), while the call to the actual library function statfs remains statfs(path, buf), and the compiler message becomes "undefined reference to `my_statfs'".

    Why is this call being generated? What am I doing wrong?

    And, is XSRETURN_EMPTY the appropriate macro for a function that returns a non-empty list?

Match Line And Combine Into One Line
4 direct replies — Read more / Contribute
by jlope043
on Jul 21, 2016 at 13:37
    Hello Everyone, I am very new to Perl and have been learning it for the last few months now, but I have a scenario here that is a little out of my skill level and seeking help from the Pros on here. I have a report that I was given and need to reformat the report into a cleaner file to import into my system. I haven't a clue how to start to write this code which is why I didn't include one. I know I will need something like a MATCH or FIND, maybe a CHOMP and so one. What I want to do is combine the lines into the matching account. I have included a copy of my INPUT file and the format of my expected OUPUT file. Any help and explanation of the code would be great! Thank you in advance.

    input

    H123456,20151209,THIS IS A TEST H123456,20151209,TO COMBINE ALL H123456,20151209,MY MATCHING LINES H123456,20151209,INTO THE FIRST LINE H123456,20151209,THAT MATCHES. H654321,20151209,MATCH LINES FOR THIS H654321,20151209,ACCT INTO THE H654321,20151209,TOP LINE OF THE ACCT H432165,20151209,SINGLE LINE FOR THIS ONE

    expected output

    H123456,20151209,THIS IS A TEST TO COMBINE ALL MY MATCHING LINES INTO +THE FIRST LINE THAT MATCHES. H654321,20151209,MATCH LINES FOR THIS ACCT INTO THE TOP LINE OF THE AC +CT. H432165,20151209,SINGLE LINE FOR THIS ONE
Average start time handling midnight
8 direct replies — Read more / Contribute
by chrisjej
on Jul 21, 2016 at 08:16

    I'm wondering if anyone has a good algorithm to work out average start time that handles times over midnight. Assume the job runs once every 24 hours and will usually start within a 6 hour window.

    Obviously you could just sum seconds since midnight / number entries, which would work well if your times were:

    11:00 and 13:00 where it would give the plausible 12:00

    However...

    23:00 and 01:00 would also give the answer 12:00 whereas 00:00 is desirable.

    If, instead, you calculated this second example on seconds since 12:00 - you would get the desired answer of 00:00. But then the first example would also give you 00:00.

    I'm thinking you could do it by doing a first pass to generate a histogram and then derive a good base time from that.

    But I was hoping someone might already have implemented or know of a solution.

Perl API version v5.18.0 of ... does not match v5.16.0 ...
3 direct replies — Read more / Contribute
by Nightgem
on Jul 21, 2016 at 05:18

    Hi!

    I'm having trouble getting a Perl module (File::Sync) to work:
    perl -e "use File::Sync" Perl API version v5.18.0 of File::Sync does not match v5.16.0 at /usr/ +lib64/perl5/DynaLoader.pm line 213. Compilation failed in require at -e line 1. BEGIN failed--compilation aborted at -e line 1.

    The Perl version installed on the system is v5.16.3, built for x86_64-linux-thread-multi. I was wondering if anyone here could point me in the right direction to get this fixed and working properly. The File::Sync module was installed using cpanm.

    Thanks!
Variables are automatically rounded off in perl
5 direct replies — Read more / Contribute
by Anonymous Monk
on Jul 21, 2016 at 02:37
    $hash->{TGT}=3335.9999999999995; print $hash->{TGT}; Actual Result:- 3336 Excepted Result:- 3335.9999999999995
Install and then load missing modules with in a script
1 direct reply — Read more / Contribute
by edimusrex
on Jul 20, 2016 at 14:16

    I am not sure if what I am attempting is possible but I'll ask any ways. I have a script which performs various checks. This script will be deployed on at least 6 servers. Currently I only require it to use 2 modules, DateTime and DBI; The idea is that it will first check to see if those modules are indeed installed and if they are not, install and load them. I am looking into Module::Load but not sure if it can handle what I am trying to accomplish. I'd prefer not to use a module to do this. What I currently have is the following

    #!/usr/bin/perl use warnings; use strict; my $version = `cat /etc/*-release | head -n 1`; chomp $version; my ($os) = $version =~ /(Ubuntu|CentOS)/; my %rhel = ( "DBI" => "perl-Class-DBI-mysql.noarch", "DateTime" => "perl-DateTime.x86_64", ); if ($os eq 'CentOS'){ foreach my $mod (keys %rhel){ eval { require $mod; $mod->import(); 1; } or do { system("yum install $rhel{$mod} -y"); } } }

    2 issues with this, 1 it does not actually seem to load the module and 2 I don't want the text in STDOUT from the eval.

    If any of this makes any sense and you can help I'd love the advice. Thanks in advance


    ------ UPDATE ------

    Seems like I have solved my issue. Here is what I ended up doing

    #!/usr/bin/perl use warnings; use strict; my $version = `cat /etc/*-release | head -n 1`; chomp $version; my ($os) = $version =~ /(Ubuntu|CentOS)/; my %rhel = ( "DBI" => "perl-Class-DBI-mysql.noarch", "DateTime" => "perl-DateTime.x86_64", ); if ($os eq 'CentOS'){ foreach my $mod (keys %rhel){ eval "use $mod"; if($@){ system("yum install $rhel{$mod} -y"); eval "use $mod"; } } }

    Thanks for the help

New Cool Uses for Perl
Perl 6 SDL2 game
No replies — Read more | Post response
by holyghost
on Jul 25, 2016 at 02:04
    I need to have something to make a buffer for C32 byte arrays. This is for the SDL2 texture. I choose an Xpm file, as it faster parsable in perl. Buffer filling and swapping from a png package is less expensive, therefor I started a PNGImageObject. With PERL 6, SDL2::Raw panda package you can make the following perliminary game :
    ### See the LICENSE file for details ### use v6.0; use NativeCall; unit module PaganVisions2; class PaganVision2::Entity is GameObject { has $!staticimagelib ### StateImagelibrary.pm6 method update() { } method draw($renderer) { $!staticimagelib.getImage().display($renderer); } } ### See the LICENSE file for details ### use v6.0; use NativeCall; unit module PaganVisions2; class PaganVision2::GameObject { has $!x; has $!y; has $!mousex; has $!mousey; has $!w; has $!h; method BUILD($x, $y, $w, $h) { $!x = $x; $!y = $y; $!w = $w; $!h = $h; } method updateset($dx, $dy, $maprelx, $maprely) { $x += $dx; $y += $dy; } method updatemouse($mousex, $mousey) { $!mousex = $mousex; $!mousey = $mousey; } method update($dx, $dy, $maprelx, $maprely, $mousex = nil, $mousey + = nil) { self.updateset($dx, $dy, $maprelx, $maprely); self.updatemouse($mousex, $mousey); } } ### See the LICENSE file for details ### use v6.0; use NativeCall; unit module PaganVisions2; class PaganVision2::Gnome is MovingEntity { } ### See the LICENSE file for details ### use v6.0; use NativeCall; use SDL2::Raw unit module PaganVisions2; class PaganVision2::Image { has $!image_data; has $!tile; has $!srcrect; has $!destrect; method BUILD($width, $height, $filename, $imageobject) { my CArray[int32] $data .= new; $imageobject.parse($filename, \$data); $!image_data = $data; ###SDL_Rect SDL_Rect $!srcrect .= new: x => 0, y => 0, w => $width, h => $ +height; SDL_Rect $!destrect .= new: x => $!x, y => $!y, w => $width, h + => $height; } method display($renderer) { SDL_RenderCopy($renderer, $tile, $!srcrect, $!destrect); } } ### See the LICENSE file for details ### use v6.0; use NativeCall; unit module PaganVisions2; class PaganVision2::MovingEntity is GameObject { has $!direction; has $!moving; has $!dx; ### move x + dx has $!dy; has $!leftstaticimagelib ### StateImagelibrary.pm6 has $!righttstaticimagelib has $!upstaticimagelib has $!downstaticimagelib has $!leftimagelib has $!rightimagelib has $!upimagelib has $!downimagelib method update() { } method draw($renderer) { if (not $!moving) { if ($!direction = "westdirection") { $!leftstaticimagelib.getImage().display($renderer); } elsif ($!direction = "eastdirection") { $!rightstaticimagelib.getImage().display($renderer); } elsif ($!direction = "northdirection") { $!upstaticimagelib.getImage().display($renderer); } elsif ($!direction = "southdirection") { $!downstaticimagelib.getImage().display($renderer); } } elsif ($!moving) { if ($!direction = "westdirection") { $!leftimagelib.getImage().display($renderer); } elsif ($!direction = "eastdirection") { $!rightimagelib.getImage().display($renderer); } elsif ($!direction = "northdirection") { $!upimagelib.getImage().display($renderer); } elsif ($!direction = "southdirection") { $!downimagelib.getImage().display($renderer); } } } ### See the LICENSE file for details ### use v6.0; use NativeCall; unit module PaganVisions2; class PaganVision2::Player { has $!image_data; has $!x; has $!y; has $!w; has $!h; } ### See the LICENSE file for details ### use v6.0; use NativeCall; use SDL2::Raw unit module PaganVisions2; class PaganVision2::PNGImageObject { has @!array; method BUILD( } method parse($filename, $dataref) { ### FIXME } } ### See the LICENSE file for details ### use v6.0; unit module PaganVisions2; class PaganVision2::Room { has $!bg_image; method BUILD() { Image $!bg_image .= new: width => $w, height => $h; } } ### See the LICENSE file for details ### use v6.0; use NativeCall; use SDL2::Raw; unit module PaganVisions; class PaganVisions::StateImageLibrary { has @!images; ### list of Image instances has $index; method addImage($image, $renderer) { my $tile = SDL_CreateTexture($renderer, %PIXELFORMAT<RGBA8888> +, TARGET, $image.width, $image.height); push(@!images, $tile); } method getImage($entity) { if ($index >= @!images.elems) { $index = 0; } SDL_UpdateTexture(@!images[$index], 0, $entity.data, 320*32); return @!images[$index++]; } method getImageWithIndex($ind) { return @!images[$ind]; } } ### See the LICENSE file for details ### use v6.0; use NativeCall; use SDL2::Raw unit module PaganVisions2; class PaganVision2::XpmDataStructure { has $!w; has $!h; has $!ncolors; has %!colors; has $!pixmap; ### donarrayref is the 32bit C integer array method BUILD(@lines) { my $flag = ""; for @lines -> $line { if (/\/\*/ or /static/) { next; } elsif (/{/) { $flag = "api" } elsif $flag == "api" { @l = split($line, " "); $!w = @l[0]; $!h = @l[1]; $!ncolors = @l[2]; $flag = "colors"; next; } elsif $flag == "colors" { my $i = $!ncolors; while (not $i--) { @colorcode = split($line, " "); if (@colorcode[0] == "") { @colorcode[0][0] = " "; } %!colors.push(@colorcode[0][0] => @colorcode[1]); $flag = "pixmpdata"; } } elsif $flag == "pixmapdata"} } } } ### See the LICENSE file for details ### use v6.0; use NativeCall; use SDL2::Raw unit module PaganVisions2; class PaganVision2::XpmImageObject { has @!array; has @!defaultimage; has $.xpmparser; method parse($filename, $arrayref) { XpmParser $.xpmparser .= new; if not defined $filename { @!array = @!defaultimage; ###FIXME prepared @!defaultimage array parsed by xpmparser + } elsif $filename { if (unless xpmparser.parse($filename, $arrayref) or @!arra +y = @!defaultimage; } } method BUILD() { @!defaultimage = qq(/* XPM */ static char * x_xpm[] = { "48 48 244 2", " c None", ". c #FFFFFF", "+ c #FAFAFA", "@ c #BEBEBE", "# c #A4A4A4", "$ c #FDFDFD", "% c #B5B5B5", "& c #B3B3B3", "* c #F7F7F7", "= c #ABABAB", "- c #C4C4C4", "; c #EBEBEB", "> c #C3C3C3", ", c #F1F1F1", "' c #B8B8B8", ") c #B4B4B4", "! c #F9F9F9", "~ c #CACACA", "{ c #9A9A9A", "] c #C1C1C1", "^ c #A5A5A5", "/ c #B7B7B7", "( c #FCFCFC", "_ c #ADADAD", ": c #D7D7D7", "< c #959595", "[ c #949494", "} c #DCDCDC", "| c #CFCFCF", "1 c #F8F8F8", "2 c #777777", "3 c #424242", "4 c #646464", "5 c #606060", "6 c #EDEDED", "7 c #505050", "8 c #848484", "9 c #D5D5D5", "0 c #828282", "a c #E2E2E2", "b c #6E6E6E", "c c #4E4E4E", "d c #E5E5E5", "e c #717171", "f c #292929", "g c #3A3A3A", "h c #555555", "i c #525252", "j c #C0C0C0", "k c #464646", "l c #757575", "m c #696969", "n c #000000", "o c #9F9F9F", "p c #3E3E3E", "q c #E3E3E3", "r c #FEFEFE", "s c #D8D8D8", "t c #D3D3D3", "u c #E0E0E0", "v c #F4F4F4", "w c #DFDFDF", "x c #838383", "y c #272727", "z c #939393", "A c #BDBDBD", "B c #2C2C2C", "C c #A3A3A3", "D c #363636", "E c #B1B1B1", "F c #999999", "G c #121212", "H c #F6F6F6", "I c #767676", "J c #CCCCCC", "K c #979797", "L c #686868", "M c #6B6B6B", "N c #7D7D7D", "O c #7F7F7F", "P c #727272", "Q c #8F8F8F", "R c #8E8E8E", "S c #7A7A7A", "T c #797979", "U c #868686", "V c #414141", "W c #858585", "X c #CBCBCB", "Y c #616161", "Z c #666666", "` c #AFAFAF", " . c #FBFBFB", ".. c #BFBFBF", "+. c #393939", "@. c #818181", "#. c #3F3F3F", "$. c #C9C9C9", "%. c #707070", "&. c #4D4D4D", "*. c #626262", "=. c #B2B2B2", "-. c #2B2B2B", ";. c #010101", ">. c #050505", ",. c #EFEFEF", "'. c #383838", "). c #E8E8E8", "!. c #101010", "~. c #A1A1A1", "{. c #989898", "]. c #181818", "^. c #AAAAAA", "/. c #B9B9B9", "(. c #0A0A0A", "_. c #8D8D8D", ":. c #A7A7A7", "<. c #4A4A4A", "[. c #C6C6C6", "}. c #E4E4E4", "|. c #474747", "1. c #BCBCBC", "2. c #454545", "3. c #7E7E7E", "4. c #BBBBBB", "5. c #737373", "6. c #565656", "7. c #313131", "8. c #A2A2A2", "9. c #888888", "0. c #5B5B5B", "a. c #A6A6A6", "b. c #808080", "c. c #5E5E5E", "d. c #787878", "e. c #353535", "f. c #0E0E0E", "g. c #3B3B3B", "h. c #C7C7C7", "i. c #929292", "j. c #8B8B8B", "k. c #7B7B7B", "l. c #E6E6E6", "m. c #747474", "n. c #0B0B0B", "o. c #070707", "p. c #F5F5F5", "q. c #1F1F1F", "r. c #090909", "s. c #F3F3F3", "t. c #040404", "u. c #6D6D6D", "v. c #434343", "w. c #7C7C7C", "x. c #E1E1E1", "y. c #111111", "z. c #656565", "A. c #141414", "B. c #A9A9A9", "C. c #E9E9E9", "D. c #B6B6B6", "E. c #878787", "F. c #4C4C4C", "G. c #1E1E1E", "H. c #131313", "I. c #282828", "J. c #D1D1D1", "K. c #202020", "L. c #D0D0D0", "M. c #545454", "N. c #CECECE", "O. c #ECECEC", "P. c #212121", "Q. c #C2C2C2", "R. c #515151", "S. c #585858", "T. c #D4D4D4", "U. c #333333", "V. c #242424", "W. c #4B4B4B", "X. c #A0A0A0", "Y. c #969696", "Z. c #ACACAC", "`. c #9D9D9D", " + c #2D2D2D", ".+ c #535353", "++ c #575757", "@+ c #484848", "#+ c #F0F0F0", "$+ c #1A1A1A", "%+ c #C5C5C5", "&+ c #2F2F2F", "*+ c #3C3C3C", "=+ c #D9D9D9", "-+ c #DADADA", ";+ c #030303", ">+ c #D2D2D2", ",+ c #191919", "'+ c #898989", ")+ c #0C0C0C", "!+ c #BABABA", "~+ c #6F6F6F", "{+ c #EEEEEE", "]+ c #F2F2F2", "^+ c #8A8A8A", "/+ c #8C8C8C", "(+ c #B0B0B0", "_+ c #171717", ":+ c #595959", "<+ c #4F4F4F", "[+ c #EAEAEA", "}+ c #5A5A5A", "|+ c #5F5F5F", "1+ c #9C9C9C", "2+ c #060606", "3+ c #444444", "4+ c #C8C8C8", "5+ c #5C5C5C", "6+ c #151515", "7+ c #9E9E9E", "8+ c #1B1B1B", "9+ c #2A2A2A", "0+ c #D6D6D6", "a+ c #1D1D1D", "b+ c #5D5D5D", "c+ c #9B9B9B", "d+ c #676767", "e+ c #0F0F0F", "f+ c #232323", "g+ c #303030", "h+ c #909090", "i+ c #222222", "j+ c #0D0D0D", "k+ c #2E2E2E", "l+ c #262626", "m+ c #494949", "n+ c #373737", "o+ c #DDDDDD", "p+ c #E7E7E7", "q+ c #161616", "r+ c #DBDBDB", "s+ c #080808", "t+ c #343434", "u+ c #020202", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . + @ # $ % & * = - ; > , ' ) ! . . . . . . . . ~ { . ] ^ . / % ( + _ ~ : < [ } . . . . . . . ", ". $ | 1 2 3 + 4 5 6 7 8 9 0 a b c / * . . . . . . d e f | 4 g ~ h i j + k l m n n o . . . . . . . ", ". 1 p . q | r s : + t u v w 1 a [ f } . . . . . . { x | y z A B C ^ D + E F G n n ^ . . . . . . . ", ". H n I J . . . . . . . . . . . w K L ^ . . . . M N O P Q N l R S T R + U p n n n ^ . . . . . . . ", ". H n V W X . . . . . . . . . . . . Y Z ` .u ..+.@.N #.$.%.&.- 4 *.= +.-.n ;.n n ^ . . . . . . . ", ". H >.,.L '.. . r . . . . . . . . . ).R !.. ~.G ; O 8 a G {.J ].^./.G + (.n n n n ^ . . . . . . . ", ". H n &._.:.<.[.. r . . . . . . . . . }.A |.2 1.2.@.3.<.4.5.6./.l 7.n + n n n n n 8.. . . . . . . ", ". H n *.9.{ 0.8 ] . . . . . . . . . . . . 5 I a.0.b.O c.a.d.L # e.n ; +.n ;.n f.g.h.. . . . . . . ", ". H n i.N d.j.k.O & l.. . . . . . . . . . ,.% I j.b.b.j.m.8 d.n.o.n n + n n -.W | .. . . . . . . ", ". p.n q.8.: r.E ) ].$.. r . . . . . . . . . 1 s.t.@.k.f.. P o.n n n n + ;.n u.. r . . . . . . . . ", ". r t n n.v.}.6.i s V S . . . . . . . . . . . . }.w.8 x.y.n.n n n n n + n Y . . . . . . . . . . . ", ". . 1 z.-.A.K S T _.2 S B.C.. . . . . . . . . . . D.O E.n n n n n n y +.F.D.. . . . . . . . . . . ", ". . . ,.Y n G.D./ H.~ R I.J.. . . . . . . . . . . .l n n n n n n n K +.D.. . . . . . . . . . . . ", ". . . . . L.n n M.C.'.e N.P N.. . . . . . . . . . . r O.n n n n n &.. + . . . . . . . . . . . . . ", ". . . . . ; b I.P.E.k.Q.X R.S.T.. . . . . . . . . . . * 2 U.H.b.V.W.r + F 4.Q.< , B.X.+ Y.Z.* . . ", ". . . . . . O.c.n V.@ . ] e.n `.. r . . . . . . . . . . 1 M +s..+&.a + g 2 W U.} ++@+6 -.0.#+. . ", ". . . . . . . . ' $+%+E.&+z *+n 2.=+. . . . . . . . . . . . -+;+& / H +.~ U 2 >+,+^.' H.n *.#+. . ", ". . . . . . . . u 9.5.N R N F 7.$+M.q . . . . . . . . . . . 6 '+I I z + 5.O @.e i.b.@+)+n Y #+. . ", ". . . . . . . . .@ <.l !+m.%+~+G n a.{+. . . . . . . . . . . ]+Z .+| + <.S W 2.J.c n n n Y #+. . ", ". . . . . . $ q i.U.% ^+2./+g `.(+F.n V @ r . . . . . . . . . . . - - +.% 8 N E _+n ;.n n Y #+. . ", ". . . . . ( N.W.&.}.g.P ~ e s :+<.O.<+>.n J , . . . . . . . . . r . [ ++3 S @.n n n n n n Y #+. . ", ". . . . . ).c F { }+8.^+z.j.|+< 1+6.:.m.2+3+# . . . . . . . . . . . ] ++4+0 G.n n n n n n Y #+. . ", ". . . .N.8 n d.k.;.'+5+6+c.(.e 3.n _.P n.n 3+7+. . . . . . . . . . . + . 1.8+n n n n n n c.#+. . ", ". . . s.5+n 9+;.n y n r.K.r.V.;+n f n n n n n.A.J.C.).0+. }.-+r x.u +.} $ /+n n n n n 8+N ]+. . ", ". . . v z.a+X #.g...B 5+B.0.% k +.h.&+n n n b+L.7.F c+|.. '+0. .T I , +.d+`./+n n ;.n n i.} .. . ", ". . . v Z e+N y V.l 8++.L '.~+-.f+S a+n n n +.N O ..l t.. |+q.! @+v.[ ++g+m.h+n ;.n i+Z O.. . . . ", ". . . v d+n &+f.f.B (.6+y 6+9+!.j+k+n.n n n 6+-.N.l.d.)+. 4 l+! c m+; + n+T Q n n P.@.* . . . . . ", ". . . v 4 P.x.k 3 t 7.Z 4.z.4+c #.o+e.n n n d+p+8+_.k.)+. 4 l+! c m+; + n+T h+n n @.[++ . . . . . ", ". . . s.Y n 7 H.y.W.(.K.V q.|.q+!.<+>.+.B.2+f+S.= 9 T )+. 4 l+! c m+; + n+T ^+$+W ).. . . . . . . ", ". . . * {.<.m+<+<+m+7 c <.c <.<+<+m+m+K . d+V.n % w N )+. L y . 7 F.s +.+.N /+7.r+. . . . . . . . ", ". . . r ,.q }.}.}.}.}.}.}.}.}.}.}.}.q {+. ; ^ 5+8+*.7 s+B.V ,+# U.g+{ + V.<+6.t+t . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . * , n n n n t.n n t.n n u ++n n n &+L.. . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . -+s s =+: =+=+: =+=+s + =+s : q 1 . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . ", ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + . . . . . . . . . . . . . "}); } } ### See the LICENSE file for details ### use v6.0; use NativeCall; use SDL2::Raw unit module PaganVisions2; class PaganVision2::XpmParser { has $.xpmadt; method parse($filename, $donearrayref) { if not $donearrayref { return; } else { $fh = fopen($filename, "rw"); @lines = []; while (<$fh>) { chomp; push(@lines, $_); } XpmDataStructure $.xpmadt .= new: lines => @lines; } } } ### See the LICENSE file for details use NativeCall; use SDL2::Raw; use nqp; my int ($w, $h) = 800, 600; my SDL_Window $window; my SDL_Renderer $renderer; constant $sdl-lib = 'SDL2'; enum GAME_KEYS ( K_UP => 82, K_DOWN => 81, K_LEFT => 80, K_RIGHT => 79, K_SPACE => 44, ); my %down_keys; SDL_Init(VIDEO); $window = SDL_CreateWindow( "Pagan Visions - SDL 2.x", SDL_WINDOWPOS_CENTERED_MASK, SDL_WINDOWPOS_CENTERED_MASK, $w, $h, SHOWN ); $renderer = SDL_CreateRenderer( $window, -1, ACCELERATED ); SDL_ClearError(); my SDL_RendererInfo $renderer_info .= new; SDL_GetRendererInfo($renderer, $renderer_info); say $renderer_info; say %PIXELFORMAT.pairs.grep({ $_.value == any($renderer_info.texf1, $r +enderer_info.texf2, $renderer_info.texf3) }); my CArray[int32] $data .= new; my int $numpoints; my @entities; ## a list of Entity.pm6 my @moving_entities; sub update () { for @entities -> $e { $e.update(); } for @moving_entities -> $e { $e.update(); } } sub draw () { for @entities -> $e { $e.draw($renderer); } for @moving_entities -> $e { $e.draw($renderer); } } sub render { ### SDL_UpdateTexture($tile, 0, $data, 320*32); SDL_SetRenderDrawColor($renderer, 0x0, 0x0, 0x0, 0xff); SDL_RenderClear($renderer); SDL_SetRenderDrawColor($renderer, 0xff, 0xff, 0xff, 0x7f); SDL_RenderPresent($renderer); ### SDL_RendererFlip; } my @times; my $event = SDL_Event.new; my num $df = 0.0001e0; main: loop { my $start = nqp::time_n(); while SDL_PollEvent($event) { my $casted_event = SDL_CastEvent($event); given $casted_event { when *.type == QUIT { last main; } when *.type == KEYDOWN { if GAME_KEYS(.scancode) -> $comm { %down_keys{$comm} = 1; } CATCH { say $_ } } when *.type == KEYUP { if GAME_KEYS(.scancode) -> $comm { %down_keys{$comm} = 0; } CATCH { say $_ } } } update(); draw(); } render(); @times.push: nqp::time_n() - $start; $df = nqp::time_n() - $start; } @times .= sort; my @timings = (@times[* div 50], @times[* div 4], @times[* div 2], @ti +mes[* * 3 div 4], @times[* - * div 100]); say "frames per second:"; say (1 X/ @timings).fmt("%3.4f"); say "timings:"; say ( @timings).fmt("%3.4f"); say ""; 'raw_timings.txt'.IO.spurt((1 X/ @times).join("\n"));
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (3)
As of 2016-07-27 02:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What is your favorite alternate name for a (specific) keyboard key?


















    Results (242 votes). Check out past polls.