hmt: read texture subtype 5, all hmt files now parse correctly

doc/file_hmt_spec.txt

@@ -22,13 +22,14 @@ TC * texture entry 52B
   2B int width
   2B int height
   8B texture format {
-    1B int ? 0x01
+    1B int : always 1?
-    1B int ?
+    1B int : bits per sample?
-    1B subtype:
+    1B int : subtype:
        -0 - palette 16x3B RGB, 4bit per pixel
        -1 - 256x3B palette RGB, 8bit per pixel
        -3 - RGBA 32bpp
        -4 - greyscale, 4bpp
+       -5 - grayscale, 8bpp
     1B int ? 0, 0x40, 0x80
     4B RGBA transparent color?
   }

doc/file_image_spec.txt

@@ -15,7 +15,7 @@ attributes {
      -5 ? ov_rdir
   1B 0, 0x80/128
 }
-4B zeros
+4B RGBA transparent color?
 4B ?
 xB pixels
 (DSO - DS)B description string (zero term.)

hmt_parser/hmt_parser.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
@@ -18,9 +18,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
@@ -32,17 +29,20 @@
         <FormatVersion Value="1"/>
       </local>
     </RunParams>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
         <Filename Value="main.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="parse_hmt"/>
       </Unit0>
       <Unit1>
-        <Filename Value="hmt_parser.pas"/>
+        <Filename Value="..\rs_units\hmt_parser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="hmt_parser"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="..\rs_units\rs_image.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -53,14 +53,9 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\rs_units"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <MsgFileName Value=""/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

hmt_parser/hmt_parser.pas

@@ -1,180 +0,0 @@
-unit hmt_parser;
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  sysutils, Classes,
-  rs_image;
-
-type
-  THmtMaterial = record
-      type_: shortint;
-      tex_index: shortint;
-      unknown_float1, unknown_float2: single;
-      zero: integer;
-      hex_a: integer;
-      name: array[0..15] of byte;
-  end;
-
-  THmtTexture = record
-      data_offset: integer;
-      palette_offset: integer;
-      name_offset: integer;
-      width, height: word;
-      name: array[0..15] of byte;
-      name_string: string;
-      image: TRSImage;
-  end;
-
-  THmtFile = record
-      material_count: integer;
-      texture_offset: integer;
-      texture_count: integer;
-      materials: array of THmtMaterial;
-      textures: array of THmtTexture;
-  end;
-
-  function ParseHmtFile(const fname: string): THmtFile;
-
-//**************************************************************************************************
-implementation
-
-function NameToString(name: array of byte): string;
-var
-  i: Integer;
-begin
-  result := '';
-  for i := 0 to length(name) - 1 do begin
-      if name[i] = 0 then break;
-      result += char( name[i] );
-  end;
-end;
-
-
-procedure ReadTexture(var tex: THmtTexture; var f: TMemoryStream);
-const
-  ImageDescription: array[0..5] of TImageDescription = (
-      (palette_entries: 16;  sample_bits: 4),
-      (palette_entries: 256; sample_bits: 8),
-      (palette_entries: 0; sample_bits: 16),
-      (palette_entries: 0; sample_bits: 32),
-      (palette_entries: 0; sample_bits: 4),
-      (palette_entries: 0; sample_bits: 16)
-    );
-var
-  image: TRSImage;
-  buf: array[0..27] of byte;
-  description: TImageDescription;
-  bpp: byte;
-  color_rgba: integer;
-  pos: int64;
-begin
-  tex.data_offset := f.ReadDWord;
-  f.ReadBuffer(buf, 28);
-  tex.palette_offset := f.ReadDWord;
-  tex.name_offset := f.ReadDWord;
-  tex.width := f.ReadWord;
-  tex.height := f.ReadWord;
-
-  f.ReadByte; //0x01
-  bpp := f.ReadByte;
-  image.type_ := f.ReadByte;
-  f.ReadByte;
-  color_rgba := f.ReadDWord;
-
-  pos := f.Position;
-  f.Seek(tex.name_offset, TSeekOrigin.soBeginning);
-  f.ReadBuffer(tex.name, 16);
-  tex.name_string := NameToString(tex.name);
-  f.Seek(pos, TSeekOrigin.soBeginning);
-
-  description := ImageDescription[image.type_];
-  image.sampleBits := description.sample_bits;
-  image.paletteEntries := description.palette_entries;
-  image.width := tex.width;
-  image.height := tex.height;
-
-  writeln('name: ', tex.name_string);
-  writeln('size: ', tex.width, 'x', tex.height);
-  writeln('subtype: ', image.type_, ' bpp: ', bpp);
-  writeln('sample bits: ', image.sampleBits);
-  writeln('palette offset: ', tex.palette_offset);
-  writeln('data offset: ', tex.data_offset);
-
-  if tex.palette_offset > 0 then begin
-      writeln('palette entries: ', image.paletteEntries);
-      f.Seek(tex.palette_offset, TSeekOrigin.soBeginning);
-      LoadPalette(image, f);
-  end;
-  f.Seek(tex.data_offset, TSeekOrigin.soBeginning);
-  LoadSamples(image, f);
-  DecodePixels(image);
-
-  f.Seek(pos, TSeekOrigin.soBeginning);
-  writeln;
-  tex.image := image;
-end;
-
-
-procedure ReadMaterial(var mat: THmtMaterial; var f: TMemoryStream);
-begin
-  mat.type_ := f.ReadWord;
-  mat.tex_index := f.ReadWord;
-  mat.unknown_float1 := f.ReadDWord;
-  mat.unknown_float2 := f.ReadDWord;
-  mat.zero := f.ReadDWord;
-  mat.hex_a := f.ReadDWord;
-  f.ReadBuffer(mat.name, 16);
-
-  writeln(NameToString(mat.name));
-  if (mat.zero <> 0) or (mat.hex_a <> $A) then
-      writeln('unusual file');
-  writeln(' type1: ', mat.type_);
-  writeln(' type2: ', mat.tex_index);
-end;
-
-
-function ParseHmtFile(const fname: string): THmtFile;
-var
-  f: TMemoryStream;
-  hmt: THmtFile;
-  i: Integer;
-begin
-  f := TMemoryStream.Create;
-  f.LoadFromFile(fname);
-
-  //read main info
-  hmt.material_count := f.ReadDWord;
-  hmt.texture_offset := f.ReadDWord;
-  f.Seek(hmt.texture_offset, TSeekOrigin.soBeginning);
-  hmt.texture_count := f.ReadDWord;
-  f.Seek(8, TSeekOrigin.soBeginning);
-
-  //read materials
-  writeln('materials: ', hmt.material_count);
-  SetLength(hmt.materials, hmt.material_count);
-  for i := 0 to hmt.material_count - 1 do begin
-      ReadMaterial(hmt.materials[i], f);
-  end;
-
-  if hmt.texture_count = 0 then begin
-      result := hmt;
-      f.Free;
-      exit;
-  end;
-
-  //read textures
-  writeln('textures: ', hmt.texture_count);
-  f.Seek(hmt.texture_offset + 4, TSeekOrigin.soBeginning);
-  SetLength(hmt.textures, hmt.texture_count);
-  for i := 0 to hmt.texture_count - 1 do begin
-      ReadTexture(hmt.textures[i], f);
-  end;
-
-  f.Free;
-  result := hmt;
-end;
-
-end.
-

hmt_parser/main.pas

@@ -63,7 +63,7 @@ begin
   case image.type_ of
       0, 1: pnm_save(outname + '.pnm', image.pixels, image.width, image.height);
       3: WriteTga32b(outname + '.tga', image.pixels, image.width, image.height, image.width * image.height * 4);
-      4: pgm_save(outname + '.pgm', image.pixels, image.width, image.height);
+      4, 5: pgm_save(outname + '.pgm', image.pixels, image.width, image.height);
   else
       writeln('image type was not saved: ', image.type_);
   end;
@@ -73,6 +73,7 @@ var
   fname: string;
   hmt: THmtFile;
   i: integer;
+  stream: TMemoryStream;
 
 begin
   if ParamCount < 1 then begin
@@ -83,10 +84,17 @@ begin
   fname := ParamStr(1);
   writeln('parsing file: ', fname);
   try
-      hmt := ParseHmtFile(fname);
+      stream := TMemoryStream.Create;
+      stream.LoadFromFile(fname);
+
+      hmt := ParseHmtFile(stream);
       writeln('saving textures');
       for i := 0 to hmt.texture_count - 1 do
-          SaveImage(hmt.textures[i].image, fname + '_' + hmt.textures[i].name_string);
+          SaveImage(hmt.textures[i].image, '_' + fname + '_' + hmt.textures[i].name_string);
+
+      hmt.materials := nil;
+      if hmt.texture_count > 0 then hmt.textures := nil;
+      stream.Free;
   except
       writeln('parsing failed!');
   end;

hmt_parser/rs_image.pas

@@ -1,168 +0,0 @@
-unit rs_image;
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils;
-
-type
-  TRGB = array[0..2] of byte;
-  PRGB = ^TRGB;
-  TPalette = array[0..255] of TRGB;
-
-  TRSImage = record
-      data_size: integer;
-      width, height: integer;
-      type_: byte;
-      sampleBits: byte;
-      paletteEntries: integer;
-      pixels: pbyte;
-      samples: pbyte;
-      palette: TPalette;
-  end;
-
-type
-  TImageDescription = record
-      palette_entries: integer;
-      sample_bits: integer;
-      //alpha: byte;
-  end;
-
-procedure LoadPalette(var image: TRSImage; var f: TMemoryStream);
-procedure LoadSamples(var image: TRSImage; var f: TMemoryStream);
-procedure DecodePixels(var img: TRSImage);
-
-//**************************************************************************************************
-implementation
-
-procedure Unpack4To8bit(const src: PByte; const samples: integer; const dst: PByte);
-var
-  i: Integer;
-  v: byte;
-begin
-  for i := 0 to samples div 2 - 1 do begin
-      v := src[i];
-      dst[i * 2    ] := ((v shr 4) and %1111) shl 4;
-      dst[i * 2 + 1] := (v and %1111) shl 4;
-  end;
-end;
-
-
-procedure Unpack4bitTo24bitRGB(const src: PByte; const size: integer; const dst: PByte; const pal: TPalette);
-var
-  i: Integer;
-  index: integer;
-  dest: PRGB;
-begin
-  dest := PRGB(dst);
-  for i := 0 to size div 2 - 1 do begin
-      index := src[i];
-      dest[i * 2    ] := pal[(index shr 4) and 15];
-      dest[i * 2 + 1] := pal[index and 15];
-  end;
-end;
-
-
-procedure Unpack8bitTo24bitRGB(const src: PByte; const size: integer; const dst: PByte; const pal: TPalette);
-var
-  i: Integer;
-  index: integer;
-  dest: PRGB;
-begin
-  dest := PRGB(dst);
-  for i := 0 to size - 1 do begin
-      index := src[i];
-      dest[i] := pal[index];
-  end;
-end;
-
-
-procedure UseOddBytes(const src: PByte; const size: integer; const dst: pbyte);
-var
-  i: integer;
-begin
-  for i := 0 to size - 1 do begin
-      dst[i] := src[i * 2 + 1];
-  end;
-end;
-
-
-procedure DecodePixels(var img: TRSImage);
-var
-  size: integer;
-begin
-  img.pixels := nil;
-  if not(img.type_ in [0, 1, 2, 3, 4, 5]) then exit;
-
-  if img.sampleBits = 32 then begin
-      size := img.width * img.height * 4;
-      img.pixels := GetMem(size);
-      Move(img.samples^, img.pixels^, size);
-  end;
-
-  if img.sampleBits = 4 then begin
-      //4bit grayscale
-      if img.paletteEntries = 0 then begin
-          size := img.width * img.height;
-          img.pixels := GetMem(size);
-          Unpack4To8bit(img.samples, size, img.pixels);
-      end;
-      //24bit RGB palettized
-      if img.paletteEntries = 16 then begin
-          size := img.width * img.height;
-          img.pixels := GetMem(size * 3);
-          Unpack4bitTo24bitRGB(img.samples, size, img.pixels, img.palette);
-      end;
-  end;
-
-  if img.sampleBits = 8 then begin
-      //8bit grayscale
-      if img.paletteEntries = 0 then begin
-          size := img.width * img.height;
-          img.pixels := GetMem(size);
-          move(img.samples^, img.pixels^, size);
-      end;
-      //24bit RGB palettized
-      if img.paletteEntries = 256 then begin
-          size := img.width * img.height;
-          img.pixels := GetMem(size * 3);
-          Unpack8bitTo24bitRGB(img.samples, size, img.pixels, img.palette);
-      end;
-  end;
-
-  if img.sampleBits = 16 then begin
-      size := img.width * img.height;
-      img.pixels := GetMem(size);
-      UseOddBytes(img.samples, size, img.pixels);
-  end;
-end;
-
-
-procedure LoadPalette(var image: TRSImage; var f: TMemoryStream);
-var
-  entries: integer;
-begin
-  entries := image.paletteEntries;
-  case entries of
-      16, 256: f.ReadBuffer(image.palette, entries * 3); //RGB
-  end;
-end;
-
-
-procedure LoadSamples(var image: TRSImage; var f: TMemoryStream);
-var
-  sample_bits: integer;
-  size: integer;
-begin
-  sample_bits := image.sampleBits;
-  size := image.width * image.height * sample_bits div 8;
-  image.samples := getmem(size);
-  f.ReadBuffer(image.samples^, size);
-  if image.type_ = 2 then
-      f.ReadBuffer(image.samples^, size div 4);
-end;
-
-
-end.
-

model_viewer/hob_mesh.pas

@@ -156,6 +156,8 @@ var
   hob: THobFile;
 begin
   hob := ParseHobFile(stream);
+  if hob.obj_count = 0 then exit;
+
   for i := 0 to 0 do
       HobReadMesh(hob.objects[i]);
   WriteLn('vertices: ', _vertices.Size);

model_viewer/model_viewer.pas

@@ -392,6 +392,9 @@ begin
   g_model := TModel.Create;
   g_model.Load(hob, hmt);
   g_model.InitGL;
+
+  hob.Free;
+  hmt.Free;
 end;
 
 

rs_units/hmt_parser.pas

@@ -54,22 +54,13 @@ end;
 
 
 procedure ReadTexture(var tex: THmtTexture; var f: TMemoryStream);
-const
-  ImageDescription: array[0..5] of TImageDescription = (
-      (palette_entries: 16;  sample_bits: 4),
-      (palette_entries: 256; sample_bits: 8),
-      (palette_entries: 0; sample_bits: 16),
-      (palette_entries: 0; sample_bits: 32),
-      (palette_entries: 0; sample_bits: 4),
-      (palette_entries: 0; sample_bits: 16)
-    );
 var
   image: TRSImage;
   buf: array[0..27] of byte;
   description: TImageDescription;
-  bpp: byte;
   color_rgba: integer;
   pos: int64;
+  u0, u1, bits_per_sample: byte;
 begin
   tex.data_offset := f.ReadDWord;
   f.ReadBuffer(buf, 28);
@@ -78,10 +69,10 @@ begin
   tex.width := f.ReadWord;
   tex.height := f.ReadWord;
 
-  f.ReadByte; //0x01
+  u0 := f.ReadByte; //always 1 ?
-  bpp := f.ReadByte;
+  bits_per_sample := f.ReadByte;
   image.type_ := f.ReadByte;
-  f.ReadByte;
+  u1 := f.ReadByte;
   color_rgba := f.ReadDWord;
 
   pos := f.Position;
@@ -99,10 +90,11 @@ begin
 
   writeln('name: ', tex.name_string);
   writeln('size: ', tex.width, 'x', tex.height);
-  writeln('subtype: ', image.type_, ' bpp: ', bpp);
+  writeln('subtype: ', image.type_);
   writeln('sample bits: ', image.sampleBits);
   writeln('palette offset: ', tex.palette_offset);
   writeln('data offset: ', tex.data_offset);
+  writeln('u0:', u0, ' u1:', u1);
 
   if tex.palette_offset > 0 then begin
       writeln('palette entries: ', image.paletteEntries);
@@ -146,9 +138,6 @@ begin
   //read main info
   hmt.material_count := f.ReadDWord;
   hmt.texture_offset := f.ReadDWord;
-  f.Seek(hmt.texture_offset, TSeekOrigin.soBeginning);
-  hmt.texture_count := f.ReadDWord;
-  f.Seek(8, TSeekOrigin.soBeginning);
 
   //read materials
   writeln('materials: ', hmt.material_count);
@@ -157,18 +146,15 @@ begin
       ReadMaterial(hmt.materials[i], f);
   end;
 
-  if hmt.texture_count = 0 then begin
-      result := hmt;
-      f.Free;
-      exit;
-  end;
-
   //read textures
+  f.Seek(hmt.texture_offset, TSeekOrigin.soBeginning);
+  hmt.texture_count := f.ReadDWord;
   writeln('textures: ', hmt.texture_count);
-  f.Seek(hmt.texture_offset + 4, TSeekOrigin.soBeginning);
+  if hmt.texture_count > 0 then begin
-  SetLength(hmt.textures, hmt.texture_count);
+      SetLength(hmt.textures, hmt.texture_count);
-  for i := 0 to hmt.texture_count - 1 do begin
+      for i := 0 to hmt.texture_count - 1 do begin
-      ReadTexture(hmt.textures[i], f);
+          ReadTexture(hmt.textures[i], f);
+      end;
   end;
 
   result := hmt;

rs_units/rs_image.pas

@@ -36,7 +36,7 @@ const
       (palette_entries: 0; sample_bits: 16),
       (palette_entries: 0; sample_bits: 32),
       (palette_entries: 0; sample_bits: 4),
-      (palette_entries: 0; sample_bits: 16)
+      (palette_entries: 0; sample_bits: 8)
     );
 
 procedure LoadPalette(var image: TRSImage; var f: TMemoryStream);
@@ -167,6 +167,8 @@ var
 begin
   sample_bits := image.sampleBits;
   size := image.width * image.height * sample_bits div 8;
+  Assert(f.Size >= f.Position + size, 'fix size/sample');
+
   image.samples := getmem(size);
   f.ReadBuffer(image.samples^, size);
   if image.type_ = 2 then