model viewer: texture export

model_viewer/hob_mesh.pas

@@ -4,7 +4,7 @@ unit hob_mesh;
 interface
 
 uses
-  Classes, SysUtils, gl, GLext, math, gvector, fpimgui,
+  Classes, SysUtils, gl, GLext, math, gvector, fpimgui, png_writer,
   hob_parser, hmt_parser;
 
 type
@@ -25,6 +25,7 @@ type
       gl_tex_id: integer;
       width, height: integer;
       pixels: pbyte;
+      name: string;
   end;
 
   TVertexList = specialize TVector<TVertex>;
@@ -40,6 +41,10 @@ type
       textures: boolean;
   end;
 
+  TMeshOpts = record
+      export_png_textures: boolean;
+  end;
+
   { TModel
     single HOB mesh
   }
@@ -54,12 +59,13 @@ type
       procedure HmtRead(stream: TMemoryStream);
       procedure HobRead(stream: TMemoryStream);
       procedure HobReadMesh(const mesh: THobObject);
+      procedure SaveMaterials(const mtl_name: string; const png_textures: boolean);
     public
       destructor Destroy; override;
       procedure Load(hob, hmt: TMemoryStream);
       procedure InitGL;
       procedure DrawGL(var opts: TRenderOpts);
-      procedure ExportObj(const obj_name: string);
+      procedure ExportObj(const obj_name: string; const png_textures: boolean);
   end;
 
 implementation
@@ -194,11 +200,16 @@ procedure TModel.HmtRead(stream: TMemoryStream);
   end;
 var
   i: integer;
+  name: string;
 begin
   _hmt := ParseHmtFile(stream);
   SetLength(_materials, _hmt.material_count);
-  for i := 0 to _hmt.material_count - 1 do
+  for i := 0 to _hmt.material_count - 1 do begin
-      SetTexByName(_materials[i], _hmt.materials[i].name_string);
+      name := _hmt.materials[i].name_string;  //preserve for obj/mtl export
+      _materials[i].name := name;
+      writeln('material: ', name);
+      SetTexByName(_materials[i], name);
+  end;
 end;
 
 
@@ -365,8 +376,7 @@ const
   HeaderComment = 'Exported with HOB viewer';
   DefaultMaterial = 'default';
 
-
+procedure TModel.ExportObj(const obj_name: string; const png_textures: boolean);
-procedure TModel.ExportObj(const obj_name: string);
 const
   DesiredUnitSize = 2;
 var
@@ -384,6 +394,8 @@ var
 
   i,j,k: integer;
   vertex_counter: Integer;
+  mat: TMaterial;
+  mtl_name: string;
 
 function GetMaxCoord: double;
 var
@@ -407,7 +419,8 @@ begin
   Rewrite(objfile);
 
   writeln(objfile, '# ' + HeaderComment);
-  writeln(objfile, 'mtllib ', obj_name + '.mtl');
+  mtl_name := obj_name + '.mtl';
+  writeln(objfile, 'mtllib ', mtl_name);
 
   //scale pass
   scaling_factor := 1;
@@ -453,8 +466,10 @@ begin
           if face.material_index <> last_material_index then begin
               if face.material_index = -1 then
                   writeln(objfile, 'usemtl ' + DefaultMaterial)
-              else
+              else begin
-                  writeln(objfile, 'usemtl material_id', face.material_index);
+                  mat := _materials[face.material_index];
+                  writeln(objfile, 'usemtl ' + mat.name);
+              end;
               last_material_index := face.material_index;
           end;
 
@@ -471,8 +486,85 @@ begin
   end;
 
   CloseFile(objfile);
+  SaveMaterials(mtl_name, png_textures);
+end;
 
-  //SaveMaterials(pdo, obj_name);
+
+procedure TModel.SaveMaterials(const mtl_name: string; const png_textures: boolean);
+var
+  mtl_file:TextFile;
+  tex_name: string;
+  mat: TMaterial;
+  pixbuf: pbyte;
+
+  procedure Flip(const samples: integer);
+  var
+    y: Integer;
+    src, dst: Pbyte;
+  begin
+    src := mat.pixels + (mat.height - 1) * mat.width * samples;
+    dst := pixbuf;
+    for y := 0 to mat.height - 1 do begin
+        move(src^, dst^, mat.width * samples);
+        src -= mat.width * samples;
+        dst += mat.width * samples;
+    end;
+  end;
+
+  procedure WriteMaterial;
+  begin
+    writeln(mtl_file, 'newmtl ', mat.name);  //begin new material
+    if mat.has_texture then begin        //texture
+        tex_name := '';
+        if mat.bpp = 24 then begin
+            tex_name := mat.name+'.pnm';
+            Flip(3);
+            if not png_textures then begin
+                pnm_save(tex_name, pixbuf, mat.width, mat.height)
+            end
+            else begin
+                tex_name := mat.name+'.png';
+                png_write(tex_name, pixbuf, mat.width, mat.height, 24);
+            end;
+        end
+        else if mat.bpp = 8 then begin
+            tex_name := mat.name+'.pgm';
+            Flip(1);
+            if not png_textures then begin
+                pgm_save(tex_name, pixbuf, mat.width, mat.height)
+            end
+            else begin
+                tex_name := mat.name+'.png';
+                png_write(tex_name, pixbuf, mat.width, mat.height, 8);
+            end;
+        end;
+        if tex_name <> '' then
+            writeln(mtl_file, 'map_Kd ' + tex_name);
+    end;
+    writeln(mtl_file, 'Ka 1.000 1.000 1.000');  //ambient color
+    writeln(mtl_file, 'Kd 1.000 1.000 1.000');  //diffuse color
+    writeln(mtl_file, 'Ks 1.000 1.000 1.000');  //specular color
+    writeln(mtl_file, 'Ns 100.0');              //specular weight
+    writeln(mtl_file, 'illum 2');               //Color on and Ambient on, Highlight on
+    writeln(mtl_file);
+  end;
+
+begin
+  pixbuf := GetMem(512*512);  //overkill for RS texture sizes
+
+  AssignFile(mtl_file, mtl_name);
+  Rewrite(mtl_file);
+
+  writeln(mtl_file, '# ' + HeaderComment);
+  mat.name := DefaultMaterial;
+  mat.has_texture := false;
+  WriteMaterial();
+  for mat in _materials do begin
+      WriteMaterial();
+  end;
+
+  CloseFile(mtl_file);
+  Freemem(pixbuf);
 end;
 
 end.

model_viewer/model_viewer.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
@@ -28,7 +28,7 @@
           </Target>
           <SearchPaths>
             <IncludeFiles Value="$(ProjOutDir)"/>
-            <OtherUnitFiles Value="..\rs_units;sdl2;imgui"/>
+            <OtherUnitFiles Value="..\rs_units;sdl2;imgui;util"/>
             <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
           </SearchPaths>
           <CodeGeneration>
@@ -51,16 +51,23 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
         <CommandLineParams Value="vwing.hob"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="vwing.hob"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="1">
       <Item1>
         <PackageName Value="LCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="9">
+    <Units Count="14">
       <Unit0>
         <Filename Value="model_viewer.pas"/>
         <IsPartOfProject Value="True"/>
@@ -98,6 +105,26 @@
         <Filename Value="..\rs_units\rs_dat.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit8>
+      <Unit9>
+        <Filename Value="util\dc2_encoder.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="util\png_writer.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="util\prediction.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="util\crc32fast.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="util\dc2core.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit13>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -108,7 +135,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\rs_units;sdl2;imgui"/>
+      <OtherUnitFiles Value="..\rs_units;sdl2;imgui;util"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Parsing>

model_viewer/model_viewer.pas

@@ -21,7 +21,8 @@ program model_viewer;
 uses
   sysutils, classes, math, strutils, gvector,
   gl, glu, glext, sdl2, fpimgui, fpimgui_impl_sdlgl2,
-  rs_dat, hob_mesh;
+  rs_dat, hob_mesh,
+  png_writer, dc2core;
 
 const
   SCR_W_INIT = 1280;
@@ -56,7 +57,8 @@ var
       pitch: single;
       x, y: single;
       autorotate: boolean;
-      opts: TRenderOpts;
+      render: TRenderOpts;
+      mesh: TMeshOpts;
   end;
 
   key_pressed: record
@@ -124,9 +126,8 @@ end;
 
 
 // The main drawing function.
-procedure DrawGLScene;
+procedure DrawModel;
 begin
-  glClear( GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT );
   glLoadIdentity;
 
   if view.distance < ZoomIncrement then
@@ -142,12 +143,8 @@ begin
       view.rotation_angle -= 360;
 
   if g_model <> nil then begin
-      g_model.DrawGL(view.opts);
+      g_model.DrawGL(view.render);
   end;
-
-  igRender;
-  
-  SDL_GL_SwapWindow(g_window);
 end;
 
 
@@ -237,12 +234,12 @@ begin
   view.y := 0;
   view.autorotate := true;
 
-  view.opts.fg_all := true;
+  view.render.fg_all := true;
-  view.opts.fg_to_draw := 0;
+  view.render.fg_to_draw := 0;
-  view.opts.wireframe := false;
+  view.render.wireframe := false;
-  view.opts.points := false;
+  view.render.points := false;
-  view.opts.vcolors := true;
+  view.render.vcolors := true;
-  view.opts.textures := true;
+  view.render.textures := true;
 end;
 
 
@@ -272,7 +269,7 @@ begin
   except
     g_model_loading_failed := true;
   end;
-  view.opts.fg_to_draw := 0;
+  view.render.fg_to_draw := 0;
 end;
 
 
@@ -318,30 +315,30 @@ begin
                    //g_model rendering opts
             SDLK_w:
                 if not key_pressed.wireframe then begin
-                    view.opts.wireframe := not view.opts.wireframe;
+                    view.render.wireframe := not view.render.wireframe;
                     key_pressed.wireframe := true;
                 end;
             SDLK_v:
                 if not key_pressed.vcolors then begin
-                    view.opts.vcolors := not view.opts.vcolors;
+                    view.render.vcolors := not view.render.vcolors;
                     key_pressed.vcolors := true;
                 end;
             SDLK_p:
                 if not key_pressed.points then begin
-                    view.opts.points := not view.opts.points;
+                    view.render.points := not view.render.points;
                     key_pressed.points := true;
                 end;
             SDLK_t:
                 if not key_pressed.textures then begin
-                    view.opts.textures := not view.opts.textures;
+                    view.render.textures := not view.render.textures;
                     key_pressed.textures := true;
                 end;
             SDLK_f:
-                view.opts.fg_all := not view.opts.fg_all;
+                view.render.fg_all := not view.render.fg_all;
             SDLK_LEFT:
-                view.opts.fg_to_draw := max(0, view.opts.fg_to_draw - 1);
+                view.render.fg_to_draw := max(0, view.render.fg_to_draw - 1);
             SDLK_RIGHT:
-                view.opts.fg_to_draw += 1;
+                view.render.fg_to_draw += 1;
             SDLK_UP:
                 if (g_selected_file_idx > 0) then begin
                     g_selected_file_idx -= 1;
@@ -420,34 +417,33 @@ end;
 
 procedure DrawGui;
 var
-  style: PImGuiStyle;
   file_item: TFileListItem;
   selected_item_idx: integer;
   selected_item: TFileListItem;
   i: Integer;
+  do_export: boolean;
 begin
-  ImGui_ImplSdlGL2_NewFrame(g_window);
-
-  style := Imgui.GetStyle();
-  style^.WindowRounding := 0;
-
   if g_selected_file_idx >= 0 then begin
       Imgui.Begin_('Mesh');  //window used in hob_mesh as well
       if not g_model_loading_failed then begin
           Imgui.Text(g_filelist[g_selected_file_idx].name);
       end else
           Imgui.Text('mesh loading failed :(');
+      if g_model <> nil then begin
+          do_export := Imgui.Button('Export to obj');
+          Imgui.SameLine(0, 15);
+          Imgui.Checkbox('with png textures', @view.mesh.export_png_textures);
+          if do_export then
+              g_model.ExportObj('rs_exported.obj', view.mesh.export_png_textures);
+      end;
       Imgui.End_;
   end;
 
   Imgui.Begin_('Rendering options');
-    Imgui.Checkbox('points', @view.opts.points);
+    Imgui.Checkbox('points', @view.render.points);
-    Imgui.Checkbox('wireframe', @view.opts.wireframe);
+    Imgui.Checkbox('wireframe', @view.render.wireframe);
-    Imgui.Checkbox('textures', @view.opts.textures);
+    Imgui.Checkbox('textures', @view.render.textures);
-    Imgui.Checkbox('vertex colors', @view.opts.vcolors);
+    Imgui.Checkbox('vertex colors', @view.render.vcolors);
-    if g_model <> nil then
-        if Imgui.Button('Export to obj') then
-            g_model.ExportObj('rs_exported.obj');
   Imgui.End_;
 
   if g_filelist.Size = 0 then
@@ -505,6 +501,22 @@ begin
 end;
 
 
+procedure BeginScene;
+var
+  style: PImGuiStyle;
+begin
+  ImGui_ImplSdlGL2_NewFrame(g_window);
+  style := Imgui.GetStyle();
+  style^.WindowRounding := 0;
+  glClear( GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT );
+end;
+
+procedure EndScene;
+begin
+  igRender;
+  SDL_GL_SwapWindow(g_window);
+end;
+
 //******************************************************************************
 var
   sec, frames: integer;
@@ -542,9 +554,10 @@ begin
   key_pressed.wireframe := false;
   key_pressed.fullscreen := false;
   while not Done do begin
-
+      BeginScene;
+      DrawModel;
       DrawGui;
-      DrawGLScene;
+      EndScene;
 
       while SDL_PollEvent(@event) > 0 do
           HandleEvent(event, done);

model_viewer/util/crc32fast.pas

@@ -0,0 +1,78 @@
+(*******************************************************************************
+crc32 slicing by 4 - http://create.stephan-brumme.com/crc32/
+
+*******************************************************************************)
+unit crc32fast;
+{$mode objfpc}{$H+}
+
+interface
+
+function crc32(crc: longword; const data: Pbyte; length: longword): longword;
+
+
+implementation
+
+var
+  Crc32Table: array[0..3, 0..255] of longword;
+
+procedure InitTable;
+const
+  POLY = $EDB88320;
+var
+  i, j: integer;
+  crc: longword;
+begin
+  for i := 0 to 255 do begin
+      crc := i;
+      for j := 0 to 7 do begin
+          crc := (crc >> 1) xor ((crc and 1) * POLY);
+      end;
+      Crc32Table[0, i] := crc;
+  end;
+
+  for i := 0 to 255 do begin
+      Crc32Table[1, i] := (Crc32Table[0, i] >> 8) xor Crc32Table[0, Crc32Table[0, i] and $ff];
+      Crc32Table[2, i] := (Crc32Table[1, i] >> 8) xor Crc32Table[0, Crc32Table[1, i] and $ff];
+      Crc32Table[3, i] := (Crc32Table[2, i] >> 8) xor Crc32Table[0, Crc32Table[2, i] and $ff];
+  end;
+end;
+
+
+function crc32(crc: longword; const data: Pbyte; length: longword): longword;
+var
+  current: plongword;
+  current_byte: pbyte;
+  x: longword;
+begin
+  if data = nil then
+    exit(0);
+
+  crc := crc xor $FFFFFFFF;
+  current := plongword(data);
+  while length >= 4 do begin
+      x := crc xor current^;
+      current += 1;
+      crc := Crc32Table[0, (x >> 24) and $ff] xor
+             Crc32Table[1, (x >> 16) and $ff] xor
+             Crc32Table[2, (x >>  8) and $ff] xor
+             Crc32Table[3, (x >>  0) and $ff];
+      length -= 4;
+  end;
+
+  current_byte := pbyte(current);
+  while length > 0 do begin
+      crc := (crc >> 8) xor Crc32Table[0, (crc and $ff) xor current_byte^];
+      current_byte += 1;
+      length -= 1;
+  end;
+
+  crc := crc xor $FFFFFFFF;
+  result := crc;
+end;
+
+
+initialization
+InitTable;
+
+end.
+

model_viewer/util/dc2_encoder.pas

@@ -0,0 +1,278 @@
+(*******************************************************************************
+dc2_encoder.pas
+Copyright (c) 2014-2015 David Pethes
+
+This file is part of Dc2.
+
+Dc2 is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+Dc2 is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Dc2.  If not, see <http://www.gnu.org/licenses/>.
+
+*******************************************************************************)
+unit dc2_encoder;
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, dc2core;
+
+const
+  DefaultCompLevel = 5;
+
+type
+  TEncodedSlice = record
+      data: pbyte;
+      size: integer;
+  end;
+
+  { TDc2Encoder }
+
+  TDc2Encoder = class
+  private type
+      TEncoderState = (stStartBlock, stProcessData, stWriteBlock);
+  private
+      dict: TMatchSearcher;              //string dictionary
+      search_results: PLiteralMatch;     //dictionary search results buffer
+      blockCoder: TBlockWriter;          //deflate block writing backend
+
+      output_buffer: pbyte;              //buffer for encoded data, used by bitstream writer
+      encoded_items: integer;            //encoded item count
+      slices_stored: integer;            //number of input slices in current block
+
+      block: record                      //current deflate block data
+          btype: TBlockTypeEnum;         //type (fixed/dynamic/raw)
+          size:  integer;                //size in bytes for raw blocks, coding elements otherwise
+          last:  boolean;                //last block in deflate stream
+      end;
+      state: TEncoderState;
+      clevel: byte;                      //compression level
+      use_fixed_huff_only: boolean;      //static huffcodes only
+      stats: stats_t;                    //block statistics
+
+      procedure SearchMatches(const stream: pbyte; const size: integer);
+
+  public
+      constructor Create(const compression_level: byte; const fixed_code_only: boolean = false);
+      destructor Destroy; override;
+      //Encode given block of data
+      procedure EncodeSlice(const data: pbyte; const input_size: longword; out slice: TEncodedSlice);
+      //Signal the last input block
+      procedure SetLastSlice;
+      //encoded data statistics
+      function GetStats: stats_t;
+  end;
+
+implementation
+
+{ TDc2Encoder }
+
+constructor TDc2Encoder.Create(const compression_level: byte; const fixed_code_only: boolean);
+begin
+  clevel := compression_level;
+  if clevel > MAX_COMPRESSION_LEVEL then
+      clevel := MAX_COMPRESSION_LEVEL;
+  use_fixed_huff_only := fixed_code_only;
+
+  dict := TMatchSearcher.Create;
+  dict.SetCompressionLevel(clevel);
+
+  output_buffer := getmem(MAX_BLOCK_SIZE * 2);  //padding for the case of data expansion
+  blockCoder := TBlockWriter.Create(output_buffer);
+
+  search_results := getmem(MAX_BLOCK_SIZE * 2 * sizeof(TLiteralMatch));
+
+  state := stStartBlock;
+  block.last := false;
+  Fillbyte(stats, sizeof(stats_t), 0);
+end;
+
+destructor TDc2Encoder.Destroy;
+begin
+  dict.Free;
+  blockCoder.Free;
+  freemem(output_buffer);
+  freemem(search_results);
+  inherited;
+end;
+
+{
+  EncodeSlice
+
+  Encode given piece of data:
+    - dictionary frontend: search for duplicate strings
+    - block coder backend: store search results in Deflate format
+}
+procedure TDc2Encoder.EncodeSlice(const data: pbyte; const input_size: longword; out slice: TEncodedSlice);
+var
+  processed_size: integer;
+
+  procedure WriteBlock;
+  var
+    append_bs_buffer: boolean;
+  begin
+    //write literals/matches to bitstream
+    if block.last then blockCoder.SetLast;
+    append_bs_buffer := slice.size > 0;
+    blockCoder.WriteBlock(data, input_size, search_results, encoded_items, append_bs_buffer);
+
+    //failed to compress the block - use raw block (if all data is available)
+    if (blockCoder.GetStreamSize >= input_size) and (slices_stored = 1) and not block.last then begin
+        block.btype := BTRaw;
+        blockCoder.InitNewBlock(block.btype);
+        blockCoder.WriteBlock(data, input_size, search_results, encoded_items);
+        encoded_items := input_size;
+    end;
+
+    //commit block data
+    blockCoder.Done;
+    slice.data := output_buffer;
+    slice.size += blockCoder.GetStreamSize();
+
+    stats.elements_encoded += encoded_items;
+    stats.blocks[block.btype] += 1;
+  end;
+
+begin
+  Assert(input_size <= MAX_BLOCK_SIZE, 'unexpected input data size');
+
+  //if no compression is specified, process the data as raw block
+  if clevel = 0 then begin
+      blockCoder.InitNewBlock(BTRaw);
+      if block.last then blockCoder.SetLast;
+      blockCoder.WriteBlock(data, input_size, search_results, 0);
+      blockCoder.Done;
+      slice.data := output_buffer;
+      slice.size := blockCoder.GetStreamSize();
+      stats.blocks[block.btype] += 1;
+      exit;
+  end;
+
+  processed_size := 0;
+  slice.data := nil;
+  slice.size := 0;
+
+  repeat
+      case state of
+      stStartBlock: begin
+          //use fixed huffcode block if the input stream is too small, the overhead of dynamic block header would kill any compression
+          block.btype := BTDynamic;
+          if use_fixed_huff_only or (input_size < 200) then
+              block.btype := BTFixed;
+
+          blockCoder.InitNewBlock(block.btype);
+          state := stProcessData;
+          encoded_items := 0;
+          slices_stored := 0;
+      end;
+      stProcessData: begin
+          //search input buffer for matches
+          SearchMatches(data, input_size);
+          processed_size := input_size;
+          slices_stored += 1;
+          //save block if no more data should go to block or last data was processed
+          if (encoded_items > MAX_BLOCK_SIZE div 8) or (slices_stored = 4) or block.last then
+               state := stWriteBlock;
+      end;
+      stWriteBlock: begin
+          WriteBlock;
+          state := stStartBlock;
+      end;
+      end;
+  until (state in [stProcessData, stStartBlock]) and (processed_size = input_size);
+end;
+
+procedure TDc2Encoder.SetLastSlice;
+begin
+  block.last := true;
+end;
+
+function TDc2Encoder.GetStats: stats_t;
+begin
+  result := stats;
+end;
+
+function InitMatch(const sr: TSearchResult): TLiteralMatch; inline;
+begin
+  result.match_length := sr.length;
+  result.offset := sr.distance;
+  result.literal := 0;
+end;
+
+function InitMatch(const l: byte): TLiteralMatch; inline;
+begin
+  result.match_length := 0;
+  result.offset := 0;
+  result.literal := l;
+end;
+
+{ SearchMatches
+  Search stream for duplicate strings using a dictionary built from gathered data
+}
+procedure TDc2Encoder.SearchMatches(const stream: pbyte; const size: integer);
+var
+  lm: TLiteralMatch;
+  lms: PLiteralMatch;
+  match, match_lazy: TSearchResult;
+  i: integer;
+  literal: byte;
+begin
+  dict.NewData(stream, size);
+  i := 0;
+  lms := search_results + encoded_items;
+  while i < size do begin
+      match := dict.FindMatch(stream + i, i);
+      literal := stream[i];
+
+      if match.length >= MIN_MATCH_LENGTH then begin
+
+          //lazy matching, biases are experimental and not tuned much
+          if (clevel >= 5) and (i < size - 1) then begin
+              if (match.length > 1) and (match.length < MAX_DEFLATE_MATCH_LENGTH-3) then begin
+
+                  match_lazy := dict.FindMatch(stream + i + 1, i + 1);
+                  if match_lazy.length > match.length + 2 then begin
+                      i += 1;
+                      lms^ := InitMatch(literal);
+                      lms += 1;
+                      blockCoder.UpdateStatsLiteral(literal);
+
+                      i += match_lazy.length;
+                      lms^ := InitMatch(match_lazy);
+                      lms += 1;
+                      blockCoder.UpdateStatsMatch(match_lazy.length, match_lazy.distance);
+
+                      Continue;
+                  end;
+
+              end;
+          end;
+          //end lazy matching
+
+          i += match.length;
+          lm := InitMatch(match);
+          blockCoder.UpdateStatsMatch(match.length, match.distance);
+      end
+      else begin
+          i += 1;
+          lm := InitMatch(literal);
+          blockCoder.UpdateStatsLiteral(literal);
+      end;
+
+      lms^ := lm;
+      lms += 1;
+  end;
+  encoded_items := lms - search_results;
+end;
+
+end.
+

model_viewer/util/dc2_simple_api.pas

@@ -0,0 +1,93 @@
+unit dc2_simple_api;
+{$mode objfpc}{$H+}
+{define use_zstream}
+
+interface
+
+uses
+  Classes, SysUtils,
+  {$ifdef use_zstream}zstream,{$endif}
+  dc2core, dc2_encoder;
+
+type
+  { TLzEncoder }
+  TLzEncoder = class
+  private
+      _ctx: TDc2Encoder;
+      _encoded_size: integer;
+
+  public
+      constructor Create(const compression_level: byte = 2);
+      destructor Destroy; override;
+      function EncodeBytesToStream(const src: pbyte; const size: integer; var dest: TMemoryStream): integer;
+      procedure WriteStats;
+  end;
+
+implementation
+
+{ TLzEncoder }
+
+constructor TLzEncoder.Create(const compression_level: byte);
+begin
+  _ctx := TDc2Encoder.Create(compression_level);
+  _encoded_size := 0;
+end;
+
+destructor TLzEncoder.Destroy;
+begin
+  inherited Destroy;
+  _ctx.free;
+end;
+
+function TLzEncoder.EncodeBytesToStream(const src: pbyte; const size: integer; var dest: TMemoryStream): integer;
+var
+  src_buffer: pbyte;
+  chunk_size: integer;
+  bytes_to_process: integer;
+  encdata: TEncodedSlice;
+  {$ifdef use_zstream}
+  zs: Tcompressionstream;
+  {$endif}
+begin
+  {$ifdef use_zstream}
+  zs := Tcompressionstream.create(cldefault, dest, true);
+  zs.WriteBuffer(src^, size);
+  zs.Free;
+  result := _encoded_size;
+  exit;
+  {$endif}
+  _encoded_size := 0;
+  src_buffer := src;
+  chunk_size := MAX_BLOCK_SIZE;
+  bytes_to_process := size;
+
+  while bytes_to_process > 0 do begin
+      if bytes_to_process <= chunk_size then begin
+          chunk_size := bytes_to_process;
+          _ctx.SetLastSlice();
+      end;
+
+      _ctx.EncodeSlice(src_buffer, chunk_size, encdata);
+      dest.Write(encdata.data^, encdata.size);
+      _encoded_size += encdata.size;
+
+      src_buffer += chunk_size;
+      bytes_to_process -= chunk_size;
+  end;
+
+  result := _encoded_size;
+end;
+
+procedure TLzEncoder.WriteStats;
+begin
+  //if _ctx^.stats.onb > 0 then
+  //    writeln('avg. offset: ', _ctx^.stats.osum / _ctx^.stats.onb:8:1);
+  //if _ctx^.stats.mnb > 0 then
+  //    writeln('avg. match : ', _ctx^.stats.msum / _ctx^.stats.mnb:8:2);
+  //with _ctx^.stats do
+  //    writeln('block types (raw/fix/dyn): ', blocks[0]:6, blocks[1]:6, blocks[2]:6);
+  //writeln('deflate bytes: ', _encoded_size);
+end;
+
+end.
+

model_viewer/util/png_writer.pas

@@ -0,0 +1,192 @@
+unit png_writer;
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  sysutils, classes,
+  crc32fast, prediction, dc2_simple_api;
+
+function ImageToPngStream(const p: pbyte; const w, h: integer): TMemoryStream;
+procedure png_write(const fname: string; const p: pbyte; const w, h, bitdepth: integer);
+
+implementation
+
+const
+  CompressionLevel = 2;
+
+var
+  //le global hack
+  g_SamplesPerPixel: byte;  //use 3 for rgb, 1 for grayscale
+
+function Adler32(const checksum: longword; const data: pbyte; const size: longword): longword;
+const
+  BASE = 65521;
+  BLOCK_SIZE = 4*1024;
+var
+  i: integer;
+  s1, s2: longword;
+  k, blocks: integer;
+  p: pbyte;
+
+begin
+  s1 := checksum and $ffff;
+  s2 := (checksum shr 16) and $ffff;
+  p := data;
+
+  //process stream in blocks
+  blocks := size div BLOCK_SIZE;
+  for k := 0 to blocks - 1 do begin
+      for i := 0 to BLOCK_SIZE - 1 do begin
+          s1 += p[i];
+          s2 += s1;
+      end;
+      s1 := s1 mod BASE;
+      s2 := s2 mod BASE;
+      p += BLOCK_SIZE;
+  end;
+
+  //final bytes
+  for i := 0 to (size mod BLOCK_SIZE) - 1 do begin
+      s1 += p[i];
+      s2 += s1;
+  end;
+  s1 := s1 mod BASE;
+  s2 := s2 mod BASE;
+
+  result := s2 shl 16 + s1;
+end;
+
+
+procedure StreamWriteDataCRC(var f: TMemoryStream; const p: pbyte; const size: longword);
+var
+  checksum: longword;
+begin
+  checksum := crc32(0, nil, 0);
+  checksum := NtoBE( crc32(checksum, p, size) );
+  f.Write(checksum, 4);  //chunk crc
+end;
+
+
+procedure WriteHeader(var f: TMemoryStream; const width, height: integer);
+const
+  CHUNK_IHDR: array[0..3] of char = ('I','H','D','R');
+  HEADER_DATA_SIZE: longword = 13;
+var
+  chunk_start_position: integer;
+  chunk_data: pbyte;
+  chunk_size: integer;
+begin
+  f.WriteDWord(NtoBE(HEADER_DATA_SIZE));
+  chunk_start_position := f.Position;
+  f.WriteBuffer(CHUNK_IHDR, 4);  //id
+  f.WriteDWord(longword(NtoBE(width)));    //width
+  f.WriteDWord(longword(NtoBE(height)));   //height
+  f.WriteByte(8);                //bits per component
+  //color type: rgb, grayscale
+  if g_SamplesPerPixel = 3 then
+      f.WriteByte(2)
+  else
+      f.WriteByte(0);
+  f.WriteByte(0);                //Compression method, Filter method, Interlace method
+  f.WriteByte(0);
+  f.WriteByte(0);
+  chunk_data := pbyte(f.Memory) + chunk_start_position;
+  chunk_size := f.Position - chunk_start_position;
+  StreamWriteDataCRC(f, chunk_data, chunk_size);
+end;
+
+
+procedure WriteEnding(var f: TMemoryStream);
+const
+  CHUNK_IEND: array[0..3] of char = ('I','E','N','D');
+begin
+  f.WriteDWord(0);
+  f.Write(CHUNK_IEND, 4);
+  StreamWriteDataCRC(f, @CHUNK_IEND, 4);
+end;
+
+
+procedure CompressAndWriteData(var f: TMemoryStream; const pixels: pbyte; const width, height: integer);
+var
+  predictor: TPngPredict;
+  data: pbyte;
+  data_size: integer;
+  stride: integer;
+  checksum: longword;
+  encoder: TLzEncoder;
+begin
+  //pixel prediction & proper data layout
+  stride := width * g_SamplesPerPixel;
+  data := predictor.PredictData(pixels, width, height, g_SamplesPerPixel);
+  data_size := height * (stride + 1);
+
+  //checksum for raw data
+  checksum := 1;
+  checksum := Adler32(checksum, data, data_size);
+
+  //compression
+  encoder := TLzEncoder.Create(CompressionLevel);
+  encoder.EncodeBytesToStream(data, data_size, f);
+  encoder.Free;
+  freemem(data);
+
+  f.WriteDWord(NtoBE(checksum));  //adler32
+end;
+
+
+procedure WritePixelData(var f: TMemoryStream; const w, h: integer; const p: pbyte);
+const
+  CHUNK_IDAT: array[0..3] of char = ('I','D','A','T');
+var
+  chunk_start_position: integer;
+  chunk_data: pbyte;
+  chunk_size: integer;
+begin
+  f.WriteDWord(0);                //data size placeholder
+  chunk_start_position := f.Position;
+  f.WriteBuffer(CHUNK_IDAT, 4);   //id
+  f.WriteByte($78);               //zlib headers: compression method, flags
+  f.WriteByte($DA);               //clevel, fdict, parity
+  CompressAndWriteData(f, p, w, h);
+
+  chunk_data := pbyte(f.Memory) + chunk_start_position;
+  chunk_size := f.Position - chunk_start_position;
+  StreamWriteDataCRC(f, chunk_data, chunk_size);
+
+  //set proper chunk data size
+  f.Seek(chunk_start_position - 4, soBeginning);
+  chunk_size -= 4;
+  f.WriteDWord(longword(NtoBE(chunk_size)));
+  f.Seek(0, soEnd);
+end;
+
+
+function ImageToPngStream(const p: pbyte; const w, h: integer): TMemoryStream;
+const
+  HEAD_MAGIC: array[0..7] of byte = (137, 80, 78, 71, 13, 10, 26, 10);
+var
+  stream: TMemoryStream;
+begin
+  stream := TMemoryStream.Create;
+  stream.Write(HEAD_MAGIC, 8);
+  WriteHeader(stream, w, h);
+  WritePixelData(stream, w, h, p);
+  WriteEnding(stream);
+  result := stream;
+end;
+
+procedure png_write(const fname: string; const p: pbyte; const w, h,
+  bitdepth: integer);
+var
+  stream: TMemoryStream;
+begin
+  g_SamplesPerPixel := bitdepth div 8;
+  stream := ImageToPngStream(p, w, h);
+  stream.SaveToFile(fname);
+  stream.Free;
+end;
+
+
+end.
+

model_viewer/util/prediction.pas

@@ -0,0 +1,204 @@
+unit prediction;
+{$mode objfpc}
+
+interface
+
+type
+  { TPngPredict }
+  //why object? to cache row_data buffer in the future perhaps?
+  TPngPredict = object
+    public
+      function PredictData(const pixels: pbyte; const width, height, samples_per_pixel: integer): pbyte;
+  end;
+
+
+//**************************************************************************************************
+implementation
+
+function filter_sub(dst, src: pbyte; const stride: integer): integer;
+var
+  i: integer;
+  delta: integer;
+begin
+  result := 0;
+  dst += 3;
+  for i := 0 to stride - 4 do begin
+      delta := dst^ - src^;
+      dst^ := byte(delta);
+      result += abs(delta);
+      dst += 1;
+      src += 1;
+  end;
+end;
+
+function filter_up(dst, src_above: pbyte; const stride: integer): integer;
+var
+  i: integer;
+  delta: integer;
+begin
+  result := 0;
+  for i := 0 to stride - 1 do begin
+      delta := dst^ - src_above^;
+      dst^ := byte(delta);
+      result += abs(delta);
+      dst += 1;
+      src_above += 1;
+  end;
+end;
+
+function filter_average(dst, src, src_above: pbyte; const stride: integer): integer;
+var
+  i: integer;
+  delta: integer;
+begin
+  result := 0;
+  for i := 0 to 2 do begin
+      delta := dst[i] - src_above[i] shr 1;
+      dst[i] := byte(delta);
+      result += abs(delta);
+  end;
+  dst += 3;
+  src_above += 3;
+  for i := 0 to stride - 4 do begin
+      delta := integer(dst^) - integer(src_above^ + src^) shr 1;
+      dst^ := byte(delta);
+      result += abs(delta);
+      dst += 1;
+      src += 1;
+      src_above += 1;
+  end;
+end;
+
+//a,b,c = left, above, upper left
+function paeth_predictor (a, b, c: integer): integer; inline;
+var
+  p, pa, pb, pc: integer;
+begin
+  p := a + b - c;
+  pa := abs(p - a);
+  pb := abs(p - b);
+  pc := abs(p - c);
+  if (pa <= pb) and (pa <= pc) then
+      result := a
+  else
+      if (pb <= pc) then
+          result := b
+      else
+          result := c;
+end;
+
+//for the first pixel, take the difference against top only. then do paeth
+function filter_paeth(dst, src, src_above: pbyte; const stride: integer): integer;
+var
+  i: integer;
+  delta: integer;
+begin
+  result := 0;
+  for i := 0 to 2 do begin
+      delta := dst[i] - src_above[i];
+      dst[i] := byte(delta);
+      result += abs(delta);
+  end;
+  dst += 3;
+  src_above += 3;
+  for i := 0 to stride - 4 do begin
+      delta := dst^ - paeth_predictor(src^, src_above^, (src_above - 3)^);
+      dst^ := byte(delta);
+      result += abs(delta);
+      dst += 1;
+      src += 1;
+      src_above += 1;
+  end;
+end;
+
+function sum_line(p: pbyte; length: integer): integer;
+var
+  i: integer;
+begin
+  result := p[0];
+  for i := 1 to length - 1 do begin
+      if (p[i-1] <> p[i]) then
+          result += p[i];
+  end;
+end;
+
+
+function Predict(const pixels: pbyte; const width, height, samples_per_pixel: integer): pbyte;
+var
+  stride: integer;
+  best_score: integer;
+  best_prediction: integer;
+  row_buffer: array[0..4] of pbyte;
+  row_src: pbyte;
+
+  procedure TestPrediction(const pred_mode: integer);
+  var
+    row_score: integer;
+  begin
+    case pred_mode of
+         0: row_score := sum_line(row_buffer[0], stride);
+         //1: row_score := filter_sub(row_buffer[1], row_src, stride);
+         2: row_score := filter_up (row_buffer[2], row_src - stride, stride);
+         //3: row_score := filter_average(row_buffer[3], row_src, row_src - stride, stride);
+         //4: row_score := filter_paeth  (row_buffer[4], row_src, row_src - stride, stride);
+    else
+        row_score := MaxInt;
+    end;
+    if row_score < best_score then begin
+        best_prediction := pred_mode;
+        best_score := row_score;
+    end;
+  end;
+
+var
+  i, y, pred_mode: integer;
+  row_dst: pbyte;
+begin
+  stride := width * samples_per_pixel;
+  result := getmem(height * (stride + 1));
+  //buffer for filter = none is set to original data, so no allocation is needed
+  row_buffer[1] := getmem(stride * 4);
+  for i := 1 to 3 do
+      row_buffer[i + 1] := row_buffer[1] + stride * i;
+
+  for y := 0 to height - 1 do begin
+      //setup pointers and copy input data to processing buffers: TestPrediction is destructive
+      row_src := pixels + y * stride;
+      row_buffer[0] := row_src;
+      for i := 1 to 4 do
+          move(row_src^, row_buffer[i]^, stride);
+
+      //only filter = none, filter = sub can be used on the first pixel row: there's no other row to predict from
+      //Also use early termination if score gets below treshold to gain some speed.
+      best_score := MaxInt;
+      best_prediction := 0;
+      TestPrediction(1);
+      if y > 0 then begin
+          for pred_mode := 2 to 4 do begin
+              if best_score < stride then
+                  break;
+              TestPrediction(pred_mode);
+          end;
+      end;
+      if best_prediction = 1 then
+          TestPrediction(0);
+
+      //save best prediction mode and predicted data to output
+      row_dst := result + y * (1 + stride);
+      row_dst^ := best_prediction;
+      move(row_buffer[best_prediction]^, (row_dst + 1)^, stride);
+  end;
+
+  freemem(row_buffer[1]);
+end;
+
+{ TPngPredict }
+
+function TPngPredict.PredictData(const pixels: pbyte; const width, height,
+  samples_per_pixel: integer): pbyte;
+begin
+  result := Predict(pixels, width, height, samples_per_pixel);
+end;
+
+end.
+