2
0
mirror of https://github.com/dpethes/rerogue.git synced 2025-06-07 18:58:32 +02:00
rerogue/hmp2obj/rs_world.pas
2017-05-04 00:49:30 +02:00

445 lines
11 KiB
ObjectPascal

unit rs_world;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
TEX_WIDTH = 64;
TEX_HEIGHT = 64;
TEXTURE_FNAME = 'level_tex.pnm';
type
TRGB = array[0..2] of byte;
PRGB = ^TRGB;
TPalette_4bit = array[0..15] of TRGB;
TTile = packed record
texture_index: word;
unknown_attrib: byte;
height_lo: byte;
height_hi: byte;
heights: array[0..24] of byte;
end;
PTile = ^TTile;
THeightmap = record
y_scale: single;
width, height: word;
blk: pword;
tile_count: integer;
tiles: PTile;
texture_count: integer;
textures: array of pbyte;
texture_index_map: array of integer;
end;
TVertex3f = record
x, y, z: single;
u, v: single
end;
PVertex3f = ^TVertex3f;
{ TWorld }
TWorld = class
private
heightmap: THeightmap;
world_texture: pbyte;
height_texture: pbyte;
vertex_array: PVertex3f;
vertex_count: integer;
procedure LoadTextures(const tex_fname, texidx_fname: string);
procedure LoadHeightmap(fname: string);
procedure GenerateCompositeTexture;
procedure HeightmapToTexture;
procedure GenerateVertices;
procedure WriteToObj(const objFname: string);
public
property TileWidth: word read heightmap.width;
property TileHeight: word read heightmap.height;
property MapScale: single read heightmap.y_scale;
procedure LoadFromFiles(const hmp, tex, texmap: string);
procedure ExportToObj(const objfname: string);
procedure ExportToRaw(const rawfname: string);
constructor Create;
destructor Destroy; override;
end;
//**************************************************************************************************
implementation
procedure pnm_save(const fname: string; const p: pbyte; const w, h: integer);
var
f: file;
c: PChar;
Begin
c := PChar(format('P6'#10'%d %d'#10'255'#10, [w, h]));
AssignFile (f, fname);
Rewrite (f, 1);
BlockWrite (f, c^, strlen(c));
BlockWrite (f, p^, w * h * 3);
CloseFile (f);
end;
procedure pgm_save(fname: string; p: pbyte; w, h: integer) ;
var
f: file;
c: PChar;
Begin
c := PChar(format('P5'#10'%d %d'#10'255'#10, [w, h]));
AssignFile (f, fname);
Rewrite (f, 1);
BlockWrite (f, c^, strlen(c));
BlockWrite (f, p^, w * h);
CloseFile (f);
end;
procedure convert_4bit_to_24bit(const indices: PByte; const w, h: Word; const image: PByte; const pal: TPalette_4bit);
var
i: Integer;
index: integer;
dst: PRGB;
begin
dst := PRGB(image);
for i := 0 to w * h div 2 - 1 do begin
index := indices[i];
dst[i * 2 ] := pal[(index shr 4) and 15];
dst[i * 2 + 1] := pal[index and 15];
end;
end;
procedure CopyTexToXY(image: PByte; texture: PByte; const x, y, stride: integer);
var
i: integer;
src, dst: pbyte;
begin
src := texture;
dst := image + y * stride + x * 3;
for i := 0 to TEX_HEIGHT - 1 do begin
move(src^, dst^, TEX_WIDTH * 3);
dst += stride;
src += TEX_WIDTH * 3;
end;
end;
procedure CopyTileToXY(image: PByte; tile: PByte; const x, y, stride: integer);
var
i: integer;
src, dst: pbyte;
begin
src := tile + 5 * 4;
dst := image + y * stride + x;
for i := 0 to 3 do begin
move(src^, dst^, 4);
dst += stride;
src -= 5;
end;
end;
{ TWorld }
procedure TWorld.LoadTextures(const tex_fname, texidx_fname: string);
var
f: file;
buf: pbyte;
tex_size: integer;
i: Integer;
palette: TPalette_4bit;
image: pbyte;
palette_size: Integer;
texture_count: integer;
begin
AssignFile(f, tex_fname);
reset(f, 1);
palette_size := 48; //16x RGB
tex_size := TEX_WIDTH * TEX_HEIGHT div 2;
texture_count := filesize(f) div (tex_size + palette_size);
//writeln('texture_count: ', texture_count);
SetLength(heightmap.textures, texture_count);
heightmap.texture_count := texture_count;
buf := getmem(tex_size);
for i := 0 to texture_count - 1 do begin
image := getmem(TEX_WIDTH * TEX_HEIGHT * 3);
Blockread(f, buf^, tex_size);
Blockread(f, palette, palette_size);
convert_4bit_to_24bit(buf, TEX_WIDTH, TEX_HEIGHT, image, palette);
heightmap.textures[i] := image;
end;
freemem(buf);
CloseFile(f);
AssignFile(f, texidx_fname);
Reset(f, 1);
texture_count := filesize(f) div 4 - 1;
SetLength(heightmap.texture_index_map, texture_count);
Blockread(f, heightmap.texture_index_map[0], texture_count * 4);
CloseFile(f);
end;
procedure TWorld.LoadHeightmap(fname: string);
var
f: file;
buffer: array[0..15] of byte;
tile_offset: integer;
blk: pword;
blk_size: integer;
tile_count: word;
i: integer;
float: single;
begin
AssignFile(f, fname);
reset(f, 1);
//header
Blockread(f, buffer, 12);
Blockread(f, float, 4);
Blockread(f, heightmap.y_scale, 4);
Blockread(f, float, 4);
Blockread(f, tile_count, 2); //tile count
Blockread(f, buffer, 2); //2B?
Blockread(f, tile_offset, 4); //tile offset
Blockread(f, buffer, 4); //offset?
Blockread(f, heightmap.width, 2);
Blockread(f, heightmap.height, 2);
//blocks / tile indices
blk_size := heightmap.width * heightmap.height * 2;
blk := getmem(blk_size);
Blockread(f, blk^, blk_size);
heightmap.blk := blk;
//tiles
//writeln('tiles: ', tile_count);
Seek(f, tile_offset);
heightmap.tile_count := tile_count;
heightmap.tiles := getmem(tile_count * 30);
for i := 0 to tile_count - 1 do
Blockread(f, heightmap.tiles[i], 30);
CloseFile(f);
end;
procedure TWorld.GenerateCompositeTexture;
var
image: pbyte;
image_size: integer;
x, y, stride: integer;
tile_idx, texture_idx, texmap_idx: integer;
texture: pbyte;
begin
image_size := heightmap.width * heightmap.height * TEX_WIDTH * TEX_HEIGHT * 3;
image := GetMem(image_size);
stride := heightmap.width * TEX_WIDTH * 3;
for y := 0 to heightmap.height - 1 do
for x := 0 to heightmap.width - 1 do begin
tile_idx := heightmap.blk[y * heightmap.width + x];
texmap_idx := heightmap.tiles[tile_idx].texture_index;
if texmap_idx > Length(heightmap.texture_index_map) - 1 then
texmap_idx := 0;
texture_idx := heightmap.texture_index_map[texmap_idx];
texture := heightmap.textures[texture_idx];
CopyTexToXY(image, texture, x * TEX_WIDTH, (heightmap.height - y - 1) * TEX_HEIGHT, stride);
end;
world_texture := image;
pnm_save(TEXTURE_FNAME, image, heightmap.width * TEX_WIDTH, heightmap.height * TEX_HEIGHT);
end;
procedure TWorld.HeightmapToTexture;
const
TILE_WIDTH = 4;
SCALE = 128;
var
x, y: integer;
tile_idx: integer;
i: integer;
image_size: integer;
image: pbyte;
begin
image_size := heightmap.width * heightmap.height * TILE_WIDTH * TILE_WIDTH;
image := GetMem(image_size);
for y := 0 to heightmap.height - 1 do begin
for x := 0 to heightmap.width - 1 do begin
tile_idx := heightmap.blk[y * heightmap.width + x];
CopyTileToXY(image, @(heightmap.tiles[tile_idx].heights),
x * TILE_WIDTH, (heightmap.height - y - 1) * TILE_WIDTH, heightmap.width * TILE_WIDTH);
end;
end;
//scale
for i := 0 to image_size - 1 do
image[i] := byte(image[i] + SCALE);
height_texture := image;
//pgm_save('map_height.pgm', image, heightmap.width * TILE_WIDTH, heightmap.height * TILE_WIDTH);
end;
procedure TWorld.GenerateVertices;
const
scale = 0.1;
var
va_size: integer;
x, y: integer;
vert: TVertex3f;
width_half, height_half: integer;
i: integer;
height_scale: single;
begin
vertex_count := heightmap.width * 4 * heightmap.height * 4;
va_size := vertex_count * SizeOf(TVertex3f);
vertex_array := getmem(va_size);
width_half := heightmap.width * 2; //half of width & height in vertex count
height_half := heightmap.height * 2;
height_scale := heightmap.y_scale * 2 / 10; //this is just a guesswork, no idea what's the real calculation
for y := 0 to heightmap.height * 4 - 1 do
for x := 0 to heightmap.width * 4 - 1 do begin
vert.x := (-width_half + x) * scale;
vert.z := (-height_half + y) * scale;
vert.u := x / (heightmap.width * 4);
vert.v := y / (heightmap.height * 4);
i := y * heightmap.width * 4 + x;
vert.y := (255 - height_texture[i]) * height_scale;
vertex_array[i] := vert;
end;
end;
procedure SaveMaterialFile(const obj_fname, mtl_name, texture_fname: string);
var
f: TextFile;
begin
AssignFile(f, obj_fname + '.mtl');
Rewrite(f);
writeln(f, '# RS heightmap');
writeln(f, 'newmtl ', mtl_name); //begin new material
writeln(f, 'map_Kd ', texture_fname); //texture
writeln(f, 'Ka 1.000 1.000 1.000'); //ambient color
writeln(f, 'Kd 1.000 1.000 1.000'); //diffuse color
writeln(f, 'Ks 1.000 1.000 1.000'); //specular color
writeln(f, 'Ns 100.0'); //specular weight
writeln(f, 'illum 2'); //Color on and Ambient on, Highlight on
CloseFile(f);
end;
procedure TWorld.WriteToObj(const objFname: string);
const
MAT_NAME = 'default';
var
f: textfile;
i: integer;
v: TVertex3f;
x, y, stride: integer;
i2, i3: integer;
begin
AssignFile(f, objFname);
Rewrite(f);
writeln(f, '# RS heightmap');
writeln(f, 'mtllib ', objFname + '.mtl');
//vertices
for i := 0 to vertex_count - 1 do begin
v := vertex_array[i];
writeln(f, 'v ', v.x:0:2, ' ', v.y:0:2, ' ', v.z:0:2);
end;
//uv-s
for i := 0 to vertex_count - 1 do begin
v := vertex_array[i];
writeln(f, 'vt ', v.u:0:4, ' ', v.v:0:4);
end;
//select material
writeln(f, 'usemtl ' + MAT_NAME);
//faces
{
12 2
3 34
}
stride := heightmap.width * 4;
for y := 0 to heightmap.height * 4 - 2 do
for x := 0 to heightmap.width * 4 - 2 do begin
i := y * stride + x + 1;
i2 := i + 1;
i3 := i + stride;
writeln(f, Format('f %d/%d %d/%d %d/%d', [i, i, i2, i2, i3, i3]));
i := i3 + 1;
writeln(f, Format('f %d/%d %d/%d %d/%d', [i2, i2, i, i, i3, i3]));
end;
CloseFile(f);
SaveMaterialFile(objFname, MAT_NAME, TEXTURE_FNAME);
end;
procedure TWorld.LoadFromFiles(const hmp, tex, texmap: string);
begin
LoadHeightmap(hmp);
LoadTextures(tex, texmap);
end;
procedure TWorld.ExportToObj(const objfname: string);
begin
GenerateCompositeTexture;
HeightmapToTexture;
GenerateVertices;
WriteToObj(objfname);
end;
procedure TWorld.ExportToRaw(const rawfname: string);
var
f: file;
image_size, i: integer;
y: Byte;
begin
AssignFile(f, rawfname);
Rewrite(f,1);
image_size := heightmap.width * heightmap.height;
for i := 0 to image_size - 1 do begin
y := 255 - height_texture[i]; //negative scale - Unity uses it like this, for example
BlockWrite(f, y, 1);
end;
CloseFile(f);
end;
constructor TWorld.Create;
begin
height_texture := nil;
vertex_array := nil;
end;
destructor TWorld.Destroy;
begin
if height_texture <> nil then Freemem(height_texture);
if vertex_array <> nil then Freemem(vertex_array);
inherited Destroy;
end;
end.