6 # SuperTux - Level conversion helper
7 # Copyright (C) 2006 Christoph Sommer <christoph.sommer@2006.expires.deltadevelopment.de>
9 # This program is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License
11 # as published by the Free Software Foundation; either version 2
12 # of the License, or (at your option) any later version.
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25 # This conversion helper aids in the conversion of SuperTux level from
26 # 0.1.3 level format to the one used by SuperTux 0.2.0.
29 # levelconverter-0.1.3_0.2.0.pl < oldformat.stl > newformat.stl
31 # Note that the script makes some unreasonable assumptions about where
32 # newlines occur in level files. It does work for most levels created
33 # in SuperTux 0.1.3 and Flexlay, though.
36 ## Helper function: Extracts contents of ($token ...) leaf list (must not contain any other lists)
41 if ($haystack =~ m{\($token\s+(.*?)\s*\)}s) {
47 # extract (supertux-level ...) list from stdin
48 $all = join("", <STDIN>);
49 if ($all !~ m{\(supertux-level\s+(.*)\s*\)}s) { die("Not a supertux level"); }
52 # make sure we deal with a (version 1) level
53 $version = lispContents("version", $level) or die("no version tag found");
54 if ($version != "1") { die("not a version 1 level"); }
56 # extract various properties
57 $author = lispContents("author", $level) or $author = "Anonymous";
58 $name = lispContents("name", $level) or $name = "Unnamed";
59 $width = lispContents("width", $level) or die("no level width definition found");
60 $height = lispContents("height", $level) or $height = "15";
61 $start_pos_x = lispContents("start_pos_x", $level) or $start_pos_x = "100";
62 $start_pos_y = lispContents("start_pos_y", $level) or $start_pos_y = "170";
63 $interactive_tm = lispContents("interactive-tm", $level) or die("no interactive tilemap found");
64 $background_tm = lispContents("background-tm", $level) or die("no background tilemap found");
65 $foreground_tm = lispContents("foreground-tm", $level) or die("no foreground tilemap found");
67 # extract objects list
68 # kind of a hack: object list is assumed to terminate at the first closing parenthesis that is alone on a line
69 if ($level !~ m{\(objects\s+(.*?)\s*\n\s*\)}s) { die("Objects list not found"); }
71 $objects =~ s{money}{jumpy}sg;
72 $objects =~ s{\(stay-on-platform\s+#[tf]\s*\)}{}sg;
74 # write out version-2 level on stdout
75 print qq{(supertux-level\n};
76 print qq{ (version 2)\n};
77 print qq{ (name (_ $name))\n} if ($name);
78 print qq{ (author $author)\n} if ($author);
80 print qq{ (name "main")\n};
82 print qq{ (tilemap\n};
83 print qq{ (z-pos -100)\n};
84 print qq{ (solid #f)\n};
85 print qq{ (speed 1)\n};
86 print qq{ (width $width)\n};
87 print qq{ (height $height)\n};
88 print qq{ (tiles $background_tm)\n};
91 print qq{ (tilemap\n};
92 print qq{ (z-pos 0)\n};
93 print qq{ (solid #t)\n};
94 print qq{ (speed 1)\n};
95 print qq{ (width $width)\n};
96 print qq{ (height $height)\n};
97 print qq{ (tiles $interactive_tm)\n};
100 print qq{ (tilemap\n};
101 print qq{ (z-pos 100)\n};
102 print qq{ (solid #f)\n};
103 print qq{ (speed 1)\n};
104 print qq{ (width $width)\n};
105 print qq{ (height $height)\n};
106 print qq{ (tiles $foreground_tm)\n};
109 print qq{ (spawnpoint\n};
110 print qq{ (name "main")\n};
111 print qq{ (x $start_pos_x)\n};
112 print qq{ (y $start_pos_y)\n};
115 print qq{ $objects\n};