view release on metacpan or  search on metacpan

xs/webgpu.xs.PL  view on Meta::CPAN

#!/usr/bin/env perl

use v5.30;
use warnings;

use FindBin qw/$Bin $Script/;
use List::Util qw/pairs/;
use Data::Dumper qw//;
use ExtUtils::Typemaps qw//;
use ExtUtils::ParseXS::Utilities qw/standard_typemap_locations/;
use autodie;

my $add_trace = $ENV{WGPU_PL_TRACE} // 0;

my $h_file = find_header();

open my $h,  '<', $h_file;
open my $xs, '>', "$Bin/webgpu.xs";
open my $c,  '>', "$Bin/webgpu_wrap.c";
open my $tm, '>', "$Bin/../typemap";
open my $pm, '>', "$Bin/../lib/WebGPU/Direct/XS.pm";

my $class_defaults = require "$Bin/$Script.default";
my $constants      = require "$Bin/$Script.constant";

my %typedefs = (
  bool     => 'bool',
  double   => 'double',
  float    => 'float',
  uint16_t => 'uint16_t',
  uint32_t => 'uint32_t',
  uint64_t => 'uint64_t',
  int32_t  => 'int32_t',
  size_t   => 'size_t',
  char     => 'str',
  void     => 'void',
);

my @typemap = (
  q{WebGPU::Direct::MappedBuffer                                    T_FETCHPTR},
  q{},
  q{# We do the tr/:/_/ in the output because ParseXS doesn't for outputs},
  q{INPUT},
  q{T_VOID},
  q{    $var = ($type) _get_struct_ptr(aTHX_ $arg, NULL)},
  q{T_FETCH},
  q{    $var = *($type *) _get_struct_ptr(aTHX_ $arg, newSVpvs(\"${ my $t=$type; $t=~s/ .*//; $t=~tr/_/:/; $t=~s/^WGPU/WebGPU::Direct::/; \$t}\"))},
  q{T_FETCHPTR},
  q{    $var = ($type) _get_struct_ptr(aTHX_ $arg, newSVpvs(\"${ my $t=$type; $t=~s/ .*//; $t=~tr/_/:/; $t=~s/^WGPU/WebGPU::Direct::/; \$t}\"))},
  q{},
  q{OUTPUT},
  q{T_VOID},
  q{    $arg = _void__wrap($var);},
  q{T_FETCH},
  q{    ${$type=~tr/:/_/, \$type}* ptr_$var; Newx(ptr_$var, 1, $type);},
  q{    Copy(&$var, ptr_$var, 1, $type);},
  q{    $arg = ${\$type}__wrap(ptr_$var); /* T_FETCH */},
  q{T_FETCHPTR},
  q{    $arg = ${$type=~tr/:/_/, \$type}__wrap($var); /* T_FETCHPTR */},
);

my $arrcnt_re = qr/^(\w+)Count$/xms;
my $arrnme_re = qr/^(\w+)s$/xms;
my $bufcnt_re = qr/^(data)?[sS]ize$/xms;
my $bufnme_re = qr/^data$/xms;

my @fns;
my @classes;
my %enums;
my %classdefs;
my %callbackdefs;

my $edit_warning = <<EOS;
# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! #
#   This file is generated by webgpu.xs.PL  #
# !!!!!!!   ANY EDIT WILL BE LOST   !!!!!!! #
EOS

say $xs qq{$edit_warning};

say $c qq{/*\n$edit_warning*/};
say $c q{};

say $tm $edit_warning;