Convert playpal generator script to Python.

lumps/cph/misc-lumps/Makefile

@@ -1,7 +1,7 @@
 all             :       playpal.lmp colormap.lmp
 
-playpal.lmp	:	playpal-base.lmp playpal.pl
+playpal.lmp	:	playpal-base.lmp playpal.py
-	./playpal.pl playpal-base.lmp > playpal.lmp
+	./playpal.py playpal-base.lmp > playpal.lmp
 
 colormap.lmp	:	playpal.lmp colormap.py
 	./colormap.py playpal.lmp > colormap.lmp

lumps/cph/misc-lumps/playpal.py

@@ -1,9 +1,12 @@
-#!/usr/bin/perl -w
+#!/usr/bin/env python
 # Script to generate the PLAYPAL lump used by the Doom engine, specifically the
 # which contains 14 alternative palettes which are used for various
 # environmental effects. The base palette from which these are derived is either
 # generated, or taken from a file.
 #
+# This is a Python version of the original Perl script.
+#
+# Copyright (C) 2008  Simon Howard
 # Copyright (C) 2001  Colin Phipps <cphipps@doomworld.com>
 # Parts copyright (C) 1999 by id Software (http://www.idsoftware.com/)
 #
@@ -21,7 +24,7 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-use strict;
+import sys
 
 # IHS (Intensity Hue Saturation) to RGB conversion, utility function
 #
@@ -36,70 +39,66 @@ use strict;
 #  Geosciences, Volume 13, published by Pergamon (Elsevier Science Ltd),
 #  pp. 120-125.
 
-use constant R2 => 1 / sqrt(2);
+R2 = 1.0 / 2
-use constant R3 => 1 / sqrt(3);
+R3 = 1.0 / 3
-use constant R6 => 1 / sqrt(6);
+R6 = 1.0 / 6
-use constant PI => 3.141592;
+PI = 3.141592
 
-sub ihs_to_rgb($$$)
+def ihs_to_rgb(i, h, s):
-{
+	i = (i * 422) / 255
-  my ($i,$h,$s) = @_;
+	h = (h * 2 * PI) / 255
-# Hue and Saturation values are unscaled first:
+	s = (s * 208.2066) / 255
-  $i = $i * (422/255);
+
-  $h = $h * (2 * PI / 255);
+	b, x = s * math.cos(h), s * math.sin(h)
-  $s = $s * ("208.2066" / 255);
+
-  my ($b,$x) = ($s * cos $h, $s * sin $h);
+	return (R3 * i - R6 * b - R2 * x,
-  return
+		R3 * i - R6 * b + R2 * x,
-    [ 
+		R3 * i + R6 * 2 * b)
-    R3 * $i - R6 * $b - R2 * $x,
-    R3 * $i - R6 * $b + R2 * $x,
-    R3 * $i + 2 * R6 * $b,
-    ];
-}
 
 # New palette builder
 
-sub make_pal_range($$$$)
+def make_pal_range(i, h, s, n):
-{
+
-  my ($i,$h,$s,$n) = @_;
+	map_function = lambda x: ihs_to_rgb(i * (n - x) / n,
-  my @r = map { ihs_to_rgb($i*(1 + $n - $_)/$n,$h,$s*(1 + $n - $_)/$n) } (1..$n);
+	                                    h,
-  die unless @r == $n;
+	                                    s * (n - x) / n),
-  return @r;
+
-}
+	return map(map_function, range(n))
 
 # Very crude traversal of the IHS colour ball
 
-sub make_palette_new ()
+def make_palette_new():
-{
+	result = []
-  my @p = (
+	
-  make_pal_range(255,0,0,32),
+	result += make_pal_range(255, 0, 0, 32)
-  ( map { make_pal_range(127,171+$_*256/7,255,16) } (1..7) ),
+
-  ( map { make_pal_range(256,$_*256/7,127,16) } (1..7) )
+	for i in range(7):
-  );
+		result += make_pal_range(127, 171 + (i + 1) * 256 / 7, 255, 16)
-  return \@p;
+	
-}
+	for i in range(7):
+		result += make_pal_range(256, (i + 1) * 256 / 7, 127, 16)
 
 # Return palette read from named file
-sub read_palette ($) {
-  {
-    my $palf = shift;
-    open(PALF,"<$palf") or die "failed to open PLAYPAL: $!";
-  }
-  my @colours = ();
-  foreach my $i (0..255) {
-    my $e;
-    read PALF,$e,3;
-    push @colours,[unpack("CCC",$e)];
-  }
-  close PALF;
-  return \@colours;
-}
 
-sub make_palette ()
+def read_palette(filename):
-{
+	f = file(filename)
-  my $palf = shift @ARGV;
+
-  return $palf ? read_palette($palf) : make_palette_new;
+	colors = []
-}
+
+	for i in range(256):
+		color = f.read(3)
+
+		colors.append((ord(color[0]), ord(color[1]), ord(color[2])))
+
+	f.close()
+
+	return colors
+
+def make_palette(filename):
+	if filename is None:
+		return make_palette_new
+	else:
+		return read_palette(filename)
 
 # Old palette builder
 #sub make_pal_range($$$$$$)
@@ -133,33 +132,49 @@ sub make_palette ()
 
 # Now the PLAYPAL stuff - take the main palette and construct biased versions
 # for the palette translation stuff
-sub bias_towards($$$) {
-  my ($rgb,$target,$p) = @_;
-  my (@r,$i);
-  for ($i=0; $i<3; $i++) { $r[$i] = $rgb->[$i]*(1-$p) + $target->[$i]*$p }
-  return \@r;
-}
 
-sub modify_palette_per_entry($$)
+# Bias an entire palette
-{
+
-  my $palref = shift;
+def bias_palette_towards(palette, target, p):
-  my $efunc = shift;
+
-  my @newpal = map { $efunc->($_) } @$palref; 
+	def bias_rgb(rgb):
-  return \@newpal;
+		r = []
-}
+
+		for i in range(3):
+			r.append(rgb[i] * (1 - p) + target[i] * p)
+
+		return r
+
+	return map(bias_rgb, palette)
 
 # Encode palette in the 3-byte RGB triples format expected by the engine
-sub clamp_pixval ($)
-{
-  my $v = int shift; 
-  return ($v < 0) ? 0 : ($v > 255) ? 255 : $v;
-}
 
-sub encode_palette
+def clamp_pixval(v):
-{
+	if v < 0:
-  my $p = shift;
+		return 0
-  return join("",map { pack("CCC", map { clamp_pixval $_ } @$_) } @$p);
+	elif v > 255:
-}
+		return 255
+	else:
+		return v
+
+def encode_palette(pal):
+
+	def color_byte(element):
+		return chr(int(clamp_pixval(element)))
+
+	def encode_color(color):
+		return "".join(map(color_byte, color))
+
+	encoded = map(encode_color, pal)
+
+	return "".join(encoded)
+
+# Main program - make a base palette, then do the biased versions
+
+if len(sys.argv) < 2:
+	print "Usage: %s <base filename> > playpal.lmp" % sys.argv[0]
+
+base_pal = read_palette(sys.argv[1])
 
 # From st_stuff.c, Copyright 1999 id Software, license GPL
 #define STARTREDPALS         1
@@ -168,37 +183,31 @@ sub encode_palette
 #define NUMBONUSPALS         4
 #define RADIATIONPAL         13
 
-my @needed_palettes = (
+palettes = []
+
 # Normal palette
-  sub { shift; },
+
+palettes.append(base_pal)
+
 # STARTREDPALS
-  (map {
+
-    my $p = $_*1/8;
+for i in range(8):
-    sub {
+	p = (i + 1) / 8.0
-      modify_palette_per_entry(shift,
+
-          sub { bias_towards(shift, [255,0,0],$p) }
+	palettes.append(bias_palette_towards(base_pal, (255, 0, 0), p))
-                              )
+
-    }
-  } (1..8)),
 # STARTBONUSPALS
-  (map {
+
-    my $p = $_*0.4/4;
+for i in range(4):
-    sub {
+	p = (i + 1) * 0.4 / 4
-      modify_palette_per_entry(shift,
+
-          sub { bias_towards(shift, [128,128,128],$p) }
+	palettes.append(bias_palette_towards(base_pal, (128, 128, 128), p))
-                              )
+
-    }
-  } (1..4)),
 # RADIATIONPAL
-  sub {
-    modify_palette_per_entry(shift,
-        sub { bias_towards(shift, [0,255,0],0.2) }
-                            )
-  }
-);
 
-# Main program - make a base palette, then do the biased versions
+palettes.append(bias_palette_towards(base_pal, (0, 255, 0), 0.2))
-my $pal = make_palette;
 
-print map { encode_palette(&$_($pal)) } @needed_palettes;
+result = "".join(map(encode_palette, palettes))
+
+sys.stdout.write(result)