tools/levelconverter-0.1.3_0.2.0.pl

   1 #!/usr/bin/perl
   2
   3 #
   4 # $Id$
   5 #
   6 # SuperTux - Level conversion helper
   7 # Copyright (C) 2006 Christoph Sommer <christoph.sommer@2006.expires.deltadevelopment.de>
   8 #
   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.
  13 #
  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.
  18 #
  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.
  22 #
  23
  24 #
  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.
  27 #
  28 # Usage:
  29 #   levelconverter-0.1.3_0.2.0.pl < oldformat.stl > newformat.stl
  30 #
  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.
  34 #
  35
  36 ## Helper function: Extracts contents of ($token ...) leaf list (must not contain any other lists)
  37 sub lispContents
  38 {
  39         $token = shift();
  40         $haystack = shift();
  41         if ($haystack =~ m{\($token\s+(.*?)\s*\)}s) {
  42                 return $1;
  43         }
  44         return;
  45 }
  46
  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"); }
  50 $level = $1;
  51
  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"); }
  55
  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");
  66
  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"); }
  70 $objects = $1;
  71 $objects =~ s{money}{jumpy}sg;
  72 $objects =~ s{\(stay-on-platform\s+#[tf]\s*\)}{}sg;
  73
  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);
  79 print qq{  (sector\n};
  80 print qq{    (name "main")\n};
  81
  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};
  89 print qq{    )\n};
  90
  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};
  98 print qq{    )\n};
  99
 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};
 107 print qq{    )\n};
 108
 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};
 113 print qq{    )\n};
 114
 115 print qq{    $objects\n};
 116
 117 print qq{  )\n};
 118
 119 print qq{)\n};
 120
 121 # EOF
 122