1#!/usr/bin/perl -w
2
3#  Simple DirectMedia Layer
4#  Copyright (C) 1997-2020 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
29use warnings;
30use strict;
31use File::Basename;
32
33chdir(dirname(__FILE__) . '/../..');
34my $sdl_dynapi_procs_h = "src/dynapi/SDL_dynapi_procs.h";
35my $sdl_dynapi_overrides_h = "src/dynapi/SDL_dynapi_overrides.h";
36
37my %existing = ();
38if (-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
48open(SDL_DYNAPI_PROCS_H, '>>', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
49open(SDL_DYNAPI_OVERRIDES_H, '>>', $sdl_dynapi_overrides_h) or die("Can't open $sdl_dynapi_overrides_h: $!\n");
50
51opendir(HEADERS, 'include') or die("Can't open include dir: $!\n");
52while (my $d = readdir(HEADERS)) {
53    next if not $d =~ /\.h\Z/;
54    my $header = "include/$d";
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}
136closedir(HEADERS);
137
138close(SDL_DYNAPI_PROCS_H);
139close(SDL_DYNAPI_OVERRIDES_H);
140
141# vi: set ts=4 sw=4 expandtab:
142