src/dynapi/gendynapi.pl
changeset 8094 9efaae827924
child 8149 681eb46b8ac4
equal deleted inserted replaced
8093:b43765095a6f 8094:9efaae827924
       
     1 #!/usr/bin/perl -w
       
     2 
       
     3 #  Simple DirectMedia Layer
       
     4 #  Copyright (C) 1997-2013 Sam Lantinga <slouken@libsdl.org>
       
     5 #
       
     6 #  This software is provided 'as-is', without any express or implied
       
     7 #  warranty.  In no event will the authors be held liable for any damages
       
     8 #  arising from the use of this software.
       
     9 #
       
    10 #  Permission is granted to anyone to use this software for any purpose,
       
    11 #  including commercial applications, and to alter it and redistribute it
       
    12 #  freely, subject to the following restrictions:
       
    13 #
       
    14 #  1. The origin of this software must not be misrepresented; you must not
       
    15 #     claim that you wrote the original software. If you use this software
       
    16 #     in a product, an acknowledgment in the product documentation would be
       
    17 #     appreciated but is not required.
       
    18 #  2. Altered source versions must be plainly marked as such, and must not be
       
    19 #     misrepresented as being the original software.
       
    20 #  3. This notice may not be removed or altered from any source distribution.
       
    21 
       
    22 # WHAT IS THIS?
       
    23 #  When you add a public API to SDL, please run this script, make sure the
       
    24 #  output looks sane (hg diff, it adds to existing files), and commit it.
       
    25 #  It keeps the dynamic API jump table operating correctly.
       
    26 
       
    27 # If you wanted this to be readable, you shouldn't have used perl.
       
    28 
       
    29 use warnings;
       
    30 use strict;
       
    31 use File::Basename;
       
    32 
       
    33 chdir(dirname(__FILE__) . '/../..');
       
    34 my $sdl_dynapi_procs_h = "src/dynapi/SDL_dynapi_procs.h";
       
    35 my $sdl_dynapi_overrides_h = "src/dynapi/SDL_dynapi_overrides.h";
       
    36 
       
    37 my %existing = ();
       
    38 if (-f $sdl_dynapi_procs_h) {
       
    39     open(SDL_DYNAPI_PROCS_H, '<', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
       
    40     while (<SDL_DYNAPI_PROCS_H>) {
       
    41         if (/\ASDL_DYNAPI_PROC\(.*?,(.*?),/) {
       
    42             $existing{$1} = 1;
       
    43         }
       
    44     }
       
    45     close(SDL_DYNAPI_PROCS_H)
       
    46 }
       
    47 
       
    48 open(SDL_DYNAPI_PROCS_H, '>>', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
       
    49 open(SDL_DYNAPI_OVERRIDES_H, '>>', $sdl_dynapi_overrides_h) or die("Can't open $sdl_dynapi_overrides_h: $!\n");
       
    50 
       
    51 opendir(HEADERS, 'include') or die("Can't open include dir: $!\n");
       
    52 while (readdir(HEADERS)) {
       
    53     next if not /\.h\Z/;
       
    54     my $header = "include/$_";
       
    55     open(HEADER, '<', $header) or die("Can't open $header: $!\n");
       
    56     while (<HEADER>) {
       
    57         chomp;
       
    58         next if not /\A\s*extern\s+DECLSPEC/;
       
    59         my $decl = "$_ ";
       
    60         if (not $decl =~ /\)\s*;/) {
       
    61             while (<HEADER>) {
       
    62                 chomp;
       
    63                 s/\A\s+//;
       
    64                 s/\s+\Z//;
       
    65                 $decl .= "$_ ";
       
    66                 last if /\)\s*;/;
       
    67             }
       
    68         }
       
    69 
       
    70         $decl =~ s/\s+\Z//;
       
    71         #print("DECL: [$decl]\n");
       
    72 
       
    73         if ($decl =~ /\A\s*extern\s+DECLSPEC\s+(const\s+|)(unsigned\s+|)(.*?)\s*(\*?)\s*SDLCALL\s+(.*?)\s*\((.*?)\);/) {
       
    74             my $rc = "$1$2$3$4";
       
    75             my $fn = $5;
       
    76 
       
    77             next if $existing{$fn};   # already slotted into the jump table.
       
    78 
       
    79             my @params = split(',', $6);
       
    80 
       
    81             #print("rc == '$rc', fn == '$fn', params == '$params'\n");
       
    82 
       
    83             my $retstr = ($rc eq 'void') ? '' : 'return';
       
    84             my $paramstr = '(';
       
    85             my $argstr = '(';
       
    86             my $i = 0;
       
    87             foreach (@params) {
       
    88                 my $str = $_;
       
    89                 $str =~ s/\A\s+//;
       
    90                 $str =~ s/\s+\Z//;
       
    91                 #print("1PARAM: $str\n");
       
    92                 if ($str eq 'void') {
       
    93                     $paramstr .= 'void';
       
    94                 } elsif ($str eq '...') {
       
    95                     if ($i > 0) {
       
    96                         $paramstr .= ', ';
       
    97                     }
       
    98                     $paramstr .= $str;
       
    99                 } elsif ($str =~ /\A\s*((const\s+|)(unsigned\s+|)([a-zA-Z0-9_]*)\s*([\*\s]*))\s*(.*?)\Z/) {
       
   100                     #print("PARSED: [$1], [$2], [$3], [$4], [$5]\n");
       
   101                     my $type = $1;
       
   102                     my $var = $6;
       
   103                     $type =~ s/\A\s+//;
       
   104                     $type =~ s/\s+\Z//;
       
   105                     $var =~ s/\A\s+//;
       
   106                     $var =~ s/\s+\Z//;
       
   107                     $type =~ s/\s*\*\Z/*/g;
       
   108                     $type =~ s/\s*(\*+)\Z/ $1/;
       
   109                     #print("SPLIT: ($type, $var)\n");
       
   110                     my $name = chr(ord('a') + $i);
       
   111                     if ($i > 0) {
       
   112                         $paramstr .= ', ';
       
   113                         $argstr .= ',';
       
   114                     }
       
   115                     my $spc = ($type =~ /\*\Z/) ? '' : ' ';
       
   116                     $paramstr .= "$type$spc$name";
       
   117                     $argstr .= "$name";
       
   118                 }
       
   119                 $i++;
       
   120             }
       
   121 
       
   122             $paramstr = '(void' if ($i == 0);  # Just to make this consistent.
       
   123 
       
   124             $paramstr .= ')';
       
   125             $argstr .= ')';
       
   126 
       
   127             print("NEW: $decl\n");
       
   128             print SDL_DYNAPI_PROCS_H "SDL_DYNAPI_PROC($rc,$fn,$paramstr,$argstr,$retstr)\n";
       
   129             print SDL_DYNAPI_OVERRIDES_H "#define $fn ${fn}_REAL\n";
       
   130         } else {
       
   131             print("Failed to parse decl [$decl]!\n");
       
   132         }
       
   133     }
       
   134     close(HEADER);
       
   135 }
       
   136 closedir(HEADERS);
       
   137 
       
   138 close(SDL_DYNAPI_PROCS_H);
       
   139 close(SDL_DYNAPI_OVERRIDES_H);
       
   140 
       
   141 # vi: set ts=4 sw=4 expandtab: