Quick actions

cmd+k|ctrl+k

Navigation

Languages

Untitled

Snippet info

Language

Raku

Visibility

unlisted

Author

legacy-anonymous

Created

2020-07-23T22:30:21Z

Updated

2020-07-23T22:30:21Z

use NativeCall;

role OpenVRInterface is export { }

class VR_IVRApplications_FnTable is repr<CStruct> is export does OpenVRInterface {
  has Pointer $!AddApplicationManifest;               #= EVRApplicationError (char * pchApplicationManifestFullPath, bool bTemporary);
  has Pointer $!RemoveApplicationManifest;            #= EVRApplicationError (char * pchApplicationManifestFullPath);
  has Pointer $!IsApplicationInstalled;               #= bool (char * pchAppKey);
  has Pointer $!GetApplicationCount;                  #= uint32_t ();
  has Pointer $!GetApplicationKeyByIndex;             #= EVRApplicationError (uint32_t unApplicationIndex, char * pchAppKeyBuffer, uint32_t unAppKeyBufferLen);
  has Pointer $!GetApplicationKeyByProcessId;         #= EVRApplicationError (uint32_t unProcessId, char * pchAppKeyBuffer, uint32_t unAppKeyBufferLen);
  has Pointer $!LaunchApplication;                    #= EVRApplicationError (char * pchAppKey);
  has Pointer $!LaunchTemplateApplication;            #= EVRApplicationError (char * pchTemplateAppKey, char * pchNewAppKey, struct AppOverrideKeys_t * pKeys, uint32_t unKeys);
  has Pointer $!LaunchApplicationFromMimeType;        #= EVRApplicationError (char * pchMimeType, char * pchArgs);
  has Pointer $!LaunchDashboardOverlay;               #= EVRApplicationError (char * pchAppKey);
  has Pointer $!CancelApplicationLaunch;              #= bool (char * pchAppKey);
  has Pointer $!IdentifyApplication;                  #= EVRApplicationError (uint32_t unProcessId, char * pchAppKey);
  has Pointer $!GetApplicationProcessId;              #= uint32_t (char * pchAppKey);
  has Pointer $!GetApplicationsErrorNameFromEnum;     #= char * (EVRApplicationError error);
  has Pointer $!GetApplicationPropertyString;         #= uint32_t (char * pchAppKey, EVRApplicationProperty eProperty, char * pchPropertyValueBuffer, uint32_t unPropertyValueBufferLen, EVRApplicationError * peError);
  has Pointer $!GetApplicationPropertyBool;           #= bool (char * pchAppKey, EVRApplicationProperty eProperty, EVRApplicationError * peError);
  has Pointer $!GetApplicationPropertyUint64;         #= uint64_t (char * pchAppKey, EVRApplicationProperty eProperty, EVRApplicationError * peError);
  has Pointer $!SetApplicationAutoLaunch;             #= EVRApplicationError (char * pchAppKey, bool bAutoLaunch);
  has Pointer $!GetApplicationAutoLaunch;             #= bool (char * pchAppKey);
  has Pointer $!SetDefaultApplicationForMimeType;     #= EVRApplicationError (char * pchAppKey, char * pchMimeType);
  has Pointer $!GetDefaultApplicationForMimeType;     #= bool (char * pchMimeType, char * pchAppKeyBuffer, uint32_t unAppKeyBufferLen);
  has Pointer $!GetApplicationSupportedMimeTypes;     #= bool (char * pchAppKey, char * pchMimeTypesBuffer, uint32_t unMimeTypesBuffer);
  has Pointer $!GetApplicationsThatSupportMimeType;   #= uint32_t (char * pchMimeType, char * pchAppKeysThatSupportBuffer, uint32_t unAppKeysThatSupportBuffer);
  has Pointer $!GetApplicationLaunchArguments;        #= uint32_t (uint32_t unHandle, char * pchArgs, uint32_t unArgs);
  has Pointer $!GetStartingApplication;               #= EVRApplicationError (char * pchAppKeyBuffer, uint32_t unAppKeyBufferLen);
  has Pointer $!GetSceneApplicationState;             #= EVRSceneApplicationState ();
  has Pointer $!PerformApplicationPrelaunchCheck;     #= EVRApplicationError (char * pchAppKey);
  has Pointer $!GetSceneApplicationStateNameFromEnum; #= char * (EVRSceneApplicationState state);
  has Pointer $!LaunchInternalProcess;                #= EVRApplicationError (char * pchBinaryPath, char * pchArguments, char * pchWorkingDirectory);
  has Pointer $!GetCurrentSceneProcessId;             #= uint32_t ();

  method AddApplicationManifest (Str $amfp, bool $bt) {
    1
  }

  method RemoveApplicationManifest (Str $amfp) {
    1
  }

  method IsApplicationInstalled (Str $ak) {
    1
  }

  method GetApplicationCount {
    1
  }

  method GetApplicationKeyByIndex (uint32 $ai, Str $akb, uint32 $akbl) {
    1
  }

  method GetApplicationKeyByProcessId (
    uint32 $pid,
    Str    $akb,
    uint32 $akbl
  ) {
    1
  }
}

sub mq ($s) {
  "{ $s }\n{ '=' x $s.chars }"
}

my token id      { <[\w _]>+ }
my token typeDec { <type=id> <.ws> ('*')? }

sub resolveTypeDec ($td) {
  my $rw = False;

  my $rt = do given $td<type>.Str {
    when 'char' { 'Str' }

    when 
        'int8_t'   |
        'int16_t'  |
        'int32_t'  |
        'int64_t'  |         
        'uint8_t'  |
        'uint16_t' |
        'uint32_t' | 
        'uint64_t'   { $rw = True if $td<p>;
                        .substr(0, * - 2)     }

    when *.ends-with('_t') {
      # If not a struct and ends with _t, it needs
      # to be 'is rw'
      #my $tv := ::("$_");
      #die "Type '$_' is not defined!" if $tv ~~ Failure;
      #$rw = True unless $tv.REPR eq 'CStruct';
      proceed;
    }

    default { $_ }
  }

  ($rt, $rw);
}

my %methods = (do for VR_IVRApplications_FnTable.^methods.map( *.name ) {
  $_ => 1;
}).Hash;

for VR_IVRApplications_FnTable.^attributes {
  my $mn = .name.substr(2);

  my $sd = .WHY.trailing;
  my $m = $sd ~~ rule {
    <typeDec> 
     [
      '(' (<-[\)]>+) ')' 
      ||
      '()'
    ] ';'
  };

  my ($rt, $al) = (
    resolveTypeDec($/<typeDec>), 
    $0 // ''
  );
  
  next if %methods{$mn};

  say "{ mq($mn) }";
  unless $m {
    say "»»»»» DID NOT PARSE!\n";
    next;
  }

  #say "Returns: $rt";

  my $ma = $al ~~ m:g/
    'const'? <.ws>
    <typeDec> <.ws>
    <name=id> [ ',' <.ws> ]?
  /;

  #$ma.gist.say;

  my (%var-names, @at, @an);
  for $ma[] -> $am {
    my $n := $am<name>;
    # Get variable placeholder name.
    my $vn = (
      ($n ~~ m:g/<[A..Z]><[a..z]>+/).map( 
        *.Str.substr(0, 1).lc 
      ).join
      || 
      $n.substr(0, 1)
    );
    # Finalize name with collision detection.
    $vn = '$' ~ $vn ~ (%var-names{$vn}++ ?? %var-names{$vn}
                                         !! ''); 
    @an.push: $vn;

    #$am.gist.say;
    
    @at.push: resolveTypeDec( $am<typeDec> );
  }
    
  my $nc = qq:to/NATIVECAST/;
  nativecast(
    :({@at.map( *[0] ).join(', ')}{ $rt[0] ?? " --> { $rt[0] }" !! '' }),
    \$!{$mn}
  )({@an.join(', ')})
  NATIVECAST

  say $nc;

  &say()
}
INFO