游戏引擎

开发平台：
Delphi

C2ResImport.pas：源码内容
							(*
 @Abstract(CAST II engine resources import unit)
 (C) 2006 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
 The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
 Unit contains resource import routines
*)
{$Include GDefines.inc}
{$Include C2Defines.inc}
unit C2ResImport;
interface
uses
  TextFile, 
  SysUtils,
  BaseTypes, Basics, Base2D, Base3D, Resources,
  Cast2, C2Types, C2Res, C2Visual, C2Materials;
function LoadImage(FileName: BaseTypes.TFileName): TImageResource;
function LoadOBJ(FileName: BaseTypes.TFileName; out VRes: TVerticesResource; out IRes: TIndicesResource; out TRes: TImageResource): Boolean;
function ImportWavResource(FileName: BaseTypes.TFileName): TAudioResource;
function LoadWav(FileName: BaseTypes.TFileName; var Data: Pointer; var Size: Cardinal; var Format: Integer): Boolean;
function SaveWavHeader(Stream: TStream; Format, Size: Cardinal): Boolean;
//function LoadMesh(FileName: BaseTypes.TFileName; Resources: TResourceManager; Actor: TActor; Scale: Single = 1; FromMax: Boolean = False; RecalcNormals: Boolean = False): Integer;
implementation
const ImportCapacityStep = 1;
function LoadImage(FileName: BaseTypes.TFileName): TImageResource;
var
  Data: Pointer;
  Palette: PPalette;
  Stream: TFileStream;
  LineSize: Integer;
  Bpp: Integer;
  PaletteSize: Cardinal;
  PalRes: TPaletteResource;
  TotalPixels: Integer;
  Signature: array[0..2] of Char;
  IDFHeader: TIDFHeader;
  TempWidth, TempHeight: Integer;
  procedure ReportError;
  begin
    {$IFDEF LOGGING} Log.Log('LoadImage: Error loading file "' + FileName + '"', lkError); {$ENDIF}
    if Assigned(Data) then FreeMem(Data);
    if Assigned(Palette) then FreeMem(Palette);
    if Result <> nil then Result.Free; Result := nil;
  end;
begin
  Result := nil;
  Stream := TFileStream.Create(FileName);
  if not Stream.ReadCheck(Signature, 3) then Exit;
  if not Stream.Seek(0) then Exit;
  Palette := nil; Data := nil;
  if Signature = 'IDF' then begin
    if not LoadIDF(Stream, IDFHeader, Data, TotalPixels) then begin
      ReportError;
      Exit;
    end;  
    Result        := TTextureResource.Create(nil);
    Result.Format := IDFHeader.PixelFormat;
    Result.SetDimensions(IDFHeader.Width, IDFHeader.Height);
    Result.SetAllocated(Integer(TotalPixels) * GetBytesPerPixel(IDFHeader.PixelFormat), Data);
    (Result as TTextureResource).Miplevels := IDFHeader.MipLevels;
  end else begin
    Result := TImageResource.Create(nil);
    if not LoadBitmap(Stream, LineSize, TempWidth, TempHeight, BPP, PaletteSize, Palette, Data) then begin
      ReportError;
      Exit;
    end;
    case BPP of
       8: Result.Format := pfP8;
      24: Result.Format := pfB8G8R8;
      32: Result.Format := pfA8R8G8B8;
      else begin
        {$IFDEF LOGGING} Log.Log('LoadImage: Invalid bits per pixel: ' + IntToStr(BPP), lkError); {$ENDIF}
        ReportError;
        Exit;
      end;
    end;
    Result.SetDimensions(TempWidth, TempHeight);
    Result.SetAllocated(Result.Height * LineSize, Data);
  end;
  Stream.Free;
  Result.Name := Signature+'_'+GetFileName(FileName);
  if (Result.Format <> pfP8) and (Result.Format <> pfA8P8) then begin
    if Assigned(Palette) then FreeMem(Palette)
  end else begin
    PalRes := TPaletteResource.Create(nil);
    PalRes.SetAllocated(PaletteSize*SizeOf(TPaletteItem), Palette);
    PalRes.Name := 'Pal_'+GetFileName(FileName);
    Result.AddChild(PalRes);
    Result.PaletteResource := PalRes;
  end;
end;
function ClearCR(s: string): string;
begin
  Result := s;
  while (Result[Length(Result)] = #$A) or (Result[Length(Result)] = #$D) do Result := Copy(Result, 1, Length(Result)-1);
end;
function LoadOBJ(FileName: BaseTypes.TFileName; out VRes: TVerticesResource; out IRes: TIndicesResource; out TRes: TImageResource): Boolean;
var
//  F: TextFile;
  FS: TFileStream;
  SS: TAnsiStringStream;
  p: Pointer;
  S, S2: string;
  i, j: Integer;
  TextureFileName: BaseTypes.TFileName;
  VertexSize: Integer;
  TexOffset, NormOffset, DiffuseOffset, SpecularOffset: Word;
  VCount, NCount, TCount, FCount, Curmaterial, MCount, GroupOffset: Integer;
{$Include LoadObj.inc}
begin
  Result := False;
  VRes := nil; IRes := nil; TRes := nil;
  S := ExtractFileName(FileName);
  S := Copy(S, 1, Length(S)-Length(ExtractFileExt(FileName)));
  if not FileExists(FileName) then if not ErrorHandler(TFileError.Create('File "' + FileName + '" not found')) then Exit;
  FS := TFileStream.Create(FileName);
  GetMem(p, FS.Size);
  FS.Read(p^, FS.Size);
  SS := TAnsiStringStream.Create(p, FS.Size, #10);
  FS.Free;
  VCount := 0; NCount := 0; TCount := 0; FCount := 0; MCount := 0; CurMaterial := -1;
  GroupOffset := 0;
//  AssignFile(F, FileName); Reset(F);
  while SS.Position < SS.Size do begin
    SS.Readln(S);
    S := Uppercase(Trim(S));
    if (S <> '') and (S[1] <> '#') then begin
      if S <> '' then while S[Length(s)] = '' do begin
        SS.Readln(S2);
        S2 := Uppercase(Trim(S2));
        S := Copy(S, 1, Length(S)-1) + ' ' + S2;
      end;
      case S[1] of
        'G': GroupOffset := VCount;
        'V': ReadVertexData(S);
        'F': ReadFaceData(S);
        'U': for i := 0 to MCount-1 do if MData[i].Name = ClearCR(Copy(S, 8, Length(S))) then CurMaterial := i;
        'M': LoadMaterials(S);
      end;
    end;
  end;
  SS.Free;
  
  if VCount = 0 then begin
    {$IFDEF LOGGING} Log.Log(Format('%S: No vertices found', ['LoadOBJ']), lkError); {$ENDIF}
    Exit;
  end;
  if NCount = 0 then begin
    {$IFDEF LOGGING} Log.Log(Format('%S: No normals found. Automatic calculation will apply', ['LoadOBJ']), lkWarning); {$ENDIF}
    CalcNormals;
  end;
  if TCount = 0 then begin
    TCount := 1; SetLength(TData, TCount);
    TData[0] := GetVector3s(0, 0, 0);
  end;
  VRes := TVerticesResource.Create(nil);
  VRes.Name          := 'VER_' + GetFileName(FileName);
  VRes.Format        := GetVertexFormat(False, True, True, True, False, 0, [2]);
  VertexSize         := GetVertexSize(VRes.Format);
  VRes.Allocate(FCount*3 * VertexSize);
  
  NormOffset     := GetVertexElementOffset(VRes.Format, vfiNORM);
  DiffuseOffset  := GetVertexElementOffset(VRes.Format, vfiDIFF);
  SpecularOffset := GetVertexElementOffset(VRes.Format, vfiSPEC);
  TexOffset      := GetVertexElementOffset(VRes.Format, vfiTEX0);
  IRes := TIndicesResource.Create(nil);
  IRes.Name          := 'IND_' + GetFileName(FileName);
  IRes.Format        := IndexSize;
  IRes.Allocate(FCount*3 * IndexSize);
  for i := 0 to FCount-1 do for j := 0 to 2 do with FData[i][j] do begin
    TVector3s((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize])^) := VData[V];
    if M >= 0 then
     Cardinal((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + DiffuseOffset])^) := Round(MData[M].Diffuse.X * 255) shl 16 + Round(MData[M].Diffuse.Y * 255) shl 8 + Round(MData[M].Diffuse.Z * 255) else
      Cardinal((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + DiffuseOffset])^) := $80808080;
    if M >= 0 then
     Cardinal((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + SpecularOffset])^) := Round(MData[M].Specular.X * 255) shl 16 + Round(MData[M].Specular.Y * 255) shl 8 + Round(MData[M].Specular.Z * 255) else
      Cardinal((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + SpecularOffset])^) := $80808080;
    TVector3s((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + TexOffset])^).X := TData[T].X;
    TVector3s((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + TexOffset])^).Y := TData[T].Y;
    if N < NCount then TVector3s((@TByteBuffer(VRes.Data^)[(i*3+j)*VertexSize + NormOffset])^) := NData[N];
    TWordBuffer(IRes.Data^)[i*3+j] := i*3+j;
  end;
  if TextureFileName <> '' then TRes := LoadImage(TextureFileName) else TRes := nil;
  SetLength(VData, 0); SetLength(NData, 0); SetLength(TData, 0); SetLength(MData, 0); SetLength(FData, 0);
  Result := True;
end;
type
  TWaveFormat = packed record
    FormatTag: Word;
    Channels: Word;
    SamplesPerSec: Longword;
    AvgBytesPerSec: Longword;
    BlockAlign: Word;
  end;
  TPCMWaveFormat = packed record
    WaveFormat: TWaveFormat;
    BitsPerSample: Word;
  end;
  TWFHeader = packed record
    RIFFSign: TFileSignature;
    FileLength: Longword;
    WAVESign: TFileSignature;
    FMTSign: TFileSignature;
    FormatLength: Longword;
    Format: TPCMWaveFormat;
    DataSign: TFileSignature;
    DataLength: Longword;
  end;
function ImportWavResource(FileName: BaseTypes.TFileName): TAudioResource;
var Data: Pointer; Size: Cardinal; Format: Integer;
begin
  Result := TAudioResource.Create(nil);
  if not LoadWav(FileName, Data, Size, Format) then Exit;
  Result.Format := Format;
  Result.SetAllocated(Size, Data);
  Result.Name := 'WAV_' + GetFileName(FileName);
end;
function LoadWav(FileName: BaseTypes.TFileName; var Data: Pointer; var Size: Cardinal; var Format: Integer): Boolean;
var F: file; WaveHeader: TWFHeader; BytesRead: Cardinal;
begin
  Result := False;
  AssignFile(F, FileName); Reset(F, 1);
  BlockRead(F, WaveHeader, SizeOf(WaveHeader), BytesRead);
  if BytesRead <> SizeOf(WaveHeader) then Exit;
  if WaveHeader.DataSign <> 'data' then WaveHeader.DataLength := FileSize(F)-SizeOf(WaveHeader);
  Format := PackSoundFormat(WaveHeader.Format.WaveFormat.SamplesPerSec, WaveHeader.Format.BitsPerSample, WaveHeader.Format.WaveFormat.Channels);
  GetMem(Data, WaveHeader.DataLength);
  BlockRead(F, Data^, WaveHeader.DataLength, BytesRead);
  Close(F);
  Size := WaveHeader.DataLength;
  Result := True;
end;
function SaveWavHeader(Stream: TStream; Format, Size: Cardinal): Boolean;
var WaveHeader: TWFHeader;
begin
  Result := False;
  WaveHeader.RIFFSign     := 'RIFF';
  WaveHeader.FileLength   := Size + SizeOf(WaveHeader) - SizeOf(WaveHeader.RIFFSign) - SizeOf(WaveHeader.FileLength);
  WaveHeader.WAVESign     := 'WAVE';
  WaveHeader.FMTSign      := 'fmt ';
  WaveHeader.FormatLength := SizeOf(WaveHeader.Format);
  WaveHeader.Format.WaveFormat.FormatTag      := 1;                    // WAVE_FORMAT_PCM
  WaveHeader.Format.WaveFormat.Channels       := UnpackSoundFormat(Format).Channels;
  WaveHeader.Format.WaveFormat.SamplesPerSec  := UnpackSoundFormat(Format).SampleRate;
  WaveHeader.Format.WaveFormat.AvgBytesPerSec := UnpackSoundFormat(Format).SampleRate * UnpackSoundFormat(Format).Channels * UnpackSoundFormat(Format).BitsPerSample div 8;
  WaveHeader.Format.WaveFormat.BlockAlign     := UnpackSoundFormat(Format).Channels * UnpackSoundFormat(Format).BitsPerSample div 8;
  WaveHeader.Format.BitsPerSample             := UnpackSoundFormat(Format).BitsPerSample;
  WaveHeader.DataSign     := 'data';
  WaveHeader.DataLength   := Size;
  if not Stream.WriteCheck(WaveHeader, SizeOf(WaveHeader)) then Exit;
  Result := True;
end;
end.

						