sdl

gendynapi.pl (5093B)

---

 #!/usr/bin/perl -w
 
 #  Simple DirectMedia Layer
 #  Copyright (C) 1997-2020 Sam Lantinga <slouken@libsdl.org>
 #
 #  This software is provided 'as-is', without any express or implied
 #  warranty.  In no event will the authors be held liable for any damages
 #  arising from the use of this software.
 #
 #  Permission is granted to anyone to use this software for any purpose,
 #  including commercial applications, and to alter it and redistribute it
 #  freely, subject to the following restrictions:
 #
 #  1. The origin of this software must not be misrepresented; you must not
 #     claim that you wrote the original software. If you use this software
 #     in a product, an acknowledgment in the product documentation would be
 #     appreciated but is not required.
 #  2. Altered source versions must be plainly marked as such, and must not be
 #     misrepresented as being the original software.
 #  3. This notice may not be removed or altered from any source distribution.
 
 # WHAT IS THIS?
 #  When you add a public API to SDL, please run this script, make sure the
 #  output looks sane (hg diff, it adds to existing files), and commit it.
 #  It keeps the dynamic API jump table operating correctly.
 
 # If you wanted this to be readable, you shouldn't have used perl.
 
 use warnings;
 use strict;
 use File::Basename;
 
 chdir(dirname(__FILE__) . '/../..');
 my $sdl_dynapi_procs_h = "src/dynapi/SDL_dynapi_procs.h";
 my $sdl_dynapi_overrides_h = "src/dynapi/SDL_dynapi_overrides.h";
 
 my %existing = ();
 if (-f $sdl_dynapi_procs_h) {
     open(SDL_DYNAPI_PROCS_H, '<', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
     while (<SDL_DYNAPI_PROCS_H>) {
         if (/\ASDL_DYNAPI_PROC\(.*?,(.*?),/) {
             $existing{$1} = 1;
         }
     }
     close(SDL_DYNAPI_PROCS_H)
 }
 
 open(SDL_DYNAPI_PROCS_H, '>>', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
 open(SDL_DYNAPI_OVERRIDES_H, '>>', $sdl_dynapi_overrides_h) or die("Can't open $sdl_dynapi_overrides_h: $!\n");
 
 opendir(HEADERS, 'include') or die("Can't open include dir: $!\n");
 while (my $d = readdir(HEADERS)) {
     next if not $d =~ /\.h\Z/;
     my $header = "include/$d";
     open(HEADER, '<', $header) or die("Can't open $header: $!\n");
     while (<HEADER>) {
         chomp;
         next if not /\A\s*extern\s+DECLSPEC/;
         my $decl = "$_ ";
         if (not $decl =~ /\)\s*;/) {
             while (<HEADER>) {
                 chomp;
                 s/\A\s+//;
                 s/\s+\Z//;
                 $decl .= "$_ ";
                 last if /\)\s*;/;
             }
         }
 
         $decl =~ s/\s+\Z//;
         #print("DECL: [$decl]\n");
 
         if ($decl =~ /\A\s*extern\s+DECLSPEC\s+(const\s+|)(unsigned\s+|)(.*?)\s*(\*?)\s*SDLCALL\s+(.*?)\s*\((.*?)\);/) {
             my $rc = "$1$2$3$4";
             my $fn = $5;
 
             next if $existing{$fn};   # already slotted into the jump table.
 
             my @params = split(',', $6);
 
             #print("rc == '$rc', fn == '$fn', params == '$params'\n");
 
             my $retstr = ($rc eq 'void') ? '' : 'return';
             my $paramstr = '(';
             my $argstr = '(';
             my $i = 0;
             foreach (@params) {
                 my $str = $_;
                 $str =~ s/\A\s+//;
                 $str =~ s/\s+\Z//;
                 #print("1PARAM: $str\n");
                 if ($str eq 'void') {
                     $paramstr .= 'void';
                 } elsif ($str eq '...') {
                     if ($i > 0) {
                         $paramstr .= ', ';
                     }
                     $paramstr .= $str;
                 } elsif ($str =~ /\A\s*((const\s+|)(unsigned\s+|)([a-zA-Z0-9_]*)\s*([\*\s]*))\s*(.*?)\Z/) {
                     #print("PARSED: [$1], [$2], [$3], [$4], [$5]\n");
                     my $type = $1;
                     my $var = $6;
                     $type =~ s/\A\s+//;
                     $type =~ s/\s+\Z//;
                     $var =~ s/\A\s+//;
                     $var =~ s/\s+\Z//;
                     $type =~ s/\s*\*\Z/*/g;
                     $type =~ s/\s*(\*+)\Z/ $1/;
                     #print("SPLIT: ($type, $var)\n");
                     my $name = chr(ord('a') + $i);
                     if ($i > 0) {
                         $paramstr .= ', ';
                         $argstr .= ',';
                     }
                     my $spc = ($type =~ /\*\Z/) ? '' : ' ';
                     $paramstr .= "$type$spc$name";
                     $argstr .= "$name";
                 }
                 $i++;
             }
 
             $paramstr = '(void' if ($i == 0);  # Just to make this consistent.
 
             $paramstr .= ')';
             $argstr .= ')';
 
             print("NEW: $decl\n");
             print SDL_DYNAPI_PROCS_H "SDL_DYNAPI_PROC($rc,$fn,$paramstr,$argstr,$retstr)\n";
             print SDL_DYNAPI_OVERRIDES_H "#define $fn ${fn}_REAL\n";
         } else {
             print("Failed to parse decl [$decl]!\n");
         }
     }
     close(HEADER);
 }
 closedir(HEADERS);
 
 close(SDL_DYNAPI_PROCS_H);
 close(SDL_DYNAPI_OVERRIDES_H);
 
 # vi: set ts=4 sw=4 expandtab: