diff --git a/dat_repack/rs_repack.lpi b/dat_repack/rs_repack.lpi new file mode 100644 index 0000000..9a6c640 --- /dev/null +++ b/dat_repack/rs_repack.lpi @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + <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> diff --git a/dat_repack/rs_repack.lpr b/dat_repack/rs_repack.lpr new file mode 100644 index 0000000..c57d3dd --- /dev/null +++ b/dat_repack/rs_repack.lpr @@ -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. + diff --git a/dat_repack/rsdat.pas b/dat_repack/rsdat.pas new file mode 100644 index 0000000..ad415b0 --- /dev/null +++ b/dat_repack/rsdat.pas @@ -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. + diff --git a/dat_repack/rsdat_common.pas b/dat_repack/rsdat_common.pas new file mode 100644 index 0000000..ef12ea6 --- /dev/null +++ b/dat_repack/rsdat_common.pas @@ -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. diff --git a/dat_repack/rsdat_pack.pas b/dat_repack/rsdat_pack.pas new file mode 100644 index 0000000..7f73cc2 --- /dev/null +++ b/dat_repack/rsdat_pack.pas @@ -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. diff --git a/hmp2obj/hmp2obj.lpi b/hmp2obj/hmp2obj.lpi new file mode 100644 index 0000000..234e8e5 --- /dev/null +++ b/hmp2obj/hmp2obj.lpi @@ -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> diff --git a/hmp2obj/hmp2obj.lpr b/hmp2obj/hmp2obj.lpr new file mode 100644 index 0000000..a2bb619 --- /dev/null +++ b/hmp2obj/hmp2obj.lpr @@ -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. + diff --git a/hmp2obj/rs_world.pas b/hmp2obj/rs_world.pas new file mode 100644 index 0000000..c8be78d --- /dev/null +++ b/hmp2obj/rs_world.pas @@ -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. + diff --git a/hmt_parser/hmt_parser.lpi b/hmt_parser/hmt_parser.lpi new file mode 100644 index 0000000..01381d3 --- /dev/null +++ b/hmt_parser/hmt_parser.lpi @@ -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> diff --git a/hmt_parser/hmt_parser.lpr b/hmt_parser/hmt_parser.lpr new file mode 100644 index 0000000..519beb4 --- /dev/null +++ b/hmt_parser/hmt_parser.lpr @@ -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. + diff --git a/image_export/ov_export.lpi b/image_export/ov_export.lpi new file mode 100644 index 0000000..e66206a --- /dev/null +++ b/image_export/ov_export.lpi @@ -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> diff --git a/image_export/ov_export.lpr b/image_export/ov_export.lpr new file mode 100644 index 0000000..1fe0db2 --- /dev/null +++ b/image_export/ov_export.lpr @@ -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. + diff --git a/image_export/rs_image.pas b/image_export/rs_image.pas new file mode 100644 index 0000000..555da63 --- /dev/null +++ b/image_export/rs_image.pas @@ -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. +