#!/usr/bin/perl -w

 #  Simple DirectMedia Layer

 #  Copyright (C) 1997-2017 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 (readdir(HEADERS)) {

     next if not /\.h\Z/;

     my $header = "include/$_";

     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: