importma2s.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit ImportMA2s;

{
 projet ADK-ISO (c)2002-2003 Paul TOTH <[e-mail]>

 http://www.web-synergy.net/naug-land/

}

interface

uses
 ADKMaps,Windows,Classes,SysUtils,Dialogs,ADKUtils;

function MA2Import(AFileName:string):string;

implementation

uses EditMaps;

type
  TTerrainModifiers = (TtermNone, TtermChasm, TtermCliff, TtermSandstorm,
    TtermFreezingCold, TtermForceWinds, TtermHeavyfog,
    TtermIceStorm, TtermMud, TtermHeavyRain, TtermLightRain,
    TtermRavine, TtermRidge, TtermRiver, TTermScorchingHeat,
    TTermSnowBlizzard, TtermSnowNormal, TtermStream);

  TSetTypeDeTemps = set of TTerrainModifiers;

  TXYTilde = record
    x: Integer;
    y: Integer;
  end;

  TMajorId= record
    MajorList, StockList, Image: Cardinal;
  end;

  TDrawMode2 = (dmOpaque, DmNormal, DmAdd, DmAlpha, DmSub);

  TTilde =  packed record // 60
{0}    XYpos: TXYTilde;
{8}    Visible: Boolean; //Le bitmap est'il visible ?.
{9}    Occuper: Boolean; //On peut se deplacer sur cette position ?.
{10}    Obstacle: TObstacle; //Type d'obstacle ou terrain.
{11}    dummy1:byte;
{12}    Offset: TPoint; //Decalage X-Y
{20}    OffsetZ: Integer; //d閏alage en Z;
{24}    Z: Shortint; //-128/+128 niveau de "hauteur" dispo: Ground= 0; 1er etage et feuillage des arbres= 10; Aigle en vol= 127;
{25}    dymmy4:array[0..2] of byte;
{28}    MajorId: TMajorId; //Num閞os permettant de recharger une image depuis un TBitmapAdkLibrary (function GetObjectById... Disponible dans plusieurs variante(overolad))
{40}    Angle: Integer;
{44}    DrawMode: TDrawMode2;
{45}    ValueDrawMode: Byte;
{46}    IndexImage: integer;
{50}   dummyz:array[0..1] of byte;
{52,56}    R10, R11: integer; //R10= Symetrie; R11= n癐D.
  end; // 60

type
 TOldImage=record
  ID:TMajorID;
  Org:TPoint;
  Base:integer;
 end;

function ImportLBA(AFileName:string):TList;
var
 lba:TFileStream;
 l1,count1:integer;
 l2,count2:integer;
 l3,count3:integer;
 item:integer;
 anim:boolean;
 img:TOldImage;
 pimg:^TOldImage;
 bi:TBitmapInfoHeader;
 extra:cardinal;
begin
 result:=TList.Create;
 lba:=TFileStream.Create(AFileName,$40);
 try
  if getInteger(lba)<>$3D52 then Error('Biblioth鑡ue graphique invalide');
  lba.Seek(getInteger(lba)*20{SizeOf(TPosRecord)},soFromCurrent);
  getString(lba); // Group
  getString(lba); // comment
  count1:=getInteger(lba); // nombre d'items
  for l1:=0 to count1-1 do begin
   item:=getInteger(lba);
   anim:=(item=$39C7);
   case item of
    $2F9C,$39C7: begin { TListOfStockage, TListOfStock8Anim }
     if getInteger(lba)<>$8E03 then error('Erreur de lecture de la biblioth鑡ue graphique');
     img.id.MajorList:=getInteger(lba); // Ident
     getString(lba); // Group
     getString(lba); // comment
     count2:=getInteger(lba);
     for l2:=0 to count2-1 do begin
      item:=getInteger(lba);
      case item of
       $5510,$3C7F: begin { TStockageListBitmaps, TStockageListAnim }
        if getInteger(lba)<>$8E03 then error('Erreur de lecture de la biblioth鑡ue graphique');
        img.id.StockList:=getInteger(lba); // Ident
        getString(lba); // nom
        getString(lba); // comment
        count3:=getInteger(lba);
        for l3:=0 to count3-1 do begin
         item:=getInteger(lba);
         case item of
          $1A57: begin { TBitmapItem }
           img.id.Image:=getInteger(lba); // Ident
           lba.ReadBuffer(img.Org,sizeof(TPoint));
           new(pimg);
           pimg^:=img;
           result.add(pimg);
           lba.Seek(2*SizeOf(Integer),soFromCurrent); // Placement, Reserved
           lba.ReadBuffer(bi,sizeof(bi));
           extra:=0;
           if bi.biBitCount<=8 then begin
            extra:=4*(1 shl bi.biBitCount);
           end else begin
            if bi.biCompression=BI_BITFIELDS then extra:=3*4;
           end;
           // le DIB et la palette de couleur/le masque
           lba.Seek(extra+bi.biSizeImage+1+1+1+4,soFromCurrent);
           //-lba.ReadBuffer(dm,SizeOf(dm)); // DrawMode
           //-lba.ReadBuffer(ma,SizeOf(ma)); // MasterAlpha
           //-lba.ReadBuffer(ts,SizeOf(ts)); // Transparent
           //-lba.ReadBuffer(cl,SizeOf(cl)); // Color

          end;
          else error('Element graphique 3 inconnu '
                  +inttostr(l1)+'/'+inttostr(count1)+'-'
                  +inttostr(l2)+'/'+inttostr(count2)+'-'
                  +inttostr(l3)+'/'+inttostr(count3)+'-'
                  +'  $'+IntToHex(item,8));
         end;
        end; // l3
        lba.Seek(1,soFromCurrent); // UsePlacement
        if anim then begin
         lba.Seek(10,soFromCurrent); // animate, reserved 1&2, Options
        end;
       end;
       else error('Element graphique 2 inconnu '
                  +inttostr(l1)+'/'+inttostr(count1)+'-'
                  +inttostr(l2)+'/'+inttostr(count2)+'-'
                  +'  $'+IntToHex(item,8));
      end;
     end; // l2
     lba.Seek(2*SizeOf(Integer),soFromCurrent); // Reserved
     if anim then begin
      //-lba.ReadBuffer(p,sizeof(p)); // offset
      lba.Seek(1,soFromCurrent); // ZCorps
     end;
    end;
    else error('Element graphique 1 inconnu $'+IntToHex(item,8));
   end;
  end; // l1
 finally
  lba.Free;
 end;
end;

function findImage(const ID:TMajorId; list:TList; var x,y,base:integer):integer;
var
 i:integer;
 m:^TOldImage;
begin
 if (id.MajorList=0)and(id.StockList=0)and(id.Image=0) then begin
  result:=-1;
  exit;
 end;
 for i:=0 to list.count-1 do begin
  m:=list[i];
  if (ID.MajorList=m^.id.MajorList)
  and(ID.StockList=m^.id.StockList)
  and(ID.Image=m^.id.Image) then begin
   result:=i;
   x:=+m.Org.x;
   y:=-m.Org.y;
   base:=m.Org.y;
   exit;
  end;
 end;
 showmessage('image non trouv閑 '+IntToHex(id.MajorList,8)+'/'+IntToHex(id.StockList,8)+'/'+IntToHex(id.Image,8));
 result:=-1;
end;

function MA2Import(AFileName:string):string;
var
 ma2:TFileStream;
 map:TEditMap;
 lba:TList;
 pt:TPoint;
 bl:boolean;
 bt:byte;
 rt:TRect;
 w,h,x,y,z:integer;
 tilde:TTilde;
// tile:TTile;
 pc:TPoint;
 ct:byte;
 ix,iy,rx,ry,dx,dy:integer;
 flags:TImageFlags;
 img:integer;
 imagelist:TList;
 base:integer;
begin
 result:='';
 ma2:=TFileStream.Create(AFileName,$40{fmOpenRead or fmShareDenyNone});
 map:=TEditMap.Create;
 lba:=nil;
 try
  if getString(ma2)<>'Adk ViewerIso Map' then error('Ce fichier n''est pas une carte ADK');
  if getInteger(ma2)<>2 then error('Ce n''est pas une carte ADK Version 2');
  lba:=ImportLBA(ExtractFilePath(AFileName)+'..\'+getString(ma2));
  ma2.ReadBuffer(pt,sizeof(pt));
  ma2.ReadBuffer(pc,sizeof(pc));  // <- centrage
  ma2.ReadBuffer(ct,sizeof(ct));
  ma2.ReadBuffer(bl,sizeof(bl));
  ma2.ReadBuffer(pt,sizeof(pt));
  ma2.ReadBuffer(bt,sizeof(bt));
  ma2.ReadBuffer(bt,sizeof(bt));
  ma2.ReadBuffer(rt,sizeof(rt));
  if getString(ma2)<>'Adk Iso Map' then error('Erreur de lecture de la carte ADK');
  if getInteger(ma2)<>1 then error('Erreur de version la carte ADK');
  ma2.Seek(SizeOf(integer),soFromCurrent); // meteo
  w:=getInteger(ma2);
  h:=getInteger(ma2);
  map.SetSize(w,h);
  case ct of
   1: inc(pc.x,96*w div 2); // Haut Centre
   2: inc(pc.x,96*w); // Haut Droite
   3: inc(pc.y,48*h div 2); // Centre gauche
   4: begin // Centre
       inc(pc.x,96*w div 2);
       inc(pc.y,48*h div 2);
      end;
   5: begin // Centre droit
       inc(pc.x,96*w);
       inc(pc.y,48*h div 2);
      end;
   6: inc(pc.y,96*h); // Bas gauche
   7: begin // Bas Centre
       inc(pc.x,96*w div 2);
       inc(pc.y,48*h);
      end;
   8: begin // Bas droit
       inc(pc.x,96*w);
       inc(pc.y,48*h);
      end;
(*
  TCentrage = (TcHautGauche, TcHautCentre, TcHautDroite,
    TcCentreGauche, TcCentre, TcCentreDroite,
    TcBasGauche, TcBasCentre, TcBasDroite);
    case FCentrage of
      TcHautGauche: begin Result.x:= 0; Result.y:= 0; end;
      TcHautCentre: begin Result.x:= FSurface.Width div 2; Result.y:= 0; end;
      TcHautDroite: begin Result.x:= FSurface.Width; Result.y:= 0; end;
      TcCentreGauche: begin Result.x:= 0; Result.y:= FSurface.Height div 2; end;
      TcCentre: begin Result.x:= FSurface.Width div 2; Result.y:= FSurface.Height div 2; end;
      TcCentreDroite: begin Result.x:= FSurface.Width; Result.y:= FSurface.Height div 2; end;
      TcBasGauche: begin Result.x:= 0; Result.y:= FSurface.Height; end;
      TcBasCentre: begin Result.x:= FSurface.Width div 2; Result.y:= FSurface.Height; end;
      TcBasDroite: begin Result.x:= FSurface.Width div 2; Result.y:= FSurface.Height; end;
    else
*)
  end;
  (*
  ADKMap1.ScrollX:=pc.X;
  ADKMap1.ScrollY:=pc.Y;
  *)
  imagelist:=TList.Create;
  for y:=0 to h-1 do begin
   for x:=0 to w-1 do begin
    z:=0;
    rx:=(x-y)*48;
    ry:=(x+y)*24+24;
    //map.Cells[x,y].Flags:=[cfDontWalk];
    while getBoolean(ma2) do begin
     ma2.ReadBuffer(tilde,sizeof(tilde));
     //if (z=0) and tilde.Occuper=False then map.Cells[x,y].Flags:=[];
     if z=0 then map.Cells[x,y].Obstacle:=tilde.Obstacle;
     ix:=-tilde.Offset.X;
     iy:=+tilde.Offset.Y;
     inc(iy,tilde.OffsetZ);
     if z=0 then begin
      dec(rx,ix);
      inc(ry,iy);
     end;
     case Tilde.R10 of
      1:flags:=[ifSwap];
      2:flags:=[ifFlip];
      3:flags:=[ifSwap,ifFlip];
      else flags:=[];
     end;
     if Tilde.DrawMode=dmAlpha then include(flags,ifBlend);

     img:=findImage(tilde.MajorID,lba,dx,dy,base);
     if (img>=0) then begin
      if z=0 then begin
      {
       rx:=+(x-y)*48-ix;
       ry:=-(x+y)*24+iy; }
       ix:=rx-dx;
       iy:=ry+dy;
       map.AddImage(ix,iy,img,Base,Flags);
      end else begin
      {
       inc(ix,rx-dx);
       inc(iy,ry-dy); }
       ix:=rx-dx-ix;
       iy:=ry+dy+iy;
       imagelist.Add(map.NewImage(ix,iy,img,Base,Flags));
      end;
     end;
     inc(z);
    end;
   end;
  end;
  for x:=0 to imagelist.count-1 do map.Add(imagelist[x]);
  imagelist.clear;
//--  ADKMap1.SaveToFile(ExtractFilePath(Application.ExeName)+ChangeFileExt(ExtractFileName(FileName),'.MAP'));
  if getInteger(ma2)<>0 then begin
   ShowMessage('cette carte comprend des "Zonages" non support閟');
  end else begin
   if ma2.position<>ma2.size then error('fin du flux non atteinte '+IntToStr(ma2.position)+'/'+IntTostr(ma2.size));
  end;
  result:=ChangeFileExt(AFileName,'.ADK');
  map.SaveToFile(result);
 finally
  ma2.Free;
  map.Free;
  if lba<>nil then begin
   for x:=0 to lba.Count-1 do dispose(lba[x]);
   lba.Free;
  end;
 end;
end;

end.