source: trunk/UGame.pas

unit UGame;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Graphics, UFile1, UEngFile, UShpFile, UDecode, Types,
  UWsaFile;

type

  { TGame }

  TGame = class
  private
    TileData: array of Byte;
    PaletteData: array of Byte;
    TableData: array of Byte;
    IconMap: array of Word;
    procedure DrawTile(Canvas: TCanvas; Pos: TPoint; Index: Integer);
    procedure LoadIconMap;
    procedure LoadIcons;
    procedure LoadMap;
    procedure LoadPalette;
    procedure LoadTexts;
    procedure LoadUnits;
    procedure LoadUnitsFile(FileName: string);
    procedure LoadWsa;
  public
    Bitmap: TBitmap;
    Palette: TIntegerDynArray;
    IW: Integer;
    procedure Paint(Canvas: TCanvas);
    constructor Create;
    destructor Destroy; override;
    procedure LoadData;
  end;

implementation

uses
  UFormLog, UFormMain;

{ TGame }

procedure TGame.Paint(Canvas: TCanvas);
begin
  Canvas.Line(10, 10, 100, 100);
  Canvas.StretchDraw(Rect(0, 0, 2000, 1400), Bitmap);
end;

constructor TGame.Create;
begin
  Bitmap := TBitmap.Create;
end;

destructor TGame.Destroy;
begin
  FreeAndNil(Bitmap);
  inherited Destroy;
end;

procedure TGame.LoadPalette;
var
  F: TFileStream;
  I: Integer;
begin
  SetLength(Palette, 256);
  F := TFileStream.Create('extracted/DUNE.PAK/IBM.PAL', fmOpenRead);
  for I := 0 to 255 do begin
    //Palette[I] := (I shl 16) or (I shl 8) or (I shl 0);
    Palette[I] := ((F.ReadByte * 4) shl 0) or ((F.ReadByte * 4) shl 8) + ((F.ReadByte * 4) shl 16);
  end;
  F.Free;
end;

procedure TGame.LoadIcons;
var
  I: Integer;
  W, H: Integer;
  F: TFileStream;
  IconFile: TFile1;
  X, Y: Integer;
  ItemSize: Integer;
  C: Byte;
  Color: TColor;
  Index: Integer;
begin
  LoadPalette;
  Bitmap.SetSize(500, 300);
  IconFile := TFile1.Create;
  IconFile.Open('extracted/DUNE.PAK/ICON.ICN');
  TileData := TFile1Block(IconFile.Blocks[1]).Read;
  PaletteData := TFile1Block(IconFile.Blocks[2]).Read;
  TableData := TFile1Block(IconFile.Blocks[3]).Read;

  // Show all tiles
  W := 16;
  H := 16;
  ItemSize := (W div 2 * H);
  for I := 0 to Length(IconMap) - 1 do begin
    //Index := IconMap[I];
    Index := I;
    if Index >= Length(TileData) div ItemSize then
      Index := 0;
    DrawTile(Bitmap.Canvas, Point((I div 16) * 16, (I mod 16) * 16), Index);
    Bitmap.Canvas.Brush.Style := bsClear;
    Bitmap.Canvas.Font.Size := 4;
    Bitmap.Canvas.Font.Color := clWhite;
    Bitmap.Canvas.TextOut((I div 16) * 16, (I mod 16) * 16, IntToHex(I, 2));
  end;

  IconFile.Free;
  //IconMap.Canvas.TextOut(0, 0, IntToStr(Length(PaletteData) div 16) + ' ' + IntToStr(Length(Data) div ItemSize));
end;

procedure TGame.DrawTile(Canvas: TCanvas; Pos: TPoint; Index: Integer);
var
  X, Y: Integer;
  H, W: Integer;
  C: Byte;
  Color: TColor;
  ItemSize: Integer;
begin
  W := 16;
  H := 16;
  ItemSize := (W div 2 * H);
  if Index >= (Length(TileData) div ItemSize) then
    raise Exception.Create('Tile index ' + IntToStr(Index) + ' out of range');
  for Y := 0 to H - 1 do
    for X := 0 to W - 1 do begin
      C := TileData[Index * ItemSize + Y * (W div 2) + X div 2 + 8];
      if (X and 1) = 0 then C := C shr 4
        else C := C and $f;

      C := PaletteData[C + TableData[Index] * 16];
      Color := Palette[C];
      Canvas.Pixels[Pos.X + X, Pos.Y + Y] := Color;
    end;
end;

procedure TGame.LoadMap;
var
  DataFile: TFileStream;
  F2: TFileStream;
  Buffer1: array of Byte;
  Buffer2: array of Byte;
  Color: TColor;
  I, II: Integer;
  W, H: Integer;
  Size: Integer;
  Size2: Integer;
  X, Y: Integer;
  S: String;
  B: Byte;
begin
  Bitmap.SetSize(2000, 1000);
  DataFile := TFileStream.Create('extracted/DUNE.PAK/FAME.CPS', fmOpenRead);
  SetLength(Buffer2, $ffff);
  Size := DataFile.ReadWord;
  DataFile.Position := DataFile.Position + 8;
  Dec(Size, 8);
  SetLength(Buffer1, Size);
  DataFile.Read(Buffer1[0], Length(Buffer1));
  Buffer2 := Format80(Buffer1);

  F2 := TFileStream.Create('dump.bin', fmCreate);
  for Y := 0 to 199 do begin
    S := '';
    for X := 0 to 319 do begin
      B := Buffer2[X + Y * 320];
      if B = $54 then S := S + '   '
        else if B = $5a then S := S + '.. '
        else if B = $68 then S := S + ',, '
        else S := S + IntToHex(B, 2) + ' ';
    end;
    S := S + #13;
    F2.Write(S[1], Length(S));
  end;
  F2.Free;

  W := 320;
  H := 500;
  for Y := 0 to 199 do
  for X := 0 to 319 do begin
    I := (Y) * W + (X);
    //Color := Buffer2[I] shl 1;
    //Color := RGBToColor(Color, Color, Color);
    //II := I;
    //IconMap.Canvas.Pixels[II mod W, II div W] := Color;
    //DrawTile(Bitmap.Canvas, Point(X * 16, Y * 16), IconMap[IconMap[9] + Buffer2[I]]);
    Bitmap.Canvas.Pixels[X, Y] := Palette[Buffer2[I]];

{    Color := (Buffer2[I] shr 4) shl 4;
    Color := RGBToColor(Color, Color, Color);
    II := I * 2 + 1;
    Bitmap.Canvas.Pixels[II mod W, II div W] := Color;
    }
  end;
  DataFile.Free;
  Bitmap.Canvas.Font.Size := 10;
  Bitmap.Canvas.TextOut(0, 0, IntToStr(Size) + ' ' + IntToStr(Size2) + ' ' + IntToStr(IW));
end;

procedure TGame.LoadTexts;
var
  F: TEngFile;
begin
  F := TEngFile.Create;
  F.LoadFromFile('extracted/ENGLISH.PAK/HERALD.ENG');
  FormLog.Memo1.Lines.Assign(F.Lines);
  FormLog.Show;
end;

procedure TGame.LoadIconMap;
var
  F: TFileStream;
begin
  F := TFileStream.Create('extracted/DUNE.PAK/ICON.MAP', fmOpenRead);
  SetLength(IconMap, F.Size div SizeOf(Word));
  F.Read(IconMap[0], F.Size);
  F.Free;
end;

procedure TGame.LoadUnitsFile(FileName: string);
var
  F: TShpFile;
  Bitmap: TBitmap;
  I: Integer;
  OutDir: string;
begin
  LoadPalette;
  F := TShpFile.Create;
  F.Open(FileName);
  F.Palette := @Palette;
  FormMain.Caption := IntToStr(F.Items.Count);
  Bitmap := TBitmap.Create;
  OutDir := FileName + '.DIR';
  ForceDirectories(OutDir);
  for I := 0 to F.Items.Count - 2 do begin
    TShpFileItem(F.Items[I]).GetBitmap(Bitmap);
    Bitmap.SaveToFile(OutDir + DirectorySeparator + IntToStr(I) + '.bmp');
  end;
  Bitmap.Free;
  F.Free;
end;

procedure TGame.LoadUnits;
begin
  LoadUnitsFile('extracted/DUNE.PAK/UNITS.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/UNITS1.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/UNITS2.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/ARROWS.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/MENSHPA.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/MENSHPH.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/MENSHPM.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/MENSHPO.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/MOUSE.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/PIECES.SHP');
  LoadUnitsFile('extracted/DUNE.PAK/SHAPES.SHP');
end;

procedure TGame.LoadWsa;
var
  F: TWsaFile;
begin
  F := TWsaFile.Create;
  F.Open('extracted/DUNE.PAK/WIN1.WSA');
  F.Free;
end;

procedure TGame.LoadData;
begin
  LoadIconMap;
  LoadIcons;
  //LoadMap;
  //LoadTexts;
  LoadUnits;
  LoadWSA;
end;

end.