jackcartersmith/rerogue
2
0
Fork 0
mirror of https://github.com/dpethes/rerogue.git synced 2025-06-07 18:58:32 +02:00
Code Issues Releases Wiki Activity

import dat_repack, hmp2obj, hmt_parser, image_export

Browse Source
This commit is contained in:
dpethes 2014-09-14 10:55:44 +02:00
parent ab5e5dc824
commit a066c665bb
13 changed files with 1899 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
dat_repack/rs_repack.lpi Normal file
View File

@ -0,0 +1,96 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="rs_repack"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="p r:\rogue_data\"/>
</local>
</RunParams>
<Units Count="4">
<Unit0>
<Filename Value="rs_repack.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rs_repack"/>
</Unit0>
<Unit1>
<Filename Value="rsdat.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rsdat"/>
</Unit1>
<Unit2>
<Filename Value="rsdat_common.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rsdat_common"/>
</Unit2>
<Unit3>
<Filename Value="rsdat_pack.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rsdat_pack"/>
</Unit3>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="rs_repack"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

44
dat_repack/rs_repack.lpr Normal file
View File

@ -0,0 +1,44 @@
program rs_repack;
uses
sysutils, rsdat, rsdat_pack;
procedure UnpackData(const basedir: string);
var
dat: TRSDatFile;
begin
dat := TRSDatFile.Create;
dat.ReadHeader(basedir + 'DATA.HDR');
dat.ReadSections(basedir + 'DATA.DAT');
dat.WriteFilesToDirectory(basedir);
dat.Free;
end;
procedure PackData(const basedir: string);
var
packer: TRSDatPacker;
begin
packer := TRSDatPacker.Create;
packer.PackDirectory(basedir);
packer.Free;
end;
var
mode: string;
basedir: string;
begin
if Paramcount < 2 then begin
writeln ('usage: rs_repack [u|p] directory');
halt;
end;
mode := ParamStr(1);
basedir := ParamStr(2);
if mode = 'u' then begin
UnpackData(basedir);
end;
if mode = 'p' then begin
PackData(basedir);
end;
writeln('done.')
end.

222
dat_repack/rsdat.pas Normal file
View File

@ -0,0 +1,222 @@
unit rsdat;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, rsdat_common;
type
{ TRSDatFile }
TRSDatFile = class
private
sections: array of TSection;
data: pbyte;
procedure ReadDatFile(const fname: string);
function ReadEntry(const stream: TMemoryStream): TFileNode;
procedure ReadSectionEntries(var section: TSection);
procedure ParseSectionStructure(var section: TSection);
public
procedure ReadHeader(const fname: string);
procedure ReadSections(const fname: string);
procedure WriteFilesToDirectory(const path: string);
constructor Create;
destructor Destroy; override;
end;
//**************************************************************************************************
implementation
procedure SaveFile(const name: string; const buffer: pbyte; const buf_size: integer);
var
f: file;
fname: string;
dups: integer;
begin
fname := name;
AssignFile(f, fname);
Rewrite(f, 1);
BlockWrite(f, buffer^, buf_size);
CloseFile(f);
end;
{ TRSDatFile }
procedure TRSDatFile.ReadDatFile(const fname: string);
var
f: file;
fsize: integer;
begin
AssignFile(f, fname);
reset(f, 1);
fsize := FileSize(f);
data := getmem(fsize);
Blockread(f, data^, fsize);
closefile(f);
end;
function TRSDatFile.ReadEntry(const stream: TMemoryStream): TFileNode;
var
entry: TFileEntry;
begin
stream.ReadBuffer(entry, 32);
result.name := Trim(entry.filename);
result.offset := entry.offset;
result.size := entry.length;
result.is_directory := (entry.type_flag and FEDirectoryFlag) <> 0;
result.subentries_count := entry.sub_entry_size div 32 - 1;
result.entry := entry;
result.data := nil;
//if (result.offset mod 32) <> 0 then writeln('unaligned offset');
writeln(stderr, format('name: %s size: %d dir: %s subsize: %d flags: %s',
[result.Name, entry.length, BoolToStr(result.is_directory),
entry.sub_entry_size, binStr(entry.type_flag, 16)]));
end;
procedure TRSDatFile.ReadSectionEntries(var section: TSection);
var
entries_offset: integer;
entries_length: integer;
entry_count: integer;
stream: TMemoryStream;
i: integer;
begin
entries_offset := (pinteger(section.data))^; //offset relative to section beginning
entries_length := (pinteger(section.data + 4))^; //length in bytes
section.size := entries_offset + entries_length;
entry_count := entries_length div 32; //actual count of entries
writeln('entries: ', entry_count);
stream := TMemoryStream.Create;
stream.WriteBuffer(section.data^, section.size);
stream.Seek(entries_offset, soBeginning);
SetLength(section.nodes, entry_count);
for i := 0 to entry_count - 1 do begin
section.nodes[i] := ReadEntry(stream);
end;
stream.Free;
end;
procedure AddNode(const parent: PFileNode; var nodes: array of TFileNode; var node_index: integer);
var
i: integer;
node: PFileNode;
begin
if node_index > length(nodes) - 1 then
exit;
//add current to parent
node := @nodes[node_index];
i := length(parent^.nodes);
Setlength(parent^.nodes, i + 1);
parent^.nodes[i] := node;
//writeln('added node: ', node^.name, ' to parent ', parent^.name);
//add all subentries if any
if node^.is_directory then begin
//writeln(' subentries: ', node^.subentries_count);
while CountSubNodes(node) < node^.subentries_count + 1 do begin
node_index += 1;
AddNode(node, nodes, node_index);
end;
end;
end;
procedure TRSDatFile.ParseSectionStructure(var section: TSection);
var
node_idx: integer = 0;
begin
section.root.name := section.name;
section.root.is_directory := true;
section.root.data := nil;
while node_idx < length(section.nodes) do begin
AddNode(@section.root, section.nodes, node_idx);
node_idx += 1;
end;
end;
procedure TRSDatFile.ReadHeader(const fname: string);
var
f: file;
section: TSection;
section_n: integer;
i: integer;
buffer: array[0..15] of char;
begin
assignfile(f, fname);
reset(f, 1);
section_n := FileSize(f) div 32;
SetLength(sections, section_n);
for i := 0 to section_n - 1 do begin
blockread(f, buffer, 16); //name
section.name := trim(buffer);
blockread(f, buffer, 12); //empty
blockread(f, section.offset, 4); //offset in DATA.DAT
sections[i] := section;
end;
closefile(f);
end;
procedure TRSDatFile.ReadSections(const fname: string);
var
i: integer;
begin
ReadDatFile(fname);
for i := 0 to length(sections) - 1 do begin
Writeln('reading section ', sections[i].name);
sections[i].data := data + sections[i].offset;
ReadSectionEntries(sections[i]);
ParseSectionStructure(sections[i]);
end;
end;
procedure WriteDirectory(const node: PFileNode; const path: string; const data: pbyte);
var
dir: string;
subnode: PFileNode;
i: Integer;
begin
dir := path + node^.name;
if not DirectoryExists(dir) then
MkDir(dir);
for i := 0 to length(node^.nodes) - 1 do begin
subnode := node^.nodes[i];
if subnode^.is_directory then
WriteDirectory(subnode, dir + DirectorySeparator, data)
else
SaveFile(dir + DirectorySeparator + subnode^.name, data + subnode^.offset, subnode^.size);
end;
end;
procedure TRSDatFile.WriteFilesToDirectory(const path: string);
var
section: TSection;
begin
for section in sections do begin
WriteDirectory(@section.root, path, section.data);
end;
end;
constructor TRSDatFile.Create;
begin
end;
destructor TRSDatFile.Destroy;
begin
inherited Destroy;
sections := nil;
freemem(data);
end;
end.

83
dat_repack/rsdat_common.pas Normal file
View File

@ -0,0 +1,83 @@
unit rsdat_common;
{$mode objfpc}{$H+}
interface
type
(*
uint32 {4} - Offset
uint32 {4} - Length (entry count * 32)
uint32 {4} - Padding (all 255's) 0xFF FF FF FF
uint16 {2} - type flag:
%10000000 - folder
%00000010 - file
%10000010 - subfolder
uint16 {2} - directory subentries length (entry count * 32)
char {16} - Filename (null) (replace "_" with ".")
*)
TFileEntry = packed record
offset: longword;
length: longword;
padding: longword;
type_flag: word;
sub_entry_size: word;
filename: array[0..15] of char;
end;
PFileEntry = ^TFileEntry;
const
FEDirectoryFlag = %10000000;
type
//file or directory node
PFileNode = ^TFileNode;
TFileNode = record
Name: string;
is_directory: boolean;
subentries_count: integer;
offset: longword;
size: longword;
entry: TFileEntry;
Data: pbyte;
nodes: array of PFileNode; //children if directory
end;
//root
TSection = record
Name: string; //section name
offset: integer; //offset in dat file
size: integer; //section length in bytes
Data: pbyte; //data
nodes: array of TFileNode; //all file entries / nodes
root: TFileNode; //tree structure of nodes
end;
function CountSubNodes(node: PFileNode): integer;
function CountSubNodeSizes(node: PFileNode): integer;
//**************************************************************************************************
implementation
function CountSubNodes(node: PFileNode): integer;
var
i: integer;
begin
Result := 1;
if node^.is_directory then
for i := 0 to Length(node^.nodes) - 1 do
Result += CountSubNodes(node^.nodes[i]);
end;
function CountSubNodeSizes(node: PFileNode): integer;
var
i: integer;
begin
Result := node^.size;
if node^.is_directory then
for i := 0 to Length(node^.nodes) - 1 do
Result += CountSubNodeSizes(node^.nodes[i]);
end;
end.

278
dat_repack/rsdat_pack.pas Normal file
View File

@ -0,0 +1,278 @@
unit rsdat_pack;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, rsdat_common;
type
{ TRSDatPacker }
TRSDatPacker = class
private
Sections: array of TSection;
Data: TMemoryStream;
procedure FreeSections;
procedure ReadSectionFiles(const basepath: string);
procedure WriteData(path: string);
procedure WriteHeader(path: string);
procedure WriteNodeData(node: PFileNode);
procedure WriteFileEntries(node: PFileNode; const base_offset: integer);
public
procedure PackDirectory(const path: string);
constructor Create;
destructor Destroy; override;
end;
//**************************************************************************************************
implementation
procedure ReadFileNodes(parent: PFileNode; path: string);
var
node: PFileNode;
info: TSearchRec;
n: integer;
f: file;
subdir_path: string;
begin
path := IncludeTrailingPathDelimiter(path);
n := 0;
if FindFirst(path + '*', faDirectory, Info) = 0 then begin
repeat
if (info.Name <> '.') and (info.name <> '..') then begin
new(node);
node^.name := info.Name;
node^.is_directory := false;
node^.data := nil;
node^.size := 0;
node^.subentries_count := 0;
node^.offset := 0;
//traverse subdirectory or load file
if (info.Attr and faDirectory) > 0 then begin
node^.is_directory := true;
subdir_path := path + node^.name;
Writeln('reading dir ', subdir_path);
ReadFileNodes(node, subdir_path);
node^.subentries_count := CountSubNodes(node) - 1;
Writeln('dir subentries: ', node^.subentries_count);
end
else begin
Writeln('reading file ', path + node^.name);
AssignFile(f, path + node^.name);
Reset(f, 1);
node^.size := FileSize(f);
node^.Data := Getmem(node^.size);
BlockRead(f, node^.Data^, node^.size);
CloseFile(f);
end;
n += 1;
SetLength(parent^.nodes, n);
parent^.nodes[n-1] := node;
end;
until FindNext(info) <> 0;
end;
end;
procedure FreeFileNodes(node: PFileNode; const no_disposing: boolean = false);
var
i: integer;
begin
for i := 0 to Length(node^.nodes) - 1 do
FreeFileNodes(node^.nodes[i]);
node^.nodes := nil;
if (not node^.is_directory) and (node^.Data <> nil) then
freemem(node^.Data);
if not no_disposing then
dispose(node);
end;
{ TRSDatPacker }
procedure TRSDatPacker.ReadSectionFiles(const basepath: string);
var
n: integer;
info: TSearchRec;
section: TSection;
node: TFileNode;
begin
n := 0;
if FindFirst(basepath + '*', faDirectory, Info) = 0 then begin
repeat
if (info.Name <> '.') and (info.name <> '..') and ((info.Attr and faDirectory) > 0) then begin
Writeln('reading section: ', info.name);
ReadFileNodes(@node, basepath + info.name);
node.name := info.Name;
node.is_directory := true;
node.data := nil;
node.offset := 0;
node.subentries_count := CountSubNodes(@node) - 1;
section.name := info.name;
section.root := node;
n += 1;
SetLength(Sections, n);
Sections[n - 1] := section;
end;
until FindNext(info) <> 0;
end;
FindClose(Info);
end;
procedure TRSDatPacker.FreeSections;
var
i: integer;
begin
for i := 0 to Length(Sections) - 1 do
FreeFileNodes(@Sections[i].root, true);
Sections := nil;
end;
procedure TRSDatPacker.WriteNodeData(node: PFileNode);
var
i: integer;
begin
if node^.is_directory then begin
for i := 0 to Length(node^.nodes) - 1 do begin
WriteNodeData(node^.nodes[i]);
end;
end else begin
node^.offset := Data.Position;
Data.WriteBuffer(node^.Data^, node^.size);
for i := 1 to 4 - (node^.size mod 4) do
Data.WriteByte(0);
end;
end;
{
TFileEntry = packed record
offset: longword;
length: longword;
padding: longword;
type_flag: word;
sub_entry_size: word;
filename: array[0..15] of char;
end; }
procedure TRSDatPacker.WriteFileEntries(node: PFileNode; const base_offset: integer);
var
entry: TFileEntry;
name: string;
i: integer;
begin
entry.offset := node^.offset - base_offset;
entry.length := CountSubNodeSizes(node);
entry.padding := $ffffffff;
entry.sub_entry_size := 0;
if node^.is_directory then
entry.sub_entry_size := (node^.subentries_count + 1) * 32;
if node^.is_directory then
entry.type_flag := FEDirectoryFlag
else
entry.type_flag := %00000010;
writeln(stderr, format('name: %s size: %d dir: %s subsize: %d',
[node^.Name, entry.length, BoolToStr(node^.is_directory), entry.sub_entry_size]));
name := node^.Name;
FillByte(entry.filename, 16, 0);
for i := 0 to Length(name) - 1 do
entry.filename[i] := name[i + 1];
Data.WriteBuffer(entry, 32);
if node^.is_directory then begin
for i := 0 to Length(node^.nodes) - 1 do begin
WriteFileEntries(node^.nodes[i], base_offset);
end;
end;
end;
procedure TRSDatPacker.WriteData(path: string);
var
i, k: integer;
head: pinteger;
entries: integer;
section: TSection;
begin
Data := TMemoryStream.Create;
Data.Size := 1 shl 20;
for i := 0 to Length(Sections) - 1 do begin
section := Sections[i];
Writeln('writing section: ', section.name);
section.offset := Data.Position;
Data.WriteQWord(0); //offset + size placeholder
Writeln('writing file data');
for k := 0 to Length(section.root.nodes) - 1 do
WriteNodeData(section.root.nodes[k]);
entries := section.root.subentries_count;
head := pinteger (pbyte(Data.Memory) + section.offset);
head^ := Data.Position - section.offset;
head += 1;
head^ := entries * 32;
Writeln('writing file entries: ', entries);
for k := 0 to Length(section.root.nodes) - 1 do
WriteFileEntries(section.root.nodes[k], section.offset);
//align?
for k := 1 to 4 - (Data.Position mod 4) do
Data.WriteByte(0);
Sections[i] := section;
end;
Data.SaveToFile(path + 'DATA.DAT');
end;
procedure TRSDatPacker.WriteHeader(path: string);
var
i, k: integer;
f: file;
section_name: string;
name: array[1..28] of byte;
begin
AssignFile(f, path + 'DATA.HDR');
Rewrite(f, 1);
for i := 0 to Length(Sections) - 1 do begin
section_name := Sections[i].Name;
Fillbyte(name, 28, 0);
for k := 1 to Length(section_name) do
name[k] := byte( section_name[k] );
Blockwrite(f, name, 28);
Blockwrite(f, Sections[i].offset, 4);
end;
CloseFile(f);
end;
procedure TRSDatPacker.PackDirectory(const path: string);
var
basepath: string;
begin
basepath := IncludeTrailingPathDelimiter(path);
ReadSectionFiles(basepath);
WriteData(basepath);
WriteHeader(basepath);
FreeSections;
end;
constructor TRSDatPacker.Create;
begin
end;
destructor TRSDatPacker.Destroy;
begin
inherited Destroy;
end;
end.

78
hmp2obj/hmp2obj.lpi Normal file
View File

@ -0,0 +1,78 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="hmp2obj"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="hmp lv_0"/>
</local>
</RunParams>
<Units Count="2">
<Unit0>
<Filename Value="hmp2obj.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="hmp2obj"/>
</Unit0>
<Unit1>
<Filename Value="rs_world.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rs_world"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="hmp2obj"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

31
hmp2obj/hmp2obj.lpr Normal file
View File

@ -0,0 +1,31 @@
program hmp2obj;
uses rs_world;
var
tex_fname, text_fname, hmp_fname: string;
world: TWorld;
begin
if Paramcount < 2 then begin
writeln('not enough files specified');
writeln('usage: hmp2obj hmp text tex');
halt;
end;
hmp_fname := ParamStr(1);
text_fname := ParamStr(2);
tex_fname := ParamStr(3);
world := TWorld.Create;
world.LoadFromFiles(hmp_fname, text_fname, tex_fname);
writeln('world loaded');
writeln('tile size: ', world.TileWidth, 'x', world.TileHeight);
world.ExportToObj('heightmap.obj');
writeln('world exported');
world.Free;
end.

422
hmp2obj/rs_world.pas Normal file
View File

@ -0,0 +1,422 @@
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;
unknown_lo: byte;
unknown_hi: byte;
unknown: array[0..24] of byte;
end;
PTile = ^TTile;
THeightmap = record
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;
procedure LoadFromFiles(const hmp, tex, texmap: string);
procedure ExportToObj(const objfname: 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_32bit(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_32bit(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;
begin
AssignFile(f, fname);
reset(f, 1);
//header
Blockread(f, buffer, 16); //15xB + 0x3f
Blockread(f, buffer, 4);
Blockread(f, buffer, 4); //0x3f
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].unknown),
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;
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;
height_half := heightmap.height * 2;
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]) * 0.01; //inverse for mos eisley / lv0
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;
texfname: string;
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:10:6, ' ', v.y:10:6, ' ', v.z:10:6);
end;
//uv-s
for i := 0 to vertex_count - 1 do begin
v := vertex_array[i];
writeln(f, 'vt ', v.u:10:6, ' ', v.v:10:6);
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;
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.

72
hmt_parser/hmt_parser.lpi Normal file
View File

@ -0,0 +1,72 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="hmt_parser"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="hmt_parser.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="hmt_parser"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="hmt_parser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

111
hmt_parser/hmt_parser.lpr Normal file
View File

@ -0,0 +1,111 @@
program hmt_parser;
uses
Classes;
type
THmtMaterial = record
type1, type2: shortint;
unknown_float1, unknown_float2: single;
zero: integer;
hex_a: integer;
name: array[0..15] of byte;
end;
THmtTexture = record
data_offset: integer;
unknown: array[0..47] of byte;
end;
THmtFile = record
material_count: integer;
texture_offset: integer;
texture_count: integer;
materials: array of THmtMaterial;
textures: array of THmtTexture;
end;
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 ParseHmtFile(const fname: string);
var
f: TMemoryStream;
hmt: THmtFile;
mat: THmtMaterial;
tex: THmtTexture;
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);
writeln('materials: ', hmt.material_count);
writeln('textures: ', hmt.texture_count);
writeln(' texture bytes: ', f.Size - sizeof(hmt.texture_count) - hmt.texture_offset);
//read materials
SetLength(hmt.materials, hmt.material_count);
for i := 0 to hmt.material_count - 1 do begin
mat.type1 := f.ReadWord;
mat.type2 := 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);
hmt.materials[i] := mat;
end;
for mat in hmt.materials do begin
writeln(NameToString(mat.name));
if (mat.zero <> 0) or (mat.hex_a <> $A) then
writeln('unusual file');
end;
//read textures
if hmt.texture_count = 0 then
exit;
f.Seek(hmt.texture_offset + sizeof(hmt.texture_count), TSeekOrigin.soBeginning);
SetLength(hmt.textures, hmt.texture_count);
for i := 0 to hmt.texture_count - 1 do begin
tex.data_offset := f.ReadDWord;
f.ReadBuffer(tex.unknown, 48);
end;
end;
var
fname: string;
begin
if ParamCount < 1 then begin
writeln ('no input file specified');
exit;
end;
fname := ParamStr(1);
writeln('parsing file: ', fname);
try
ParseHmtFile(fname);
except
writeln('parsing failed!');
end;
writeln('done.');
end.

84
image_export/ov_export.lpi Normal file
View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ov_export"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="awing"/>
<WorkingDirectory Value="d:\david\devel\projekty\rogue_ext\gamedata\sorted_data\images\pictures_ov\"/>
</local>
</RunParams>
<Units Count="2">
<Unit0>
<Filename Value="ov_export.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ov_export"/>
</Unit0>
<Unit1>
<Filename Value="rs_image.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rs_image"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="img_export"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Optimizations>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

133
image_export/ov_export.lpr Normal file
View File

@ -0,0 +1,133 @@
program fpic_export;
uses
sysutils, classes, rs_image;
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 WriteTga(const filename: string; const data: pbyte; const width, height, data_length: integer);
const
HeaderComment = 'NZA';
var
f: file;
stream: TMemoryStream;
begin
stream := TMemoryStream.Create();
stream.WriteByte(Length(HeaderComment)); //id field length
stream.WriteByte (0); //color map type
stream.WriteByte (2); //image type: 2 = uncompressed true-color image
stream.WriteDWord(0); //5B color map specification: 2B origin, 2B length
stream.WriteByte (0); // 1B Color Map Entry Size.
stream.WriteDWord(0); //2B x origin, 2B y origin
stream.WriteWord (width); //width in pixels
stream.WriteWord (height); //height in pixels
stream.WriteByte (32); //bits per pixel
stream.WriteByte ($20); //image descriptor
stream.Write(HeaderComment, Length(HeaderComment));
AssignFile(f, filename);
Rewrite(f, 1);
blockwrite(f, stream.Memory^, stream.Size);
blockwrite(f, data^, data_length);
CloseFile(f);
stream.Free;
end;
procedure SaveImage(var image: TRSImage; const outname: string);
begin
case image.type_ of
0: pnm_save(outname + '.pnm', image.pixels, image.width, image.height);
1: pnm_save(outname + '.pnm', image.pixels, image.width, image.height);
2: pgm_save(outname + '.pgm', image.pixels, image.width, image.height);
3: WriteTga(outname + '.tga', image.pixels, image.width, image.height, image.width * image.height * 4);
4: pgm_save(outname + '.pgm', image.pixels, image.width, image.height);
5: pgm_save(outname + '.pgm', image.pixels, image.width, image.height);
end;
end;
procedure ReadImagePack(var f: file; const fname: string);
var
image_count: integer;
file_ptr: int64;
outname: string;
image: TRSImage;
begin
image_count := 0;
file_ptr := 0;
while file_ptr < FileSize(f) do begin
writeln('reading at: ', file_ptr);
outname := fname;
if image_count > 0 then
outname += '_' + IntToStr(image_count);
image := LoadImageFromPack(f);
if image.pixels <> nil then
SaveImage(image, outname);
//freemem(image.pixels);
image_count += 1;
file_ptr := FilePos(f);
if file_ptr mod 4 <> 0 then begin
file_ptr := (file_ptr div 4 + 1) * 4;
if file_ptr < FileSize(f) then begin
writeln('seeking to mod4 file position');
Seek(f, file_ptr);
end;
end;
end;
end;
procedure LoadImageFile(const fname: string);
var
f: file;
begin
AssignFile(f, fname);
Reset(f, 1);
ReadImagePack(f, fname);
CloseFile(f);
end;
//main
var
fname: string;
begin
if Paramcount < 1 then begin
writeln('no file specified');
halt;
end;
fname := ParamStr(1);
LoadImageFile(fname);
writeln('done.');
end.

245
image_export/rs_image.pas Normal file
View File

@ -0,0 +1,245 @@
unit rs_image;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TRGB = array[0..2] of byte;
PRGB = ^TRGB;
TPalette = array[0..256] of TRGB;
TRSImage = record
data_size: integer;
width, height: integer;
type_: byte;
sampleBits: byte;
paletteEntries: integer;
pixels: pbyte;
samples: pbyte;
palette: TPalette;
end;
function LoadImageFromPack(var f: file): TRSImage;
//**************************************************************************************************
implementation
type
TImageDescription = record
palette_entries: integer;
sample_bits: integer;
//alpha: byte;
end;
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)
);
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 f: file; var image: TRSImage);
var
entries: integer;
begin
entries := image.paletteEntries;
case entries of
16: Blockread(f, image.palette, entries * 3); //RGB
256: Blockread(f, image.palette, entries * 3); //RGB
end;
end;
procedure LoadSamples(var f: file; var image: TRSImage);
var
sample_bits: integer;
size: integer;
begin
sample_bits := image.sampleBits;
size := image.width * image.height * sample_bits div 8;
image.samples := getmem(size);
Blockread(f, image.samples^, size);
if image.type_ = 2 then
Blockread(f, image.samples^, size div 4);
end;
procedure LoadImageHeader(var f: file; var image: TRSImage);
var
h: word;
w: word;
buffer: array[0..15] of byte;
description: TImageDescription;
bpp: byte;
begin
blockread(f, w, 2);
blockread(f, h, 2);
blockread(f, buffer, 4);
blockread(f, buffer[8], 4); //zero padding
w := w + (w and 1); //make width even
image.width := w;
image.height := h;
bpp := buffer[1];
image.type_ := buffer[2]; //image type
description := ImageDescription[image.type_];
image.sampleBits := description.sample_bits;
image.paletteEntries := description.palette_entries;
if image.type_ = 4 then
image.sampleBits := bpp * 4 + 4;
writeln('data size: ', image.data_size);
writeln('size: ', image.width, 'x', image.height);
writeln('subtype: ', image.type_);
writeln('sample bits: ', image.sampleBits);
writeln('attrs: ', buffer[0], ', ', buffer[1], ', ', buffer[3]);
end;
procedure LoadName(var f: file; const data_size: integer);
var
i: integer;
buffer: array[0..15] of byte;
s: string;
begin
s := '';
blockread(f, buffer, data_size);
for i := 0 to data_size - 1 do
s += char(buffer[i]);
s := Trim(s);
writeln('name: ', s);
end;
function LoadImageFromPack(var f: file): TRSImage;
var
offset, string_offset: integer;
buffer: array[0..31] of byte;
begin
blockread(f, result.data_size, 4);
blockread(f, offset, 4);
blockread(f, buffer, 32); //mostly zeros?
blockread(f, string_offset, 4);
LoadImageHeader(f, result);
LoadPalette(f, result);
LoadSamples(f, result);
DecodePixels(result);
LoadName(f, result.data_size - string_offset);
end;
end.