diff --git a/hob_display/genericstructlist.pas b/hob_display/genericstructlist.pas deleted file mode 100644 index 581263a..0000000 --- a/hob_display/genericstructlist.pas +++ /dev/null @@ -1,224 +0,0 @@ -{ - Based on FPC FGL unit, copyright by FPC team. - License of FPC RTL is the same as our engine (modified LGPL, - see COPYING.txt for details). - Fixed to compile also under FPC 2.4.0 and 2.2.4. - Some small comfortable methods added. -} - -{ Generic list of any type (TGenericStructList). } -unit GenericStructList; - -{$mode objfpc}{$H+} - -{$IF defined(VER2_2)} {$DEFINE OldSyntax} {$IFEND} -{$IF defined(VER2_4)} {$DEFINE OldSyntax} {$IFEND} - -{$define HAS_ENUMERATOR} -{$ifdef VER2_2} {$undef HAS_ENUMERATOR} {$endif} -{$ifdef VER2_4_0} {$undef HAS_ENUMERATOR} {$endif} -{ Just undef enumerator always, in FPC 2.7.1 it's either broken - or I shouldn't overuse TFPGListEnumeratorSpec. } -{$undef HAS_ENUMERATOR} - -{ FPC < 2.6.0 had buggy version of the Extract function, - also with different interface, see http://bugs.freepascal.org/view.php?id=19960. } -{$define HAS_EXTRACT} -{$ifdef VER2_2} {$undef HAS_EXTRACT} {$endif} -{$ifdef VER2_4} {$undef HAS_EXTRACT} {$endif} - -interface - -uses FGL; - -type - { Generic list of types that are compared by CompareByte. - - This is equivalent to TFPGList, except it doesn't override IndexOf, - so your type doesn't need to have a "=" operator built-in inside FPC. - When calling IndexOf or Remove, it will simply compare values using - CompareByte, this is what TFPSList.IndexOf uses. - This way it works to create lists of records, vectors (constant size arrays), - old-style TP objects, and also is suitable to create a list of methods - (since for methods, the "=" is broken, for Delphi compatibility, - see http://bugs.freepascal.org/view.php?id=9228). - - We also add some trivial helper methods like @link(Add) and @link(L). } - - { TGenericStructList } - - generic TGenericStructList = class(TFPSList) - private - type - TCompareFunc = function(const Item1, Item2: T): Integer; - TTypeList = array[0..MaxGListSize] of T; - PTypeList = ^TTypeList; - PT = ^T; - {$ifdef HAS_ENUMERATOR} TFPGListEnumeratorSpec = specialize TFPGListEnumerator; {$endif} - {$ifndef OldSyntax}protected var{$else} - {$ifdef PASDOC}protected var{$else} { PasDoc can't handle "var protected", and I don't know how/if they should be handled? } - var protected{$endif}{$endif} - FOnCompare: TCompareFunc; - procedure CopyItem(Src, Dest: Pointer); override; - procedure Deref(Item: Pointer); override; - function Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif} - function GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif} - function ItemPtrCompare(Item1, Item2: Pointer): Integer; - procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif} - public - constructor Create; - function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif} - {$ifdef HAS_EXTRACT} function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif} {$endif} - function First: T; {$ifdef CLASSESINLINE} inline; {$endif} - {$ifdef HAS_ENUMERATOR} function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif} {$endif} - function IndexOf(const Item: T): Integer; - procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif} - function Last: T; {$ifdef CLASSESINLINE} inline; {$endif} -{$ifndef OldSyntax} - procedure Assign(Source: TGenericStructList); -{$endif OldSyntax} - function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif} - procedure Sort(Compare: TCompareFunc); - property Items[Index: Integer]: T read Get write Put; default; - property List: PTypeList read GetList; - - { Pointer to items. Exactly like @link(List), but this points to a single item, - which means you can access particular item by @code(L[I]) instead of - @code(List^[I]) in FPC objfpc mode. - - This is just trivial shortcut, but we use direct access a @italic(lot) - for structures. Reasonis: using Items[] default - property means copying the structures, which is - @orderedList( - @item(very dangerous (you can trivially easy modify a temporary result)) - @item(slow (important for us, since these are used for vector arrays that - are crucial for renderer and various processing).) - ) } - function L: PT; - - { Increase Count and return pointer to new item. - Comfortable and efficient way to add a new item that you want to immediately - initialize. } - function Add: PT; - - function Copy: TGenericStructList; - end; - -implementation - -constructor TGenericStructList.Create; -begin - inherited Create(sizeof(T)); -end; - -procedure TGenericStructList.CopyItem(Src, Dest: Pointer); -begin - T(Dest^) := T(Src^); -end; - -procedure TGenericStructList.Deref(Item: Pointer); -begin - Finalize(T(Item^)); -end; - -function TGenericStructList.Get(Index: Integer): T; -begin - Result := T(inherited Get(Index)^); -end; - -function TGenericStructList.GetList: PTypeList; -begin - Result := PTypeList(FList); -end; - -function TGenericStructList.ItemPtrCompare(Item1, Item2: Pointer): Integer; -begin - Result := FOnCompare(T(Item1^), T(Item2^)); -end; - -procedure TGenericStructList.Put(Index: Integer; const Item: T); -begin - inherited Put(Index, @Item); -end; - -function TGenericStructList.Add(const Item: T): Integer; -begin - Result := inherited Add(@Item); -end; - -{$ifdef HAS_EXTRACT} -function TGenericStructList.Extract(const Item: T): T; -begin - inherited Extract(@Item, @Result); -end; -{$endif} - -function TGenericStructList.First: T; -begin - Result := T(inherited First^); -end; - -{$ifdef HAS_ENUMERATOR} -function TGenericStructList.GetEnumerator: TFPGListEnumeratorSpec; -begin - Result := TFPGListEnumeratorSpec.Create(Self); -end; -{$endif} - -function TGenericStructList.IndexOf(const Item: T): Integer; -begin - Result := inherited IndexOf(@Item); -end; - -procedure TGenericStructList.Insert(Index: Integer; const Item: T); -begin - T(inherited Insert(Index)^) := Item; -end; - -function TGenericStructList.Last: T; -begin - Result := T(inherited Last^); -end; - -{$ifndef OldSyntax} -procedure TGenericStructList.Assign(Source: TGenericStructList); -var - i: Integer; -begin - Clear; - for I := 0 to Source.Count - 1 do - Add(Source[i]); -end; -{$endif OldSyntax} - -function TGenericStructList.Remove(const Item: T): Integer; -begin - Result := IndexOf(Item); - if Result >= 0 then - Delete(Result); -end; - -procedure TGenericStructList.Sort(Compare: TCompareFunc); -begin - FOnCompare := Compare; - inherited Sort(@ItemPtrCompare); -end; - -function TGenericStructList.L: PT; -begin - Result := PT(FList); -end; - -function TGenericStructList.Add: PT; -begin - Count := Count + 1; - Result := Addr(L[Count - 1]); -end; - -function TGenericStructList.Copy: TGenericStructList; -begin - result := TGenericStructList.Create; - result.Assign(Self); -end; - -end. diff --git a/hob_display/hmt_parser.pas b/hob_display/hmt_parser.pas deleted file mode 100644 index a6ac51d..0000000 --- a/hob_display/hmt_parser.pas +++ /dev/null @@ -1,180 +0,0 @@ -unit hmt_parser; -{$mode objfpc}{$H+} - -interface - -uses - sysutils, Classes, - rs_image; - -type - THmtMaterial = record - type1, type2: shortint; - unknown_float1, unknown_float2: single; - zero: integer; - hex_a: integer; - name: array[0..15] of byte; - name_string: string; - end; - - THmtTexture = record - data_offset: integer; - palette_offset: integer; - name_offset: integer; - width, height: word; - name: array[0..15] of byte; - name_string: string; - image: TRSImage; - end; - - THmtFile = record - material_count: integer; - texture_offset: integer; - texture_count: integer; - materials: array of THmtMaterial; - textures: array of THmtTexture; - end; - - function ParseHmtFile(const fname: string): THmtFile; - -//************************************************************************************************** -implementation - -function NameToString(name: array of byte): string; -var - i: Integer; -begin - result := ''; - for i := 0 to length(name) - 1 do begin - if name[i] = 0 then break; - result += char( name[i] ); - end; -end; - - -procedure ReadTexture(var tex: THmtTexture; var f: TMemoryStream); -const - ImageDescription: array[0..5] of TImageDescription = ( - (palette_entries: 16; sample_bits: 4), - (palette_entries: 256; sample_bits: 8), - (palette_entries: 0; sample_bits: 16), - (palette_entries: 0; sample_bits: 32), - (palette_entries: 0; sample_bits: 4), - (palette_entries: 0; sample_bits: 16) - ); -var - image: TRSImage; - buf: array[0..27] of byte; - description: TImageDescription; - bpp: byte; - color_rgba: integer; - pos: int64; -begin - tex.data_offset := f.ReadDWord; - f.ReadBuffer(buf, 28); - tex.palette_offset := f.ReadDWord; - tex.name_offset := f.ReadDWord; - tex.width := f.ReadWord; - tex.height := f.ReadWord; - - f.ReadByte; //0x01 - bpp := f.ReadByte; - image.type_ := f.ReadByte; - f.ReadByte; - color_rgba := f.ReadDWord; - - pos := f.Position; - f.Seek(tex.name_offset, TSeekOrigin.soBeginning); - f.ReadBuffer(tex.name, 16); - tex.name_string := NameToString(tex.name); - f.Seek(pos, TSeekOrigin.soBeginning); - - description := ImageDescription[image.type_]; - image.sampleBits := description.sample_bits; - image.paletteEntries := description.palette_entries; - image.width := tex.width; - //if (image.width and 1) > 1 then image.width += 1; - image.height := tex.height; - - writeln('name: ', tex.name_string); - writeln('size: ', tex.width, 'x', tex.height); - writeln('subtype: ', image.type_, ' bpp: ', bpp); - writeln('sample bits: ', image.sampleBits); - writeln('palette offset: ', tex.palette_offset); - writeln('data offset: ', tex.data_offset); - - if tex.palette_offset > 0 then begin - writeln('palette entries: ', image.paletteEntries); - f.Seek(tex.palette_offset, TSeekOrigin.soBeginning); - LoadPalette(image, f); - end; - f.Seek(tex.data_offset, TSeekOrigin.soBeginning); - LoadSamples(image, f); - DecodePixels(image); - - f.Seek(pos, TSeekOrigin.soBeginning); - writeln; - tex.image := image; -end; - - -procedure ReadMaterial(var mat: THmtMaterial; var f: TMemoryStream); -begin - mat.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); - mat.name_string := NameToString(mat.name); - - writeln(mat.name_string); - if (mat.zero <> 0) or (mat.hex_a <> $A) then - writeln('unusual file'); -end; - - -function ParseHmtFile(const fname: string): THmtFile; -var - f: TMemoryStream; - hmt: THmtFile; - i: Integer; -begin - f := TMemoryStream.Create; - f.LoadFromFile(fname); - - //read main info - hmt.material_count := f.ReadDWord; - hmt.texture_offset := f.ReadDWord; - f.Seek(hmt.texture_offset, TSeekOrigin.soBeginning); - hmt.texture_count := f.ReadDWord; - f.Seek(8, TSeekOrigin.soBeginning); - - //read materials - writeln('materials: ', hmt.material_count); - SetLength(hmt.materials, hmt.material_count); - for i := 0 to hmt.material_count - 1 do begin - ReadMaterial(hmt.materials[i], f); - end; - - if hmt.texture_count = 0 then begin - result := hmt; - f.Free; - exit; - end; - - //read textures - writeln('textures: ', hmt.texture_count); - f.Seek(hmt.texture_offset + 4, TSeekOrigin.soBeginning); - SetLength(hmt.textures, hmt.texture_count); - for i := 0 to hmt.texture_count - 1 do begin - ReadTexture(hmt.textures[i], f); - end; - - f.Free; - result := hmt; -end; - -end. - diff --git a/hob_display/hob_mesh.pas b/hob_display/hob_mesh.pas deleted file mode 100644 index e34b68a..0000000 --- a/hob_display/hob_mesh.pas +++ /dev/null @@ -1,456 +0,0 @@ -unit hob_mesh; -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, gl, GLext, math, fgl, - GenericStructList, hob_parser, hmt_parser; - -type - TVertex = record - x, y, z: single; - end; - - TTriangle = record - vertices: array [0..2] of TVertex; - material_index: integer; - tex_coords: array [0..2, 0..1] of single; - colors: array[0..2] of TRGBA; - end; - - TMaterial = record - has_texture: boolean; - bpp: byte; - gl_tex_id: integer; - width, height: integer; - pixels: pbyte; - end; - - TVertexList = specialize TGenericStructList; - TTriangleList = specialize TGenericStructList; - TMaterialArray = array of TMaterial; - - TRenderOpts = record - wireframe: boolean; - points: boolean; - vcolors: boolean; - textures: boolean; - fg_to_draw: integer; - end; - - { TModel - single HOB mesh - } - - TModel = class - private - _vertices: TVertexList; - _triangles: array of TTriangleList; - _materials: array of TMaterial; - _hmt: THmtFile; - _hmt_loaded: boolean; - procedure HmtRead(const filename: string); - procedure HobRead(const filename: string); - procedure HobReadMesh(const mesh: THobObject); - public - destructor Destroy; override; - procedure Load(const hob_filename, hmt_filename: string); - procedure InitGL; - procedure DrawGL(opts: TRenderOpts); - procedure ExportObj(const obj_name: string); - end; - -implementation - -{ TModel } - -function FixRange(const coord_i16: smallint): single; -begin - result := 0; - if coord_i16 <> 0 then - result := coord_i16 * (1 / 4000); -end; - -function FixUvRange(const coord_i16: smallint): single; -begin - result := 0; - if coord_i16 <> 0 then - result := coord_i16 * (1 / 4096); -end; - - -{ rearrange HOB data, triangulate quads -} -procedure TModel.HobReadMesh(const mesh: THobObject); -var - i: Integer; - fg: THobFaceGroup; - v: TVertex; - group_vertices: TVertexList; - triangle: TTriangle; - fg_idx: integer; - tris: TTriangleList; - last_idx: integer; - tx, ty, tz: single; - - function InitVertex(face: THobFace; offset: integer): TTriangle; - var - i, k: Integer; - begin - for i := 0 to 2 do begin - k := (i + offset) and $3; - result.vertices[i] := group_vertices[face.indices[k]]; - result.colors[i] := face.vertex_colors[k]; - result.tex_coords[i, 0] := FixUvRange(face.tex_coords[k].u); - result.tex_coords[i, 1] := FixUvRange(face.tex_coords[k].v); - end; - result.material_index := face.material_index; - end; - -begin - group_vertices := TVertexList.Create; - setlength(_triangles, Length(mesh.face_groups)); - fg_idx := 0; - last_idx:=0; - for fg in mesh.face_groups do begin - for i := 0 to fg.vertex_count - 1 do begin - v.x := FixRange(fg.vertices[i].x); - v.y := FixRange(fg.vertices[i].y); - v.z := FixRange(fg.vertices[i].z); - - - v.x += fg.transform.x/16; - v.y += fg.transform.y/16; - v.z += fg.transform.z/16; - - - //flip Y for OpenGL coord system, otherwise the model is upside down. - //Flip x coord too, otherwise the model looks mirrored - v.y := -v.y; - v.x := -v.x; - - _vertices.Add(v); - group_vertices.Add(v); - end; - tris := TTriangleList.Create; - for i := 0 to fg.face_count - 1 do begin - triangle := InitVertex(fg.faces[i], 0); - tris.Add(triangle); - if fg.faces[i].ftype <> 3 then begin - triangle := InitVertex(fg.faces[i], 2); - tris.Add(triangle); - end; - end; - _triangles[fg_idx] := tris; - fg_idx += 1; - group_vertices.Clear; - last_idx:=fg.fg_group_id; - end; - group_vertices.Free; -end; - - -procedure TModel.HobRead(const filename: string); -var - i: Integer; - hob: THobFile; -begin - hob := ParseHobFile(filename); - for i := 0 to 0 do - HobReadMesh(hob.objects[i]); - WriteLn('vertices: ', _vertices.Count); - //WriteLn('faces (triangulated): ', _triangles.Count); -end; - - -procedure TModel.HmtRead(const filename: string); - procedure SetTexByName (var mat: TMaterial; const name: string); - var - i: integer; - tex: THmtTexture; - begin - mat.has_texture := false; - for i := 0 to _hmt.texture_count - 1 do - if _hmt.textures[i].name_string = name then begin - tex := _hmt.textures[i]; - if not (tex.image.type_ in [0,1,3,4]) then - break; - - mat.bpp := 24; - if tex.image.type_ = 4 then - mat.bpp := 8; - - mat.width := tex.width; - mat.height := tex.height; - mat.pixels := tex.image.pixels; - mat.has_texture := true; - - writeln('material texture found: ', name); - break; - end; - end; -var - i: integer; -begin - _hmt := ParseHmtFile(filename); - SetLength(_materials, _hmt.material_count); - for i := 0 to _hmt.material_count - 1 do - SetTexByName(_materials[i], _hmt.materials[i].name_string); -end; - - -destructor TModel.Destroy; -begin - inherited Destroy; -// _triangles.Free; -end; - -procedure TModel.Load(const hob_filename, hmt_filename: string); -begin - _vertices := TVertexList.Create; - //_triangles := TTriangleList.Create; - WriteLn('Loading mesh file ', hob_filename); - HobRead(hob_filename); - if FileExists(hmt_filename) then begin - WriteLn('Loading material file ', hmt_filename); - HmtRead(hmt_filename); - _hmt_loaded := true; - end else begin - _hmt_loaded := false; - end; -end; - -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 TModel.InitGL; - - procedure GenTexture(var mat: TMaterial); - begin - glGenTextures(1, @mat.gl_tex_id); - glBindTexture(GL_TEXTURE_2D, mat.gl_tex_id); - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - - if mat.bpp = 24 then begin - glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB8, mat.width, mat.height, 0, GL_RGB, GL_UNSIGNED_BYTE, mat.pixels); - //pnm_save(IntToStr(mat.gl_tex_id)+'.pnm', mat.pixels, mat.width, mat.height); - end; - if mat.bpp = 8 then begin - glTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, mat.width, mat.height, 0, GL_RED, GL_UNSIGNED_BYTE, mat.pixels); - //pgm_save(IntToStr(mat.gl_tex_id)+'.pgm', mat.pixels, mat.width, mat.height); - end; - - glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR ); - glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR ); - //clamp seems to be the correct mode - glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - end; - -var - i: integer; -begin - if not _hmt_loaded then - exit; - for i := 0 to _hmt.material_count - 1 do begin - if _materials[i].has_texture then - GenTexture(_materials[i]); - end; -end; - - -procedure TModel.DrawGL(opts: TRenderOpts); -var - vert: TVertex; - i, k: integer; - - procedure DrawTri(tri: TTriangle); - var - mat: TMaterial; - k: Integer; - begin - if _hmt_loaded then begin - mat := _materials[tri.material_index]; - if mat.has_texture then begin - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, mat.gl_tex_id); - end else - glDisable(GL_TEXTURE_2D); - end; - glBegin(GL_TRIANGLES); - for k := 0 to 2 do begin - if opts.vcolors then - glColor4ubv(@tri.colors[k]); - if opts.textures then - glTexCoord2fv(@tri.tex_coords[k, 0]); - glVertex3fv(@tri.vertices[k]); - end; - glEnd; - end; - -begin - if opts.wireframe then - glPolygonMode(GL_FRONT_AND_BACK, GL_LINE) - else - glPolygonMode(GL_FRONT_AND_BACK, GL_FILL); - - glDisable(GL_TEXTURE_2D); - if opts.points then begin - glBegin( GL_POINTS ); - glColor3f(0, 1, 0); - for i := 0 to _vertices.Count - 1 do begin - vert := _vertices[i]; - glVertex3fv(@vert); - end; - glEnd; - end; - - glColor3f(1, 1, 1); - for k := 0 to Length(_triangles) - 1 do -//k := min(opts.fg_to_draw, Length(_triangles) - 1); - for i := 0 to _triangles[k].Count - 1 do - DrawTri(_triangles[k][i]); -end; - - -const - HeaderComment = 'Exported with HOB viewer'; - DefaultMaterial = 'default'; - - -procedure TModel.ExportObj(const obj_name: string); -const - DesiredUnitSize = 2; -var - objfile: TextFile; - vt: TVertex; - face: TTriangle; - - x, y, z: double; - u, v: double; - - scaling_factor: double; - coord_max: double; - uv_counter: integer; - vertex3d_offset: integer; - last_material_index: integer; - - i,j,k: integer; - vertex_counter: Integer; - -function GetMaxCoord: double; -var - vt: TVertex; - i,j,k: integer; -begin - result := 0; - for i := 0 to _vertices.Count - 1 do begin - vt := _vertices[i]; - x := abs(vt.x); - y := abs(vt.y); - z := abs(vt.z); - coord_max := Max(z, Max(x, y)); - if coord_max > result then - result := coord_max; - end; -end; - -begin - AssignFile(objfile, obj_name); - Rewrite(objfile); - - writeln(objfile, '# ' + HeaderComment); - writeln(objfile, 'mtllib ', obj_name + '.mtl'); - - //scale pass - scaling_factor := 1; - //scaling_factor := DesiredUnitSize / GetMaxCoord; - - //vertex pass - for k := 0 to Length(_triangles) - 1 do - for i := 0 to _triangles[k].Count - 1 do begin - face := _triangles[k][i]; - for vt in face.vertices do begin - x := (vt.x) * scaling_factor; - y := (vt.y) * scaling_factor; - z := (vt.z) * scaling_factor; - writeln(objfile, 'v ', x:10:6, ' ', y:10:6, ' ', z:10:6); - end; - end; - - //uv pass - for k := 0 to Length(_triangles) - 1 do - for i := 0 to _triangles[k].Count - 1 do begin - face := _triangles[k][i]; - for j := 0 to 2 do begin - u := face.tex_coords[j, 0]; - v := face.tex_coords[j, 1]; - writeln(objfile, 'vt ', u:10:6, ' ', v:10:6); - end; - end; - - //face / material pass - uv_counter := 1; - vertex_counter := 1; - last_material_index := -1; - - for k := 0 to Length(_triangles) - 1 do begin - if _triangles[k].Count = 0 then - continue; - - writeln(objfile, 'g ', k); - - for i := 0 to _triangles[k].Count - 1 do begin - face := _triangles[k][i]; - - if face.material_index <> last_material_index then begin - if face.material_index = -1 then - writeln(objfile, 'usemtl ' + DefaultMaterial) - else - writeln(objfile, 'usemtl material_id', face.material_index); - last_material_index := face.material_index; - end; - - write(objfile, 'f '); - for vt in face.vertices do begin - write(objfile, vertex_counter); - write(objfile, '/', uv_counter); - write(objfile, ' '); - vertex_counter += 1; - uv_counter += 1; - end; - writeln(objfile); - end; - end; - - CloseFile(objfile); - - //SaveMaterials(pdo, obj_name); -end; - -end. - diff --git a/hob_display/hob_parser.pas b/hob_display/hob_parser.pas deleted file mode 100644 index 6d34f4f..0000000 --- a/hob_display/hob_parser.pas +++ /dev/null @@ -1,361 +0,0 @@ -unit hob_parser; -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - -type - TRGBA = record - color: integer; - end; - - TTexCoord = record - u, v: smallint; - end; - - THobFace = record - flags: integer; - b1, b2, b3: byte; - bsize: byte; - ftype: byte; //3 - tri, 4 - quad - material_index: word; - indices: array[0..3] of word; - vertex_colors: array[0..3] of TRGBA; - tex_coords: array[0..3] of TTexCoord; - end; - - THobFaceGroup = record - meshdef1_offset: integer; - - face_block_end_offset, - face_block_offset, - vertex_block_offset: integer; - - fg_group_id: integer; - transform: record - x,y,z: single; - end; - - face_count: integer; - faces: array of THobFace; - - vertex_count: integer; - vertices: array of record - x, y, z, unknown: smallint; //+-2^15 - end; - end; - - THobObject = record - name: array[0..15] of byte; - face_group_offset: integer; - face_group_header_offset: integer; - face_group_header2_offset: integer; - - face_group_count: integer; - face_group_count0: integer; - - face_groups: array of THobFaceGroup; - end; - - THobFile = record - obj_count: integer; - objects: array of THobObject; - end; - -function ParseHobFile(const fname: string): THobFile; - -//************************************************************************************************** -implementation - -const - DumpFaces = false; - -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 ReadFaces(var group: THobFaceGroup; var f: TMemoryStream); -const - FACE_UV = %100; - FACE_QUAD = %1000; - FACE_VCOLORS = %10000; - FACE_COLOR = %100000; - FACE_EXT = %1000000; -var - i, k: integer; - face: THobFace; - zero: integer; - file_pos: integer; - color: integer; -begin - zero := f.ReadDWord; - if (zero <> 0) then - writeln('unusual file: zero'); - zero := f.ReadDWord; - if (zero <> 0) then - writeln('unusual file: zero'); - file_pos := f.ReadDWord; - if file_pos <> f.Position + 4 then - writeln('unusual file: face data start position'); - group.face_count := f.ReadDWord; - writeln('faces: ', group.face_count); - - SetLength(group.faces, group.face_count); - for i := 0 to group.face_count - 1 do begin - file_pos := f.Position; - face.flags := f.ReadDWord; - face.b1 := f.ReadByte; //46/49/4B - face.b2 := f.ReadByte; //51/71 - face.b3 := f.ReadByte; //0C - face.bsize := f.ReadByte * 4; //block size - zero := f.ReadWord; - if (zero <> 0) then - writeln('unusual file: face header separator'); - - //material index - face.material_index := f.ReadWord; - - //face type: quad or triangle - if face.flags and FACE_QUAD > 0 then - face.ftype := 4 - else - face.ftype := 3; - - //read vertex indices - for k := 0 to 3 do - face.indices[k] := f.ReadWord; - - //ext0 - if face.flags and FACE_EXT > 0 then begin - f.ReadDWord; - f.ReadDWord; - end; - - //vertex colors - either per vertex, or the same for all vertices - if face.flags and FACE_COLOR > 0 then begin - if face.flags and FACE_VCOLORS > 0 then begin - for k := 0 to face.ftype - 1 do - face.vertex_colors[k].color := f.ReadDWord; - end else begin - color := f.ReadDWord; - for k := 0 to face.ftype - 1 do - face.vertex_colors[k].color := color; - end; - end; - - //uv coords - if face.flags and FACE_UV > 0 then begin - for k := 0 to face.ftype - 1 do begin - face.tex_coords[k].u := f.ReadWord; - face.tex_coords[k].v := f.ReadWord; - end; - end; - - if DumpFaces then begin - if (face.flags and FACE_QUAD) = 0 then write('t') else write('q'); - write(face.flags:5, face.b1:3, face.b2:4, face.b3:3, face.bsize:3); - write(' mt: ', face.material_index); - write(' verts: '); - for k := 0 to face.ftype - 1 do - write(face.indices[k]:4); - write(' colors: '); - for k := 0 to face.ftype - 1 do - write(IntToHex(face.vertex_colors[k].color, 8), ' '); - if (face.flags and FACE_UV) > 0 then begin - write(' uvs: '); - for k := 0 to face.ftype - 1 do - write('(', face.tex_coords[k].u, ', ', face.tex_coords[k].v, ') '); - end; - end; - - //hack for awing.hob - if f.Position <> (file_pos + face.bsize) then begin - write(' rest:'); - for k := f.Position to file_pos + face.bsize - 1 do - write(IntToHex(f.ReadByte, 2):3); - end; - - if DumpFaces then - writeln; - - group.faces[i] := face; - end; -end; - - -procedure ReadVertices(var group: THobFaceGroup; var f: TMemoryStream; const vertex_count: integer); -var - i: integer; -begin - SetLength(group.vertices, vertex_count); - for i := 0 to vertex_count - 1 do begin - group.vertices[i].x := SmallInt(f.ReadWord); - group.vertices[i].y := SmallInt(f.ReadWord); - group.vertices[i].z := SmallInt(f.ReadWord); - group.vertices[i].unknown := SmallInt(f.ReadWord); - end; -end; - -var fgid: integer = 0; - -procedure ReadFaceGroup(var fg: THobFaceGroup; var f: TMemoryStream); -var - filepos: int64; - fnum: single; - i: Integer; - zero: int64; - fg_next, fg_end: integer; -begin - //save file position before seeking to face/vertex data and restore it, to read next group properly - filepos := f.Position; - - //read group/meshdef0 - fg_next := f.ReadDWord; - f.Seek(4*2, fsFromCurrent); //unknown - fg_end := f.ReadDWord; - fg.meshdef1_offset := f.ReadDWord; - - writeln(); - writeln('fg: ', fgid); fgid += 1; - writeln('fg next: ', fg_next, ' end: ', fg_end); - writeln('fg meshdef1 offset:', fg.meshdef1_offset); - - zero := f.ReadQWord; - if zero <> 0 then - writeln('unusual file: facegroup 0 zero'); - - for i := 1 to (48) div 4 do begin - f.ReadBuffer(fnum, 4); - //writeln(fnum); - end; - fg.fg_group_id := f.ReadDWord; - for i := 1 to (3*4 + 3*4 + 4*4) div 4 do begin - f.ReadBuffer(fnum, 4); - //writeln(fnum); - end; - f.ReadBuffer(fg.transform.x, 4); - f.ReadBuffer(fg.transform.y, 4); - f.ReadBuffer(fg.transform.z, 4); - - writeln(fg.fg_group_id); - writeln(fg.transform.x:7:5); - writeln(fg.transform.y:7:5); - writeln(fg.transform.z:7:5); - - if fg.meshdef1_offset > 0 then begin - //read meshdef1 - f.Seek(fg.meshdef1_offset - 4, fsFromBeginning); - fg.face_block_end_offset := f.ReadDWord; - f.Seek(20, fsFromCurrent); //zero - fg.vertex_count := f.ReadDWord; - f.Seek(8, fsFromCurrent); //zero - fg.face_block_offset := f.ReadDWord; - fg.vertex_block_offset := f.ReadDWord; - - //faces - writeln('faces at: ', fg.face_block_offset, hexStr(fg.face_block_offset, 4):6); - f.Seek(fg.face_block_offset, fsFromBeginning); - ReadFaces(fg, f); - - //vertices - writeln('vertices at: ', fg.vertex_block_offset, hexStr(fg.vertex_block_offset, 4):6); - f.Seek(fg.vertex_block_offset, fsFromBeginning); - ReadVertices(fg, f, fg.vertex_count); - - //if (scale > 0) then - //for i := 0 to fg.vertex_count - 1 do begin - // //fg.vertices[i].x += trunc(tx * 300); - // //fg.vertices[i].y += trunc(ty * 300); - // //fg.vertices[i].z += trunc(tz * 300); - // fg.vertices[i].x *= scale; - // fg.vertices[i].y *= scale; - // fg.vertices[i].z *= scale; - //end; - end; -end; - - -procedure ReadObject(var mesh: THobObject; var f: TMemoryStream); -var - i: integer; - fg_offsets: array of integer; - unknown: integer; -begin - f.ReadBuffer(mesh.name, 16); - mesh.face_group_offset := f.ReadDWord; - mesh.face_group_header_offset := f.ReadDWord; - mesh.face_group_header2_offset := f.ReadDWord; - - writeln('object: ', NameToString(mesh.name)); - writeln('face group offset: ', mesh.face_group_offset); - - //get face group count - f.Seek(mesh.face_group_header_offset, fsFromBeginning); //16B zero - mesh.face_group_count := f.ReadWord; //which? - mesh.face_group_count0 := f.ReadWord; - if mesh.face_group_count <> mesh.face_group_count0 then begin - writeln('facegroup counts don''t match!: ', mesh.face_group_count, mesh.face_group_count0:5); - end; - - SetLength(fg_offsets, mesh.face_group_count); - for i := 0 to mesh.face_group_count - 1 do begin - unknown := f.ReadDWord; - fg_offsets[i] := f.ReadDWord; - end; - - //read face group defs - SetLength(mesh.face_groups, mesh.face_group_count); - for i := 0 to mesh.face_group_count - 1 do begin - writeln('fg meshdef0 offset: ', fg_offsets[i], IntToHex(fg_offsets[i], 8):9); - f.Seek(fg_offsets[i], fsFromBeginning); - ReadFaceGroup(mesh.face_groups[i], f); - end; - writeln; -end; - - -function ParseHobFile(const fname: string): THobFile; -var - f: TMemoryStream; - hob: THobFile; - i: integer; - filepos: int64; -begin - f := TMemoryStream.Create; - f.LoadFromFile(fname); - - hob.obj_count := f.ReadDWord; - f.ReadDWord; //sometimes face block start, but useless in general - - writeln('objects: ', hob.obj_count); - if hob.obj_count = 0 then begin - writeln('hob file is empty!'); - result := hob; - exit; - end; - - SetLength(hob.objects, hob.obj_count); - for i := 0 to hob.obj_count - 1 do begin - filepos := f.Position; - ReadObject(hob.objects[i], f); - - //seek to next object header - if i + 1 < hob.obj_count then - f.Seek(filepos + 116, fsFromBeginning); - end; - - f.Free; - result := hob; -end; - -end. - diff --git a/hob_display/hob_viewer.lpi b/hob_display/hob_viewer.lpi deleted file mode 100644 index 44c9621..0000000 --- a/hob_display/hob_viewer.lpi +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - <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="xwing.hob"/> - </local> - </RunParams> - <RequiredPackages Count="1"> - <Item1> - <PackageName Value="LCL"/> - </Item1> - </RequiredPackages> - <Units Count="5"> - <Unit0> - <Filename Value="hob_viewer.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="hob_viewer"/> - </Unit0> - <Unit1> - <Filename Value="hob_mesh.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="hob_mesh"/> - </Unit1> - <Unit2> - <Filename Value="hob_parser.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="hob_parser"/> - </Unit2> - <Unit3> - <Filename Value="hmt_parser.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="hmt_parser"/> - </Unit3> - <Unit4> - <Filename Value="rs_image.pas"/> - <IsPartOfProject Value="True"/> - </Unit4> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="11"/> - <PathDelim Value="\"/> - <Target> - <Filename Value="hob_viewer"/> - </Target> - <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="2"> - <Item1> - <Name Value="ECodetoolError"/> - </Item1> - <Item2> - <Name Value="EFOpenError"/> - </Item2> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/hob_display/hob_viewer.pas b/hob_display/hob_viewer.pas deleted file mode 100644 index 31a6e7e..0000000 --- a/hob_display/hob_viewer.pas +++ /dev/null @@ -1,379 +0,0 @@ -(* -hob_viewer.pas -Copyright (c) 2014 David Pethes - -This file is part of HOB viewer. - -HOB viewer is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -HOB viewer is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with HOB viewer. If not, see <http://www.gnu.org/licenses/>. -*) -program hob_viewer; - -uses - sysutils, - gl, glu, glext, sdl, - hob_mesh, GenericStructList, hob_parser, hmt_parser, rs_image; - -const - SCR_W_fscrn = 1024; - SCR_H_fscrn = 768; - SCR_W_INIT = 1280; - SCR_H_INIT = 720; - SCREEN_BPP = 0; - RotationAngleIncrement = 1; - ZoomIncrement = 0.3; - MouseZoomDistanceMultiply = 0.15; - PitchIncrement = 0.5; - MouseTranslateMultiply = 0.025; - -var - surface: PSDL_Surface; - done, - fullscreen: boolean; - model: TModel; - - view: record - rotation_angle: single; - distance: single; - pitch: single; - x, y: single; - autorotate: boolean; - opts: TRenderOpts; - end; - - key_pressed: record - wireframe: boolean; - vcolors: boolean; - points: boolean; - textures: boolean; - fullscreen: boolean; - autorotate: boolean; - end; - - mouse: record - drag: boolean; - translate: boolean; - last_x, last_y: integer; - resume_autorotate_on_release: boolean; - end; - - -procedure ReportError(s: string); -begin - writeln(s); - halt; -end; - - -// initial parameters -procedure InitGL; -var - ogl_info: string; -begin - ogl_info := format('vendor: %s renderer: %s', [glGetString(GL_VENDOR), glGetString(GL_RENDERER)]); - writeln(ogl_info); - ogl_info := 'version: ' + glGetString(GL_VERSION); - writeln(ogl_info); - - //glShadeModel( GL_SMOOTH ); // Enable smooth shading - glClearColor( 0.0, 0.0, 0.0, 0.0 ); - glClearDepth( 1.0 ); // Depth buffer setup - glEnable( GL_DEPTH_TEST ); // Enables Depth Testing - glDepthFunc( GL_LEQUAL ); // The Type Of Depth Test To Do - glHint( GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST ); // Really Nice Perspective Calculations - - //glEnable( GL_CULL_FACE ); //backface culling - //glCullFace( GL_BACK ); - - glEnable(GL_TEXTURE_2D); -end; - - -// function to reset our viewport after a window resize -procedure ResizeWindow( width, height : integer ); -begin - if ( height = 0 ) then - height := 1; // Protect against a divide by zero - - glViewport( 0, 0, width, height ); // Setup our viewport. - glMatrixMode( GL_PROJECTION ); // change to the projection matrix and set our viewing volume. - glLoadIdentity; - gluPerspective( 45.0, width / height, 0.1, 1000.0 ); // Set our perspective - - glMatrixMode( GL_MODELVIEW ); // Make sure we're changing the model view and not the projection - glLoadIdentity; // Reset The View -end; - - -// The main drawing function. -procedure DrawGLScene; -begin - glClear( GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT ); - glLoadIdentity; - - if view.distance < ZoomIncrement then - view.distance := ZoomIncrement; - - glTranslatef(view.x, view.y, -view.distance); - glRotatef(view.rotation_angle, 0.0, 1.0, 0.0); - glRotatef(view.pitch, 1, 0, 0); - - if view.autorotate then - view.rotation_angle += RotationAngleIncrement; - if view.rotation_angle > 360 then - view.rotation_angle -= 360; - - model.DrawGL(view.opts); - - SDL_GL_SwapBuffers; -end; - - -procedure SetMode(w, h: word; fullscreen: boolean = false); -var - flags: UInt32; -begin - if fullscreen then - flags := SDL_OPENGL or SDL_FULLSCREEN - else - flags := SDL_OPENGL or SDL_RESIZABLE; - surface := SDL_SetVideoMode( w, h, SCREEN_BPP, flags); - if surface = nil then - ReportError('SDL_SetVideoMode failed'); - SDL_WM_SetCaption('HOB viewer', nil); -end; - - -procedure WindowScreenshot(const width, height : integer); -const - head: array[0..8] of word = (0, 2, 0, 0, 0, 0, 0, 0, 24); - counter: integer = 0; -var - buf: pbyte; - f: file; - fname: string; -begin - buf := getmem(width * height * 4); - glReadBuffer(GL_FRONT); - glReadPixels(0, 0, width, height, GL_BGR, GL_UNSIGNED_BYTE, buf); - - fname := format('screenshot_%.4d.tga', [counter]); - AssignFile(f, fname); - Rewrite(f, 1); - head[6] := width; - head[7] := height; - BlockWrite(f, head, sizeof(head)); - BlockWrite(f, buf^, width * height * 3); - CloseFile(f); - counter += 1; - - Freemem(buf); -end; - - -procedure InitView; -begin - view.rotation_angle := 0; - view.distance := 6; - view.pitch := 0; - view.x := 0; - view.y := 0; - view.autorotate := true; - view.opts.wireframe := false; - view.opts.points := false; - view.opts.vcolors := true; - view.opts.textures := true; -end; - - -procedure HandleEvent; -var - event: TSDL_Event; -begin - SDL_PollEvent( @event ); - case event.type_ of - SDL_QUITEV: - Done := true; - - SDL_VIDEORESIZE: - begin - SetMode (event.resize.w, event.resize.h); - ResizeWindow( surface^.w, surface^.h ); - end; - - SDL_KEYDOWN: - case event.key.keysym.sym of - SDLK_ESCAPE: - Done := true; - SDLK_F1: - if not key_pressed.fullscreen then begin - if not fullscreen then begin - SetMode(SCR_W_fscrn, SCR_H_fscrn, true); - fullscreen := true; - end else begin - SetMode(SCR_W_INIT, SCR_H_INIT, false); - fullscreen := false; - end; - InitGL; - ResizeWindow( surface^.w, surface^.h ); - key_pressed.fullscreen := true; - end; - SDLK_s: - WindowScreenshot( surface^.w, surface^.h ); - SDLK_PAGEUP: - view.distance += ZoomIncrement; - SDLK_PAGEDOWN: - view.distance -= ZoomIncrement; - SDLK_r: - if not key_pressed.autorotate then begin - view.autorotate := not view.autorotate; - key_pressed.autorotate := true; - end; - - //model rendering opts - SDLK_w: - if not key_pressed.wireframe then begin - view.opts.wireframe := not view.opts.wireframe; - key_pressed.wireframe := true; - end; - SDLK_v: - if not key_pressed.vcolors then begin - view.opts.vcolors := not view.opts.vcolors; - key_pressed.vcolors := true; - end; - SDLK_p: - if not key_pressed.points then begin - view.opts.points := not view.opts.points; - key_pressed.points := true; - end; - SDLK_t: - if not key_pressed.textures then begin - view.opts.textures := not view.opts.textures; - key_pressed.textures := true; - end; - end; - - SDL_KEYUP: - case event.key.keysym.sym of - SDLK_F1: - key_pressed.fullscreen := false; - SDLK_w: - key_pressed.wireframe := false; - SDLK_v: - key_pressed.vcolors := false; - SDLK_p: - key_pressed.points := false; - SDLK_t: - key_pressed.textures := false; - SDLK_r: - key_pressed.autorotate := false; - end; - - SDL_MOUSEBUTTONDOWN: begin - mouse.resume_autorotate_on_release := view.autorotate; - if event.button.button in [1..3] then begin - mouse.drag := true; - mouse.translate := event.button.button in [2]; - mouse.last_x := event.button.x; - mouse.last_y := event.button.y; - view.autorotate := false; - end; - if event.button.button = 5 then - view.distance += view.distance * MouseZoomDistanceMultiply; - if event.button.button = 4 then - view.distance -= view.distance * MouseZoomDistanceMultiply; - end; - SDL_MOUSEBUTTONUP: begin - mouse.drag := false; - view.autorotate := mouse.resume_autorotate_on_release; - end; - - SDL_MOUSEMOTION: begin - if mouse.drag then begin - if not mouse.translate then begin - if event.motion.y <> mouse.last_y then begin - view.pitch += PitchIncrement * event.motion.yrel; - mouse.last_y := event.motion.y; - end; - if event.motion.x <> mouse.last_x then begin - view.rotation_angle += RotationAngleIncrement * event.motion.xrel; - mouse.last_x := event.motion.x; - end; - end else begin - if event.motion.y <> mouse.last_y then begin - view.y -= MouseTranslateMultiply * event.motion.yrel; - mouse.last_y := event.motion.y; - end; - if event.motion.x <> mouse.last_x then begin - view.x += MouseTranslateMultiply * event.motion.xrel; - mouse.last_x := event.motion.x; - end; - end; - end; - end; - end; {case} -end; - -//****************************************************************************** -var - sec, frames: integer; - hob_file, hmt_file, obj_file: string; - -begin - if Paramcount < 1 then begin - writeln('specify HOB file'); - exit; - end; - hob_file := ParamStr(1); - hmt_file := StringReplace(hob_file, '.hob', '.hmt', [rfIgnoreCase]); - model := TModel.Create; - model.Load(hob_file, hmt_file); - - writeln('Init SDL...'); - SDL_Init( SDL_INIT_VIDEO ); - SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - - SetMode(SCR_W_INIT, SCR_H_INIT); - writeln('Init OpenGL...'); - InitGL; - ResizeWindow( surface^.w, surface^.h ); - - InitView; - model.InitGL; - - //export - obj_file := StringReplace(hob_file, '.hob', '.obj', [rfIgnoreCase]); - model.ExportObj(obj_file); - - sec := SDL_GetTicks; - frames := 0; - Done := False; - key_pressed.wireframe := false; - key_pressed.fullscreen := false; - while not Done do begin - HandleEvent; - DrawGLScene; - frames += 1; - if (SDL_GetTicks - sec) >= 1000 then begin - write(frames:3, ' dist: ', view.distance:5:1, ' rot: ', view.rotation_angle:5:1, #13); - frames := 0; - sec := SDL_GetTicks; - end; - SDL_Delay(10); - //WindowScreenshot( surface^.w, surface^.h ); - end; - - model.Free; - SDL_Quit; -end. - diff --git a/hob_display/rs_image.pas b/hob_display/rs_image.pas deleted file mode 100644 index c12a98d..0000000 --- a/hob_display/rs_image.pas +++ /dev/null @@ -1,168 +0,0 @@ -unit rs_image; -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - -type - TRGB = array[0..2] of byte; - PRGB = ^TRGB; - TPalette = array[0..255] of TRGB; - - TRSImage = record - data_size: integer; - width, height: integer; - type_: byte; - sampleBits: byte; - paletteEntries: integer; - pixels: pbyte; - samples: pbyte; - palette: TPalette; - end; - -type - TImageDescription = record - palette_entries: integer; - sample_bits: integer; - //alpha: byte; - end; - -procedure LoadPalette(var image: TRSImage; var f: TMemoryStream); -procedure LoadSamples(var image: TRSImage; var f: TMemoryStream); -procedure DecodePixels(var img: TRSImage); - -//************************************************************************************************** -implementation - -procedure Unpack4To8bit(const src: PByte; const samples: integer; const dst: PByte); -var - i: Integer; - v: byte; -begin - for i := 0 to samples div 2 - 1 do begin - v := src[i]; - dst[i * 2 ] := ((v shr 4) and %1111) shl 4; - dst[i * 2 + 1] := (v and %1111) shl 4; - end; -end; - - -procedure Unpack4bitTo24bitRGB(const src: PByte; const size: integer; const dst: PByte; const pal: TPalette); -var - i: Integer; - index: integer; - dest: PRGB; -begin - dest := PRGB(dst); - for i := 0 to size div 2 - 1 do begin - index := src[i]; - dest[i * 2 ] := pal[(index shr 4) and 15]; - dest[i * 2 + 1] := pal[index and 15]; - end; -end; - - -procedure Unpack8bitTo24bitRGB(const src: PByte; const size: integer; const dst: PByte; const pal: TPalette); -var - i: Integer; - index: integer; - dest: PRGB; -begin - dest := PRGB(dst); - for i := 0 to size - 1 do begin - index := src[i]; - dest[i] := pal[index]; - end; -end; - - -procedure UseOddBytes(const src: PByte; const size: integer; const dst: pbyte); -var - i: integer; -begin - for i := 0 to size - 1 do begin - dst[i] := src[i * 2 + 1]; - end; -end; - - -procedure DecodePixels(var img: TRSImage); -var - size: integer; -begin - img.pixels := nil; - if not(img.type_ in [0, 1, 2, 3, 4, 5]) then exit; - - if img.sampleBits = 32 then begin - size := img.width * img.height * 4; - img.pixels := GetMem(size); - Move(img.samples^, img.pixels^, size); - end; - - if img.sampleBits = 4 then begin - //4bit grayscale - if img.paletteEntries = 0 then begin - size := img.width * img.height; - img.pixels := GetMem(size); - Unpack4To8bit(img.samples, size, img.pixels); - end; - //24bit RGB palettized - if img.paletteEntries = 16 then begin - size := img.width * img.height; - img.pixels := GetMem(size * 3); - Unpack4bitTo24bitRGB(img.samples, size, img.pixels, img.palette); - end; - end; - - if img.sampleBits = 8 then begin - //8bit grayscale - if img.paletteEntries = 0 then begin - size := img.width * img.height; - img.pixels := GetMem(size); - move(img.samples^, img.pixels^, size); - end; - //24bit RGB palettized - if img.paletteEntries = 256 then begin - size := img.width * img.height; - img.pixels := GetMem(size * 3); - Unpack8bitTo24bitRGB(img.samples, size, img.pixels, img.palette); - end; - end; - - if img.sampleBits = 16 then begin - size := img.width * img.height; - img.pixels := GetMem(size); - UseOddBytes(img.samples, size, img.pixels); - end; -end; - - -procedure LoadPalette(var image: TRSImage; var f: TMemoryStream); -var - entries: integer; -begin - entries := image.paletteEntries; - case entries of - 16, 256: f.ReadBuffer(image.palette, entries * 3); //RGB - end; -end; - - -procedure LoadSamples(var image: TRSImage; var f: TMemoryStream); -var - sample_bits: integer; - size: integer; -begin - sample_bits := image.sampleBits; - size := image.width * image.height * sample_bits div 8; - image.samples := getmem(size); - f.ReadBuffer(image.samples^, size); - if image.type_ = 2 then - f.ReadBuffer(image.samples^, size div 4); -end; - - -end. -